CTITLESDVSPF -- VSP STATICS APPLICATION 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. E. GAISER 00000200 CA DESIGNER R. D. KNIGHT 00000300 CA LANGUAGE VSFORTRAN 00000400 CA WRITTEN NOV 1983 00000500 C REVISED 01-24-84 RDK. REAPPLY MUTES AFTER INTEGER 00000600 C SHIFT; MODIFY TO PROCESS 00000700 C AUX TRACES (REQUEST BY DWD).00000800 C REVISED 09-04-84 RDK. REVISED FOR EXTENDED HEADERS00000900 C REVISED 10-10-84 REP. CONVERT TO VSFORTRAN. 00001000 C REVISED 10-15-85 DCB. REPLACED ALL REFERENCES TO 00001100 C THRSST WITH REFERENCES TO 00001200 C THFRES. 00001300 C REVISED 12-05-85 BNM. CORRECT JITTER IN SHALLOW 00001310 C DATA WITH ZERO OUT OF OPER- 00001320 C ATOR SPILL. 00001330 CA 00001400 CA 00001500 CA CALL SDVSPF (INH,INTR,OH,OTR) 00001600 CA INPUT INH = INPUT HEADER MIXED I2, I4, R4, R8 00001700 CA INPUT INTR = INPUT TRACE R4 00001800 CA OUTPUT OH = OUTPUT HEADER MIXED I2, I4, R4, R8 00001900 CA OUTPUT OTR = OUTPUT TRACE R4 00002000 CA 00002100 CA 00002200 CA THIS PROCESSOR DRIVER APPLIES USER-SPECIFIED STATICS TO 00002300 CA TRACES FROM A VSP SURVEY. 00002400 CA 00002500 CAEND 00002600 C SUBROUTINES CALLED: ARMVE (S1ATP) 00002700 C ARSET (S1ATP) 00002800 C FORC 00002900 C FORP (FOIP) 00003000 C S1CPCH 00003100 C UPRESM 00003200 C USRTHV 00003300 C USSTHV 00003400 C EJECT 00003500 C 00003600 C LOCAL OR INTERNAL ARRAYS. 00003700 C 00003800 C DATTR ( 96) = DATA ATTRIBUTES STORAGE I4 00003900 C DENTRY ( 104) = PARAMETER STORAGE I4 00004000 C DLOCAL ( 250) = LOCAL VARIABLES STORAGE I4 00004100 C INH ( 1) = INPUT TRACE HEADER I4 00004200 C INTR ( 1) = INPUT TRACE AREA R4 00004300 C OH ( 1) = OUTPUT TRACE HEADER I4 00004400 C OTR ( 1) = OUTPUT TRACE AREA R4 00004500 C LSHT ( 24) = PROCESSED SHOTPOINTS OR DEPTH POINTS. I4 00004600 C LSTT ( 24) = STAIC APPLIED TO THE TRACE. I4 00004700 C LTRC ( 24) = TRACES PASSED BY THIS PROCESS. I4 00004800 C LDEV ( 24) = DEVIATION FROM USER PICK. I4 00004900 C LDAT ( 24) = DATUM I4 00005000 C XCOM ( 1) = EQUIVALENCED TO COMMON R4 00005100 C 00005200 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00005300 C 00005400 C A = VARIABLE A FOR THE QUADRATIC FIT R4 00005500 C AMAX = MAXIMUM OR MINIMUM IN A WINDOW I4 00005600 C B = VARIABLE B FOR THE QUADRATIC FIT R4 00005700 C C = VARIABLE C FOR THE QUADRATIC FIT R4 00005800 C CBSPT = BEGINNING SHOT POINT FOR CURRENT DATA I4 00005900 C CDP = COMMON DEPTH POINT ENSEMBLE NUMBER I4 00006000 C CDCTYP = CURRENT DCTYP I4 00006100 C CESPT = ENDING SHOT POINT FOR CURRENT DATA I4 00006200 C COR = THE DATUM MINUS THE COMPUTER PICK I4 00006300 C CPIK = COMPUTED PICK OF PEAK OR THROUGH I4 00006400 C CTR = CURRENT DATA POINTER I4 00006500 C CTRE = POINTER TO END OF CURRENT DATA I4 00006600 C CTRED = CURRENT DATA POINTER FOR DP OR SP NUMBERS I4 00006700 C CTRST = POINTER TO END OF CURRENT DATA FOR DP OR SP NUMBERS I4 00006800 C CWIN = POINTER TO CURRENT WINDOW I4 00006900 C DAP = COUNTER FOR PARAMETER READ AND WRITE SUBROUTINE I4 00007000 C DAT = DISK ADDRESS TABLE I4 00007100 C DATEND = POINTER TO END OF DISK ADDRESS TABLES I4 00007200 C DATFT = FLOATING POINT DATUM R4 00007300 C DATUM = FIXED POINT DATUM I4 00007400 C DEV = DEVIATION FROM USER PICK TO PROGRAM PICK I4 00007500 C DINC = DATUM INCREMENT R4 00007600 C ESTAT = STATIC SHIFT I4 00007700 C ELEDIF = DIFFERENCE BETWEEN USER PICKS I4 00007800 C FLAG = FLAG TO TELL YOUR ON THE EDGE I4 00007900 C FLOATN = FLOATING POINT STATIC SHIFT R4 00008000 C GATH = GATHER OR SHOTPOINT ORDER I4 00008100 C IC = UNRESERVED SCRATCH TRACE-BLOCK INDEX I4 00008200 C ID = ID FOR THE PICK CARD(STORED IN THE 3RD POS.OF PMODE) I2 00008300 C IDLAST = LAST ID I4 00008400 C INDEX = INDEX OF THE MAX OR MIN VALUE I4 00008500 C IP = DATA POINTER I4 00008600 C IPR = KPPRNT (OUTPUT PRINT CHANNEL) I4 00008700 C KILL = TRACE IDENTIFICATION CODE I4 00008800 C LOCDIF = LOCATION DIFFERENCES I4 00008900 C LLOCAL = LENGTH OF DLOCAL ( = 250) I4 00009000 C NOPAR = NUMBER OF PARAMETERS I4 00009100 C NOSAMP = NUMBER OF SAMPLE POINTS I4 00009200 C NOWDS = APPROXIMATE NUMBER OF WORDS OF MEMORY NEEDED FOR I4 00009300 C THIS PROCESS 00009400 C NS = NUMBER OF SHOT OR DEPTH POINTS IN LTRC I4 00009500 C PMODE = PROCESSING MODE I4 00009600 C POS = CDP OR TWICE SHOTPOINT NUMBER I4 00009700 C POSL = LAST SHOTPOINT OR DEPTH POINT NUMBER I4 00009800 C PRTLEN = MAXIMUM NUMBER OF POINTS TO PRINT I4 00009900 C RANG = POINTER TO PROCESSING RANGE I4 00010000 C RANGE = POINTER TO END OF PROCESSING RANGE I4 00010100 C RLENG = RECORD LENGTH I4 00010200 C SAMPR = SAMPLE INTERVAL IN MS. I4 00010300 C SCAN = USER INPUT SCAN WIDTH I4 00010400 C SERED = COMPUTED START FOR SEARCH I4 00010500 C SERST = COMPUTED END FOR SEARCH I4 00010600 C SHOT = SURVEY SHOTPOINT NUMBER I4 00010700 C SHOTT = EITHER CDP OR SHOTPOINT NUMBER I4 00010800 C SPLOCN = SHOT POINT LOCATION I4 00010900 C SHIFT = FIXED POINT SHIFT I4 00011000 C SPT = STARTING POINT I4 00011100 C THL = TRACE HEADER LENGTH I4 00011200 C TNS = TOTAL NUMBER OF SHOT OR DEPTH POINTS PROCESSED I4 00011300 C TOTDIF = TOTAL DIFFERENCES I4 00011400 C TPS = TRACES PER SHOT OR DEPTH POINT I4 00011500 C TRH = CHARACTER STRING ' TRH' A4 00011600 C TRACE = TRACE NUMBER FROM TRACE HEADER I4 00011700 C 00011800 C EJECT 00011900 C ===================================================================== 00012000 C FORMAT OF OUTPUT PARAMETER RECORDS 00012100 C 00012200 C ****** FIRST RECORDS ****** PROCESSING RANGES ****** 00012300 C 00012400 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00012500 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 00012600 C | VSPF | INVOC. | PTS | NOT | NOT | # OF |N|P| NOT | NOT | 00012700 C |_______|_NUMBER_|_______|__USED_|__USED_|_PARMS_|_|M|_USED|__USED_| 00012800 C 00012900 C WORD 9 WORD 10 00013000 C |_______|________| 00013100 C | START | END | 00013200 C |___D_PT|____D_PT| 00013300 C . . . 00013400 C . . . 00013500 C . . . 00013600 C WORD 103WORD 104 00013700 C |_______|________| 00013800 C | START | END | 00013900 C |___D_PT|____D_PT| 00014000 C 00014100 C EJECT 00014200 C 00014300 C ****** PARM RECORD ****** SELECTION PARAMETERS ****** 00014400 C 00014500 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00014600 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 00014700 C | VSPF | INVOC. |PEK OR | DEPTH | NOT | # OF |N|P| NOT | SHOT | 00014800 C |_______|_NUMBER_|TRH____|__PT.__|__USED_|_PARMS_|_|M|_USED|_LOCN._| 00014900 C 00015000 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 00015100 C |_______|________|_______|_______|_______|_______|_______| 00015200 C |END | INPUT |STATIC | TRVTIM| OPR | BAND | PRINT | 00015300 C |DPTH_PT|_DATUM__|_CODE__|__TYPE_|_LENGTH|WIDTH%_|_SWITCH| 00015400 C 00015500 C WORD 16 WORD 104 00015600 C |_______|_________________________________________|________| 00015700 C | --------------- NOT USED --------------------------> | 00015800 C |_______|_________________________________________|________| 00015900 C 00016000 C ==================================================================== 00016100 C EJECT 00016200 C ==================================================================== 00016300 C LAYOUT OF BLANK COMMON 00016400 C 00016500 C ________________________________ 00016600 C | 250 WORDS FOR | 00016700 C | LOCAL VARIABLES | 00016800 C | ("DLOCAL") | 00016900 C | | 00017000 C |______________________________| 00017100 C DAT --> | DAP ANAL. | 00017200 C | SPLOCN | 00017300 C | . | 00017400 C | . | 00017500 C DATEND --> |______________________________| 00017600 C RANG --> | STARTING AND ENDING SHOT | 00017700 C | POINTS FOR ANALYSIS | 00017800 C | . | 00017900 C | . | 00018000 C RANGE --> |______________________________| 00018100 C CIT --> | CIT AREA FOR 3838 PROGRAM | 00018200 C | (50 WORDS) | 00018300 C | . | 00018400 C | . | 00018500 C |______________________________| 00018600 C COEF --> | OPERATOR STORAGE | 00018700 C | (1200 WORDS) | 00018800 C | . | 00018900 C | . | 00019000 C |______________________________| 00019100 C 00019200 C ===================================================================== 00019300 C EJECT 00019400 C 00019500 SUBROUTINE SDVSPF (INH,INTR,OH,OTR) 00019600 C 00019700 IMPLICIT INTEGER (A-Z) 00019800 EXTERNAL S1ATP 00019900 CX 00020000 CX 00020100 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 12/13/83 00020200 COMMON /P/ STARTP 00020300 REAL *8 STARTP 00020400 COMMON /P/ LCNAME 00020500 COMMON /P/ LC5 00020600 COMMON /P/ LCINT 00020700 COMMON /P/ LCTYP , M00020 00020800 COMMON /P/ LCBGSP 00020900 COMMON /P/ LCENSP , M00032( 2) 00021000 COMMON /P/ LCNSP 00021100 COMMON /P/ LCTPSP 00021200 COMMON /P/ LCRL 00021300 COMMON /P/ LCSI 00021400 COMMON /P/ LCPI 00021500 COMMON /P/ LCGRPI 00021600 COMMON /P/ LCMXFD , M00068( 6) 00021700 COMMON /P/ ACNAME , M00096( 4) 00021800 COMMON /P/ ACDIST 00021900 COMMON /P/ ACPROJ 00022000 COMMON /P/ ACLNAM ( 5) 00022100 COMMON /P/ ACCOM ( 8) , M00144 00022200 COMMON /P/ ACTYPE 00022300 COMMON /P/ ACNSP 00022400 COMMON /P/ ACUSER ( 5) , M00188( 52) 00022500 COMMON /P/ KPNA 00022600 COMMON /P/ KPRNO , M00420 00022700 COMMON /P/ KPA 00022800 COMMON /P/ KPDBGS 00022900 COMMON /P/ KPDBGA 00023000 COMMON /P/ KPDBGN 00023100 COMMON /P/ KPWRKS 00023200 COMMON /P/ KPWRKD , M00448( 4) 00023300 COMMON /P/ KPFCF 00023400 COMMON /P/ KPIRSM 00023500 COMMON /P/ KPNRSM 00023600 COMMON /P/ KPIUSM 00023700 COMMON /P/ KPNUSM 00023800 COMMON /P/ KPTIME 00023900 COMMON /P/ KPRTF 00024000 COMMON /P/ KPDRTF 00024100 COMMON /P/ KPMOTF , M00500( 4) 00024200 COMMON /P/ KPLOTF 00024300 COMMON /P/ KPMITF 00024400 COMMON /P/ KPPRNT 00024500 COMMON /P/ KPPLOT 00024600 COMMON /P/ KPPLTA 00024700 COMMON /P/ KPBUGF , M00540( 226) 00024800 COMMON /P/ ENDP 00024900 C 00025000 COMMON COM (1) 00025100 REAL XCOM(1) 00025200 EQUIVALENCE (COM(1),XCOM(1)) 00025300 INTEGER LLOCAL /250/ 00025400 C 00025500 C=================================================================== 00025600 C 00025700 C REAL ARRAYS IN PARAMETER LIST. 00025800 C 00025900 REAL INTR(1) 00026000 REAL OTR (1) 00026100 C 00026200 C INTEGER ARRAYS IN PARAMETER LIST. 00026300 C 00026400 INTEGER INH(1) 00026500 INTEGER OH (1) 00026600 C 00026700 C INTEGER ARRAYS--LOCAL 00026800 C 00026900 INTEGER DATTR (96) 00027000 INTEGER DENTRY (104) 00027100 INTEGER DLOCAL (250) 00027200 C 00027300 INTEGER LSHT (24) 00027400 INTEGER LTRC (24) 00027500 INTEGER MMNE (02) 00027600 INTEGER PRST (24) 00027700 INTEGER NRSS (24) 00027800 INTEGER OTOT (24) 00027900 INTEGER NTOT (24) 00028000 INTEGER STAP (24) 00028100 INTEGER VMNE (02) 00028200 C 00028300 EQUIVALENCE (DCTYP ,DENTRY (03)) 00028400 EQUIVALENCE (SPT ,DENTRY (04)) 00028500 EQUIVALENCE (EXTRA ,DENTRY (05)) 00028600 EQUIVALENCE (NOPAR ,DENTRY (06)) 00028700 EQUIVALENCE (PMODE ,DENTRY (07)) 00028800 EQUIVALENCE (SPLOCN ,DENTRY (08)) 00028900 EQUIVALENCE (DATTR(1) ,DENTRY (09)) 00029000 C 00029100 C EQUIVALENCE ( ,DLOCAL (01)) 00029200 C EQUIVALENCE ( ,DLOCAL (02)) 00029300 EQUIVALENCE (DAT ,DLOCAL (03)) 00029400 EQUIVALENCE (DATEND ,DLOCAL (04)) 00029500 EQUIVALENCE (RANG ,DLOCAL (05)) 00029600 EQUIVALENCE (RANGE ,DLOCAL (06)) 00029700 EQUIVALENCE (CBSPT ,DLOCAL (07)) 00029800 EQUIVALENCE (CESPT ,DLOCAL (08)) 00029900 EQUIVALENCE (COEF ,DLOCAL (09)) 00030000 EQUIVALENCE (VTCN ,DLOCAL (10)) 00030100 C 00030200 C EQUIVALENCE (CWIN ,DLOCAL (16)) 00030300 C EQUIVALENCE ( ,DLOCAL (17)) 00030400 EQUIVALENCE (GATH ,DLOCAL (18)) 00030500 EQUIVALENCE (RLENG ,DLOCAL (19)) 00030600 EQUIVALENCE (SAMPR ,DLOCAL (20)) 00030700 EQUIVALENCE (SRATE ,DLOCAL (21)) 00030800 EQUIVALENCE (LRPREV ,DLOCAL (22)) 00030900 EQUIVALENCE (IBWPRV ,DLOCAL (23)) 00031000 EQUIVALENCE (NOSAMP ,DLOCAL (24)) 00031100 EQUIVALENCE (THL ,DLOCAL (25)) 00031200 C 00031300 EQUIVALENCE (IPR ,DLOCAL (31)) 00031400 EQUIVALENCE (IPS ,DLOCAL (32)) 00031500 EQUIVALENCE (NS ,DLOCAL (33)) 00031600 EQUIVALENCE (TNS ,DLOCAL (34)) 00031700 EQUIVALENCE (POSL ,DLOCAL (35)) 00031800 EQUIVALENCE (FLOATN ,DLOCAL (36)) 00031900 C 00032000 EQUIVALENCE (NDATST ,DLOCAL (37)) 00032100 EQUIVALENCE (RN ,DLOCAL (38)) 00032200 EQUIVALENCE (TMODE ,DLOCAL (39)) 00032300 EQUIVALENCE (LR ,DLOCAL (40)) 00032400 EQUIVALENCE (LR2 ,DLOCAL (41)) 00032500 EQUIVALENCE (BW ,DLOCAL (42)) 00032600 EQUIVALENCE (PRINT ,DLOCAL (43)) 00032700 EQUIVALENCE (TRCREF ,DLOCAL (44)) 00032800 EQUIVALENCE (VMNE(1) ,DLOCAL (45)) 00032900 EQUIVALENCE (MMNE(1) ,DLOCAL (47)) 00033000 C 00033100 EQUIVALENCE (X ,DLOCAL (51)) 00033200 EQUIVALENCE (U ,DLOCAL (52)) 00033300 EQUIVALENCE (CIT ,DLOCAL (53)) 00033400 EQUIVALENCE (APREGS ,DLOCAL (54)) 00033500 EQUIVALENCE (APUNIT ,DLOCAL (55)) 00033600 EQUIVALENCE (APDCN ,DLOCAL (56)) 00033700 C 00033800 EQUIVALENCE (LSHT(1) ,DLOCAL (76 )) 00033900 EQUIVALENCE (LTRC(1) ,DLOCAL (101)) 00034000 EQUIVALENCE (PRST(1) ,DLOCAL (126)) 00034100 EQUIVALENCE (STAP(1) ,DLOCAL (151)) 00034200 EQUIVALENCE (NRSS(1) ,DLOCAL (176)) 00034300 EQUIVALENCE (OTOT(1) ,DLOCAL (201)) 00034400 EQUIVALENCE (NTOT(1) ,DLOCAL (226)) 00034500 C 00034600 C INTEGER VARIABLES AND CONSTANTS--LOCAL 00034700 C 00034800 C INTEGER BLANK /' '/ 00034900 INTEGER OBSR /'OBSR'/ 00035000 INTEGER PTS /'PTS '/ 00035100 INTEGER RSST /'RSST'/ 00035200 INTEGER THL96 / 96 / 00035300 INTEGER VERT /'VERT'/ 00035400 C 00035500 INTEGER R1 / 1/ 00035600 INTEGER R2 / 2/ 00035700 C INTEGER R3 / 3/ 00035800 INTEGER R4 / 4/ 00035900 INTEGER R5 / 5/ 00036000 C INTEGER R6 / 6/ 00036100 INTEGER R7 / 7/ 00036200 INTEGER R8 / 8/ 00036300 INTEGER R9 / 9/ 00036400 INTEGER R10 / 10/ 00036500 C 00036600 C REAL VARIABLES AND CONSTANTS--LOCAL 00036700 C 00036800 REAL PI /3.141592654/ 00036900 C 00037000 REAL AMAX 00037100 REAL BW 00037200 REAL*8 CCW ( 10) 00037300 REAL CORDIS 00037400 REAL FLOATN 00037500 REAL FLPST 00037600 REAL FNHRST 00037700 REAL FPRS 00037800 REAL FRAC 00037900 REAL FRSC 00038000 REAL PIBW 00038100 REAL RHTST 00038200 REAL RN 00038300 REAL RNFRSC 00038400 REAL RNHTST 00038500 REAL RSHFTS 00038600 REAL SAMPST 00038700 REAL SHTI 00038800 REAL SIGN 00038900 REAL SRATE 00039000 REAL TEMP 00039100 REAL TX 00039200 C 00039300 C================================================================== 00039400 C CHECK IF FIRST TIME THROUGH 00039500 C================================================================== 00039600 C 00039700 IF (KPFCF.EQ.0) GO TO 80 00039800 C 00039900 C INITIALIZATION 00040000 C 00040100 IPR = KPPRNT 00040200 KPFCF = 0 00040300 DAP = 1 00040400 C 00040500 C =================================================================== 00040600 C PRINT HEADING 00040700 C =================================================================== 00040800 C 00040900 CALL USPHD ( 2, ACLNAM, KPNA, KPRNO, 0, 0, IPR ) 00041000 C 00041100 CALL USRTHV (INH, 'THNS ', NOSAMP) 00041200 CALL USRTHV (INH, 'THSI ',SAMPR) 00041300 CALL USRTHV (INH, 'THL ', THL) 00041400 SAMPR = SAMPR/1000 00041500 SRATE = SAMPR 00041600 RLENG = NOSAMP * SAMPR 00041700 C 00041800 C APPROXIMATE THE AMOUNT OF MEMORY REQUIRED 00041900 C 00042000 NOWDS = LLOCAL 00042100 C 00042200 C GET LOCAL MEMORY REQUIREMENTS 00042300 C 00042400 CALL UPRESM (NOWDS) 00042500 IF (NOWDS.EQ.0) GO TO 440 00042600 IC = KPIUSM 00042700 C 00042800 C =================================================================== 00042900 C BUILD DISK ADDRESS TABLES 00043000 C =================================================================== 00043100 C 00043200 DAT = IC 00043300 SHOTL = -999999999 00043400 DAP = 1 00043500 C 00043600 10 CALL FORP(KPNA,KPRNO,DAP,104,DENTRY, *30 ) 00043700 IF (DCTYP.EQ.PTS .OR. SHOTL.EQ.SPT) GO TO 10 00043800 C 00043900 20 CONTINUE 00044000 IF (IC+1.GE.KPIUSM+KPNUSM) GO TO 440 00044100 COM(IC) = DAP - 1 00044200 COM(IC+1) = SPLOCN 00044300 SHOTL = SPT 00044400 IC = IC + 2 00044500 GO TO 10 00044600 30 DATEND = IC-1 00044700 C 00044800 C SORT THE DISK ADDRESS TABLES 00044900 C 00045000 IF (DAT+2.GT.DATEND) GO TO 50 00045100 IPS = DAT + 2 00045200 IP = DATEND 00045300 C 00045400 DO 40 J=IPS,IP,2 00045500 C 00045600 DO 40 K=IPS,IP,2 00045700 IF (COM(K-1).LT.COM(K+1)) GO TO 40 00045800 H1 = COM(K-2) 00045900 H2 = COM(K-1) 00046000 COM(K-2) = COM(K) 00046100 COM(K-1) = COM(K+1) 00046200 COM(K) = H1 00046300 COM(K+1) = H2 00046400 C 00046500 40 CONTINUE 00046600 C 00046700 C =================================================================== 00046800 C READ THE PROCESSING RANGES 00046900 C =================================================================== 00047000 C 00047100 50 RANG = IC 00047200 DAP = 1 00047300 C 00047400 60 CALL FORP(KPNA,KPRNO,DAP,104,DENTRY, *70 00047500 *) 00047600 IF (DCTYP.NE.PTS ) GO TO 60 00047700 IF (IC+NOPAR.GT.KPIUSM+KPNUSM) GO TO 440 00047800 CALL ARMVE(DATTR,COM(IC),NOPAR) 00047900 IC = IC + NOPAR 00048000 RANGE = IC - 1 00048100 GO TO 60 00048200 C 00048300 C RESERVE CIT AREA FOR 3838 PROGRAM 00048400 70 CIT = IC 00048500 IC = IC + 50 00048600 C 00048700 C RESERVE ARRAY FOR INTERPOLATION OPERATORS 00048800 COEF= IC 00048900 IC = IC + 1200 00049000 C 00049100 NOWDS = IC - KPIUSM 00049200 CALL UPRESM ( NOWDS ) 00049300 IF ( NOWDS.EQ.0 ) GO TO 440 00049400 C 00049500 C ================================================================== 00049600 C BUILD AP PROGRAM FOR INTERPOLATION OPERATOR APPLICATION 00049700 C ================================================================== 00049800 C 00049900 MAXLEN = NOSAMP + 100 00050000 NREGS = 10 00050100 LENB = 12 00050200 C 00050300 END = KPIUSM + KPNUSM 00050400 X = END - MAXLEN 00050500 U = X - LENB 00050600 APREGS = U - NREGS 00050700 IF ( APREGS.LT.KPIUSM ) GO TO 440 00050800 C 00050900 ISTATE = 120 00051000 ISTAT = 002 00051100 NWDS = 2*MAXLEN + 20 00051200 C 00051300 CALL CSAPUN ( NWDS, APUNIT ) 00051400 CALL VPSS ( APUNIT, 'BLD ', ISTAT, CCW, 20, COM(CIT), 50 ) 00051500 C 00051600 CALL VPSS ( APUNIT, 'XWR ', COM(APREGS), NREGS, 1 ) 00051700 CALL VPSS ( APUNIT, 'VPUT',COM( X),MAXLEN, 0, R5 ) 00051800 CALL VPSS ( APUNIT, 'VPUT',COM( U), LENB, 0, R4 ) 00051900 C 00052000 CALL VPSS ( APUNIT, 'ZMV ',ISTATE, 00052100 * 64, 0, 0, 1, 00052200 * R5 ) 00052300 C 00052400 CALL VPSS ( APUNIT, 'ZMV ',ISTATE, 00052500 * 96, 0, 0, 1, 00052600 * R8, R9 ) 00052700 C 00052800 CALL VPSS ( APUNIT, 'CVM ',ISTATE, 00052900 * 96, 0, 0, 1, 00053000 * R7, R1, 00053100 * 64, 1, 0, 1, 00053200 * R10, 00053300 * 96, 0, 0, 1, 00053400 * R4, R2 ) 00053500 C 00053600 CALL VPSS ( APUNIT, 'VGET',COM( X),MAXLEN, 0, R7 ) 00053700 CALL VPSS ( APUNIT, 'XLTE', APDCN ) 00053800 C 00053900 CBSPT = -999999999 00054000 CESPT = -999999999 00054100 LRPREV= -999999999 00054200 IBWPRV= -999999999 00054300 POSL = -999999999 00054400 VTCN = -999999999 00054500 NS = 0 00054600 TNS = 0 00054700 C 00054800 GATH = 0 00054900 IF (S1CPCH(PMODE,2,'D',1,1).EQ.0) GATH = 1 00055000 C 00055100 GO TO 90 00055200 C 00055300 C =================================================================== 00055400 C NOW READY TO PROCESS THE DATA 00055500 C =================================================================== 00055600 C 00055700 80 CALL ARMVE (COM(KPIRSM),DLOCAL,LLOCAL) 00055800 IF (KPMITF.EQ.0) GO TO 380 00055900 C 00056000 90 CALL ARMVE ( INH, OH, NOSAMP+THL ) 00056100 C 00056200 100 IF(KPBUGF .NE. 3) GO TO 110 00056300 KKKK = KPIRSM + KPNRSM - 1 00056400 WRITE (IPR, 9000 ) (COM(I), I=KPIRSM,KKKK) 00056500 C 00056600 C RETRIEVAL OF INFORMATION FROM THE 00056700 C INPUT TRACE HEADER. THE VALUE OF 'SHOTT' 00056800 C IS EITHER THE SHOTPOINT NO. OR THE CDP NO. 00056900 C THE VALUE OF 'POS ' IS EITHER THE SHOTPOINT 00057000 C LOCATION OR THE CDP. 00057100 C 00057200 110 CALL USRTHV ( OH, 'THTICD ', KILL ) 00057300 CALL USRTHV ( OH, 'THFLV ', FLV ) 00057310 C 00057400 IF (KILL.EQ.2) GO TO 420 00057500 IF (GATH.EQ.0) GO TO 120 00057600 IF (GATH.EQ.1) GO TO 130 00057700 C 00057800 120 CALL USRTHV ( OH, 'THSSP ',SHOT) 00057900 CALL USRTHV ( OH, 'THSLN ', POS) 00058000 CALL USRTHV ( OH, 'THORTN ', TRACE) 00058100 SHOTT = SHOT 00058200 GO TO 140 00058300 C 00058400 130 CALL USRTHV ( OH, 'THCDPN ', CDP) 00058500 CALL USRTHV ( OH, 'THCDPT ', TRACE) 00058600 POS = CDP 00058700 SHOTT = CDP 00058800 C 00058900 C ==================================================================== 00059000 C CHECK IF CURRENT DATA IS IN CORE 00059100 C ==================================================================== 00059200 C 00059300 140 IF (CBSPT.LE.SHOTT.AND.SHOTT.LE.CESPT) GO TO 260 00059400 IF (CBSPT.GE.SHOTT.AND.SHOTT.GE.CESPT) GO TO 260 00059500 C 00059600 C CURRENT DATA IS NOT IN CORE 00059700 C SEARCH THE SHOTPOINT TABLE 00059800 C FOR THE INPUT SHOT NUMBER. 00059900 C 00060000 DO 150 J = RANG,RANGE,2 00060100 IF (COM(J).LE.SHOTT.AND.SHOTT.LE.COM(J+1)) GO TO 160 00060200 IF (COM(J).GE.SHOTT.AND.SHOTT.GE.COM(J+1)) GO TO 160 00060300 C 00060400 150 CONTINUE 00060500 C SHOT POINT IS NOT TO BE PROCESSED 00060600 GO TO 420 00060700 C 00060800 C ==================================================================== 00060900 C GET DISK ADDRESS FOR DATA TO BE READ 00061000 C ==================================================================== 00061100 C 00061200 160 CONTINUE 00061300 C 00061400 IPS = DAT 00061500 IP = DATEND - 2 00061600 IF (IP.LT.IPS) GO TO 180 00061700 C 00061800 DO 170 J = IPS,IP,2 00061900 IF (COM(J+1).EQ.POS.OR.COM(J+3).GT.POS) GO TO 190 00062000 C 00062100 170 CONTINUE 00062200 C 00062300 180 J = DATEND - 1 00062400 C 00062500 C READ THE DATA FROM THE PARAMETER FILE 00062600 C 00062700 190 DA1 = COM(J) 00062800 200 CALL FORP (KPNA,KPRNO,DA1,104,DENTRY, *460 ) 00062900 IF (S1CPCH(DCTYP,1,'PTS',1,3).EQ.0) GO TO 460 00063000 C 00063100 CBSPT = SPT 00063200 CESPT = DATTR(1) 00063300 C CDCTYP= DCTYP 00063400 C 00063500 NDATST= DATTR ( 02) 00063600 N = DATTR ( 03) 00063700 TMODE = DATTR ( 04) 00063800 LR = DATTR ( 05) / LCPI 00063900 IBW = DATTR ( 06) 00064000 PRINT = DATTR ( 07) 00064100 TRCREF= DATTR ( 08) 00064200 CALL ARMVE ( DATTR(09), VMNE(01), 2 ) 00064300 CALL ARMVE ( DATTR(11), MMNE(01), 2 ) 00064400 C 00064500 RN = N 00064600 BW = FLOAT(IBW)/100. 00064700 LR2 = LR/2 00064800 C 00064900 C PRINT PAGE HEADING IF NECESSARY 00065000 IF (POSL.NE.-999999999) GO TO 210 00065100 IF (PRINT.GT.0 ) 00065200 *WRITE ( IPR, 9005 ) 00065300 WRITE ( IPR, 9010 ) 00065400 C 00065500 C GENERATE INTERPOLATION OPERATORS FOR THIS RANGE 00065600 C IF THE INTERPOLATION PARAMETERS ARE DIFFERENT 00065700 C 00065800 210 IF ( LR.EQ.LRPREV .AND. IBW.EQ.IBWPRV ) GO TO 260 00065900 C 00066000 WL = LR + 2 00066100 A = KPIUSM 00066200 F = A + WL 00066300 G = F + WL 00066400 R = G + WL 00066500 E = R + WL 00066600 END= E + WL 00066700 C 00066800 IF ( END.GT.KPIUSM+KPNUSM ) GO TO 440 00066900 C 00067000 CALL ARSET ( COM(A ), WL, 0 ) 00067100 CALL ARSET ( COM(F ), WL, 0 ) 00067200 CALL ARSET ( COM(G ), WL, 0 ) 00067300 CALL ARSET ( COM(R ), WL, 0 ) 00067400 CALL ARSET ( COM(E ), WL, 0 ) 00067500 CALL ARSET (COM(COEF),99*LR, 0 ) 00067600 C 00067700 PIBW = PI*BW 00067800 LR1 = LR-1 00067900 FRAC = 0.01 00068000 XCOM(R ) = 1.0 00068100 CORDIS = 1.0 00068200 C 00068300 DO 220 I=1,LR1 00068400 TX = CORDIS*PI*BW 00068500 XCOM(R +I) = SIN(TX)/TX 00068600 220 CORDIS = CORDIS + 1.0 00068700 C 00068800 DO 250 LCN=1,50 00068900 C 00069000 CORDIS = -(LR2-1) - FRAC 00069100 C 00069200 DO 240 I=1,LR 00069300 TX = CORDIS*PI*BW 00069400 IF (TX.EQ.0.) GO TO 230 00069500 XCOM(G +I-1) = SIN(TX)/TX 00069600 GO TO 240 00069700 230 XCOM(G +I-1) = 1.0 00069800 240 CORDIS = CORDIS + 1.0 00069900 C 00070000 I = LCN 00070100 INDX1 = (I- 1)*LR + COEF 00070200 INDX2 = (099-I)*LR + COEF 00070300 C 00070400 CALL S1EURK ( LR, XCOM(R), XCOM(G), XCOM(F), XCOM(A), XC 00070500 * OM(E) ) 00070600 CALL ARMVE ( XCOM(F), XCOM(INDX1), LR ) 00070700 IF (LCN.NE.50)CALL ARFLP ( XCOM(F), XCOM(INDX2), LR ) 00070800 C 00070900 250 FRAC = FRAC + 0.01 00071000 C 00071100 LRPREV = LR 00071200 IBWPRV = IBW 00071300 IF (KPBUGF.EQ.0) GO TO 260 00071400 C 00071500 WRITE ( IPR , 9020 ) 00071600 DO 255 I = 1,99 00071700 WRITE ( IPR , 9022 ) ( XCOM(COEF+(I-1)*LR+J-1),J=1,LR ) 00071800 255 CONTINUE 00071900 C 00072000 C ==================================================================== 00072100 C SPECIAL CODE TO SET ANY LOCATION 00072200 C LESS THAN THE FIRST LOCATION EQUAL 00072300 C TO THE FIRST TIME 00072400 C ==================================================================== 00072500 C 00072600 C 260 IF (TRCREF.LT.0 ) CALL USRTHV ( OH, 'THVTCN ', VTCN ) 00072700 C IF (TRCREF.LT.0 .AND. IABS(TRCREF).NE.VTCN ) GO TO 420 00072800 C IF (TRCREF.GT.0 .AND. TRCREF .NE.TRACE) GO TO 420 00072900 C 00073000 260 IF ( THL.LE.THL96 ) CALL USRTHV ( OH, 'THTST ', IHTST ) 00073100 IF ( THL.LE.THL96 ) RHTST = IHTST 00073200 IF ( THL.GT.THL96 ) CALL USRTHV ( OH, 'THFTST ', RHTST ) 00073300 CALL USRTHV ( OH, 'THFRES ', TEMP ) 00073400 IHRSST = TEMP 00073500 CALL USRTHV ( OH, 'THFRSC ', FRSC ) 00073600 C 00073700 IHSTUH = 0 00073800 IHRTUH = 0 00073900 IF ( TMODE.EQ.RSST )GO TO 265 00074000 CALL USRTHV ( OH, VMNE , IHSTUH ) 00074100 CALL USRTHV ( OH, MMNE , IHRTUH ) 00074200 C 00074300 265 IF ( IHRTUH.EQ.0 .AND. TMODE.NE.RSST ) GO TO 470 00074400 IF ( IHSTUH.EQ.0 .AND. TMODE.EQ.VERT ) GO TO 480 00074500 C 00074600 SHTI = IHSTUH / 1000. 00074700 IF ( TMODE.EQ.OBSR ) SHTI = IHRTUH / 1000. 00074800 C 00074900 RSHFTS = (RN*SHTI) - IHRTUH/1000. - (IHRSST+FRSC) 00075000 IF ( RN.EQ.0.0 ) RSHFTS = RSHFTS + NDATST 00075100 C 00075200 IF ( TMODE.EQ.RSST ) RSHFTS = (IHRSST+FRSC-NDATST)*(-RN)-N 00075300 *DATST 00075400 FLOATN = RSHFTS 00075500 C 00075600 C ==================================================================== 00075700 C APPLY STATIC 00075800 C ==================================================================== 00075900 C 00076000 270 IS100 = 100.*(FLOATN/SRATE) + SIGN(0.5,FLOATN) 00076100 IF (IS100.EQ.0) GO TO 340 00076200 C 00076300 C ROUND TO NEAREST 100TH OF A SAMPLE INTERVAL 00076400 SAMPST = IS100/100. 00076500 INTST = SAMPST 00076600 FLPST = SAMPST - INTST 00076700 ICN = FLPST*100. + SIGN(0.5,FLPST) 00076800 C 00076900 IF (KPBUGF.GE.2) WRITE (IPR, 9030 ) IS100,SAMPST,INTST,FLP 00077000 *ST,ICN 00077100 IF ( ICN .NE. 0 ) GO TO 280 00077200 C 00077300 LINT = NOSAMP - IABS(INTST) 00077400 INT1 = IABS(INTST) + 1 00077500 C 00077600 CALL ARSET ( OTR, NOSAMP, 0 ) 00077700 IF ( INTST.LT. 0 ) CALL ARMVE (INTR(INT1), OTR(0001), LINT ) 00077800 IF ( INTST.GT. 0 ) CALL ARMVE (INTR(0001), OTR(INT1), LINT ) 00077900 GO TO 340 00078000 C 00078100 280 ICN = IABS(ICN) 00078200 LENB = LR 00078300 IF(IS100) 290 , 290 , 300 00078400 C 00078500 290 LAG = LR2+1-INTST 00078600 LENC = NOSAMP - IABS(INTST) 00078700 GO TO 310 00078800 C 00078900 300 ICN = 100 - ICN 00079000 LAG = LR2 -INTST 00079100 LENC = NOSAMP 00079200 C 00079300 C X X X X X X X X X X 00079400 C A1 A2 A3 A4 A5 A6 00079500 C B1 B2 B3 LAG =-1 00079600 C B1 B2 B3 LAG = 0 00079700 C B1 B2 B3 LAG = 1 00079800 C 00079900 310 IXADR = MAX0 ( LENB-LAG+1, 1 ) 00080000 NDX = MAX0 ( LAG-LENB+1, 1 ) 00080100 LDX = MIN0 ( LAG+LENC-1,NOSAMP) 00080200 MOVEL = LDX - NDX + 1 00080300 LENCA = LENB + LENC - 1 00080400 INDXZ = IXADR + MOVEL 00080500 IUADR = LENCA + 2 00080600 LENZ = IUADR - INDXZ 00080700 IRET = IUADR + LENB 00080800 C 00080900 IF (KPBUGF.GE.2) WRITE (IPR, 9040 ) LAG,LENB,LENC,MOVEL,LE 00081000 *NZ 00081100 IF ( LDX .LE. 0 ) GO TO 330 00081200 C 00081300 320 IF ( APREGS.LT.KPIUSM ) GO TO 440 00081400 C 00081500 INDEX = (ICN-1)*LR + COEF 00081600 CALL ARMVE ( OTR(NDX) , COM(X), MOVEL ) 00081700 CALL ARMVE ( COM(INDEX) , COM(U), LR ) 00081800 C 00081900 COM (APREGS ) = LENC 00082000 COM (APREGS+ 1) = LENB 00082100 COM (APREGS+ 2) = 0 00082200 COM (APREGS+ 3) = IUADR 00082300 COM (APREGS+ 4) = IXADR 00082400 COM (APREGS+ 5) = 0 00082500 COM (APREGS+ 6) = IRET 00082600 COM (APREGS+ 7) = INDXZ 00082700 COM (APREGS+ 8) = LENZ 00082800 COM (APREGS+ 9) = LENCA 00082900 C 00083000 CALL VPSS ( APUNIT, 'EXCW', APDCN ) 00083100 IF ( KPRTF.LT.0 ) GO TO 320 00083200 C 00083300 330 CALL ARSET ( OTR, NOSAMP , 0 ) 00083400 IF ( LDX .GT. 0 )CALL ARMVE ( COM(X), OTR(1), LENC ) 00083500 C 00083600 C UPDATE TRACE HEADER VALUES 00083700 C 00083800 C FIRST LIVE VALUE 00083900 C 00084000 340 DO 350 I = 1,NOSAMP 00084100 J = I 00084200 IF (OTR(J) .NE. 0.0) GO TO 360 00084300 350 CONTINUE 00084400 C 00084500 360 IF ( ICN .EQ. 0 ) GO TO 365 00084510 C 00084511 C FIND LOCATION OF FIRST GOOD DATA POINT; SET UP ZERO IF NEEDED 00084512 C ( DONT ZAP GOOD DATA ! ) 00084513 C 00084514 PT = FLV + INTST 00084515 IF ( PT .GT. LR2 ) GO TO 361 00084516 IF ( PT .LE. 1 ) GO TO 365 00084517 ZAP = PT - 1 00084518 GO TO 362 00084519 C 00084520 C ZERO OUT INTERPOLATION SPILL 00084530 C 00084540 361 ZAP = LR2 00084541 C 00084542 C DO NOT ZERO PAST END OF TRACE 00084543 C 00084544 362 TAIL = NOSAMP - LR2 + 1 00084545 IF ( J .LE. TAIL ) GO TO 363 00084546 ZAP = NOSAMP - J + 1 00084547 C 00084548 363 CALL ARSET ( OTR(J), ZAP, 0.0) 00084550 J = J + ZAP 00084560 IF ( J .GT. NOSAMP ) J = NOSAMP 00084570 365 CALL USSTHV (OH, 'THFLV ',J) 00084600 C 00084700 C RESIDUAL STATICS 00084800 C 00084900 FNHRST = IHRSST + FRSC + RSHFTS 00085000 INHRST = FNHRST + SIGN(0.5,FNHRST) 00085100 RNFRSC = FNHRST - INHRST 00085200 CHDR RNHTST = IHTST + RSHFTS + FRSC 00085300 RNHTST = RHTST + RSHFTS 00085400 IF (THL.LE.THL96) 00085500 *RNHTST = RNHTST + FRSC 00085600 INHTST = RNHTST + SIGN(0.5,RNHTST) 00085700 C 00085800 C INHRST = NEW RESIDUAL STATIC 00085900 C RNHTST = NEW TOTAL STATIC 00086000 TEMP = INHRST 00086100 CALL USSTHV (OH, 'THFRES ', TEMP ) 00086200 CALL USSTHV (OH, 'THFRSC ', RNFRSC ) 00086300 IF (THL.LE.THL96) 00086400 *CALL USSTHV (OH, 'THTST ', INHTST ) 00086500 IF (THL.GT.THL96) 00086600 *CALL USSTHV (OH, 'THFTST ', RNHTST ) 00086700 C 00086800 C ==================================================================== 00086900 C KEEP TRACK OF SHOT OR DEPTH POINTS PROCESSED 00087000 C ==================================================================== 00087100 C 00087200 380 IF (NS.GE.20 ) GO TO 390 00087300 IF (KPMITF.NE.0) GO TO 405 00087400 C 00087500 390 IF (GATH.EQ.0)WRITE ( IPR , 9050 ) TNS,(LSHT(L),L=1,N 00087600 *S) 00087700 IF (GATH.NE.0)WRITE ( IPR , 9060 ) TNS,(LSHT(L),L=1,N 00087800 *S) 00087900 IF (PRINT.LE.0) GO TO 400 00088000 C 00088100 WRITE ( IPR , 9070 ) (LTRC(L),L=1,NS) 00088200 WRITE ( IPR , 9080 ) (PRST(L),L=1,NS) 00088300 WRITE ( IPR , 9090 ) (STAP(L),L=1,NS) 00088400 WRITE ( IPR , 9100 ) (NRSS(L),L=1,NS) 00088500 WRITE ( IPR , 9110 ) (OTOT(L),L=1,NS) 00088600 WRITE ( IPR , 9120 ) (NTOT(L),L=1,NS) 00088700 C 00088800 400 IF ( KPMITF.EQ.0 ) GO TO 435 00088900 NS = 0 00089000 405 IF ( PRINT .EQ.2 ) GO TO 410 00089100 IF ( POS.EQ.POSL ) GO TO 420 00089200 C 00089300 410 NS = NS + 1 00089400 TNS = TNS + 1 00089500 LSHT(NS) = SHOTT 00089600 LTRC(NS) = TRACE 00089700 PRST(NS) = IHRSST 00089800 STAP(NS) = RSHFTS*100. + SIGN(0.5,RSHFTS) 00089900 NRSS(NS) = INHRST 00090000 CHDR OTOT(NS) = IHTST 00090100 OTOT(NS) = RHTST + SIGN(0.5, RHTST) 00090200 NTOT(NS) = INHTST 00090300 C 00090400 C SAVE LOCAL VARIABLES 00090500 C 00090600 POSL = POS 00090700 C 00090800 420 CALL ARMVE (DLOCAL, COM(KPIRSM), LLOCAL) 00090900 C 00091000 430 RETURN 00091100 C 00091200 435 KPRTF = 0 00091300 KPLOTF = 0 00091400 KPMOTF = 0 00091500 RETURN 00091600 C NOT ENOUGH MEMORY AVAILABLE 00091700 C 00091800 440 WRITE (IPR, 9130 ) KPNUSM,KPNRSM 00091900 C 00092000 450 KPRTF = -1 00092100 GO TO 430 00092200 C 00092300 460 WRITE (IPR, 9140 ) KPNA,KPRNO 00092400 GO TO 450 00092500 C 00092600 470 WRITE (IPR, 9150 ) 00092700 GO TO 450 00092800 C 00092900 480 WRITE (IPR, 9160 ) 00093000 GO TO 450 00093100 C 00093200 C 490 WRITE (IPR, 9170 ) SHOTT, TRACE 00093300 C GO TO 450 00093400 C 00093500 9000 FORMAT (1X,20I5) 00093600 9005 FORMAT ('-',4X,'=============================================', 00093700 *'=======',/,5X,'=',50X,'=',/,5X,'=',15X,'VARIABLE DESCRIPTION', 00093800 X *15X,'=',/,5X,'=',50X,'=',/,5X,'= SP = SHOTPOINT',34X,'=',/, 00093900 * 5X,'= DP = DEPTH POINT',32X,'=',/, 00094000 * 5X,'= TR = TRACE NUMBER',31X,'=',/, 00094100 * 5X,'= PRS = PREVIOUS RESIDUAL STATIC ',2X,'(MS)', 00094200 *12X,'=',/, 00094300 * 5X,'= SSA = STATIC SHIFT ACTUALLY APPLIED (MS*100)', 00094400 * 5X,'=',/, 00094500 * 5X,'= NRS = NEW RESIDUAL STATIC FOR TRACE (MS) ', 00094600 * 5X,'=',/, 00094700 * 5X,'= OTS = OLD TOTAL STATIC (MS) ', 00094800 * 5X,'=',/, 00094900 * 5X,'= NTS = NEW TOTAL STATIC (MS) ', 00095000 * 5X,'=',/, 5X,'=',50X,'=',/, 5X,'=',50X,'=', 00095100 */,5X,'====================================================',//) 00095200 9010 FORMAT ('-',' COUNT TRACES PROCESSED') 00095300 9020 FORMAT (5X,' COEF ARRAY ' ) 00095400 9022 FORMAT (1X, 12E11.4 ) 00095500 9030 FORMAT (5X,'IS100=',I5,' SAMPST=',F6.1,' INTST=',I5, 00095600 * ' FLPST=',F6.1,' ICN=',I5 ) 00095700 9040 FORMAT (5X,'LAG=',I5,' LENB=',I5,' LENC=',I5,' MOVEL=',I5, 00095800 * ' LENZ=',I5,/ ) 00095900 9050 FORMAT (1X,I4,' SP ',20I6) 00096000 9060 FORMAT (1X,I4,' DP ',20I6) 00096100 9070 FORMAT (5X,' TR ',20I6) 00096200 9080 FORMAT (5X,'PRS ',20I6) 00096300 9090 FORMAT (5X,'SSA ',20I6) 00096400 9100 FORMAT (5X,'NRS ',20I6) 00096500 9110 FORMAT (5X,'OTS ',20I6) 00096600 9120 FORMAT (5X,'NTS ',20I6,/) 00096700 9130 FORMAT (5X,'*** NOT ENOUGH MEMORY AVAILABLE: KPNUSM,KPNRSM',2I6) 00096800 9140 FORMAT (5X,'*** NO INFORMATION PRESENT FOR ',A4,I1) 00096900 9150 FORMAT (5X, 00097000 * '*** PROCESS ABORTED. NO OBSERVED TRAVELTIMES IN HEADERS ***') 00097100 9160 FORMAT (5X, 00097200 * '*** PROCESS ABORTED. NO VERTICAL TRAVELTIMES IN HEADERS ***') 00097300 C9170 FORMAT (5X, 00097400 C * '*** PROCESS ABORTED. ', 00097500 C * ' TRAVELTIMES MISSING FOR REC, TR =', 2I5, '***' ) 00097600 9180 FORMAT (/5X, 00097700 * '*** WARNING: COMPONENT NUMBER MISSING FOR REC, TR =',2I5,'***') 00097800 C 00097900 END 00098000