CTITLESDFREQ -- FREQUENCY ANALYSIS 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. E. MCMILLAN 00000200 CA DESIGNER R. E. MCMILLAN 00000300 CA LANGUAGE S/370 FORTRAN H 00000400 CA WRITTEN 07-29-75 00000500 C REVISED 4-06-76 BY R. MCMILLAN TO CHANGE FFT 00000600 C CALLS TO S2FFT2. 00000700 C REVISED 5-25-76 BY R. MCMILLAN TO PREVENT LFOUR 00000800 C BEING > NOSAMP 00000900 C REVISED 8-02-77 BY REM. THIS USED TO BE FRAN BUT 00001000 C WAS RENAMED FREQ WHEN ONE PAGE 00001100 C PRINTER PLOTS WERE INTRODUCED. 00001200 C REVISED 12-19-77 BY REM. FIX ERROR WHEN INDEXING 00001300 C LAST SAMPLE. ALSO TOOK ABS 00001400 C VALUE OF POWER SPECTRUM AFTER 00001500 C SMOOTHING. 00001600 C REVISED 04-15-82 BY CMP. ADDED UPPER FREQUENCY 00001700 C LIMIT TO PLOT. 00001800 C REVISED 11-20-85 BY DCB. CORRECTED A PROBLEM WITH 00001900 C INTERPOLATION OF TRACE WINDOW 00002000 C START AND END TIMES. 00002100 C REVISED 11-25-85 BY DCB. CORRECTED AN ERROR THAT 00002200 C SHOWED UP WHEN START TIME AT X1 00002300 C EQUALED START TIME AT X2 AND END 00002400 C TIME AT X1 EQUALED END TIME AT X2.00002500 C FREQ PROCESSED NO DATA WHEN THESE 00002600 C CONDITIONS EXISTED. 00002700 CA 00002800 CA 00002900 CA CALL SDFREQ (INH,INTR,OH,OTR) 00003000 CA INPUT INH = INPUT HEADER MIXED I2, I4, R4, R8 00003100 CA INPUT INTR = INPUT TRACE R4 00003200 CA OUTPUT OH = OUTPUT HEADER MIXED I2, I4, R4, R8 00003300 CA OUTPUT OTR = OUTPUT TRACE R4 00003400 CA 00003500 CA 00003600 CA THIS PROCESS DRIVER PERFORMS A FREQUENCY ANALYSIS ON THE INPUT 00003700 CA DATA TRACE. OPTIONAL PLOTS OF THE TRACE, POWER SPECTRUM, 00003800 CA AMPLITUDE SPECTRUM AND PHASE ARE OUTPUT. 00003900 CA 00004000 C 00004100 C EJECT 00004200 C 00004300 C LOCAL OR INTERNAL ARRAYS. 00004400 C 00004500 C CWIN ( 4) = POINTERS TO CURRENT WINDOWS I4 00004600 C DATTR ( 96) = DATA ATTRIBUTES STORAGE I4 00004700 C DENTRY ( 104) = PARAMETER STORAGE I4 00004800 C DLOCAL ( 50) = LOCAL VARIABLES STORAGE I4 00004900 C INH ( 1) = INPUT TRACE HEADER I4 00005000 C INTR ( 1) = INPUT TRACE AREA R4 00005100 C OH ( 1) = OUTPUT TRACE HEADER I4 00005200 C OTR ( 1) = OUTPUT TRACE AREA R4 00005300 C XCOM ( 1) = EQUIVALENCED TO COMMON R4 00005400 C ZCOM ( 1) = EQUIVALENCED TO COMMON COMPLEX 00005500 C 00005600 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00005700 C 00005800 C ANAL = CHARACTER STRING "ANAL" A4 00005900 C CBSPT = BEGINNING SHOT POINT FOR CURRENT DATA I4 00006000 C CDP = COMMON DEPTH POINT ENSEMBLE NUMBER I4 00006100 C CESPT = ENDING SHOT POINT FOR CURRENT DATA I4 00006200 C CTR = CURRENT DATA POINTER I4 00006300 C CTRE = POINTER TO END OF CURRENT DATA I4 00006400 C DAP = COUNTER FOR PARAMETER READ AND WRITE SUBROUTINE I4 00006500 C DAT = DISK ADDRESS TABLE I4 00006600 C DATEND = POINTER TO END OF DISK ADDRESS TABLES I4 00006700 C DA1 = POINTER TO PARAMETER FILE I4 00006800 C ENDW = WINDOW END TIME(MS) I4 00006900 C GATH = GATHER OR SHOTPOINT ORDER I4 00007000 C HC = HIGH FREQUENCY CUT ( = NYQUIST) I4 00007100 C IC = UNRESERVED SCRATCH TRACE-BLOCK INDEX I4 00007200 C IPR = KPPRNT (OUTPUT PRINT CHANNEL) I4 00007300 C KILL = TRACE IDENTIFICATION CODE I4 00007400 C LC = LOW FREQUENCY CUT ( = 0) I4 00007500 C LLOCAL = LENGTH OF DLOCAL ( = 50) I4 00007600 C MUTE = INDEX OF FIRST LIVE VALUE, COUNTING FROM THE I4 00007700 C BEGINNING OF THE TRACE (FORTRAN INDEX) 00007800 C NOPAR = NUMBER OF PARAMETERS I4 00007900 C NOSAMP = NUMBER OF SAMPLE POINTS I4 00008000 C NOWDS = APPROXIMATE NUMBER OF WORDS OF MEMORY NEEDED FOR I4 00008100 C THIS PROCESS 00008200 C PMODE = PROCESSING MODE I4 00008300 C POS = CDP OR TWICE SHOTPOINT NUMBER I4 00008400 C RANG = POINTER TO PROCESSING RANGE I4 00008500 C RANGE = POINTER TO END OF PROCESSING RANGE I4 00008600 C RLENG = RECORD LENGTH I4 00008700 C SAMPR = SAMPLE INTERVAL IN MS. I4 00008800 C SHOT = ENERGY SOURCE POINT NUMBER I4 00008900 C SHOTL = LAST SHOT POINT I4 00009000 C SHOTT = EITHER CDP OR SHOTPOINT NUMBER I4 00009100 C SPLOCN = SHOT POINT LOCATION I4 00009200 C SPT = STARTING POINT I4 00009300 C STW = WINDOW START TIME (MS) I4 00009400 C S1 = WINDOW START INDEX I4 00009500 C S2 = WINDOW END INDEX I4 00009600 C TANAL = TYPE OF ANALYSIS I4 00009700 C TPS = TRACES PER SHOT OR DEPTH POINT I4 00009800 C TRACE = TRACE NUMBER FROM TRACE HEADER I4 00009900 C TSMOTH = TYPE OF SMOOTHING FOR POWER SPECTRUM I4 00010000 C WS = NUMBER OF POINTS IN WINDOW I4 00010100 C 00010200 C EJECT 00010300 C ===================================================================== 00010400 C FORMAT OF PARAMETER RECORDS 00010500 C 00010600 C ****** FIRST RECORDS ****** PROCESSING RANGES ****** 00010700 C 00010800 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00010900 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 00011000 C | FREQ | INVOC. | PTS | NOT | NOT | # OF |N|P| NOT | NOT | 00011100 C |_______|_NUMBER_|_______|__USED_|__USED_|_PARMS_|_|M|_USED|__USED_| 00011200 C 00011300 C WORD 9 WORD 10 00011400 C |_______|________| 00011500 C | START | END | 00011600 C |SHOT_PT|_SHOT_PT| 00011700 C . . . 00011800 C . . . 00011900 C . . . 00012000 C WORD 103WORD 104 00012100 C |_______|________| 00012200 C | START | END | 00012300 C |SHOT_PT|_SHOT_PT| 00012400 C 00012500 C EJECT 00012600 C 00012700 C ******ANAL RECORD ****** TYPE OF ANALYSIS ****** 00012800 C 00012900 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00013000 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 00013100 C | FREQ | INVOC. | ANAL | SHOT | NOT | # OF |N|P| NOT | SHOT | 00013200 C |_______|_NUMBER_|_______|__PT.__|__USED_|_PARMS_|_|M|_USED|_LOCN._| 00013300 C 00013400 C WORD 9 WORD 10 WORD 11 TYPE ANALYSIS = 1 AMP 00013500 C |_______|________|_______| = 2 POW 00013600 C |END | TYPE | TYPE | = 3 AP 00013700 C |SHOT PT|__ANAL._|_SMOOTH| 00013800 C TYPE SMOOTH = 0 NONE 00013900 C WORD 12 WORD 13 WORD 14 1 HAMMING 00014000 C |_______|________|_______| 2 HANNING 00014100 C |SMOOTH | OUTPUT | TYPE | 3 PARZEN 00014200 C |LENGTH_|_MEDIUM_|_TRACE_| 4 BARTLETT 00014300 C 00014400 C WORD 15 WORD 16 WORD 17 WORD 18 OUTPUT MEDIUM = 1 PRINT 00014500 C |_______|________|_______|_______| = 2 CALCOMP 00014600 C |WINDOW1| WINDOW1| VEL | VEL | = 3 PRT & CAL 00014700 C |__X1___|___X2___|_START_|__END__| = 4 LASER 00014800 C = 5 PRT & LAS 00014900 C WORD 19 WORD 20 WORD 21 WORD 22 00015000 C |_______|________|_______|_______| TYPE TRACE = 0 NO ORIGINAL 00015100 C | T1 | T2 | T3 | T4 | = 1 FULL ORIG. 00015200 C |_______|________|_______|_______| = 2 WIND. ORIG. 00015300 C . . . . . 00015400 C . . . . . <-- REPEAT WORDS 15 -22 TWICE 00015500 C . . . . . 00015600 C WORD 39 WORD 40 WORD 41 WORD 42 00015700 C |_______|________|_______|_______| 00015800 C |WINDOW4| WINDOW4| VEL | VEL | 00015900 C |__X1___|___X2___|_START_|__END__| 00016000 C 00016100 C WORD 43 WORD 44 WORD 45 WORD 46 00016200 C |_______|________|_______|_______| 00016300 C | T1 | T2 | T3 | T4 | 00016400 C |_______|________|_______|_______| 00016500 C 00016600 C WORD 47 WORD 48 00016700 C |_______|________| 00016800 C |UP.FREQ| NOT | 00016900 C |TO_PLOT|__USED__| 00017000 C 00017100 C WORD 49 WORD 50 ..... WORD 104 00017200 C |_______|________| ..... |_______| (-T(N) INDICATES OPERATE ON 00017300 C | T(1) | T(2) | ..... | T(56) | TRACES T(N-1) THRU T(N)) 00017400 C |_______|________| ..... |_______| 00017500 C 00017600 C ==================================================================== 00017700 C EJECT 00017800 C ==================================================================== 00017900 C LAYOUT OF BLANK COMMON 00018000 C 00018100 C ________________________________ 00018200 C | 50 WORDS FOR | 00018300 C | LOCAL VARIABLES | 00018400 C | ("DLOCAL") | 00018500 C | | 00018600 C |______________________________| 00018700 C CTR --> | CURRENT TRACES TO | 00018800 C | BE ANALYZED | 00018900 C | . | 00019000 C | . | 00019100 C CTRE --> |______________________________| 00019200 C CWIN(1) --> | WINDOW #1 X1 | 00019300 C | X2 | 00019400 C | VS | 00019500 C | VE | 00019600 C | T1 | 00019700 C | T2 | 00019800 C | T3 | 00019900 C | T4 | 00020000 C |______________________________| 00020100 C CWIN(2) --> | WINDOW # 2 | 00020200 C | . | 00020300 C | . | 00020400 C |______________________________| 00020500 C CWIN(3) --> | WINDOW # 3 | 00020600 C | . | 00020700 C | . | 00020800 C |______________________________| 00020900 C CWIN(4) --> | WINDOW # 4 | 00021000 C | . | 00021100 C | . | 00021200 C |______________________________| 00021300 C DAT --> | DAP ANAL. | 00021400 C | SPLOCN | 00021500 C | . | 00021600 C | . | 00021700 C DATEND --> |______________________________| 00021800 C RANG --> | STARTING AND ENDING SHOT | 00021900 C | POINTS FOR ANALYSIS | 00022000 C | . | 00022100 C | . | 00022200 C RANGE --> |______________________________| 00022300 C 00022400 C ===================================================================== 00022500 C EJECT 00022600 C 00022700 SUBROUTINE SDFREQ (INH, INTR, OH, OTR) 00022800 C 00022900 IMPLICIT INTEGER (A-Z) 00023000 EXTERNAL S1ATP 00023100 C 00023200 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/23/83 00023300 COMMON /P/ STARTP 00023400 REAL *8 STARTP 00023500 COMMON /P/ LCNAME 00023600 COMMON /P/ LC5 00023700 COMMON /P/ LCINT 00023800 COMMON /P/ LCTYP , M00020 00023900 COMMON /P/ LCBGSP 00024000 COMMON /P/ LCENSP , M00032( 2) 00024100 COMMON /P/ LCNSP 00024200 COMMON /P/ LCTPSP 00024300 COMMON /P/ LCRL 00024400 COMMON /P/ LCSI 00024500 COMMON /P/ LCPI 00024600 COMMON /P/ LCGRPI 00024700 COMMON /P/ LCMXFD , M00068( 2) 00024800 COMMON /P/ LCDRYF , M00080( 3) 00024900 COMMON /P/ ACNAME 00025000 COMMON /P/ AC0506 00025100 COMMON /P/ AC64BC 00025200 COMMON /P/ ACOPCD 00025300 COMMON /P/ ACQCF 00025400 COMMON /P/ ACDIST 00025500 COMMON /P/ ACPROJ 00025600 COMMON /P/ ACLNAM ( 5) 00025700 COMMON /P/ ACCOM ( 8) , M00144 00025800 COMMON /P/ ACTYPE 00025900 COMMON /P/ ACNSP 00026000 COMMON /P/ ACUSER ( 5) , M00188( 12) 00026100 COMMON /P/ LHJBNO 00026200 COMMON /P/ LHLNO 00026300 COMMON /P/ LHRLNO 00026400 COMMON /P/ LHTPSP 00026500 COMMON /P/ LHATSP 00026600 COMMON /P/ LHSI 00026700 COMMON /P/ LHORSI 00026800 COMMON /P/ LHST 00026900 COMMON /P/ LHORST 00027000 COMMON /P/ LHDFCD 00027100 COMMON /P/ LHEXFD 00027200 COMMON /P/ LHTSCD 00027300 COMMON /P/ LHVSCD 00027400 COMMON /P/ LHSWFS 00027500 COMMON /P/ LHSWFE 00027600 COMMON /P/ LHSWL 00027700 COMMON /P/ LHSWCD 00027800 COMMON /P/ LHTSNO 00027900 COMMON /P/ LHSWTS 00028000 COMMON /P/ LHSWTE 00028100 COMMON /P/ LHSWTT 00028200 COMMON /P/ LHTCF 00028300 COMMON /P/ LHBGRF 00028400 COMMON /P/ LHARCD 00028500 COMMON /P/ LHMS 00028600 COMMON /P/ LHSGPL 00028700 COMMON /P/ LHVPCD 00028800 COMMON /P/ LHNSP 00028900 COMMON /P/ LHNDP 00029000 COMMON /P/ LHNSL 00029100 COMMON /P/ LHMTPR , M00376( 9) 00029200 COMMON /P/ KPNA 00029300 COMMON /P/ KPRNO , M00420 00029400 COMMON /P/ KPA 00029500 COMMON /P/ KPDBGS 00029600 COMMON /P/ KPDBGA 00029700 COMMON /P/ KPDBGN 00029800 COMMON /P/ KPWRKS 00029900 COMMON /P/ KPWRKD , M00448( 4) 00030000 COMMON /P/ KPFCF 00030100 COMMON /P/ KPIRSM 00030200 COMMON /P/ KPNRSM 00030300 COMMON /P/ KPIUSM 00030400 COMMON /P/ KPNUSM 00030500 COMMON /P/ KPTIME 00030600 COMMON /P/ KPRTF 00030700 COMMON /P/ KPDRTF 00030800 COMMON /P/ KPMOTF 00030900 COMMON /P/ KPNBR 00031000 COMMON /P/ KPIBN 00031100 COMMON /P/ KPITSV 00031200 COMMON /P/ KPTAMF 00031300 COMMON /P/ KPLOTF 00031400 COMMON /P/ KPMITF 00031500 COMMON /P/ KPPRNT 00031600 COMMON /P/ KPPLOT 00031700 COMMON /P/ KPPLTA 00031800 COMMON /P/ KPBUGF , M00540( 226) 00031900 COMMON /P/ ENDP 00032000 C 00032100 COMMON COM (1) 00032200 REAL XCOM(1) 00032300 EQUIVALENCE (COM(1),XCOM(1)) 00032400 COMPLEX ZCOM(1) 00032500 EQUIVALENCE (COM(1),ZCOM(1)) 00032600 INTEGER LLOCAL /50/ 00032700 C 00032800 C=================================================================== 00032900 C 00033000 C REAL ARRAYS IN PARAMETER LIST. 00033100 C 00033200 REAL INTR(1) 00033300 REAL OTR (1) 00033400 C 00033500 C INTEGER ARRAYS IN PARAMETER LIST. 00033600 C 00033700 REAL INH(1) 00033800 REAL OH (1) 00033900 C 00034000 C INTEGER ARRAYS--LOCAL 00034100 C 00034200 INTEGER BART ( 2) /'BART','LETT'/ 00034300 INTEGER DATTR (96) 00034400 INTEGER DENTRY (104) 00034500 INTEGER DLOCAL (50) 00034600 INTEGER CWIN ( 4) 00034700 INTEGER HAMM ( 2) /' HAM','MING'/ 00034800 INTEGER HANN ( 2) /' HAN','NING'/ 00034900 INTEGER PARZEN ( 2) /' PA','RZEN'/ 00035000 INTEGER TYPSM ( 2) /' ',' '/ 00035100 C 00035200 EQUIVALENCE (DCTYP ,DENTRY (03)) 00035300 EQUIVALENCE (SPT ,DENTRY (04)) 00035400 EQUIVALENCE (EXTRA ,DENTRY (05)) 00035500 EQUIVALENCE (NOPAR ,DENTRY (06)) 00035600 EQUIVALENCE (PMODE ,DENTRY (07)) 00035700 EQUIVALENCE (SPLOCN ,DENTRY (08)) 00035800 EQUIVALENCE (DATTR(1) ,DENTRY (09)) 00035900 C 00036000 EQUIVALENCE (CTR ,DLOCAL (01)) 00036100 EQUIVALENCE (CTRE ,DLOCAL (02)) 00036200 EQUIVALENCE (DAT ,DLOCAL (03)) 00036300 EQUIVALENCE (DATEND ,DLOCAL (04)) 00036400 EQUIVALENCE (RANG ,DLOCAL (05)) 00036500 EQUIVALENCE (RANGE ,DLOCAL (06)) 00036600 EQUIVALENCE (CBSPT ,DLOCAL (07)) 00036700 EQUIVALENCE (CESPT ,DLOCAL (08)) 00036800 EQUIVALENCE (CWIN(1) ,DLOCAL (09)) 00036900 EQUIVALENCE (TANAL ,DLOCAL (15)) 00037000 EQUIVALENCE (TSMOTH ,DLOCAL (16)) 00037100 EQUIVALENCE (SMWIN ,DLOCAL (17)) 00037200 EQUIVALENCE (OUT ,DLOCAL (18)) 00037300 EQUIVALENCE (ORIG ,DLOCAL (19)) 00037400 EQUIVALENCE (GATH ,DLOCAL (20)) 00037500 EQUIVALENCE (IPR ,DLOCAL (21)) 00037600 EQUIVALENCE (TYPSM(1) ,DLOCAL (22)) 00037700 C 00037800 C REAL VARIABLES AND CONSTANTS--LOCAL 00037900 C 00038000 REAL ANG 00038100 REAL D 00038200 REAL E 00038300 REAL END 00038400 REAL F 00038500 REAL FRAC 00038600 REAL PI /Z413243F7/ 00038700 REAL RENDW 00038800 REAL RSAMPR 00038900 REAL RSTW 00039000 REAL SINC 00039100 REAL VVE 00039200 REAL VVS 00039300 REAL XX 00039400 REAL XXDST 00039500 C 00039600 C INTEGER VARIABLES AND CONSTANTS--LOCAL 00039700 C 00039800 INTEGER ANAL /'ANAL'/ 00039900 INTEGER BLNK /' '/ 00040000 INTEGER NO /' NO'/ 00040100 C================================================================== 00040200 C 00040300 C CHECK IF FIRST TIME THROUGH 00040400 C 00040500 IF (KPFCF .EQ. 0) GO TO 70 00040600 C 00040700 C INITIALIZATION 00040800 C ============== 00040900 C 00041000 C FIRST TIME THROUGH 00041100 C 00041200 IPR = KPPRNT 00041300 KPFCF = 0 00041400 DAP = 1 00041500 C 00041600 C PRINT HEADING 00041700 C 00041800 CALL USPHD (2,ACLNAM,KPNA,KPRNO,0,0,IPR) 00041900 C 00042000 C APPROXIMATE THE AMOUNT OF MEMORY REQUIRED FOR 00042100 C THIS PROCESS. 00042200 C 00042300 NOWDS = LLOCAL 00042400 C 00042500 C GET LOCAL MEMORY REQUIREMENTS 00042600 C 00042700 CALL UPRESM (NOWDS) 00042800 IF (NOWDS .EQ. 0) GO TO 630 00042900 IC = KPIUSM 00043000 C 00043100 C GET NUMBER OF TRACES PER SHOT POINT OR DEPTH 00043200 C POINT 00043300 C 00043400 CALL FORP(KPNA,KPRNO,DAP,104,DENTRY, *650 ) 00043500 TPS = LCTPSP 00043600 IF (S1CPCH(PMODE,2,'D',1,1) .EQ. 0) TPS = LCMXFD 00043700 C 00043800 C ALLOCATE SPACE FOR CURRENT DATA FOR EACH TYPE 00043900 C OF PROCESS 00044000 C 00044100 CTR = IC 00044200 CWIN(1)= CTR + TPS 00044300 CWIN(2)= CWIN(1) + 8 00044400 CWIN(3)= CWIN(2) + 8 00044500 CWIN(4)= CWIN(3) + 8 00044600 IC = CWIN(4) + 8 00044700 C 00044800 C BUILD DISK ADDRESS TABLES 00044900 C 00045000 DAT = IC 00045100 SHOTL = -999999 00045200 DAP = 1 00045300 C 00045400 10 CALL FORP(KPNA,KPRNO,DAP,104,DENTRY, *20 ) 00045500 IF (DCTYP.NE.ANAL .OR. SPT.EQ.SHOTL) GO TO 10 00045600 IF (IC+1 .GT. KPIUSM+KPNUSM) GO TO 630 00045700 COM(IC) = DAP - 1 00045800 COM(IC+1) = SPLOCN 00045900 SHOTL = SPT 00046000 IC = IC + 2 00046100 GO TO 10 00046200 C 00046300 20 DATEND = IC-1 00046400 C 00046500 C SORT THE DISK ADDRESS TABLES 00046600 C 00046700 IF (DAT+2 .GT. DATEND) GO TO 40 00046800 IPS = DAT + 2 00046900 IP = DATEND 00047000 C 00047100 DO 30 00047200 * J=IPS,IP,2 00047300 C 00047400 DO 30 00047500 * K=IPS,IP,2 00047600 IF (COM(K-1) .LT. COM(K+1)) GO TO 30 00047700 H1 = COM(K-2) 00047800 H2 = COM(K-1) 00047900 COM(K-2) = COM(K) 00048000 COM(K-1) = COM(K+1) 00048100 COM(K) = H1 00048200 COM(K+1) = H2 00048300 C 00048400 30 CONTINUE 00048500 C 00048600 C READ THE PROCESSING RANGES 00048700 C 00048800 40 RANG = IC 00048900 DAP = 1 00049000 C 00049100 50 CALL FORP(KPNA,KPRNO,DAP,104,DENTRY, *60 ) 00049200 IF (S1CPCH(DCTYP,1,'PTS',1,3) .NE. 0) GO TO 50 00049300 IF (IC+NOPAR .GT. KPIUSM+KPNUSM) GO TO 630 00049400 CALL ARMVE(DATTR,COM(IC),NOPAR) 00049500 IC = IC + NOPAR 00049600 RANGE = IC - 1 00049700 GO TO 50 00049800 C 00049900 60 NOWDS = IC - KPIUSM 00050000 CALL UPRESM(NOWDS) 00050100 IF (NOWDS .EQ. 0) GO TO 630 00050200 C 00050300 CBSPT = -999999 00050400 CESPT = -999999 00050500 C 00050600 GATH = 0 00050700 IF (S1CPCH(PMODE,2,'D',1,1) .EQ. 0) GATH = 1 00050800 GO TO 80 00050900 C 00051000 C PROCESSES THE DATA 00051100 C ================== 00051200 C 00051300 C RETRIEVE LOCAL VARIABLES 00051400 C 00051500 70 CALL ARMVE (COM(KPIRSM),DLOCAL,LLOCAL) 00051600 C 00051700 C EXTRACT SOME VITAL INFORMATION FROM THE 00051800 C INPUT TRACE HEADER. THE VALUE OF 'SHOTT' 00051900 C IS EITHER THE SHOTPOINT NO. OR THE CDP NO. 00052000 C THE VALUE OF 'POS ' IS EITHER THE SHOTPOINT 00052100 C LOCATION OR THE CDP. 00052200 C 00052300 80 IF(KPBUGF .EQ. 0) GO TO 90 00052400 KKKK = KPIRSM + KPNRSM - 1 00052500 WRITE (IPR, 9000 ) (COM(I), I=KPIRSM,KKKK) 00052600 C 00052700 C RETRIEVAL OF INFORMATION FROM 00052800 C THE TRACE HEADER. 00052900 C 00053000 90 CALL USRTHV (INH, 'THTICD ',KILL) 00053100 IF (KILL .EQ. 2) GO TO 610 00053200 CALL USRTHV (INH, 'THSSP ',SHOT) 00053300 CALL USRTHV (INH, 'THCDPN ', CDP) 00053400 CALL USRTHV (INH, 'THNS ', NOSAMP) 00053500 CALL USRTHV (INH, 'THSI ',SAMPR) 00053600 SAMPR = SAMPR/1000 00053700 RLENG = NOSAMP * SAMPR 00053800 CALL USRTHV (INH, 'THSLN ', POS) 00053900 CALL USRTHV (INH, 'THORTN ', TRACE) 00054000 CALL USRTHV (INH, 'THXDST ', XDST) 00054100 C 00054200 SHOTT = SHOT 00054300 IF (GATH .EQ. 0) GO TO 100 00054400 POS = CDP 00054500 SHOTT = CDP 00054600 CALL USRTHV (INH, 'THCDPT ', TRACE) 00054700 C 00054800 C CHECK IF CURRENT DATA IS IN CORE 00054900 C 00055000 100 IF (CBSPT.LE.SHOTT .AND. SHOTT.LE.CESPT) GO TO 230 00055100 IF (CBSPT.GE.SHOTT .AND. SHOTT.GE.CESPT) GO TO 230 00055200 C 00055300 C CURRENT DATA IS NOT IN CORE - SEARCH THE SHOTPOINT 00055400 C TABLE FOR THE INPUT SHOT NUMBER. 00055500 C 00055600 DO 110 00055700 * J = RANG,RANGE,2 00055800 IF (COM(J).LE.SHOTT .AND. SHOTT.LE.COM(J+1)) GO TO 120 00055900 IF (COM(J).GE.SHOTT .AND. SHOTT.GE.COM(J+1)) GO TO 120 00056000 C 00056100 110 CONTINUE 00056200 C SHOT POINT IS NOT TO BE PROCESSED 00056300 GO TO 610 00056400 C 00056500 C GET DISK ADDRESS FOR DATA TO BE READ 00056600 C 00056700 120 IPS = DAT 00056800 IP = DATEND - 2 00056900 IF (IP .LT. IPS) GO TO 140 00057000 C 00057100 DO 130 00057200 * J = IPS,IP,2 00057300 IF (COM(J+1).EQ.POS .OR. COM(J+3).GT.POS) GO TO 150 00057400 C 00057500 130 CONTINUE 00057600 C 00057700 140 J = DATEND - 1 00057800 C 00057900 C READ THE DATA FROM THE PARAMETER FILE 00058000 C 00058100 150 DA1 = COM(J) 00058200 CTRE = CTR 00058300 CALL FORP (KPNA,KPRNO,DA1,104,DENTRY, *610 ) 00058400 CBSPT = SPT 00058500 CESPT = DATTR(1) 00058600 TANAL = DATTR(2) 00058700 TSMOTH = DATTR(3) 00058800 SMWIN = DATTR(4) 00058900 OUT = DATTR(5) 00059000 ORIG = DATTR(6) 00059100 C MOVE WINDOW DATA INTO COMMON 00059200 CALL ARMVE (DATTR(7), COM(CWIN(1)), 32) 00059300 NFREQ = DATTR(39) 00059400 C 00059500 C NOW MOVE TRACES INTO COMMON 00059600 C 00059700 160 CALL ARMVE (DATTR(41), COM(CTRE), NOPAR-40) 00059800 CTRE = CTRE + NOPAR - 40 00059900 C ARE THERE MORE TRACES 00060000 CALL FORP (KPNA,KPRNO,DA1,104,DENTRY, *170 ) 00060100 IF (SPT.EQ.CBSPT .AND. DATTR(1).EQ.CESPT) GO TO 160 00060200 C 00060300 170 CTRE = CTRE - 1 00060400 C 00060500 IF (TSMOTH .EQ. 0) GO TO 220 00060600 C 00060700 GO TO (180, 00060800 * 190, 00060900 * 200, 00061000 * 210) 00061100 * ,TSMOTH 00061200 C 00061300 180 TYPSM(1) = HAMM(1) 00061400 TYPSM(2) = HAMM(2) 00061500 GO TO 230 00061600 C 00061700 190 TYPSM(1) = HANN(1) 00061800 TYPSM(2) = HANN(2) 00061900 GO TO 230 00062000 C 00062100 200 TYPSM(1) = PARZEN(1) 00062200 TYPSM(2) = PARZEN(2) 00062300 GO TO 230 00062400 C 00062500 210 TYPSM(1) = BART(1) 00062600 TYPSM(2) = BART(2) 00062700 GO TO 230 00062800 C 00062900 220 TYPSM(1) = BLNK 00063000 TYPSM(2) = NO 00063100 C 00063200 C? CHECK TRACE NUMBER AGAINST TRACES TO BE ANALYZED 00063300 C 00063400 230 DO 240 00063500 * J = CTR,CTRE 00063600 IF (COM(J) .LT. 0) GO TO 240 00063700 IF (COM(J) .EQ. TRACE) GO TO 250 00063800 IF (J.EQ.CTRE .OR. COM(J+1).GT.0) GO TO 240 00063900 IF (COM(J).LT.TRACE .AND. TRACE.LE.-COM(J+1)) GO TO 250 00064000 C 00064100 240 CONTINUE 00064200 C THIS TRACE NOT TO BE ANALYZED 00064300 GO TO 610 00064400 C 00064500 250 DO 600 00064600 * I =1,4 00064700 C CHECK THE X1 AND X2 WINDOW START AND END 00064800 C TIMES TO SEE IF A WINDOW IS PRESENT 00064900 C 00065000 IF (COM(CWIN(I)+4) .EQ. 0 .AND. 00065100 * COM(CWIN(I)+5) .EQ. 0 .AND. 00065200 * COM(CWIN(I)+6) .EQ. 0 .AND. 00065300 * COM(CWIN(I)+7) .EQ. 0 ) 00065400 * GO TO 600 00065500 C 00065600 C GET WINDOW START AND END 00065700 C 00065800 IF (XDST .GT. COM(CWIN(I))) GO TO 260 00065900 STW = COM(CWIN(I)+4) 00066000 ENDW = COM(CWIN(I)+5) 00066100 GO TO 280 00066200 C 00066300 260 IF (XDST .LT. COM(CWIN(I)+1)) GO TO 270 00066400 STW = COM(CWIN(I)+6) 00066500 ENDW = COM(CWIN(I)+7) 00066600 GO TO 280 00066700 C 00066800 270 XX = COM(CWIN(I)) 00066900 VVS = XCOM(CWIN(I)+2) 00067000 VVE = XCOM(CWIN(I)+3) 00067100 XXDST = XDST 00067200 IF (VVS .NE. 0.0) THEN 00067300 STW = (XXDST-XX)/VVS + COM(CWIN(I)+4) 00067400 ELSE 00067500 STW = COM(CWIN(I)+4) 00067600 END IF 00067700 IF (VVE .NE. 0.0) THEN 00067800 ENDW = (XXDST-XX)/VVE + COM(CWIN(I)+5) 00067900 ELSE 00068000 ENDW = COM(CWIN(I)+5) 00068100 END IF 00068200 C 00068300 C CONVERT ALL TIME AND FREQUENCY POINTS 00068400 C 00068500 280 S1 = STW / SAMPR + 1 00068600 S2 = ENDW / SAMPR + 1 00068700 IF (S1 .LT. 0) S1 = 1 00068800 IF (S2 .LT. 0) S2 = 1 00068900 IF (S2 .GT. NOSAMP) S2 = NOSAMP 00069000 WS = S2 - S1 + 1 00069100 IF (WS .GT. NOSAMP) WS = NOSAMP 00069200 C 00069300 C CHECK FOR NO PLOT AT ALL 00069400 C 00069500 C NO DATA IN WINDOW CHECK 00069600 C 00069700 IF (WS .LT. 32) GO TO 660 00069800 C 00069900 C SET FOURIER LENGTH AND MAGNITUDE 00070000 C 00070100 LFOUR = 1024 / SAMPR 00070200 IF (LFOUR .GT. NOSAMP) LFOUR = NOSAMP 00070300 CALL S1FMAG (LFOUR,MAG,LFOUR) 00070400 C 00070500 CALL S1FMAG (WS,N1,N2) 00070600 IF (N1 .GT. MAG) MAG = N1 00070700 IF (N2 .GT. LFOUR) LFOUR = N2 00070800 C 00070900 LFOUR2 = LFOUR/2 00071000 IF (KPNUSM .LT. LFOUR+2) GO TO 690 00071100 IC = KPIUSM 00071200 RSTW = (S1 - 1) * SAMPR 00071300 RENDW = (S2 - 1) * SAMPR 00071400 RSAMPR = SAMPR 00071500 C 00071600 CALL ARMVE (INTR(S1),COM(IC),WS) 00071700 C 00071800 C ZERO TAIL 00071900 C 00072000 CALL ARSET (COM(IC+WS), LFOUR - WS, 0.) 00072100 C 00072200 C CHECK FOR TYPE OF ORIGINAL TRACE PLOT 00072300 C 00072400 IF (ORIG .EQ. 0) GO TO 300 00072500 IF (ORIG .EQ. 2) GO TO 290 00072600 C PLOT FULL ORIGINAL TRACE 00072700 IF (I .NE. 1) GO TO 300 00072800 RSTW = 0. 00072900 RENDW = RLENG 00073000 WRITE (IPR, 9010 ) RSTW , RENDW 00073100 WRITE (IPR, 9020 ) TRACE,SHOT,CDP 00073200 WRITE (IPR, 9030 ) 00073300 CALL USFPLT (INTR,NOSAMP,RSTW,RSAMPR,0,IPR) 00073400 RSTW = (S1 - 1) * SAMPR 00073500 RENDW = (S2 - 1) * SAMPR 00073600 GO TO 300 00073700 C PLOT TRACE WINDOW 00073800 C 00073900 290 WRITE (IPR, 9010 ) RSTW, RENDW 00074000 WRITE (IPR, 9020 ) TRACE,SHOT,CDP 00074100 WRITE (IPR, 9030 ) 00074200 CALL USFPLT (COM(IC),WS,RSTW,RSAMPR,0,IPR) 00074300 C 00074400 300 LC = 0 00074500 HC = 1000/(2*SAMPR) 00074600 N1 = LC * LFOUR * SAMPR / 1000 00074700 N2 = HC * LFOUR * SAMPR / 1000 00074800 IF (N2 .LT. N1) N2 = LFOUR2 - 1 00074900 IF (N1 .GT. LFOUR2-1) N1 = LFOUR2-1 00075000 IF (N2 .GT. LFOUR2-1) N2 = LFOUR2-1 00075100 NW = N2 - N1 + 1 00075200 C 00075300 IF (NW .LT. 1) GO TO 680 00075400 D = N1 * 1000./ (LFOUR*SAMPR) 00075500 E = N2 * 1000./ (LFOUR*SAMPR) 00075600 F = 1000. / (LFOUR * SAMPR) 00075700 C 00075800 C TRANSFORM TRACE WINDOW 00075900 C 00076000 CALL S2DFT2 (MAG, COM(IC), *670 ) 00076100 C########### 00076200 KKKK = IC + LFOUR 00076300 IF (KPBUGF .GE. 3) WRITE (IPR,9040) (COM(II),II=IC,KKKK) 00076400 C########### 00076500 C 00076600 GO TO (310, 00076700 * 350, 00076800 * 310) 00076900 * ,TANAL 00077000 C CALCULATE PHASE 00077100 C 00077200 310 K = 1 00077300 C 00077400 DO 340 00077500 * J = 1,LFOUR,2 00077600 IF (XCOM(IC+N1+J-1) .EQ. 0.) GO TO 320 00077700 OTR(K) = ATAN2(XCOM(IC+N1+J),XCOM(IC+N1+J-1)) * 57.296 00077800 GO TO 330 00077900 C 00078000 320 OTR(K) = 0. 00078100 C 00078200 330 K = K + 1 00078300 C 00078400 340 CONTINUE 00078500 C 00078600 C EXTRACT POWER SPECTRUM 00078700 C 00078800 350 CALL ARPOW (COM(IC),COM(IC),LFOUR2) 00078900 XCOM(IC+LFOUR2) = XCOM(IC+LFOUR)*XCOM(IC+LFOUR) + 00079000 * XCOM(IC+LFOUR+1)*XCOM(IC+LFOUR+1) 00079100 C########### 00079200 IF (KPBUGF .GE. 3) WRITE (IPR,9040) (COM(II),II=IC,KKKK) 00079300 C########### 00079400 C 00079500 C CHECK FOR UPPER FREQUENCY LIMIT FOR PLOTTING 00079600 C 00079700 END = E 00079800 IF (NFREQ .EQ. 0. OR. NFREQ .GT. INT(E))GO TO 355 00079900 IJ = (NFREQ - D)/ F 00080000 END = D + IJ * F 00080100 NW = IJ + 1 00080200 C 00080300 C CHECK FOR POWER SPECTRUM PLOT 00080400 C 00080500 355 GO TO (590, 00080600 * 360, 00080700 * 360) 00080800 * ,TANAL 00080900 C 00081000 C PLOT POWER SPECTRUM 00081100 C 00081200 360 WRITE (IPR, 9050 ) RSTW,RENDW,D,END 00081300 WRITE (IPR, 9060 ) TRACE,SHOT,CDP,TYPSM 00081400 C 00081500 C CHECK FOR SMOOTHING OF POWER SPECTRUM 00081600 C 00081700 IF (TSMOTH .EQ. 0) GO TO 530 00081800 C MAKE SURE THERE IS ENOUGH SPACE FOR COMPLEX 00081900 C ARRAY 00082000 IF (2*LFOUR .GT. KPNUSM-LFOUR-2) GO TO 690 00082100 C 00082200 C MAKE POWER SPECTRUM SYMMETRIC AND COMPLEX 00082300 C 00082400 IC1 = IC + LFOUR 00082500 CALL ARSET (COM(IC1), 2*LFOUR, 0.) 00082600 C 00082700 DO 370 00082800 * J = 1, LFOUR2 00082900 XCOM(IC1+2*(J-1)) = XCOM(IC+J-1) 00083000 C 00083100 370 XCOM(IC1+2*(LFOUR-J)) = XCOM(IC+J) 00083200 C 00083300 CALL S2FFI2 (MAG, XCOM(IC1), *670 ) 00083400 C 00083500 SMLEN = SMWIN/SAMPR 00083600 C 00083700 C IF NO SMOOTHING LENGTH IS GIVEN, DEFAULT TO 00083800 C 10% OF WINDOW SIZE 00083900 C 00084000 IF (SMLEN .EQ. 0) SMLEN = 0.1 * WS + 0.5 00084100 C 00084200 SINC = 1./SMLEN 00084300 IP = LFOUR - SMLEN + 1 00084400 IC2 = IC1/2 00084500 C DETERMINE TYPE OF SMOOTHING 00084600 GO TO (380, 00084700 * 410, 00084800 * 440, 00084900 * 460) 00085000 * ,TSMOTH 00085100 C 00085200 C HAMMING 00085300 C 00085400 380 DO 400 00085500 * J = 2, IP 00085600 IF (J .GT. SMLEN) GO TO 390 00085700 K = LFOUR - J + 2 00085800 ANG = PI * (J-1) * SINC 00085900 FRAC = 0.54 + 0.46 * COS(ANG) 00086000 ZCOM(IC2 + J) = ZCOM(IC2 + J) * FRAC 00086100 ZCOM(IC2 + K) = ZCOM(IC2 + K) * FRAC 00086200 GO TO 400 00086300 C 00086400 390 ZCOM(IC2 + J) = 0. 00086500 C 00086600 400 CONTINUE 00086700 C 00086800 GO TO 490 00086900 C 00087000 C HANNING 00087100 C 00087200 410 DO 430 00087300 * J = 2, IP 00087400 IF (J .GT. SMLEN) GO TO 420 00087500 K = LFOUR - J + 2 00087600 ANG = PI * (J-1) * SINC 00087700 FRAC = (1. + COS(ANG))/2. 00087800 ZCOM(IC2 + J) = ZCOM(IC2 + J) * FRAC 00087900 ZCOM(IC2 + K) = ZCOM(IC2 + K) * FRAC 00088000 GO TO 430 00088100 C 00088200 420 ZCOM(IC2 + J) = 0. 00088300 C 00088400 430 CONTINUE 00088500 C 00088600 GO TO 490 00088700 C 00088800 C PARZEN 00088900 C 00089000 440 DO 450 00089100 * J = 1, IP 00089200 IF (J .LE. SMLEN) GO TO 450 00089300 ZCOM(IC2 + J) = 0. 00089400 C 00089500 450 CONTINUE 00089600 C 00089700 GO TO 490 00089800 C 00089900 C BARTLETT 00090000 C 00090100 460 FRAC = 1. - SINC 00090200 C 00090300 DO 480 00090400 * J = 2, IP 00090500 IF (J .GT. SMLEN) GO TO 470 00090600 K = LFOUR - J + 2 00090700 ZCOM(IC2 + J) = ZCOM(IC2 + J) * FRAC 00090800 ZCOM(IC2 + K) = ZCOM(IC2 + K) * FRAC 00090900 FRAC = FRAC - SINC 00091000 GO TO 480 00091100 C 00091200 470 ZCOM(IC2 + J) = 0. 00091300 C 00091400 480 CONTINUE 00091500 C 00091600 490 CALL S2FFT2 (MAG, XCOM(IC1), *670 ) 00091700 C 00091800 IC2 = IC + LFOUR2 00091900 C 00092000 C GET POWER SPECTRUM IN DB 00092100 C 00092200 DO 500 00092300 * J = 1, LFOUR2 00092400 XCOM(IC2 + J-1) = 0. 00092500 C### IF (XCOM(IC1 + 2*(J-1)) .LE. 0.) GO TO 510 00092600 IF (XCOM(IC1 + 2*(J-1)) .EQ. 0.) GO TO 500 00092700 XCOM(IC1 + 2*(J-1)) = ABS(XCOM(IC1 + 2*(J-1))) 00092800 C 00092900 XCOM(IC2 + J-1) = 10. * ALOG10( XCOM(IC1 + 2*(J-1)) ) 00093000 C 00093100 500 CONTINUE 00093200 C 00093300 IC1 = IC2 00093400 GO TO 570 00093500 C## 00093600 C## THE FOLLOWING CODE IS NO LONGER USED SINCE WE TAKE 00093700 C## THE ABSOLUTE VALUE INSTEAD OF GIVING A MESSAGE. 00093800 C## 12/19/77. 00093900 C## 00094000 C 00094100 C POWER SPECTRUM HAS GONE NEGATIVE - ZERO WHAT 00094200 C IS LEFT 00094300 C 00094400 C#510 K = J 00094500 C# WRITE (IPR, 9070 ) 00094600 C 00094700 C# DO 520 00094800 C# * J = K,LFOUR2 00094900 C 00095000 C#520 XCOM(IC2 + J - 1) = 0. 00095100 C 00095200 C# IC1 = IC2 00095300 C# GO TO 570 00095400 C 00095500 C GET NON-SMOOTHED POWER SPECTRUM AS DB 00095600 C 00095700 530 IC1 = IC + LFOUR2 00095800 C 00095900 DO 540 00096000 * J = 1,LFOUR2 00096100 XCOM(IC1+J-1) = 0. 00096200 C## IF (XCOM(IC+J-1) .LE. 0.) GO TO 550 00096300 IF (XCOM(IC+J-1) .EQ. 0.) GO TO 540 00096400 XCOM(IC1+J-1) = ABS(XCOM(IC1+J-1)) 00096500 XCOM(IC1+J-1) = 10. * ALOG10(XCOM(IC+J-1)) 00096600 C 00096700 540 CONTINUE 00096800 C 00096900 GO TO 570 00097000 C## 00097100 C## THE FOLLOWING CODE IS NO LONGER USED SINCE WE TAKE 00097200 C## THE ABSOLUTE VALUE INSTEAD OF GIVING A MESSAGE. 00097300 C## 12/19/77. 00097400 C## 00097500 C 00097600 C POWER SPECTRUM HAS GONE NEGATIVE - ZERO WHAT 00097700 C IS LEFT 00097800 C 00097900 C#550 K = J 00098000 C# WRITE (IPR, 9080 ) 00098100 C 00098200 C# DO 560 00098300 C# * J = K, LFOUR2 00098400 C 00098500 C#560 XCOM(IC1+J-1) = 0. 00098600 C 00098700 570 WRITE (IPR, 9090 ) 00098800 CALL USFPLT (COM(IC1+N1),NW,D,F,1,IPR) 00098900 C########### 00099000 KKKK = IC1 + NW 00099100 IF (KPBUGF .GE. 3) WRITE (IPR,9040) (COM(II),II=IC1,KKKK) 00099200 C########### 00099300 C 00099400 580 GO TO 00099500 * ( 590 ,600 , 590 ),TANAL 00099600 C 00099700 C AMPLITUDE SPECTRUM PLOT 00099800 C 00099900 590 CALL ARSQRT (COM(IC),COM(IC),LFOUR2) 00100000 WRITE (IPR, 9100 ) RSTW,RENDW,D,END 00100100 WRITE (IPR, 9020 ) TRACE,SHOT,CDP 00100200 WRITE (IPR, 9110 ) 00100300 CALL USFPLT (COM(IC+N1),NW,D,F,0,IPR) 00100400 C PHASE PLOT 00100500 WRITE (IPR, 9120 ) RSTW,RENDW,D,END 00100600 WRITE (IPR, 9020 ) TRACE,SHOT,CDP 00100700 WRITE (IPR, 9130 ) 00100800 CALL USFPLT (OTR,NW,D,F,0,IPR) 00100900 C 00101000 600 CONTINUE 00101100 C 00101200 C SAVE LOCAL VARIABLES 00101300 C 00101400 610 CALL ARMVE (DLOCAL, COM(KPIRSM), LLOCAL) 00101500 KPRTF = 2 00101600 C 00101700 620 RETURN 00101800 C NOT ENOUGH MEMORY AVAILABLE 00101900 C 00102000 630 WRITE (IPR, 9140 ) 00102100 C 00102200 640 KPRTF = -1 00102300 GO TO 620 00102400 C 00102500 650 WRITE (IPR, 9150 ) KPNA,KPRNO 00102600 GO TO 640 00102700 C 00102800 660 WRITE (IPR, 9160 ) 00102900 GO TO 700 00103000 C 00103100 670 WRITE (IPR, 9170 ) 00103200 GO TO 700 00103300 C 00103400 680 WRITE (IPR, 9180 ) 00103500 GO TO 700 00103600 C 00103700 690 WRITE (IPR, 9190 ) 00103800 GO TO 700 00103900 C 00104000 700 WRITE (IPR, 9020 ) TRACE,SHOT,CDP 00104100 GO TO 610 00104200 C 00104300 9000 FORMAT (1X,20I5) 00104400 C 00104500 9010 FORMAT ('1',4X,'TIME DOMAIN PLOT OF TRACE WINDOW',F6.0, 00104600 * ' TO',F6.0,' MS'/) 00104700 C 00104800 9020 FORMAT (5X,'TRACE',I4,' SHOTPOINT',I5,' C.D.P. NO',I5/) 00104900 C 00105000 9030 FORMAT ('0 TIME/AMPLITUDE') 00105100 C 00105200 9040 FORMAT (4(2X,E14.8,1X,E14.8)) 00105300 C 00105400 9050 FORMAT ('1',4X,'POWER SPECTRUM PLOT OF TRACE WINDOW',F6.0, 00105500 * ' TO',F6.0,' MS FREQUENCY WINDOW',F7.2,' TO',F7.2,' HZ'/) 00105600 C 00105700 9060 FORMAT (5X,'TRACE',I4,' SHOTPOINT',I5,' C.D.P. NO',I5,6X, 00105800 * 2A4,' SMOOTHING HAS BEEN PERFORMED'/) 00105900 C 00106000 9070 FORMAT ('0',4X,'*** POWER SPECTRUM HAS GONE NEGATIVE BECAUSE ', 00106100 * 'OF DATA AND SMOOTHING FUNCTION ***') 00106200 C 00106300 9080 FORMAT ('0',4X,'*** POWER SPECTRUM HAS GONE NEGATIVE BECAUSE ', 00106400 * 'OF DATA ***') 00106500 C 00106600 9090 FORMAT ('0 HERTZ/DB') 00106700 C 00106800 9100 FORMAT ('1',4X,'AMPLTUDE SPECTRUM PLOT OF TRACE WINDOW',F6.0, 00106900 * ' TO',F6.0,' MS FREQUENCY WINDOW',F7.2,' TO',F7.2,' HZ'/) 00107000 C 00107100 9110 FORMAT ('0 HERTZ/AMPLITUDE') 00107200 C 00107300 9120 FORMAT ('1',4X,'PHASE PLOT',F6.0,' TO',F6.0,' MS FREQUENCY', 00107400 * ' WINDOW',F7.2,' TO',F7.2,' HZ'/) 00107500 C 00107600 9130 FORMAT ('0 HERTZ/DEGREES') 00107700 C 00107800 9140 FORMAT (5X,'*** NOT ENOUGH MEMORY AVAILABLE') 00107900 C 00108000 9150 FORMAT (5X,'*** NO INFORMATION PRESENT FOR ',A4,I1) 00108100 C 00108200 9160 FORMAT ('1',4X,'DATA WINDOW .LT. 32 POINTS') 00108300 C 00108400 9170 FORMAT ('1',4X,'FOURIER TRANSFORM LENGTH IS TOO LONG FOR ', 00108500 * 'SIN/COS TABLE') 00108600 C 00108700 9180 FORMAT ('1',4X,'SPECTRUM WINDOW .LT. 1 POINT') 00108800 C 00108900 9190 FORMAT ('1',4X,'NOT ENOUGH SCRATCH SPACE FOR FOURIER TRANSFORM') 00109000 END 00109100