CTITLESACNAX -- DISPERSION ANALYSIS OF COHERENT NOISE 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR L. B. LIN 00020000 CA DESIGNER L. B. LIN 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN JUNE, 1985 00060000 C REVISED 10-28-85 LBL. - "DSNUM" CHANGED INTO INTEGER FROM 00070000 C CHAR*8. 00080000 C UPGRADE ANNOTATION AT UPPER BOUNDARY 00090000 C OF PLOTS. 00100000 C REVISED 11-19-85 WCC. - CHANGED TO ARCO EXPLORATION & TECH- 00110000 C NOLOGY CO.. 00120000 C REVISED 01-28-86 ESN. - FOR CRAY COMPATABILITY. 00130000 C REVISED 01-26-88 LWC. - CHANGE WAY LAST SHOT POINT NUMBER TO 00131000 C PLOT IS FOUND. 00132000 C REVISED 02-16-88 JJC. - INTRODUCE CONTOUR CAPABILITY. 00133001 C REVISED 03-24-88 JJC. - ADD REMARK TO PLOT. 00134001 C REVISED 04-20-88 JJC. - ADDED THE PLOT ANNOTATION. 00135002 C REVISED 11-13-89 RDK. - FOR CRAY CFT77 COMPATIBILITY. 00136002 CA 00140000 CA THIS ROUTINE HAS FOUR ENTRY POINTS: 00150000 CA 00160000 CA SACNAX PERFORMS PHASE SHIFT AND STACKING OF THE TRACES. 00170000 CA SACNX2 PERFORMS MUTING OF THE ALIASED SPECTRUM 00180000 CA SACNX3 PERFORMS RESCALING OF THE SPECTRUM SUCH THAT THE MAX 00190000 CA AMPLITUDE AT EACH FREQUENCY EQUALS 10. 00200000 CA SACNX4 PERFORMS PLOTING OF THE F-V SPECTRUM. 00210000 CA 00220000 CA THE CALLING SEQUENCE IS DESCRIBED BELOW. 00230000 CA 00240000 CA CALL SACNAX (A, X, FMN, DLF, NF, VMN, DLV, NV, B, MDLF) 00250001 CA INPUT A = INPUT FREQUENCY DOMAIN TRACE R4 00260000 CA INPUT X = OFFSET FOR THIS TRACE R4 00270000 CA INPUT FMN = MINIMUN FREQUENCY FOR ANALYSIS R4 00280000 CA INPUT DLF = FREQUENCY SAMPLE INTERVAL R4 00290000 CA INPUT NF = NUMBER OF FREQUENCIES I4 00300000 CA INPUT VMN = MINIMUM VELOCITY FOR ANALYSIS R4 00310000 CA INPUT DLV = VELOCITY SAMPLE INTERVAL R4 00320000 CA INPUT NV = NUMBER OF VELOCITIES I4 00330000 CA IN/OUT B = ARRAY HOLDING STACKS FOR NV*NF COMPLEX R4 00340000 CA VALUES 00350000 CA INPUT MDLF = FREQUENCY MULTIPLIER I4 00360000 CA 00370000 CA CALL SACNX2 (A, NF, NV, FMN, VMN, DLF, DLV, DLX) 00380000 CA IN/OUT A = SPECTRUM ARRAY R4 00390000 CA INPUT NF = NUMBER OF FREQUENCIES I4 00400000 CA INPUT NV = NUMBER OF VELOCITIES I4 00410000 CA INPUT FMN = MINIMUN FREQUENCY FOR ANALYSIS R4 00420000 CA INPUT VMN = MINIMUM VELOCITY FOR ANALYSIS R4 00430000 CA INPUT DLF = FREQUENCY SAMPLE INTERVAL R4 00440000 CA INPUT DLV = VELOCITY SAMPLE INTERVAL R4 00450000 CA INPUT DLV = TRACE SPACING R4 00460000 CA 00470000 CA CALL SACNX3 (A, NF, NV ) 00480000 CA IN/OUT A = INPUT/OUTPUT SPECTRUM ARRAY R4 00490000 CA INPUT NF = NUMBER OF FREQUENCIES I4 00500000 CA INPUT NV = NUMBER OF VELOCITIES I4 00510000 CA 00520000 CA CALL SACNX4 (A,B,D,CTEXT,FMN,DLF,NF,VMN,DLV,NV,ITYP,ICLP,ICLK, 00530001 CA * MODE,REC,LREC, 00540000 CA * SCLTAX,SCLVAX,IPR,SPT,EPT,STACK,TA, 00550000 CA * LBDIST,ACCOM,ACLNAM,ACUSER,DSNUM,IPLOT, 00560001 CA * DBINC, DLX, VMX, IPLTNO) 00561001 CA INPUT A = INPUT F-V SPECTRUM R4 00570000 CA INPUT B = TEMPORARY ARRAY FOR VEL AMPLITUDES R4 00580000 CA INPUT CTEXT = COMMENT IN 60 ALPHANUMERIC BYTES A60 00581001 CA INPUT FMN = MINIMUM FREQUENCY R4 00590000 CA INPUT DLF = FREQUENCY INCREMENT R4 00600000 CA INPUT NF = NUMBER OF FREQUENCIES I4 00610000 CA INPUT VMN = MINIMUM VELOCITY R4 00620000 CA INPUT DLV = VELOCITY INCREMENT R4 00630000 CA INPUT NV = NUMBER OF VELOCITIES I4 00640000 CA INPUT ITYP = TRUE (=1) OR REL (=2) AMPLITUDE I4 00650000 CA INPUT ICLP = CLIP LEVEL FOR PRINTING I4 00660000 CA INPUT ICLK = CLIP LEVEL FOR PICKING I4 00670000 CA INPUT MODE = PROCESSING MODE (=0,SPN;=1,CDP) I4 00680000 CA INPUT REC = SPN(CDP) NUMBER R4 00690000 CA INPUT LREC = LAST SPN(CDP) NUMBER R4 00691000 CA INPUT SCLTAX = SCALE FOR FREQ. AXIS, INCHES/100 HZ R4 00700000 CA INPUT SCLVAX = SCALE FOR VEL. AXIS, INCHES/1000 FT/SEC R4 00710000 CA INPUT IPR = UNIT OF PRINTER I4 00720000 CA INPUT SPT = BEGIN DEPTH POINT FOR STACK DATA I4 00730000 CA INPUT EPT = END DEPTH POINT FOR STACK DATA I4 00740000 CA INPUT STACK = STACK DATA INDICATOR I4 00750000 CA INPUT TA = TRUE AMPLITUDE R4 00760000 CA INPUT LBDIST = DISTRICT NAMES I4 00770000 CA INPUT ACCOM = ACCT CARD INFO I4 00780000 CA INPUT ACLNAM = ACCT CARD INFO I4 00790000 CA INPUT ACUSER = ACCT CARD INFO I4 00800000 CA INPUT DSNUM = DATA SET NUMBER A8 00810000 CA INPUT IPLOT = FIRST PLOT FALG (FOR ARCO LOGO) I4 00820000 CA INPUT DBINC = POSITIVE (INCREMENT IN DB) R4 00821001 CA = NEGATIVE (INCREMENT IN LINEAR) 00822001 CA INPUT DLX = TRACE SPACING R4 00823001 CA INPUT VMX = MAXIMUM VELOCITY R4 00824001 CA INPUT IPLTNO = COUNT OF PLOTS I4 00825001 CA 00830000 C EJECT 00840000 C 00850000 SUBROUTINE SACNAX (A, X, FMN, DLF, NF, VMN, DLV, NV, B, MDLF) 00860000 C 00870000 DIMENSION A(1) 00880000 DIMENSION B(1) 00890000 DIMENSION C(1) 00900000 DIMENSION D(1) 00910000 C 00920000 DIMENSION LBDIST(1) 00930000 DIMENSION ACCOM (1) 00940000 DIMENSION ACLNAM(1) 00950000 DIMENSION ACUSER(1) 00960000 C 00961001 C REAL ARRAY 00962001 C 00963001 REAL ZCOM1(250) 00964001 REAL ZCOM2(250) 00965001 C 00970000 REAL NEWX 00980000 REAL NEWY 00990000 REAL LREC 00991000 C 01000000 INTEGER STACK 01010000 INTEGER SPT 01020000 INTEGER EPT 01030000 INTEGER YES 01040000 INTEGER NO 01050000 INTEGER DSNUM (1) 01060000 INTEGER CTEXT (1) 01061001 C 01070000 CHARACTER*8 DATE 01080000 CHARACTER*8 TIME 01090000 CHARACTER*22 CDPSTK 01100000 CHARACTER*32 TAMP 01110001 C 01120000 DATA PI /3.14159265/ 01130000 DATA YES / 0 / 01140000 DATA NO / 1 / 01150000 DATA SCANDF / 2.50 / 01160000 DATA SCL1 / 10.0 / 01170000 C 01180000 DATA CDPSTK /'CDP TO CDP '/ 01190000 DATA TAMP /' (TRUE AMPLITUDE 10 => )'/ 01200001 C 01210000 C 01220000 C 01230000 C 01240000 C ==================================================================== 01250000 C 01260000 IF1 = INT(FMN/DLF + 1.0001) 01270002 IF2 = IF1 + NF - 1 01280000 C 01290000 DO 20 IV = 1, NV 01300000 C 01310000 V = VMN + (IV-1)*DLV 01320000 PX = X/V 01330000 IB = 1 + NF*(IV-1) 01340000 C 01350000 DO 10 IF = IF1, IF2 01360000 W = 2. * PI * (IF-1) * DLF 01370000 PHS = W * PX 01380000 COSARG = COS(PHS) 01390000 SINARG = SIN(PHS) 01400000 IDX2 = ((IF-1)*MDLF + 1) * 2 01410000 IB2 = IB * 2 01420000 DUMR = A(IDX2-1) * COSARG - A(IDX2) * SINARG 01430000 DUMI = A(IDX2-1) * SINARG + A(IDX2) * COSARG 01440000 B(IB2-1) = B(IB2-1) + DUMR 01450000 B(IB2 ) = B(IB2 ) + DUMI 01460000 10 IB = IB + 1 01470000 C 01480000 20 CONTINUE 01490000 RETURN 01500000 C 01510000 C================================================================== 01520000 ENTRY SACNX2 (A, NF, NV, FMN, VMN, DLF, DLV, DLX) 01530000 C 01540000 TWODLX = 1. * DLX 01550000 DO 35 IF = 1, NF 01560000 F = (IF-1) * DLF + FMN 01570000 IA = IF 01580000 DO 30 IV = 1, NV 01590000 V = (IV - 1) * DLV + VMN 01600000 IF (V .LE. F * TWODLX) A(IA) = 0. 01610000 30 IA = IA + NF 01620000 35 CONTINUE 01630000 C 01640000 RETURN 01650000 C 01660000 C================================================================== 01670000 ENTRY SACNX3 (A, NF, NV, D) 01680000 C 01690000 DO 70 IF = 1, NF 01700000 C 01710000 AMX = 0. 01720000 IA = IF 01730000 DO 40 IV = 1, NV 01740000 AMX = AMAX1( AMX,A(IA) ) 01750000 40 IA = IA + NF 01760000 C 01770000 D(IF) = AMX 01780000 SCF = 1.0 01790000 IF (AMX .GT. 0.) SCF = 10.0/AMX 01800000 IA = IF 01810000 DO 60 IV = 1, NV 01820000 A(IA) = SCF*A(IA) 01830000 60 IA = IA + NF 01840000 C 01850000 70 CONTINUE 01860000 C 01870000 RETURN 01880000 C 01890000 C================================================================== 01900000 C 01910000 ENTRY SACNX4 (A,B,D,CTEXT,FMN,DLF,NF,VMN,DLV,NV,ITYP,ICLP,ICLK, 01920001 * MODE,REC,LREC, 01930000 * SCLTAX,SCLVAX,IPR,SPT,EPT,STACK,TA, 01940000 * LBDIST,ACCOM,ACLNAM,ACUSER,DSNUM,IPLOT,DBINC, 01950001 * DLX, VMX, IPLTNO) 01951001 C 01960000 C 01970000 C ================================================================ 01980000 C COMPANY LOGO BEFORE FIRST PLOT (IPLOT .EQ. 0) 01990000 C ================================================================ 02000000 C 02010000 CALL PLOT (1.0, 0.5, -3) 02020000 IF (IPLOT .EQ. 0 .AND. IPLTNO .EQ. 1) CALL SALOGO 02030001 C 02040000 CALL PLOT (-0.8, -0.3, -3) 02050000 C 02051001 C FOR LABEL ANNOTATION 02052001 C 02053001 IF (DBINC .NE. 0.0) THEN 02054001 XCLP = FLOAT(ICLP) 02055001 ELSE 02056001 XCLP = ICLP * 10.0 02057001 ENDIF 02058001 XCLK = ICLK * 10.0 02059001 C 02060000 C ================================================================ 02070000 C DISPLAY HEADING 02080000 C ================================================================ 02090000 C 02100000 IF (IPLOT .EQ. 0 .AND. IPLTNO .EQ. 1) THEN 02110001 CALL SYMBOL (0.5,3.0,.21,'ARCO OIL & GAS COMPANY',90.,22) 02120001 C 02140000 CALL SYMBOL (1.0,3.0,.14,'EXPLORATION DATA PROCESSING',90.,27) 02150001 C 02170000 CALL SYMBOL (1.3,3.0,.14,'SPARC SEISMIC PROCESSING SYSTEM', 02180001 * 90.,31) 02190001 C 02200000 CALL SYMBOL (1.6,3.0,.14,'CNAX DISPERSION RELATION ANALYSIS', 02210001 * 90.,33) 02220001 ENDIF 02230000 C 02240000 CALL PLOT (2.5, 1.0, -3 ) 02250000 C 02260000 C ================================================================ 02270000 C WRITET LINE/USER/DATE INFOMATION 02280000 C ================================================================ 02290000 C 02300000 IF (IPLOT .EQ. 0) THEN 02310000 CALL DATIME (DATE, TIME, KDUM) 02320000 C 02330000 CALL SYMBOL (0.5,0.3,.14,'DISTRICT : ',90.,11) 02340001 CALL SYMBOL (999.,999.,.14,LBDIST,90.,16) 02360001 C 02370000 CALL SYMBOL (0.8,0.3,.14,'AREA OR PROSPECT : ',90.,19) 02380001 CALL SYMBOL (999.,999.,.14,ACCOM,90.,16) 02410001 C 02420000 CALL SYMBOL (1.1,0.3,.14,'LINE NO. ',90.,10) 02430001 CALL SYMBOL (999.,999.,.14, ACLNAM,90.,20) 02450001 C 02451001 CALL SYMBOL (1.1,5.0,.14,'CLIP LEVEL : ',90.,13) 02452001 CALL NUMBER (999.,999.,.14,XCLP,90.,-1) 02453001 C 02460000 CALL SYMBOL (1.4,0.3,.14,'ANALYST : ',90.,10) 02470001 CALL SYMBOL (999.,999.,.14,ACUSER,90.,16) 02490001 C 02491001 CALL SYMBOL (1.4,5.0,.14,'PICK LEVEL : ',90.,13) 02492001 CALL NUMBER (999.,999.,.14,XCLK,90.,-1) 02493001 C 02500000 CALL SYMBOL (1.7,0.3,.14,'DATE : ',90.,7) 02510001 CALL SYMBOL (999.,999.,.14,DATE,90.,8) 02530001 C 02531001 IF (DBINC .GT. 0.0) THEN 02532001 CALL SYMBOL (1.7,5.0,.14,'CONTOUR INTERVAL : ',90.,19) 02532101 BBINC = DBINC * 100.0 02533001 CALL NUMBER (999.,999.,.14,BBINC,90.,-1) 02534001 CALL SYMBOL (999.,999.,.14,' %',90.,2) 02535001 ENDIF 02536001 IF (DBINC .LT. 0.0) THEN 02537001 CALL SYMBOL (1.7,5.0,.14,'CONTOUR INTERVAL : ',90.,19) 02537101 BBINC = -DBINC 02537201 CALL NUMBER (999.,999.,.14,BBINC,90.,2) 02538001 CALL SYMBOL (999.,999.,.14,' DB',90.,3) 02539001 ENDIF 02539101 C 02540000 C ================================================================ 02550000 C WRITE OUT DATA SET ID AND DRAW A BLANK LINE FOR REMARKS 02560000 C MOVE PEN DOWN THE PAPER, PREPARE FOR SUBSEQUENT PLOTS. 02570000 C ================================================================ 02580000 C 02590000 CALL SYMBOL (2.3,0.3,.10,DSNUM,90.,8) 02600001 C 02610000 CALL SYMBOL (2.6,0.3,.10,'REMARKS : ',90.,10) 02620001 CALL SYMBOL (2.6,1.5,.10,CTEXT,90.,60) 02621001 C 02630000 CALL PLOT (2.7, 1.2, 3) 02640001 CALL PLOT (2.7, 7.5, 2) 02650001 ENDIF 02660000 C 02661001 C 02670000 C 02680000 C ================================================================ 02690000 C RESET ORIGIN 02700000 C ================================================================ 02710000 C 02720000 CALL PLOT (4.5, 0.0, -3) 02730000 IF (IPLOT .NE. 0) THEN 02731001 C 02732001 CALL SYMBOL (-2.6,5.0,.14,'CLIP LEVEL : ',90.,13) 02733001 CALL NUMBER (999.,999.,.14,XCLP,90.,-1) 02734001 C 02735001 CALL SYMBOL (-2.3,5.0,.14,'PICK LEVEL : ',90.,13) 02736001 CALL NUMBER (999.,999.,.14,XCLK,90.,-1) 02737001 C 02738001 IF (DBINC .GT. 0.0) THEN 02739101 CALL SYMBOL (-2.0,5.0,.14,'CONTOUR INTERVAL : ',90.,19) 02739201 BBINC = DBINC * 100.0 02739301 CALL NUMBER (999.,999.,.14,BBINC,90.,-1) 02739401 CALL SYMBOL (999.,999.,.14,' %',90.,2) 02739501 ENDIF 02739601 IF (DBINC .LT. 0.0) THEN 02739701 CALL SYMBOL (-2.0,5.0,.14,'CONTOUR INTERVAL : ',90.,19) 02739801 BBINC = -DBINC 02739901 CALL NUMBER (999.,999.,.14,BBINC,90.,2) 02740001 CALL SYMBOL (999.,999.,.14,' DB',90.,3) 02740101 ENDIF 02740201 ENDIF 02740301 CALL PLOT (0.0, 0.0, 3) 02741000 C 02750000 C ================================================================ 02760000 C CALCULATE LENGTH OF Y-AXIS (VELOCITY) AND DRAW IT 02770000 C ================================================================ 02780000 C 02790000 NVELS = NV 02800000 NVELP = NV - 1 02810000 C 02820000 INCPTF = INT(1000.01 / DLV) 02830002 YLNINC = SCLVAX / INCPTF 02840000 YDIR1 = YLNINC * NVELP 02850000 C 02860000 CALL PLOT (0.0, YDIR1, 2) 02870000 C 02880000 C ================================================================ 02890000 C ANNOTATE THE Y-AXIS (VELOCITY). 02900000 C PLACE A TIC MARK AT EVERY VELOCITY INCREMENT AND A 02910000 C LONGER TIC MARK EVERY 10 INCREMENTS. LABEL AT LONG TICK MARK. 02920000 C ================================================================ 02930000 C 02940000 TST1 = NVELS / 10 02950000 TICST = (NVELS - (10 * TST1)) 02960000 TICCK1 = TICST 02970000 YDIR = YDIR1 02980000 VELPRT = VMN + (10 * TST1) * DLV 02990000 PRTVLK = NVELP / 2 03000000 C 03010000 DO 630 03020000 * II = 1,NVELS 03030000 TIC = -0.1 03040000 C 03050000 IF ( II .NE. PRTVLK ) GO TO 610 03060000 C 03070000 IF (STACK .EQ. NO) THEN 03080000 IF (MODE .EQ. 0) 03090000 * CALL SYMBOL (-1.3, YDIR1 / 2 - 1.85, .14, 03100000 * 'SPN ', 90., 4) 03110000 C 03120000 IF (MODE .EQ. 1) 03130000 * CALL SYMBOL (-1.3, YDIR1 / 2 - 1.85, .14, 03140000 * 'CDP ', 90., 4) 03150000 C 03160000 C CALL NUMBER (-1.3, YDIR1 / 2 - 1.0 , .14, REC, 90., -1) 03170000 CALL NUMBER (999., 999., .14, REC, 90., -1) 03180000 CALL SYMBOL (999., 999., .14, ' TO ', 90., 4) 03190000 RECADD = LREC 03200000 CALL NUMBER (999., 999., .14, RECADD, 90., -1) 03210000 ENDIF 03220000 C 03230000 IF (STACK .EQ. YES) THEN 03240000 CALL S1BNCV (SPT, CDPSTK, 5, 5) 03250000 CALL S1BNCV (EPT, CDPSTK, 18, 5) 03260000 CALL SYMBOL (-1.3, YDIR1 / 2 - 1.85, .14, 03270000 * CDPSTK, 90., 22) 03280000 ENDIF 03290000 C 03300000 IF (ITYP .EQ. 1) THEN 03310000 WRITE (TAMP(23:31), 500) TA 03320001 500 FORMAT(1PE9.2) 03330000 CALL SYMBOL (999., 999., .14, TAMP, 90., 32) 03340001 ENDIF 03350000 C 03360000 IF (ITYP .EQ. 2) 03370000 * CALL SYMBOL (999., 999., .14, 03380000 * ' (RELATIVE AMPLITUDE)', 90., 21) 03390001 C 03400000 CALL SYMBOL (-1.0, YDIR1 / 2 - 1.85, .14, 03410000 * 'PHASE VELOCITY IN FEET PER SECOND', 90., 33) 03420000 C 03430000 CALL PLOT (0.0, YDIR, 3) 03440000 C 03450000 610 IF (TICCK1 .EQ. 0) GO TO 618 03460000 IF (II .NE. TICCK1) GO TO 620 03470000 618 TIC = -0.2 03480000 TICCK1 = TICCK1 + 10 03490000 C 03500000 CALL NUMBER (-0.9, YDIR, 0.14, VELPRT, 0.0, -1 ) 03510000 C 03520000 VELPRT = VELPRT - 10 * DLV 03530000 C 03540000 CALL PLOT (0.0, YDIR, 3) 03550000 620 CALL PLOT (TIC, YDIR, 2) 03560000 C 03570000 YDIR = YDIR - YLNINC 03580000 CALL PLOT (0.0, YDIR, 3) 03590000 C 03600000 630 CONTINUE 03610000 C 03620000 CALL PLOT (0.0, 0.0, 3) 03630000 C 03640000 C ================================================================ 03650000 C CALCULATE THE LENGTH OF THE X-AXIS (FREQUENCY) AND DRAW IT 03660000 C ================================================================ 03670000 C 03680000 INCPSC = INT(100.001 / DLF) 03690002 XLNINC = SCLTAX / INCPSC 03700000 FQHT = 0.10 03710000 IF (XLNINC .LT. 0.11 ) FQHT = 0.07 03720000 XDIR1 = XLNINC * NF 03730000 XDIR = XDIR1 + XLNINC 03740000 C 03750000 C ================================================================ 03760000 C DRAW THE FREQUENCY AXIS AT MINIMUM VELOCITY 03770000 C ================================================================ 03780000 C 03790000 CALL PLOT (XDIR, 0.0, 2) 03800000 C 03810000 C ================================================================ 03820000 C DRAW THE VELOCITY AXIS AT MAXIMUM FREQUENCY 03830000 C ================================================================ 03840000 C 03850000 CALL PLOT (XDIR, YDIR1, 2) 03860000 C 03870000 C ================================================================ 03880000 C DRAW THE FREQUENCY AXIS AT MAXIMUM VELOCITY 03890000 C ================================================================ 03900000 C 03910000 CALL PLOT ( 0.0, YDIR1, 2) 03920000 C 03930000 C ================================================================ 03940000 C WRITE HEADINGS FOR VELOCITY AND AMPLITUDE AT PEAK 03950000 C ================================================================ 03960000 C 03970000 NEWY = YDIR1 + 0.8 03980000 C 03990000 CALL PLOT (0., NEWY , 3 ) 04000000 CALL PLOT (0., NEWY + 0.4, 2 ) 04010000 C 04020000 CALL SYMBOL (-1.65, NEWY + 0.15, .14, 04030000 * 'VELOCITY(*)', 0., 11) 04040000 C 04050000 CALL SYMBOL (-1.65, NEWY , .08, 04060000 * 'AT PEAK AMPLITUDE', 0., 17) 04070000 C 04080000 NEWY = YDIR1 + 1.4 04090000 C 04100000 CALL PLOT (0., NEWY , 3 ) 04110000 CALL PLOT (0., NEWY + 0.4, 2 ) 04120000 C 04130000 CALL SYMBOL (-1.65, NEWY + 0.08, .14, 04140000 * 'AMPLITUDE', 0., 9) 04150000 C 04160000 C ================================================================ 04170000 C ANNOTATE THE FREQUENCY AXIS AT MAXIMUM VELOCITY 04180000 C ================================================================ 04190000 C 04200000 CALL PLOT ( 0.0, YDIR1 + 0.1, 3) 04210000 CALL PLOT ( 0.0, YDIR1 + 0.5, 2) 04220000 C 04230000 CALL SYMBOL (-1.7, YDIR1 + 0.2, 0.14, 'FREQUENCY (HZ)', 04240000 * 0.0, 14) 04250000 C 04260000 XDIR = XLNINC 04270000 FREQPT = FMN 04280000 CALL PLOT (XDIR, YDIR1, 3) 04290000 C 04300000 DO 640 04310000 * II = 1,NF 04320000 C 04330000 CALL NUMBER (XDIR, YDIR1+0.14, FQHT, FREQPT, 90.0, +2) 04340000 C 04350000 FREQPT = FREQPT + DLF 04360000 XDIR = XDIR + XLNINC 04370000 C 04380000 640 CONTINUE 04390000 C 04400000 CALL PLOT (XDIR, YDIR1, 3) 04410000 C 04420000 C ================================================================ 04430000 C ANNOTATE THE VELOCITY AXIS AT MAXIMUM FREQUENCY, LABEL 04440000 C AND TICK MARKS JUST LIKE AT MINIMUM FREQUENCY 04450000 C ================================================================ 04460000 C 04470000 TICCK = TICST 04480000 YDIR = YDIR1 04490000 VELPRT = VMN + ( 10 * TST1 ) * DLV 04500000 PRTVLK = NVELP / 2 04510000 C 04520000 DO 660 04530000 * II = 1,NVELS 04540000 TIC = -.1 04550000 C 04560000 IF (II .EQ. PRTVLK) 04570000 C 04580000 * CALL SYMBOL (XDIR1 + XLNINC + 1.1, YDIR1 / 2 - 1.85, .14, 04590000 * 'PHASE VELOCITY IN FEET PER SECOND', 90., 33) 04600000 C 04610000 IF (II .EQ. PRTVLK) 04620000 * CALL PLOT (XDIR1 + XLNINC, YDIR, 3 ) 04630000 C 04640000 IF (TICCK .EQ. 0) GO TO 645 04650000 IF (II .NE. TICCK) GO TO 650 04660000 TIC = -0.2 04670000 645 TICCK = TICCK + 10 04680000 C 04690000 CALL NUMBER (XDIR1 + XLNINC + 0.3, YDIR, 0.14, VELPRT, 04700000 * 0.0, -1) 04710000 C 04720000 VELPRT = VELPRT - 10 * DLV 04730000 CALL PLOT (XDIR1 + XLNINC, YDIR, 3 ) 04740000 C 04750000 650 TIK = XDIR1 - TIC + XLNINC 04760000 CALL PLOT (TIK , YDIR, 2 ) 04770000 C 04780000 YDIR = YDIR - YLNINC 04790000 CALL PLOT (XDIR1 + XLNINC, YDIR, 3) 04800000 C 04810000 660 CONTINUE 04820000 C 04830000 CALL PLOT (XDIR1, 0.0, 3) 04840000 C 04850000 XDIR = XLNINC 04860000 C 04870000 C ================================================================ 04880000 C PLOT THE GRID 04890000 C ================================================================ 04900000 C 04910000 DO 700 04920000 * KII = 1, NF 04930000 YDIR = 0.0 04940000 CHECK1 = 6 04950000 CHECK2 = 11 04960000 C 04970000 DO 690 04980000 * KIJ = 2, NVELP 04990000 TIC = XLNINC * .3 05000000 YDIR = YDIR + YLNINC 05010000 IF (CHECK1 .NE. KIJ) GO TO 670 05020000 TIC = TIC * 2.0 05030000 CHECK1 = CHECK1 + 10 05040000 C 05050000 670 CONTINUE 05060000 IF ( CHECK2 .NE. KIJ ) GO TO 680 05070000 TIC = XLNINC 05080000 CHECK2 = CHECK2 + 10 05090000 C 05100000 680 CONTINUE 05110000 CALL PLOT (XDIR, YDIR, 3 ) 05120000 TIK = XDIR - TIC 05130000 CALL PLOT ( TIK, YDIR, 2 ) 05140000 C 05150000 690 CONTINUE 05160000 C 05170000 XDIR = XDIR + XLNINC 05180000 C 05190000 700 CONTINUE 05200000 C 05210000 CALL PLOT (XLNINC, 0., 3 ) 05220000 C 05230000 C ======================================================================05240000 C PLOT THE 2-D FIELD 05250000 C TWO LOOPS: FOR EACH FREQUENCY, DRAW FROM LOW VELOCITY TO 05260000 C HIGH VELOCITY 05270000 C ======================================================================05280000 C 05290000 FREQ = FMN 05300000 C 05310000 DO 1050 IIF = 1,NF 05320000 C 05330000 C ======================================================================05340000 C *** PLOT 2-D FIELD *** 05350000 C AT EACH FREQUENCY, ZERO OUT DATA IF THE FIELD AMPLITUDE 05360000 C IS LESS THAN A PRESCRIBED THRESHOLD 05370000 C ======================================================================05380000 C 05390000 IA = IIF 05400000 DO 300 IV = 1, NV 05410000 B(IV) = A(IA) 05420000 IF (DBINC .EQ. 0.0) THEN 05421001 IF (B(IV) .LT. ICLP ) B(IV) = 0.0 05430001 ENDIF 05431001 300 IA = IA + NF 05440000 C 05450000 C ======================================================================05460000 C *** PLOT 2-D FIELD *** 05470000 C AT THIS FREQ, PICK THE HIGHEST AMPLITUDE AND OBTAIN ITS 05480000 C "Y-COORDINATE". IF AMPLITUDE PEAK IS GREATER THAN A 05490000 C PRESCRIBE CLIP LEVEL (IDXV .NE. 0), THEN SAVE VEL VALUE. 05500000 C ======================================================================05510000 C 05520000 AHIGH = 0. 05530000 DO 301 IV = 1, NV 05540000 AHIGH = AMAX1 (AHIGH, B(IV)) 05550000 301 CONTINUE 05560000 C 05570000 IF(AHIGH .LT. ICLK) THEN 05580000 IDXV = 0 05590000 GO TO 303 05600000 ENDIF 05610000 C 05620000 DO 302 IV = 1, NV 05630000 IF (B(IV) .GE. AHIGH) THEN 05640000 IDXV = IV 05650000 PKVEL = (IDXV - 1) * DLV + VMN 05660000 GO TO 303 05670000 ENDIF 05680000 302 CONTINUE 05690000 C 05700000 303 CONTINUE 05710000 C 05720000 C =============================================================== 05730000 C *** PLOT 2-D FIELD *** 05740000 C TRACE AMPLITUDE VALUES (FROM LOW VEL TO HIGH VEL). 05750000 C DRAW A TICK MARK AT EACH FREQ VALUE 05760000 C (ON THE LINE: Y = 0.). 05770000 C SAVE PLOTTING COORDINATES (X,Y) CORRESPONDING TO 05780000 C THE HIGHEST AMPLITUDE FOR THIS FREQ. 05790000 C =============================================================== 05800000 C 05810000 ASCAL1 = (SCANDF * XLNINC ) / SCL1 05820000 XDIR = IIF * XLNINC 05830000 Y1DIR = 0. 05840000 C 05850000 CALL PLOT (XDIR, Y1DIR - .1, 3) 05860000 CALL PLOT (XDIR, Y1DIR, 2) 05870000 C 05871001 IDBPEN = 3 05872001 IF (DBINC .EQ. 0.0) IDBPEN = 2 05873001 C 05880000 DO 920 05890001 * JJI = 1, NVELS 05900001 X1DIR = XDIR - ASCAL1 * B(JJI) 05910001 C 05920000 CALL PLOT( X1DIR, Y1DIR, IDBPEN) 05930001 C 05940000 IF (JJI .EQ. IDXV) THEN 05950001 XSTAR = XDIR 05960001 YSTAR = Y1DIR 05970001 ENDIF 05980001 C 05990000 Y1DIR = Y1DIR + YLNINC 06000001 C 06010000 920 CONTINUE 06020001 C 06030000 C ================================================================ 06040000 C *** PLOT 2-D FIELD *** 06050000 C END OF VEL. LOOP, EXTEND THE END POINT AT MAXIMUM VELOCITY 06060000 C TO POINT TO THE ANNOTATED FREQ VALUE. 06070000 C ALSO, PLOT A "*" AT THE AMPLITUDE PEAK AND WRITE VELOCITY 06080000 C AND AMPLITUDE AT TOP 06090000 C ================================================================ 06100000 C 06110000 CALL PLOT (XDIR, YDIR1 + .1, 2 ) 06120000 C 06121001 X1DIR = XDIR + XLNINC 06122001 Y1DIR = Y1DIR + YLNINC 06123001 CALL PLOT(X1DIR, Y1DIR, 3) 06124001 IF (DBINC .NE. 0.0) THEN 06125001 IF (IIF .EQ. 1) THEN 06126001 CALL ARDVFC (B, ZCOM2, SCL1, NVELS) 06127001 ELSE 06128001 CALL ARDVFC (B, ZCOM1, SCL1, NVELS) 06129001 CALL SACOND (ZCOM1, ZCOM2, NVELS, (X1DIR-2.0*XLNINC), 06129101 * XLNINC, Y1DIR, YLNINC, ICLP, DBINC) 06129201 CALL ARMVE (ZCOM1, ZCOM2, NVELS) 06129301 ENDIF 06129401 ENDIF 06129501 C 06130000 IF (IDXV .NE. 0 ) THEN 06140000 CALL SYMBOL (XSTAR, YSTAR, .07, '*', 90., 1 ) 06150000 C 06160000 CALL NUMBER (XSTAR, YDIR1 + 0.8, FQHT, PKVEL, 90., -1) 06170000 C 06180000 IF (ITYP .EQ. 1) 06190000 * CALL NUMBER (XSTAR, YDIR1 + 1.4, FQHT, AHIGH, 90., +2) 06200000 C 06210000 IF (ITYP .EQ. 2) 06220000 * CALL NUMBER (XSTAR, YDIR1 + 1.4, FQHT, D(IIF), 90., +2) 06230000 C 06240000 ENDIF 06250000 C 06260000 FREQ = FREQ + DLF 06270000 C 06280000 1050 CONTINUE 06290000 C 06291001 C PLOT THE ALIAS LINES 06292001 C 06293001 ONEDLX = 1.0 * DLX 06294001 TWODLX = 2.0 * DLX 06295001 CALL PLOT (0.0, 0.0, 3) 06295101 DO 1070 IF = 1, NF 06296001 F = (IF -1) * DLF + FMN 06297001 XLOC = IF * XLNINC 06298001 Y1 = F * ONEDLX 06298101 IF (Y1 .LE. VMN) THEN 06299101 CALL PLOT (XLOC, 0.0, 3) 06299201 GO TO 1070 06299301 ELSE IF (Y1 .GT. VMX) THEN 06299401 GO TO 1080 06299501 ELSE 06299601 Y1LOC = (Y1 - VMN) / DLV * YLNINC 06299701 CALL PLOT (XLOC, Y1LOC, 2) 06299801 ENDIF 06300001 1070 CONTINUE 06300101 C 06300201 1080 CALL PLOT (0.0, 0.0, 3) 06300301 C 06300401 DO 1120 IF = 1, NF 06300501 F = (IF -1) * DLF + FMN 06300601 XLOC = IF * XLNINC 06300701 Y2 = F * TWODLX 06300801 IF (Y2 .LE. VMN) THEN 06301001 CALL PLOT (XLOC, 0.0, 3) 06301101 GO TO 1120 06301201 ELSE IF (Y2 .GT. VMX) THEN 06301301 GO TO 1130 06301401 ELSE 06301501 Y2LOC = (Y2 - VMN) / DLV * YLNINC 06301601 CALL PLOT (XLOC, Y2LOC, 2) 06301701 ENDIF 06301801 1120 CONTINUE 06301901 C 06302000 C =================================================================== 06310000 C RESET ORIGION FOR RELATIVE AMPLITUDE PLOT 06320000 C =================================================================== 06330000 C 06340000 1130 CALL PLOT (XDIR, -1.2, -3 ) 06350001 C 06360000 RETURN 06370000 C 06380000 END 06390000