CTITLESAFRQP -- VARIAN FRAN/FREQ TRACE/POWER/AMP/PHASE PLOTS 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C INDSAFRQP 00020000 CA AUTHOR STEVE SVATEK 00030000 CA DESIGNER STEVE SVATEK 00040000 CA LANGUAGE FORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 CA WRITTEN 06-25-80 00070000 C REVISED MO-DA-YR BY PROGRAMMER - DESCRIPTION OF CHANGE. 00080000 C REVISED 04-14-81 BY DJP - CHANGED PLOTTING CALLS FOR IMPLEM- 00090000 C ENTATION OF THE LOGIC ASSOCIATES SOFTWARE. 00100000 C REVISED 02-12-82 BY JBC - PLOT COMPLETE GRID 00110000 C FOR POWER SPECTRUM 00120000 C REVISED 04-14-82 BY CMP - ADDED UPPER FREQUENCY LIMIT TO PLOT00130000 C REVISED 01-24-86 BY ESN - FOR CRAY COMPATABILITY. 00140000 C REVISED 11-06-87 BY JJC - ADDED RELATIVE AND REFERENCE 00141000 C AMPLITUDE SPECTRUM PLOT IN DB. 00142000 C REVISED 11-04-88 BY MCD - ADDED MIN/MAX DB VALUES FOR THE 00143000 C AMPLITUDE SPECTRUM PLOT IN DB. 00144000 C REVISED 02-08-89 BY LWC - CORRECTED SOME SCALING PROBLEMS. 00145001 C PLOT ACTUAL POWER VALUE AT DB GRID 00145101 C LINES. 00145201 C REVISED 11-13-89 BY RDK - FOR CRAY CFT77 COMPATIBILITY. 00145302 C 00146001 CA 00150000 CA CALL SAFRQP(BUF, NPTS, ITYPE, IWST, IWEND, ISAMP, XCORD, 00160000 CA YCORD, NFRQ, F, MINDB, MAXDB, IPR) 00170000 CA 00180000 CA INPUT BUF = INPUT DATA ARRAY R4 00190000 CA INPUT NPTS = NO. POINTS IN INPUT DATA ARRAY I4 00200000 CA INPUT ITYPE = TYPE OF PLOT I4 00210000 CA 1 => TRACE PLOT 00220000 CA 2 => POWER SPECTRUM 00230000 CA 3 => RELATIVE AMP SPECTRUM 00240000 CA 4 => PHASE PLOT 00250000 CA 5 => RELATIVE AMP SPECTRUM IN DB 00251000 CA 6 => REFERENCE AMPLITUDE SPECTRUM (DB) 00252000 CA INPUT IWST = TRACE WINDOW START TIME (MS) I4 00260000 CA INPUT IWEND = TRACE WINDOW END TIME (MS) I4 00270000 CA INPUT ISAMP = TRACE SAMPLE RATE I4 00280000 CA INPUT XCORD = BEGINNING X COORD OF E OF TRACE R4 00290000 CA INPUT YCORD = BEGINNING Y COORDINATE OF TRACE R4 00300000 CA INPUT NFRQ = UPPER FREQUENCY LIMIT TO PLOT I4 00310000 CA INPUT F = FREQUENCY INCREMENT IN ARRAY R4 00320000 CA INPUT MINDB = MINIMUM DB VALUE FOR AMP.SPECTRUM PLOT R4 00321000 CA INPUT MAXDB = MAXIMUM DB VALUE FOR AMP.SPECTRUM PLOT R4 00322000 CA INPUT IPR = INTERNAL PRINT UNIT I4 00330000 CA 00340000 CA 00350000 CA THIS ROUTINE BUILDS CALCOMP/VARIAN COMMANDS FOR ONE OF FOUR 00360000 CA FREQUENCY ANANLYSIS PLOTS. THE SIZE OF THE FOUR PLOTS IS 00370000 CA CURRENTLY CANNED. 00380000 CA 00390000 CA (1) TRACE PLOT -- FULL OR WINDOW WIGGLE TRACE PLOT 00400000 CA AT 2 TR/IN AND 4 IN/SEC. 00410000 CA 00420000 CA (2) POWER SPECTRUM -- A 5 X 12 INCH POWER SPECTRUM PLOT 00430000 CA IN -DB VS FREQUENCY. 00440000 CA 00450000 CA (3) AMP SPECTRUM -- A 5 X 12 INCH AMPLITUDE SPECTRUM 00460000 CA PLOT IN AMPLITUDE VS FREQUENCY. 00470000 CA 00480000 CA (4) PHASE PLOT -- A 5 X 12 INCH PHASE PLOT IN DEGREES 00490000 CA VS FREQUENCY. 00500000 CA 00510000 CAEND 00520000 C 00530000 C EJECT 00540000 C 00550000 SUBROUTINE SAFRQP (BUF, NPTS, ITYPE, IWST, IWEND, ISAMP, 00560000 * XCORD, YCORD, NFRQ, F, MINDB, MAXDB, IPR) 00570000 C 00580000 IMPLICIT INTEGER (A-Z) 00590000 C 00600000 C REAL ARRAYS IN PARAMETER LIST. 00610000 C 00620000 REAL BUF (1) 00630000 C 00640000 C REAL VARIABLES IN PARAMETER LIST. 00650000 C 00660000 REAL XCORD 00670000 REAL YCORD 00680000 REAL MINDB 00681000 REAL MAXDB 00682000 C 00690000 C EXTERNAL S1ATP 00700001 C 00710000 C REAL VARIABLES AND CONSTANTS--LOCAL (INTERNAL 00720000 C TO SUBROUTINE). 00730000 C 00740000 REAL F 00750000 REAL X 00760000 REAL Y 00770000 REAL X1 00780000 REAL Y1 00790000 REAL X2 00800000 REAL Y2 00810000 REAL XLEN 00820000 REAL YLEN 00830000 REAL AA 00840000 REAL BB 00850000 REAL CC 00860000 REAL TIC 00870000 REAL CHT 00880000 REAL AMIN 00890000 REAL AMIN1 00891000 REAL AMAX 00900000 REAL ARMSPK 00910000 REAL ASCAL1 00920000 REAL ASCAL2 00930000 REAL TRCIPS 00940000 REAL TRCPIN 00950000 REAL XINC 00960000 REAL YINC 00970000 REAL SI 00981000 REAL XGRID 00990000 REAL YGRID 01000000 REAL TVAL 01001001 REAL TVAL1 01002001 C 01010000 CHARACTER*12 CTVAL 01010101 C 01010201 IF (1.EQ.2) CALL S1ATP 01010301 C 01011001 SCLFLG = 1 01020000 NP = NPTS 01021000 SI = ISAMP 01030000 X = XCORD 01040000 Y = YCORD 01050000 AMIN = 999999999. 01060000 AMAX = -999999999. 01070000 CM 01071000 IF (MINDB .EQ. 0.0 .AND. MAXDB .EQ. 0.0) SCLFLG = 0 01072000 C 01080000 C GET INPUT ARRAY MIN / MAX 01090000 C 01100000 DO 10 01110000 * I = 1, NP 01120000 IF (BUF(I) .LT. AMIN) THEN 01130000 AMIN = BUF(I) 01131000 LMIN = I 01132000 ENDIF 01133000 IF (BUF(I) .GT. AMAX) AMAX = BUF(I) 01140000 C 01150000 10 CONTINUE 01160000 C 01161000 C TO REDUCE THE SCALE WHICH IS ENLARGED BY APPLYING DC 01162000 C COMPONENT REMOVAL, SET UP THE DIFFERENCE BETWEEN THE LAST 01163000 C TWO MINIMUM VALUES TO ZERO FOR BETTER SCALE IF THE 01164000 C DIFFERENCE IS LARGER THAN 50. 01164100 C 01165000 IF (ITYPE .EQ. 5 .OR. ITYPE .EQ. 6) THEN 01165100 AMIN1 = 999999999. 01166000 DO 15 01167000 * I = 1, NP 01168000 IF (I .NE. LMIN .AND. BUF(I) .LT. AMIN1) AMIN1 = BUF(I) 01169000 15 CONTINUE 01169100 IF ( ABS( AMIN - AMIN1 ) .GE. 50. ) THEN 01169300 BUF(LMIN) = AMIN1 01169400 AMIN = AMIN1 01169500 ENDIF 01169600 ENDIF 01170000 C 01171000 C CHECK PLOT TYPE 01180000 C 01190000 IF (ITYPE .GT. 1) GO TO 60 01200000 C 01210000 C ***************************** 01220000 C ITYPE = 1 -- TRACE PLOT 01230000 C ***************************** 01240000 C 01250000 20 CONTINUE 01260000 C 01270000 TRCIPS = 4.0 01280000 TRCPIN = 2.0 01290000 XINC = (TRCIPS * SI) / 1000. 01300000 C 01310000 C DRAW BOX AND TRACE AXIS 01320000 C 01330000 XLEN = (IWEND - IWST) 01340000 XLEN = XLEN / 1000. * TRCIPS 01350000 YLEN = 2.0 01360000 X1 = X + XLEN 01370000 Y1 = Y + YLEN 01380000 Y2 = Y + (YLEN / 2.0) 01390000 C 01400000 CALL PLOT (X, Y, 3) 01410000 CALL PLOT (X1, Y, 2) 01420000 CALL PLOT (X1, Y1, 2) 01430000 CALL PLOT (X, Y1, 2) 01440000 CALL PLOT (X, Y, 2) 01450000 C 01460000 CALL PLOT (X, Y2, 3) 01470000 CALL PLOT (X1, Y2, 2) 01480000 C 01490000 C PLOT BOX LABEL 01500000 C 01510000 Y1 = Y2 - .65 01520000 CALL SYMBOL (X-.1, Y1, .14, 'INPUT TRACE', 90., 11) 01530000 C 01540000 C PLOT TIME ANNOTATION AND TIC MARKS 01550000 C 01560000 X1 = X 01570000 Y1 = Y 01580000 ICNT = -1 01590000 IW = IWST 01600000 IWINC = 200 01610000 NCHR = 3 01620000 IF (IW/10*10 .EQ. IW) NCHR = 2 01630000 IF (IW/100*100 .EQ. IW) NCHR = 1 01640000 C 01650000 30 ICNT = ICNT + 1 01660000 TIC = .1 01670000 CHT = .07 01680000 IF (ICNT/5*5 .NE. ICNT) GO TO 40 01690000 TIC = .2 01700000 CHT = .14 01710000 C 01720000 40 AA = IW 01730000 AA = AA / 1000. 01740000 NCH = NCHR + 2 01750000 IF (AA .GT. 10.) NCH = NCHR + 3 01760000 C 01770000 BB = NCH 01780000 X2 = X1 + (CHT / 2.0) 01790000 Y2 = Y1 - (CHT * BB + TIC) 01800000 C 01810000 CALL NUMBER (X2, Y2, CHT, AA, 90., NCHR) 01820000 CALL PLOT (X1, Y1-TIC, 3) 01830000 CALL PLOT (X1, Y1, 2) 01840000 C 01850000 BB = IWINC 01860000 X1 = X1 + (IWINC / 1000. * TRCIPS) 01870000 IW = IW + IWINC 01880000 IF (IW .LE. IWEND) GO TO 30 01890000 C 01900000 C COMPUTE TRACE ROOT MEAN SQUARE PEAK AMP 01910000 C 01920000 CALL ARSQM (BUF, ARMSPK, NP, NP) 01930000 ARMSPK = SQRT(ARMSPK) /.707 01940000 C 01950000 IF (ARMSPK .EQ. 0.) ASCAL1 = 0.0 01960000 IF (ARMSPK .GT. 0.) ASCAL1 = 1.0 / (TRCPIN * ARMSPK) 01970000 C 01980000 C PLOT WIGGLE TRACE 01990000 C 02000000 X1 = X 02010000 Y1 = Y + (YLEN/2.) 02020000 Y2 = Y1 + (BUF(1) * ASCAL1) 02030000 CALL PLOT (X1, Y2, 3) 02040000 C 02050000 DO 50 02060000 * I = 2, NP 02070000 C 02080000 X1 = X1 + XINC 02090000 AA = BUF(I) 02100000 IF (AA .GT. ARMSPK) AA = ARMSPK 02110000 IF (AA .LT. -ARMSPK) AA = -ARMSPK 02120000 Y2 = Y1 + (AA * ASCAL1) 02130000 CALL PLOT (X1, Y2, 2) 02140000 C 02150000 50 CONTINUE 02160000 C 02170000 GO TO 200 02180000 C 02190000 C ITYPE = 2/3/4 -- FREQUENCY PLOT 02200000 C 02210000 60 CONTINUE 02220000 C 02230000 XLEN = 5.0 02240000 YLEN = 12.0 02250000 X1 = X + XLEN 02260000 XGRID = X1 02270000 IF (ITYPE .EQ. 2) XGRID = X 02280000 Y1 = Y + YLEN 02290000 YGRID = Y1 02300000 NFREQ = 1000 / (2 * ISAMP) 02310000 IF (NFRQ .LT. NFREQ .AND. NFRQ .NE. 0) NFREQ = NFRQ 02320000 IFRINC = 5 02330000 IF (NFREQ .GE. 125) IFRINC = 10 02340000 IF (NFREQ .GE. 250) IFRINC = 20 02350000 IF (NFREQ .GE. 500) IFRINC = 50 02360000 AA = NP - 1 02370000 YINC = YLEN / NFREQ 02380000 ASCAL1 = YINC*F 02390000 C 02400000 C DRAW FREQUENCY BOX 02410000 C 02420000 CALL PLOT (X, Y, 3) 02430000 CALL PLOT (X1, Y, 2) 02440000 CALL PLOT (X1, Y1, 2) 02450000 CALL PLOT (X, Y1, 2) 02460000 CALL PLOT (X, Y, 2) 02470000 C 02480000 C DRAW FREQUENCY ANNOTATION AND TICS 02490000 C 02500000 Y1 = Y 02510000 IFREQ = 0 02520000 C 02530000 70 CALL PLOT (XGRID, Y1, 3) 02540000 CALL PLOT (X1+.1, Y1, 2) 02550000 C 02560000 NCH = 3 02570000 IF (IFREQ .GE. 10) NCH =4 02580000 IF (IFREQ .GE. 100) NCH = 5 02590000 AA = NCH 02600000 X2 = X1 + .3 02610000 Y2 = Y1 - (AA * .14 / 2.0) 02620000 AA = IFREQ 02630000 C 02640000 CALL NUMBER (X2, Y2, .14, AA, 90., 1) 02650000 C 02660000 IFREQ = IFREQ + IFRINC 02670000 Y1 = Y + (IFREQ * YINC) 02680000 IF (IFREQ .LE. NFREQ) GO TO 70 02690000 C 02700000 X2 = X + XLEN + .6 02710000 Y2 = Y + (YLEN / 2.0 - .55) 02720000 CALL SYMBOL (X2, Y2, .14, 'FREQUENCY', 90., 9) 02730000 C 02740000 C CHECK TYPE FREQUENCY PLOT 02750000 C 02760000 GO TO ( 200 , 80 , 110 , 140 , 80, 170 ), ITYPE 02770000 C 02780000 C ***************************** 02790000 C ITYPE = 2 -- POWER SPECTRUM 02800000 C ***************************** 02810000 C 02810100 C ******************************************** 02811000 C ITYPE = 5 -- REL. AMPLITUDE SPECTRUM IN DB 02812000 C ******************************************** 02813000 C 02820000 80 IF (ITYPE .EQ. 2) THEN 02821000 X1 = X - .2 02830000 Y1 = Y + (YLEN / 2.0 - .85) 02840000 CALL SYMBOL (X1, Y1, .14, 'POWER SPECTRUM', 90., 14) 02850000 ELSE 02851000 X1 = X - .2 02852000 Y1 = Y + (YLEN / 2.0 - 1.05) 02853000 CALL SYMBOL (X1, Y1, .14, 'AMPLITUDE SPECTRUM', 90., 18) 02854000 ENDIF 02855000 C 02860000 Y1 = Y - 1.0 02880000 IF (ITYPE .EQ. 2) THEN 02881000 X1 = X + (XLEN / 2.0 + .2) 02882000 CALL SYMBOL (X1, Y1, .14, '-DB', 180., 3) 02890000 C 02890101 X1 = X + (XLEN / 2.0 + .71) 02890201 Y1 = YGRID + 2.08 02890301 CALL SYMBOL (X1, Y1, .14, 'POWER VALUE', 180., 11) 02890401 C 02890601 ELSE 02891000 X1 = X + (XLEN / 2.0 + .9) 02891100 CALL SYMBOL (X1, Y1, .14,'REL. AMP. (-DB)', 180.,15) 02892000 ENDIF 02893000 CM 02893100 CD 02901000 C WRITE(IPR,*)'AMAX/AMIN AFTER 80:',AMAX,AMIN 02902001 CD 02903000 CC = AMAX 02903100 IF (ITYPE .NE. 2 .AND. SCLFLG .EQ. 1) THEN 02904000 AMAX = MAXDB 02905000 AMIN = MINDB 02906000 END IF 02907000 CM 02908000 CHT = .14 02910000 N = AMAX - AMIN + .999 02920000 INC = 6 02930000 IF (N .GT. 36) INC = 12 02940000 NDB = ((N + INC - 1) / INC) + 1 02950000 XINC = INC 02960000 CM 02971000 IF (ITYPE .EQ. 2 .OR. SCLFLG .EQ. 0) THEN 02972000 C 02972101 AMIN = (NDB - 1) * INC * (-1) 02974101 AMAX = 0.0 02974201 C 02974301 END IF 02975000 CM 02994000 ASCAL2 = XLEN / (AMAX - AMIN) 03000000 C AA = 0.0 03011100 C 03011201 AA = ABS(AMAX) 03011401 C 03011501 CD 03011600 C WRITE(IPR,*)'AA/AMAX/AMIN/NDB AFTER 80:',AA,AMAX,AMIN,NDB 03011701 CD 03011800 C 03020000 TVAL = CC 03021001 C 03022001 DO 90 03030000 * I = 1, NDB 03040000 BB = 3.0 03050000 IF (AA .GT. 10.) BB = 4.0 03060000 X1 = X + ((I - 1) * XINC * ASCAL2) 03070000 X2 = X1 + (CHT / 2.0) 03080000 Y1 = Y - (BB * CHT + .2) 03090000 C 03100000 CALL NUMBER (X2, Y1, CHT, AA, 90., 1) 03110000 CALL PLOT (X1, Y-.2, 3) 03120000 IF (ITYPE .EQ. 2) CALL PLOT (X1, YGRID+.2, 2) 03130001 C 03130101 IF (ITYPE .EQ. 2) THEN 03130201 TVAL1 = 10. **(TVAL /10.0) 03130301 WRITE (CTVAL, FMT=9000) TVAL1 03130401 9000 FORMAT ( E12.4) 03130501 Y1 = YGRID + .3 03130601 CALL SYMBOL (X2, Y1, CHT, CTVAL, 90., 12) 03131101 TVAL = TVAL - XINC 03132001 ENDIF 03133001 C 03140001 AA = AA + XINC 03150000 C 03160000 90 CONTINUE 03170000 C 03180000 CD 03190100 C WRITE(IPR,*)'SCLFLG/AA/I/NDB/AMAX AFTER 95:',SCLFLG,AA,I,NDB,AMAX 03190201 CD 03190300 X1 = X 03191000 Y1 = Y 03200000 C 03200101 IF (ITYPE .EQ. 2) THEN 03200501 AA = BUF(1) - CC 03200601 ELSE 03200701 TVAL = BUF(1) 03200801 IF (TVAL .GT. AMAX) TVAL = AMAX 03200901 IF (TVAL .LT. AMIN) TVAL = AMIN 03201001 AA = TVAL - AMAX 03201101 ENDIF 03201201 X2 = X1 + (-1)*(AA * ASCAL2) 03210101 C 03210201 CD 03211000 C WRITE(IPR,*)'X1/X2/Y1/AA/SCAL/NDB AFTER 90:',X1,X2,Y1,AA,SCAL,NDB 03212001 CD 03213000 C 03220000 CALL PLOT (X2, Y1, 3) 03230000 C 03240000 DO 100 03250000 * I = 2, NP 03260000 C 03261001 IF (ITYPE .EQ. 2) THEN 03262001 AA = BUF(I) - CC 03263001 ELSE 03264001 TVAL = BUF(I) 03264101 IF (TVAL .GT. AMAX) TVAL = AMAX 03264201 IF (TVAL .LT. AMIN) TVAL = AMIN 03264301 AA = TVAL - AMAX 03265001 ENDIF 03266001 C 03268001 X2 = X1 + (-1)*(AA * ASCAL2) 03275201 Y2 = Y1 + ((I-1) * ASCAL1) 03290000 CD 03301000 C WRITE(IPR,*)'AA/X2/Y2/BUF(I)/I/CC IN DO 100:',AA,X2,Y2, 03302001 C * BUF(I),I,CC 03303001 CD 03304000 CALL PLOT (X2, Y2, 2) 03310000 C 03320000 100 CONTINUE 03330000 C 03340000 GO TO 200 03350000 C 03360000 C ************************************** 03370000 C ITYPE = 3 -- REL. AMPLITUDE SPECTRUM 03380000 C ************************************** 03390000 C 03400000 110 X1 = X - .2 03410000 Y1 = Y + (YLEN / 2.0 - 1.05) 03420000 CALL SYMBOL (X1, Y1, .14, 'AMPLITUDE SPECTRUM', 90., 18) 03430000 C 03440000 X1 = X + (XLEN / 2. + .75) 03450000 Y1 = Y - 1.0 03460000 CALL SYMBOL (X1, Y1, .14, 'REL AMPLITUDE', 180., 13) 03470000 C 03480000 CHT = .14 03490000 BB = AMAX 03500000 AMIN = 0.0 03510000 AMAX = 1.0 03520000 XINC = -0.5 03530000 ASCAL2 = XLEN / (AMAX - AMIN) 03540000 AA = 1.0 03550000 C 03560000 DO 120 03570000 * I = 1,3 03580000 X1 = X - ((I-1) * XINC * ASCAL2) 03590000 X2 = X1 + (CHT / 2.0) 03600000 Y1 = Y - (3.0 * CHT + .2) 03610000 C 03620000 CALL NUMBER (X2, Y1, CHT, AA, 90., 1) 03630000 CALL PLOT (X1, Y-.2, 3) 03640000 CALL PLOT (X1, Y, 2) 03650000 C 03660000 AA = AA + XINC 03670000 C 03680000 120 CONTINUE 03690000 C 03700000 C X1 = X + XLEN 03710000 Y1 = Y 03720000 AA = BUF(I) / BB 03730000 X2 = X1 - (AA * ASCAL2) 03740000 CALL PLOT (X2, Y1, 3) 03750000 C 03760000 DO 130 03770000 * I = 2, NP 03780000 C 03790000 AA = BUF(I) / BB 03800000 X2 = X1 - (AA * ASCAL2) 03810000 Y2 = Y1 + ((I-1) * ASCAL1) 03820000 C 03830000 CALL PLOT (X2, Y2, 2) 03840000 C 03850000 130 CONTINUE 03860000 C 03870000 GO TO 200 03880000 C 03890000 C ************************* 03900000 C ITYPE = 4 -- PHASE PLOT 03910000 C ************************* 03920000 C 03930000 140 X1 = X - .2 03940000 Y1 = Y + (YLEN / 2.0 - .6) 03950000 CALL SYMBOL (X1, Y1, .14, 'PHASE PLOT', 90., 10) 03960000 C 03970000 X1 = X + (XLEN / 2.0 + .45) 03980000 Y1 = Y - 1.0 03990000 CALL SYMBOL (X1, Y1, .14, 'DEGREES', 180., 7) 04000000 C 04010000 CHT = .14 04020000 BB = AMAX 04030000 IF (-AMIN .GT. AMAX) BB = -AMIN 04040000 AMIN = -180. 04050000 AMAX = 180. 04060000 ASCAL2 = XLEN / (AMAX - AMIN) 04070000 XINC = -90. 04080000 AA = 180. 04090000 C 04100000 DO 150 04110000 * I = 1, 5 04120000 IF (I .EQ. 1) NCH = 5 04130000 IF (I .EQ. 2) NCH = 4 04140000 IF (I .EQ. 3) NCH = 3 04150000 IF (I .EQ. 4) NCH = 5 04160000 IF (I .EQ. 5) NCH = 6 04170000 C 04180000 X1 = X - ((I-1) * XINC * ASCAL2) 04190000 X2 = X1 + (CHT / 2.0) 04200000 Y1 = Y - (NCH * CHT + .2) 04210000 Y2 = Y 04220000 IF (I .EQ. 3) Y2 = Y + YLEN 04230000 C 04240000 CALL NUMBER (X2, Y1, CHT, AA, 90., 1) 04250000 CALL PLOT (X1, Y-.2, 3) 04260000 CALL PLOT (X1, Y2, 2) 04270000 C 04280000 AA = AA + XINC 04290000 C 04300000 150 CONTINUE 04310000 C 04320000 X1 = X + XLEN 04330000 Y1 = Y 04340000 AA = BUF(1) - AMIN 04350000 X2 = X1 - (AA * ASCAL2) 04360000 CALL PLOT (X2, Y1, 3) 04370000 C 04380000 DO 160 04390000 * I = 2, NP 04400000 C 04410000 AA = BUF(I) - AMIN 04420000 X2 = X1 - (AA * ASCAL2) 04430000 Y2 = Y1 + ((I-1) * ASCAL1) 04440000 C 04450000 CALL PLOT (X2, Y2, 2) 04460000 C 04470000 160 CONTINUE 04480000 GO TO 200 04480100 C 04481000 C ******************************************* 04482000 C ITYPE = 6 -- REFERENCE AMPLITUDE SPECTRUM 04483000 C ******************************************* 04484000 C 04485000 170 X1 = X - .2 04486000 Y1 = Y + (YLEN / 2.0 - 1.05) 04487000 CALL SYMBOL (X1, Y1, .14, 'AMPLITUDE SPECTRUM', 90., 18) 04488000 C 04489000 X1 = X + (XLEN / 2. + .85) 04489100 Y1 = Y - 1.2 04489200 CALL SYMBOL (X1, Y1, .14, 'REF. AMP. (DB)', 180., 14) 04489300 CM 04489400 IF (SCLFLG .EQ. 1) THEN 04489500 AMAX = MAXDB 04489600 AMIN = MINDB 04489700 END IF 04489800 CM 04489900 CHT = .14 04490000 N = AMAX - AMIN + .999 04490100 INC = -6 04490200 IF (N .GT. 60) INC = -18 04490300 XINC = INC 04490400 CM 04490500 IF (SCLFLG .EQ. 0) THEN 04490600 IF (AMAX .GT. 0.) MAX = (INT(AMAX / INC) - 1) * INC 04490700 IF (AMAX .LT. 0.) MAX = (INT(AMAX / INC)) * INC 04490800 IF (AMIN .GT. 0.) MIN = (INT(AMIN / INC)) * INC 04490900 IF (AMIN .LT. 0.) MIN = (INT(AMIN / INC) + 1) * INC 04491000 AMAX = MAX 04491100 AMIN = MIN 04491200 END IF 04491600 CM 04492200 NDB = INT(((AMIN - AMAX) / INC )) + 1 04492301 ASCAL2 = XLEN / (AMIN - AMAX) 04492600 AA = AMAX 04492700 CD 04492800 C WRITE(IPR,*)'AMAX/AMIN/ASCAL2/XLEN/NDB AFTER 170:',AMAX, 04492901 C * AMIN,ASCAL2,XLEN,NDB 04493001 CD 04493100 C 04493200 DO 180 04493300 * I = 1,NDB 04493400 BB = 3.0 04493500 IF (AA .GT. 10.) BB = 4.0 04493600 IF (AA .GT. 100.) BB = 5.0 04493700 IF (AA .LT. 0. .AND. AA .GT. -10.) BB = 4.0 04493800 IF (AA .LT. -10.) BB = 5.0 04493900 IF (AA .LT. -100.) BB = 6.0 04494000 X1 = X + ((I-1) * XINC * ASCAL2) 04494100 X2 = X1 + (CHT / 2.0) 04494200 Y1 = Y - (BB * CHT + .2) 04494300 C 04494400 CALL NUMBER (X2, Y1, CHT, AA, 90., 1) 04494800 CALL PLOT (X1, Y-.2, 3) 04494900 CALL PLOT (X1, Y, 2) 04495000 C 04495100 AA = AA + XINC 04495200 C 04495300 180 CONTINUE 04495400 X1 = X 04495900 Y1 = Y 04496000 C 04496101 TVAL = BUF(1) 04496201 IF (TVAL .GT. AMAX) TVAL = AMAX 04496301 IF (TVAL .LT. AMIN) TVAL = AMIN 04496401 X2 = X1 + ((TVAL - AMAX) * ASCAL2) 04496701 C 04496901 CALL PLOT (X2, Y1, 3) 04497000 C 04497100 DO 190 04497200 * I = 2, NP 04497300 C 04497400 TVAL = BUF(I) 04497601 IF (TVAL .GT. AMAX) TVAL = AMAX 04497701 IF (TVAL .LT. AMIN) TVAL = AMIN 04497801 AA = TVAL - AMAX 04497901 C 04498001 X2 = X1 + (AA * ASCAL2) 04498600 Y2 = Y1 + ((I-1) * ASCAL1) 04498700 CALL PLOT (X2, Y2, 2) 04498800 C 04498900 CD 04499000 C WRITE(IPR,*)'AA/X2/Y2/BUF(I)/I IN DO 190:',AA,X2,Y2,BUF(I),I 04499101 CD 04499200 190 CONTINUE 04499300 C 04499400 C PLOT COMPLETED 04500000 C 04510000 200 RETURN 04520000 C 04530000 END 04540000