CTITLESAFANF -- PRINT ANALYSIS FOR FAN FILTER 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RALPH MCMILLAN 00000200 CA DESIGNER RALPH MCMILLAN 00000300 CA LANGUAGE FORTRAN 00000400 CA SYSTEM IBM AND CRAY 00000500 CA WRITTEN 06-30-76 00000600 C REVISED 11-18-81 STU NELAN - FOR THE CRAY. 00000700 C REVISED 12-06-84 LBL. MADE SURE THIS CODE RAN ON IBM AND 00000800 C CRAY. 00000900 C REVISED 11-13-89 KNIGHT - FOR CRAY CFT77 COMPATIBILITY. 00001002 CA 00001100 CA 00001200 CA CALL SAFANF (X, N, MAX, MIN, FREQ, CLIP, IPR) 00001300 CA INPUT X = FLOATING POINT INPUT ARRAY. R4 00001400 CA INPUT N = NUMBER OF ELEMENTS IN X. I4 00001500 CA INPUT MAX = MAXIMUM VALUE IN X. R4 00001600 CA INPUT MIN = MINIMUM VALUE IN X. R4 00001700 CA INPUT FREQ = VALUE TO BE PRINTED ON LEFT AXIS. R4 00001800 CA INPUT CLIP = CLIPPING PERCENTAGE. R4 00001900 CA INPUT IPR = PRINTER UNIT. I4 00002000 CA 00002100 CA 00002200 CA THIS ROUTINE PRINTS THE ANALYSIS PLOT FOR THE FAN FILTER 00002300 CA PROCESS. ONE LINE AT A TIME IS PASSED IN THE ARRAY "X". THE 00002400 CA VALUES ARE THEN SCALED BASED ON "MAX" AND "MIN" AND UP TO 127 00002500 CA VALUES ARE PRINTED IN THE HORIZONTAL DIRECTION. THE SCALED 00002600 CA VALUES ARE BETWEEN 1 AND 9 IF "N" IS GREATER THAN 42 AND BETWEEN 00002700 CA 1 AND 99 IF "N" IS LESS THAN OR EQUAL TO 42. 00002800 CA 00002900 CA THE CALLING PROGRAM IS RESPONSIBLE FOR THE TITLE. 00003000 CA 00003100 C EJECT 00003200 C 00003300 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). 00003400 C 00003500 C LINE ( 127) = HOLDS ONE PRINT LINE IN CHARACTER FORM. I4 00003600 C 00003700 C 00003800 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00003900 C 00004000 C A = TEMPORARY VALUE USED FOR AVERAGING R4 00004100 C B = TEMPORARY VALUE USED FOR AVERAGING R4 00004200 C BLANK = ONE WORD OF BLANK CHARACTERS I4 00004300 C CLIPV = SCALED VALUED FOR CLIPPING (= CLIP * IMAX) I4 00004400 C CNT = NUMBER OF CHARACTERS IN SCALED VALUES I4 00004500 C IMAX = MAXIMUM SCALED VALUE (EITHER 9 OR 99) I4 00004600 C INC = INCREMENT TO KEEP NUMBER OF POINTS .LE. 120 I4 00004700 C POINT = ONE WORD OF '.' CHARACTERS I4 00004800 C SCALE = SCALING FACTOR R4 00004900 C TEMP = TEMPORARY SCALED VALUE I4 00005000 C 00005100 C EJECT 00005200 SUBROUTINE SAFANF (X, N, MAX, MIN, FREQ, CLIP, IPR) 00005300 C 00005400 IMPLICIT INTEGER (A-Z) 00005500 C 00005600 C 00005700 C REAL ARRAYS IN PARAMETER LIST. 00005800 REAL X (1) 00005900 C 00006000 C 00006100 C REAL VARIABLES IN PARAMETER LIST. 00006200 REAL CLIP 00006300 REAL FREQ 00006400 REAL MAX 00006500 REAL MIN 00006600 C 00006700 C 00006800 C INTEGER ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 00006900 INTEGER LINE ( 127) 00007000 C 00007100 C 00007200 C REAL VARIABLES AND CONSTANTS--LOCAL (INTERNAL TO SUBROUTINE). 00007300 REAL A 00007400 REAL B 00007500 REAL SCALE 00007600 C 00007700 C 00007800 C INTEGER VARIABLES AND CONSTANTS--LOCAL (INTERNAL TO SUBROUTINE). 00007900 INTEGER BLANK 00008000 DATA BLANK /' '/ 00008100 C 00008200 C EJECT A NEW PAGE MAY BE DESIRABLE HERE. PUT EJECT IN COL. 7. 00008300 C 00008400 IMAX = 99 00008500 CNT = 2 00008600 IF (N .LE. 42) GO TO 10 00008700 IMAX = 9 00008800 CNT = 1 00008900 C 00009000 10 SCALE = IMAX / (MAX - MIN) 00009100 C 00009200 DO 20 00009300 * I = 1, 127 00009400 LINE(I) = BLANK 00009500 C 00009600 20 CONTINUE 00009700 C 00009800 INC = 1 00009900 IF (N .GT. 128) INC = (N + 127) / 128 00010000 K = 1 00010100 J = N / 2 00010200 CLIPV = CLIP * IMAX + 0.5 00010300 C 00010400 C SCALE MID-POINT 00010500 C 00010600 IF (X(1) .EQ. 0.) GO TO 40 00010700 TEMP = INT((X(1) - MIN) * SCALE + 0.5) 00010801 IF (TEMP .LT. CLIPV) GO TO 40 00010900 IF (TEMP .LE. 9 .AND. N .LE. 42) GO TO 30 00011000 CALL S1BNCV (TEMP, LINE(64), 1, CNT) 00011100 GO TO 40 00011200 C 00011300 30 CALL S1BNCV (TEMP, LINE(64), 2, 1) 00011400 C 00011500 40 DO 100 00011600 * I = 2, J, INC 00011700 A = 0. 00011800 B = 0. 00011900 C 00012000 DO 50 00012100 * I1 = 1, INC 00012200 A = A + X(I + I1 - 1) 00012300 B = B + X(N + 3 - I - I1) 00012400 C 00012500 50 CONTINUE 00012600 C 00012700 IF (A .EQ. 0.) GO TO 70 00012800 TEMP = INT((A / INC - MIN) * SCALE + 0.5) 00012901 IF (TEMP .LT. CLIPV) GO TO 70 00013000 IF (TEMP .LE. 9 .AND. N .LE. 42) GO TO 60 00013100 CALL S1BNCV (TEMP, LINE(64-K), 1, CNT) 00013200 GO TO 70 00013300 C 00013400 60 CALL S1BNCV (TEMP, LINE(64-K), 2, 1) 00013500 C 00013600 70 IF (B .EQ. 0.) GO TO 90 00013700 TEMP = (B / INC - MIN) * SCALE + 0.5 00013800 IF (TEMP .LT. CLIPV) GO TO 90 00013900 IF (TEMP .LE. 9 .AND. N .LE. 42) GO TO 80 00014000 CALL S1BNCV (TEMP, LINE(64+K), 1, CNT) 00014100 GO TO 90 00014200 C 00014300 80 CALL S1BNCV (TEMP, LINE(64+K), 2, 1) 00014400 C 00014500 90 K = K + 1 00014600 C 00014700 100 CONTINUE 00014800 C 00014900 IF (N .LE. 42) WRITE (IPR, 9000 ) FREQ, (LINE(I), I=44,84) 00015000 IF (N .GT. 42) WRITE (IPR, 9010 ) FREQ, (LINE(I), I=1,127) 00015100 C 00015200 RETURN 00015300 C 00015400 C 00015500 9000 FORMAT (1X,F4.0,1X,41A3) 00015600 C 00015700 9010 FORMAT (1X,F4.0,1X,127A1) 00015800 END 00015900