CTITLESASTPR -- ELEVATION AND WEATHERING STATICS PROCESSING ROUTINE 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C 00020000 CA AUTHOR J.MENDEKE 00030000 CA DESIGNER J.MENDEKE 00040000 CA LANGUAGE S/370 FORTRAN H 00050000 CA SYSTEM IBM AND CRAY 00060000 CA WRITTEN 02-18-75 00070000 C REVISED 08-16-84 GRAY - MOVED PROCESSING INTO SUBROUTINE TO 00080000 C COMPLY WITH NAMING CONVENTIONS. 00090000 C REVISED 07-08-85 BYRD - ELIMINATED ROUND-OFF/INTERPOLATION PRO- 00100000 C BLEMS THROUGHOUT PROGRAM. CONVERTED THE FOL- 00110000 C LOWING ARRAYS FROM I*2 TO R: SPE, SST, UPHOLE, 00120000 C TWTH, DSHOT, DWTH, DATVEL, DATELE, WTHVEL, GPE, 00130000 C GST, SSD. CREATED THE FOLLOWING ARRAYS TO BE 00140000 C USED IN PRODUCING PRINTER PLOTS: ISPE, IUPHOL, 00150000 C IDSHOT, IDATVL, IDATEL, IWTHVL, IGPE, ISSD. 00160000 C REVISED 07-17-85 BYRD - CHANGED ACTUAL ARGUMENT LIST IN CALL TO 00170000 C SUBROUTINE MRDTM TO SPECIFY ARRAYS IGPE AND 00180000 C ISSD, INSTEAD OF GPE AND SSD. CHANGED ALL RE- 00190000 C FERENCES TO GPE AND SSD IN LOGIC FOLLOWING THIS 00200000 C CALL TO IGPE AND ISSD. 00210000 C REVISED 07-25-85 BYRD - CORRECTED A PROBLEM WITH ACCESSING CON- 00220000 C TENTS OF STORAGE AREA EQUIVALENCED FOR ARRAYS 00230000 C IGPE, GPE, AND GST. CODE WAS TRYING TO ACCESS 00240000 C CONTENTS THROUGH REFERENCING GST AFTER CONTENTS 00250000 C HAD BEEN CONVERTED TO HALF-WORD INTEGERS AND 00260000 C STORED THROUGH REFERENCING IGPE. 00270000 C REVISED 02-07-86 BYRD - ALTERED SUBROUTINE TO STORE CALCULATED 00280000 C VALUES FOR SOURCE AND RECEIVER STATICS IN NEW 00290000 C TRACE HEADER VARIABLES, THCSST AND THCRST. 00300000 C THSST AND THRST WILL NOW BE UPDATED AT THE TIME 00310000 C OF ACTUAL APPLICATION OF A STATIC CORRECTION TO 00320000 C THE DATA. 00330000 C REVISED 03-12-86 BYRD - CONVERTED CODE TO A SINGLE 00340000 C SOURCE FOR EXECUTION ON BOTH THE 00350000 C IBM AND CRAY SYSTEMS. 00360000 C REVISED 04-14-86 MJM - ADDED CODE TO PREVENT JOB TIME OUT WHEN 00370000 C NEGATIVE RECEIVER STATIONS ARE USED. 00380000 C REVISED 09-09-86 CMP - CHANGE USSRTC SORT CODE FROM 3 TO 1. 00390000 C REVISED 09-24-86 CMP - FIX BUG IN ASSOCIATING CORRECT GM3D SHOT 00400000 C ELEVATIONS. 00410000 C REVISED 10-03-86 PKC - CHECK FOR DATUM ELEVATION BLANK IF DOING 00420000 C DATUM SMOOTHING - SET TO ZERO IF BLANK. 00430000 C REVISED 10-03-86 CMP - FIX ERROR MESSAGE 9045. 00440000 C REVISED 10-17-86 CMP - FIX TO READ SHOT ELEVATIONS IN SEQUENCE 00450000 C AFTER MODIFICATION TO SAGXYE. 00460000 C FIX DUPLICATE SHOT LOCATION PROBLEM. 00470000 C FIX SHOT STATIC PRINTER ARRAY FOR MDP OPTION. 00480000 C REVISED 11-13-86 CMP - MAKE CARD ARRAY C*80 FOR CRAY. 00490000 C REVISED 03-13-87 CMP - FIX BUG IN RSE OPTION FOR DUPLICATE SHOTS.00500000 C REVISED 12-24-87 PKC - ADD SHOTPOINT AND RECEIVER INTERPOLATION 00510000 C BASED ON X-Y'S FOR 3D DATA. 00520000 C REVISED 01-25-88 LWC OPTION FOR NO PRINT. 00521000 C REVISED 03-04-88 JJC - FOR CRAY COMPATIBILITY TO DO SHOTPOINT 00521100 C AND RECEIVER INTERPOLATION BASED ON X-Y. 00521200 C REVISED 04-30-88 JJC - OPTION TO ADJUST THE SHOT ELEVATIONS TO 00521300 C WATER BOTTOM IN A COMBINATION OF LAND AND 00521400 C MARINE DATA 00521500 C REVISED 06-24-88 TJT. MADE LCGRPI FLOATING PT. CHANGE PERMANENT. 00521600 C REVISED 10-17-88 LWC. CHECK FOR ELEVATIONS FROM GM3D AND CARD 00521700 C TYPE SSE OR GST OR SST OR SPE. 00521800 C REVISED 02-27-89 TJT. CHANGE TO GET ELEVATIONS FROM HEADER FILE 00521900 C INSTEAD OF FROM PARM FILE. ALSO HANDLE GM3D 00522000 C MULTIPLE ALP CARD CASE IN WHICH THERE ARE 00522100 C DUPLICATED SHOT POINTS. 00522200 C REVISED 04-03-89 TJT. FIX INITIALIZATION OF SPE ARRAY WHEN ELEVS 00522300 C ARE INPUT FROM CARDS. 00522400 C REVISED 11-13-89 RDK. FOR CRAY CFT77 COMPATIBILITY. 00522500 C REVISED 12-08-89 LWC. MAKE NEW VARIABLE FOR DEPTH OF SHOT (DSS) 00522600 C TO CORRECT VALUE BEING PUT IN TRACE HEADER. 00522700 CA 00522800 CA 00522900 CA 00523000 CA THIS PREPARATION ROUTINE SCRUTINIZES USER INPUT DATA 00523100 CA CARDS FOR POSSIBLE ERRORS. IF NO ERRORS ARE FOUND THE 00523200 CA PARAMETERS LISTED ON THE INPUT CARDS ARE USED TO 00524000 CA COMPUTE STATICS WHICH ARE USED TO UPDATE THE TRACE 00525000 CA HEADERS IN THE SEISPARM FILE. 00526000 CA 00527000 CA 00528000 CA 00529000 CA 00530000 CA 00540000 CA CALL SASTPR( SAVI, REFNO, ASPNO, SHSTAT, 00550000 CA 00560000 CA * SPE, SST, UPHOLE, TWTH, 00570000 CA 00580000 CA * DSHOT, DWTH, DATVEL, DATELE, 00590000 CA 00600000 CA * WTHVEL, PLOTZ, MDDE, MDDEHW, 00610000 CA 00620000 CA * CDPREF, GPREFN, GPE, GST, 00630000 CA 00640000 CA * GPSTAN, GPSTAT, SSD, FOLD, 00650000 CA 00660000 CA * ISPE, IUPHOL, IDSHOT, IDATVL, 00670000 CA 00680000 CA * IDATEL, IWTHVL, IGPE, ISSD, 00690000 CA 00700000 CA * ISHOTX, ISHOTY, IRCVRX, IRCVRY, 00710000 CA 00720000 CA * IWDPS, WDPS, 00730000 CA 00740000 CA * MAXSPS, MAXRVS, MAXDS ) 00750000 CA 00760000 CA 00770000 CA 00780000 CA IN/OUT ARG TYPE LENGTH DESCRIPTION 00790000 CA 00800000 CA IN SAVI I*4 MAXSPS ARRAY TO SAVE SHOT INDEXES 00810000 CA IN REFNO I*4 MAXSPS SHOTPOINT LOCATION ARRAY 00820000 CA IN ASPNO I*4 MAXSPS SHOTPOINT NUMBER ARRAY 00830000 CA IN SHSTAT I*2 MAXSPS SHOT STATIC ARRAY 00840000 CA IN SPE R MAXSPS SHOTPOINT ELEVATION ARRAY 00850000 CA IN SST R MAXSPS WORK ARRAY 00860000 CA IN UPHOLE R MAXSPS UPHOLE TIME AT THIS SHOT 00870000 CA IN TWTH R MAXSPS TIME THROUGH WEATHERING ARRAY 00880000 CA IN DSHOT R MAXSPS SHOT DEPTH ARRAY 00890000 CA IN DWTH R MAXSPS DEPTH OF WEATHERING ARRAY 00900000 CA IN DATVEL R MAXSPS DATUM VELOCITY AT THIS SHOT 00910000 CA IN DATELE R MAXSPS DATUM ELEVATION AT THIS SHOT 00920000 CA IN WTHVEL R MAXSPS WEATHERING VELOCITY AT THIS SHOT 00930000 CA IN PLOTZ I*2 MAXSPS WORK ARRAY 00940000 CA IN MDDE I*4 MAXDS CDF DATUM ELEVATION ARRAY 00950000 CA IN MDDEHW I*2 MAXDS CDF DATUM ELEVATION ARRAY (HALFWORDS) 00960000 CA IN CDFREF I*4 MAXDS CDF LOCATION ARRAY 00970000 CA IN GRPEFN I*4 MAXRVS RECEIVER REFERENCE NUMBER ARRAY 00980000 CA IN GPE R MAXRVS RECEIVER ELEVATION ARRAY 00990000 CA IN GST R MAXRVS WORK ARRAY 01000000 CA IN GPSTAN I*2 MAXRVS RECEIVER STATION NUMBER ARRAY 01010000 CA IN GPSTAT I*2 MAXRVS RECEIVER STATIC ARRAY 01020000 CA IN SSD R MAXRVS RECEIVER DATUM ELEVATIONS 01030000 CA IN FOLD I*2 MAXDS ARRAY TO HOLD NUMBER OF TRACES IN CDF 01040000 CA IN ISPE I*2 MAXSPS SHOTPOINT ELEVATION ARRAY 01050000 CA IN IUPHOL I*2 MAXSPS UPHOLE TIME AT THIS SHOT 01060000 CA IN IDSHOT I*2 MAXSPS SHOT DEPTH ARRAY 01070000 CA IN IDATVL I*2 MAXSPS DATUM VELOCITY AT THIS SHOT 01080000 CA IN IDATEL I*2 MAXSPS DATUM ELEVATION AT THIS SHOT 01090000 CA IN IWTHVL I*2 MAXSPS WEATHERING VELOCITY AT THIS SHOT 01100000 CA IN IGPE I*2 MAXRVS RECEIVER ELEVATION ARRAY 01110000 CA IN ISSD I*2 MAXRVS RECEIVER DATUM ELEVATIONS 01120000 CA IN ISHOTX I*4 MAXSPS SHOTPOINT X-COOR. ARRAY 01130000 CA IN ISHOTY I*4 MAXSPS SHOTPOINT Y-COOR. ARRAY 01140000 CA IN IRCVRX I*4 MAXRVS RECEIVER X-COOR. ARRAY 01150000 CA IN IRCVRY I*4 MAXRVS RECEIVER Y-COOR. ARRAY 01160000 CA IN MAXSPS I*4 1 SIZE OF SHOTPOINT BUFFERS ALLOCATED 01170000 CA IN MAXRVS I*4 1 SIZE OF RECEIVER BUFFERS ALLOCATED 01180000 CA IN MAXDS I*4 1 MAX (MAXSPS, MAX CDFS) 01190000 CA IN IWDPS I*4 MAXSPS SHOT WATER DEPTH ARRAY 01200000 CA IN WDPS R MAXSPS SHOT WATER DEPTH ARRAY 01210000 CA 01220000 CA 01230000 CA 01240000 CA 01250000 C EJECT 01260000 C 01270000 C 01280000 C 01290000 C DEBUG UNIT(6),TRACE,INIT(SPDP,NDPS,CDPS,STSTAN,NGPS,REFNO, 01291000 C * SPINDX,SPT,ASPNO,MAXSPS,SESNDX,SEENDX) 01292000 C AT 25 01293000 C TRACE ON 01293100 C AT 1040 01293200 C TRACE OFF 01293300 C END DEBUG 01293400 SUBROUTINE SASTPR( SAVI, REFNO, ASPNO, SHSTAT, 01293500 C 01293600 * SPE, SST, UPHOLE, TWTH, 01293700 C 01293800 * DSHOT, DWTH, DATVEL, DATELE, 01293900 C 01294000 * WTHVEL, PLOTZ, MDDE, MDDEHW, 01295000 C 01296000 * CDPREF, GPREFN, GPE, GST, 01297000 C 01298000 * GPSTAN, GPSTAT, SSD, FOLD, 01299000 C 01300000 * ISPE, IUPHOL, IDSHOT, IDATVL, 01310000 C 01320000 * IDATEL, IWTHVL, IGPE, ISSD, 01330000 C 01340000 * ISHOTX, ISHOTY, IRCVRX, IRCVRY, 01350000 C 01360000 * IWDPS, WDPS, 01370000 C 01380000 * MAXSPS, MAXRVS, MAXDS ) 01390000 C 01400000 C 01410000 C 01420000 C 01430000 C 01440000 IMPLICIT INTEGER (A-Z) 01450000 C EXTERNAL S1ATP 01460000 CX 01470000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/29/83 01480000 COMMON /P/ STARTP ( 2) 01490000 COMMON /P/ LCNAME 01500000 COMMON /P/ LC5 01510000 COMMON /P/ LCINT 01520000 COMMON /P/ LCTYP , M00020 01530000 COMMON /P/ LCBGSP 01540000 COMMON /P/ LCENSP , M00032( 2) 01550000 COMMON /P/ LCNSP 01560000 COMMON /P/ LCTPSP 01570000 COMMON /P/ LCRL 01580000 COMMON /P/ LCSI 01590000 COMMON /P/ LCPI 01600000 COMMON /P/ LCGRPI 01610000 COMMON /P/ LCMXFD , M00068 01620000 COMMON /P/ LCMXLN 01630000 COMMON /P/ LCDRYF , M00080( 3) 01640000 COMMON /P/ ACNAME 01650000 COMMON /P/ AC0506 01660000 COMMON /P/ AC64BC 01670000 COMMON /P/ ACOPCD 01680000 COMMON /P/ ACQCF 01690000 COMMON /P/ ACDIST 01700000 COMMON /P/ ACPROJ 01710000 COMMON /P/ ACLNAM ( 5) 01720000 COMMON /P/ ACCOM ( 8) , M00144 01730000 COMMON /P/ ACTYPE 01740000 COMMON /P/ ACNSP 01750000 COMMON /P/ ACUSER ( 5) , M00188( 12) 01760000 COMMON /P/ LHJBNO 01770000 COMMON /P/ LHLNO 01780000 COMMON /P/ LHRLNO 01790000 COMMON /P/ LHTPSP 01800000 COMMON /P/ LHATSP 01810000 COMMON /P/ LHSI 01820000 COMMON /P/ LHORSI 01830000 COMMON /P/ LHST 01840000 COMMON /P/ LHORST 01850000 COMMON /P/ LHDFCD 01860000 COMMON /P/ LHEXFD 01870000 COMMON /P/ LHTSCD 01880000 COMMON /P/ LHVSCD 01890000 COMMON /P/ LHSWFS 01900000 COMMON /P/ LHSWFE 01910000 COMMON /P/ LHSWL 01920000 COMMON /P/ LHSWCD 01930000 COMMON /P/ LHTSNO 01940000 COMMON /P/ LHSWTS 01950000 COMMON /P/ LHSWTE 01960000 COMMON /P/ LHSWTT 01970000 COMMON /P/ LHTCF 01980000 COMMON /P/ LHBGRF 01990000 COMMON /P/ LHARCD 02000000 COMMON /P/ LHMS 02010000 COMMON /P/ LHSGPL 02020000 COMMON /P/ LHVPCD 02030000 COMMON /P/ LHNSP 02040000 COMMON /P/ LHNDP 02050000 COMMON /P/ LHNSL 02060000 COMMON /P/ LHMTPR , M00376( 9) 02070000 COMMON /P/ KPNA 02080000 COMMON /P/ KPRNO , M00420 02090000 COMMON /P/ KPA 02100000 COMMON /P/ KPDBGS 02110000 COMMON /P/ KPDBGA 02120000 COMMON /P/ KPDBGN 02130000 COMMON /P/ KPWRKS 02140000 COMMON /P/ KPWRKD , M00448( 4) 02150000 COMMON /P/ KPFCF 02160000 COMMON /P/ KPIRSM 02170000 COMMON /P/ KPNRSM 02180000 COMMON /P/ KPIUSM 02190000 COMMON /P/ KPNUSM 02200000 COMMON /P/ KPTIME 02210000 COMMON /P/ KPRTF 02220000 COMMON /P/ KPDRTF 02230000 COMMON /P/ KPMOTF 02240000 COMMON /P/ KPNBR 02250000 COMMON /P/ KPIBN 02260000 COMMON /P/ KPITSV 02270000 COMMON /P/ KPTAMF 02280000 COMMON /P/ KPLOTF 02290000 COMMON /P/ KPMITF 02300000 COMMON /P/ KPPRNT 02310000 COMMON /P/ KPPLOT 02320000 COMMON /P/ KPPLTA 02330000 COMMON /P/ KPBUGF , M00540( 226) 02340000 COMMON /P/ ENDP 02350000 C 02360000 REAL LCGRPI 02370000 C 02380000 C DYNAMICALLY DIMENSIONED ARRAYS IN BLANK COMMON 02390000 C 02400000 INTEGER*4 SAVI (MAXSPS) 02410000 INTEGER*4 REFNO (MAXSPS) 02420000 INTEGER*4 ASPNO (MAXSPS) 02430000 INTEGER*2 SHSTAT (MAXSPS) 02440000 INTEGER*2 ISPE (MAXSPS) 02450000 INTEGER*2 IUPHOL (MAXSPS) 02460000 INTEGER*2 IDSHOT (MAXSPS) 02470000 INTEGER*2 IDATVL (MAXSPS) 02480000 INTEGER*2 IDATEL (MAXSPS) 02490000 INTEGER*2 IWTHVL (MAXSPS) 02500000 INTEGER*4 ISHOTX (MAXSPS) 02510000 INTEGER*4 ISHOTY (MAXSPS) 02520000 INTEGER*2 PLOTZ (MAXSPS) 02530000 INTEGER*4 MDDE (MAXDS ) 02540000 INTEGER*2 MDDEHW (MAXDS ) 02550000 INTEGER*4 CDPREF (MAXDS ) 02560000 INTEGER*4 GPREFN (MAXRVS) 02570000 INTEGER*2 IGPE (MAXRVS) 02580000 INTEGER*4 GPSTAN (MAXRVS) 02590000 INTEGER*2 GPSTAT (MAXRVS) 02600000 INTEGER*2 ISSD (MAXRVS) 02610000 INTEGER*4 IRCVRX (MAXRVS) 02620000 INTEGER*4 IRCVRY (MAXRVS) 02630000 INTEGER*2 FOLD (MAXDS ) 02640000 INTEGER*4 IWDPS (MAXSPS) 02650000 C 02660000 REAL SPE (MAXSPS) 02670000 REAL SST (MAXSPS) 02680000 REAL UPHOLE (MAXSPS) 02690000 REAL TWTH (MAXSPS) 02700000 REAL DSHOT (MAXSPS) 02710000 REAL DWTH (MAXSPS) 02720000 REAL DATVEL (MAXSPS) 02730000 REAL DATELE (MAXSPS) 02740000 REAL WTHVEL (MAXSPS) 02750000 REAL GPE (MAXRVS) 02760000 REAL GST (MAXRVS) 02770000 REAL SSD (MAXRVS) 02780000 REAL WDPS (MAXSPS) 02790000 C 02800000 C NOTE - THE FOLLOWING ARRAYS ARE EQUIVALENCED IN DYNAMIC MEMORY 02810000 C 02820000 CKG EQUIVALENCE (TWTH(1), UPHOLE(1), IUPHOL(1)) 02830000 CKG EQUIVALENCE (DWTH(1), DSHOT(1), IDSHOT(1)) 02840000 CKG EQUIVALENCE (SST (1), SPE (1), ISPE (1)) 02850000 CKG EQUIVALENCE (MDDE(1), MDDEHW(1)) 02860000 CKG EQUIVALENCE (GST(1), GPE(1), IGPE(1)) 02870000 CDB EQUIVALENCE (DATVEL(1), IDATVL(1)) 02880000 CDB EQUIVALENCE (DATELE(1), IDATEL(1)) 02890000 CDB EQUIVALENCE (WTHVEL(1), IWTHVL(1)) 02900000 CDB EQUIVALENCE (SSD(1), ISSD(1)) 02910000 C 02920000 INTEGER*4 TRCNO (24) 02930000 INTEGER*4 TSTAT (24) 02940000 INTEGER*4 RSTAT (24) 02950000 INTEGER*4 SSTAT (24) 02960000 C 02970000 C 02980000 CHARACTER*80 CARD 02990000 CHARACTER*80 CARD2 03000000 C 03010000 INTEGER TRCHDR (190) 03020000 INTEGER DENTRY (104) 03030000 INTEGER DATTR (96) 03040000 INTEGER SVE 03050000 INTEGER XYP 03060000 INTEGER DYN 03070000 INTEGER CHSPE 03080000 INTEGER GM3D 03090000 INTEGER TYPE 03100000 C 03110000 C PREPARE FOR PARAMETER RECORD FROM GM3D 03120000 C 03130000 EQUIVALENCE (DCTYP , DENTRY(3)) 03140000 EQUIVALENCE (SRCV , DENTRY(4)) 03150000 CE EQUIVALENCE ( , DENTRY(5)) 03160000 EQUIVALENCE (NOPAR , DENTRY(6)) 03170000 CE EQUIVALENCE ( , DENTRY(7)) 03180000 CE EQUIVALENCE ( , DENTRY(8)) 03190000 EQUIVALENCE (DATTR(1), DENTRY(9)) 03200000 C 03210000 C INTEGER VARIABLES AND CONSTANTS -- LOCAL 03220000 C 03230000 INTEGER NCALL 03240000 C 03250000 C 03260000 C REAL VARIABLES AND CONSTANTS--LOCAL 03270000 C 03280000 REAL LINT 03290000 REAL RVINT 03300000 REAL VJ 03310000 REAL VIM1 03320000 REAL RJ 03330000 REAL RIM1 03340000 REAL RI 03350000 REAL RJM1 03360000 REAL VJM1 03370000 REAL PT5 03380000 REAL DE 03390000 REAL DS 03400000 REAL UH 03410000 REAL DV 03420000 REAL EL 03430000 REAL FSSTC 03440000 REAL FGSTC 03450000 REAL DPEL 03460000 REAL DPDE 03470000 REAL SPDP 03480000 REAL SOURCE 03490000 REAL FACTOR 03500000 REAL FSSTC1 03510000 REAL FSSTC2 03520000 REAL COSLN 03530000 REAL SINLN 03540000 REAL AZMTH 03550000 REAL TWOPI 03560000 REAL XMIN 03570000 REAL XMAX 03580000 REAL YMIN 03590000 REAL YMAX 03600000 C 03610000 C INITIALIZE INTEGER VARIABLES AND CONSTANTS -- LOCAL 03620000 C 03630000 DATA TRCHDR / 190*0/ 03640000 DATA SVE /'SVE '/ 03650000 DATA XYP /'XYP '/ 03660000 DATA DYN /'DYN '/ 03670000 DATA CHSPE /'SPE '/ 03680000 DATA GM3D /'GM3D'/ 03690000 DATA TYPE /' SUB'/ 03700000 DATA NCALL / 1/ 03710000 DATA TWOPI /6.283185307/ 03720000 C 03730000 C INITIALIZATION AREA 03740000 C ================== 03750000 C 03760000 IF(1.EQ.2) CALL S1ATP 03770000 C 03780000 DA1 = 1 03790000 DA2 = 1 03800000 DA3 = 1 03810000 COLD THRLEN = 96 03820000 MAXDPS = 0 03830000 CKG MAXSPS = 2500 03840000 CKG MAXGPS = 5000 03850000 C 03860000 MAXGPS = MAXRVS 03870000 C 03880000 SPEFLG = 0 03890000 SSTFLG = 0 03900000 GSTFLG = 0 03910000 DWTHFL = 0 03920000 TWTHFL = 0 03930000 IMINXS = 999999999 03940000 IMAXXS = -999999999 03950000 IMINYS = 999999999 03960000 IMAXYS = -999999999 03970000 IMINXR = 999999999 03980000 IMAXXR = -999999999 03990000 IMINYR = 999999999 04000000 IMAXYR = -999999999 04010000 RVINT = LCGRPI 04020000 C PRINT HEADING 04030000 CALL USPHD (1,ACLNAM,KPNA,KPRNO,0,0,KPPRNT) 04040000 C 04050000 IF (NCALL .EQ. 0) GO TO 1010 04060000 NCALL = 0 04070000 NOREC = 0 04080000 C 04090000 C ZERO ARRAYS 04100000 C 04110000 DO 10 04120000 * I = 1, MAXGPS 04130000 GPREFN (I) = 0 04140000 GPE (I) = -9999 04150000 GPSTAN (I) = 0 04160000 GPSTAT (I) = 0 04170000 SSD (I) = -9999 04180000 IRCVRX (I) = -9999 04190000 IRCVRY (I) = -9999 04200000 C 04210000 10 CONTINUE 04220000 C 04230000 GESNDX = MAXGPS 04240000 GEENDX = 1 04250000 SDSNDX = MAXGPS 04260000 SDENDX = 1 04270000 C 04280000 C 04290000 C 04300000 DO 15 04310000 * I = 1, MAXDS 04320000 MDDE (I) = 0 04330000 FOLD (I) = 0 04340000 CDPREF (I) = 0 04350000 C 04360000 15 CONTINUE 04370000 C 04380000 C 04390000 C 04400000 DO 20 04410000 * I = 1, MAXSPS 04420000 SPE (I) = -9999 04430000 SHSTAT (I) = 0 04440000 REFNO (I) = 0 04450000 ASPNO (I) = 0 04460000 UPHOLE (I) = -9999 04470000 DSHOT (I) = -9999 04480000 DATVEL (I) = -9999 04490000 DATELE (I) = -9999 04500000 WTHVEL (I) = -9999 04510000 DWTH (I) = -9999 04520000 TWTH (I) = -9999 04530000 PLOTZ (I) = 0 04540000 ISHOTX (I) = -9999 04550000 ISHOTY (I) = -9999 04560000 WDPS (I) = -9999 04570000 C 04580000 20 CONTINUE 04590000 C 04600000 UPSNDX = MAXSPS 04610000 UPENDX = 1 04620000 DSSNDX = MAXSPS 04630000 DSENDX = 1 04640000 SESNDX = MAXSPS 04650000 SEENDX = 1 04660000 DVSNDX = MAXSPS 04670000 DVENDX = 1 04680000 DESNDX = MAXSPS 04690000 DEENDX = 1 04700000 WVSNDX = MAXSPS 04710000 WVENDX = 1 04720000 C 04730000 C RETRIEVE LINE AZIMUTH IF PRESENT 04740000 C 04750000 CALL USRHDR (TRCHDR , DA1, *25 ) 04760000 CALL USRTHV (TRCHDR, 'THLNBG ', AZMTH) 04770000 CALL USRTHV (TRCHDR, 'THSPLN ', LINT) 04780000 AZMTH = 450 - AZMTH 04790000 IF (AZMTH .GE. 360) AZMTH = AZMTH - 360 04800000 AZMTH = AZMTH * TWOPI/360. 04810000 COSLN = COS(AZMTH) 04820000 SINLN = SIN(AZMTH) 04830000 C READ THE TRACE HEADERS AND STORE DATA 04840000 C INTO REFNO, ASPNO, AND SPE.... 04850000 C ===================================== 04860000 25 I = 0 04870000 NSSP = 0 04880000 C 04890000 30 DA1 = NSSP * (LCTPSP) + 1 04900000 C 04910000 CALL USRHDR (TRCHDR , DA1, *40 ) 04920000 CALL USRTHV (TRCHDR, 'THSSP ',XSPNO) 04930000 NSSP = NSSP + 1 04940000 IF (I .NE. 0) THEN 04950000 DO 35 J = 1, I 04960000 IF (XSPNO .EQ. ASPNO(J)) GO TO 30 04970000 35 CONTINUE 04980000 ENDIF 04990000 I = I + 1 05000000 ASPNO(I) = XSPNO 05010000 CALL USRTHV (TRCHDR, 'THSLN ',REFNO(I)) 05020000 CALL USRTHV (TRCHDR, 'THSSEL ',SPELEV ) 05030000 SPE(I) = SPELEV 05031000 SAVI(I) = I 05032000 IF (LINT .NE. 0.0) THEN 05033000 CALL USRTHV (TRCHDR, 'THSRXC ',IX) 05034000 CALL USRTHV (TRCHDR, 'THSRYC ',IY) 05035000 ISHOTX(I) = IX * COSLN + IY * SINLN 05036000 ISHOTY(I) = IY * COSLN - IX * SINLN 05037000 IF (ISHOTX(I) .LT. IMINXS) IMINXS = ISHOTX(I) 05038000 IF (ISHOTY(I) .LT. IMINYS) IMINYS = ISHOTY(I) 05039000 IF (ISHOTX(I) .GT. IMAXXS) IMAXXS = ISHOTX(I) 05040000 IF (ISHOTY(I) .GT. IMAXYS) IMAXYS = ISHOTY(I) 05050000 ENDIF 05060000 C 05070000 GO TO 30 05080000 C 05090000 40 IF (I.EQ.0) GO TO 970 05100000 INDEX = I 05110000 LOCATN = INDEX 05120000 LOCM1 = LOCATN -1 05130000 C 05140000 C SORT THE SHOTS BY LOCATION 05150000 C 05160000 C 05170000 C 05180000 CALL USSRTC (LOCATN, 1, 'INCR', 1, REFNO, ASPNO, SAVI, ISHOTX, 05190000 * ISHOTY, SPE) 05200000 C 05210000 DA1 = 1 05220000 ELVFLG = 0 05230000 41 CALL FORC(KPNA,KPRNO,DA1,CARD, * 43 ) 05240000 IF (S1CPCH(CARD,8,' ',1,3).NE.0) GO TO 41 05250000 IF (S1CPCH(CARD,78,'RCE',1,3) .EQ. 0) ELVFLG = 1 05260000 IF (S1CPCH(CARD,78,'SHE',1,3) .EQ. 0) ELVFLG = 2 05270000 IF (S1CPCH(CARD,78,'RSE',1,3) .EQ. 0) ELVFLG = 3 05280000 C 05290000 IF (ELVFLG .NE. 2 .AND. ELVFLG .NE. 3) THEN 05291000 DO 161 I = 1, MAXSPS 05291100 161 SPE(I) = -9999 05291200 GO TO 46 05291300 ENDIF 05291400 C 05291500 43 DO 45 J = 1, INDEX 05291600 IF (SPE(J) .EQ. -9999) GO TO 45 05291700 SESNDX = MIN (J, SESNDX) 05291800 SEENDX = MAX (J, SEENDX) 05291900 45 CONTINUE 05292000 46 CONTINUE 05293000 C STSTAN - FIRST REC. STN.05294000 CALL USRTHV (TRCHDR, 'THSTGS ', STSTAN) 05295000 C NGPS - NO. RECEIVERS 05296000 CALL USRTHV (TRCHDR, 'THNGPS ', NGPS) 05297000 C STCDPN - FIRST CDF 05298000 CALL USRTHV (TRCHDR, 'THSDPN ', STCDPN) 05299000 C NDPS - NO. CDFS 05300000 CALL USRTHV (TRCHDR, 'THNDPS ', NDPS ) 05310000 C 05320000 CALL USRTHV (TRCHDR, 'THSPDP ', SPDP ) 05330000 C 05340000 NGPS = NGPS 05350000 C 05360000 C CHECK FOR MORE INFORMATION INPUT THAN ACTUAL RECEIVERS 05370000 C 05380000 DAP = 1 05390000 48 CALL FORP(GM3D,0,DAP,104,DENTRY, *49) 05400000 IF (DCTYP .NE. DYN) GO TO 48 05410000 IF (DATTR(4) .GT. NGPS) NGPS = DATTR(4) 05420000 C 05430000 49 GPREFN(1) = STSTAN*100 05440000 GPSTAN (1) = STSTAN 05450000 C 05460000 DO 50 05470000 * I = 2,NGPS 05480000 GPREFN(I) = GPREFN(I-1) + 100 05490000 GPSTAN(I) = GPSTAN(I-1) + 1 05500000 C 05510000 50 CONTINUE 05520000 C 05530000 C CHECK FOR 3D DATA - IF SO THEN RETRIEVE RECEIVER X-Y'S 05540000 C 05550000 IF (LINT .NE. 0.0) THEN 05560000 DA1 = 1 05570000 DX = 0 05580000 CALL CLOCK (DX, TX) 05590000 DAP = 1 05600000 NOC = 0 05610000 C 05620000 C READ X-Y'S PASSED BY GM3D 05630000 C 05640000 51 CALL FORP(GM3D,0,DAP,104,DENTRY, *57) 05650000 IF (DCTYP .NE. XYP) GO TO 51 05660000 IF (KPBUGF .EQ. 2) WRITE(KPPRNT, 99991) DENTRY 05670000 99991 FORMAT(//2X,A4,I1,1X,A4,5I6,5(/2X,20I6)) 05680000 NOC = NOC + 1 05690000 BGE = 1 05700000 RCV = SRCV 05710000 ENDDO = NOPAR / 2 05720000 DO 52 05730000 * I = 1, ENDDO 05740000 IF (RCV.GE.STSTAN.AND.RCV.LE.GPSTAN(NGPS)) GO TO 53 05750000 WRITE (KPPRNT, 9000) RCV 05760000 RCV = RCV + 1 05770000 BGE = BGE + 2 05780000 52 CONTINUE 05790000 C 05800000 GO TO 51 05810000 C 05820000 53 RCVNDX = RCV * 100 05830000 SVENDX = RCV - STSTAN + 1 05840000 C 05850000 54 IF (RCVNDX .EQ. GPREFN(SVENDX)) GO TO 55 05860000 IF (RCVNDX .LT. GPREFN(SVENDX)) SVENDX = SVENDX - 1 05870000 IF (RCVNDX .GT. GPREFN(SVENDX)) SVENDX = SVENDX + 1 05880000 GO TO 54 05890000 C 05900000 C RETRIEVE AND ROTATE X-Y'S TO PROSPECT AZIMUTH 05910000 C 05920000 55 J = 0 05930000 DO 56 05940000 * I = BGE, NOPAR, 2 05950000 J = J + 1 05960000 IX = DATTR(I) * COSLN + DATTR(I+1) * SINLN 05970000 IY = DATTR(I+1) * COSLN - DATTR(I) * SINLN 05980000 IRCVRX(SVENDX+J-1) = IX 05990000 IRCVRY(SVENDX+J-1) = IY 06000000 IF (IX .LT. IMINXR) IMINXR = IX 06010000 IF (IY .LT. IMINYR) IMINYR = IY 06020000 IF (IX .GT. IMAXXR) IMAXXR = IX 06030000 IF (IY .GT. IMAXYR) IMAXYR = IY 06040000 C 06050000 C 06060000 56 CONTINUE 06070000 C 06080000 GO TO 51 06090000 C 06100000 C ERROR MESSAGE IF NO X-Y'S FROM GM3D 06110000 C 06120000 57 IF (NOC .NE. 0) GO TO 58 06130000 WRITE (KPPRNT, 9245) 06140000 GO TO 1030 06150000 C 06160000 58 WRITE (KPPRNT, 9275) 06170000 C 06180000 C THIS CODE RETRIEVES ONLY THE RECEIVERS THAT HAVE TRACES 06190000 C 52 CALL USRHDR (TRCHDR , DA1, *59 ) 06200000 C CALL USRTHV (TRCHDR,'THRCLN ', RCLN) 06210000 C CALL USRTHV (TRCHDR, 'THRXC ', IX) 06220000 C CALL USRTHV (TRCHDR, 'THRYC ', IY) 06230000 C DO 53 I = 1, NGPS 06240000 C IF (RCLN .EQ. GPREFN(I)) THEN 06250000 C WRITE (KPPRNT,*)'RCLN',RCLN,'IX',IX,'IY',IY 06260000 C IRCVRX(I) = IX * COSLN + IY * SINLN 06270000 C IRCVRY(I) = IY * COSLN - IX * SINLN 06280000 C IF (IRCVRX(I) .LT. IMINXR) IMINXR = IRCVRX(I) 06290000 C IF (IRCVRY(I) .LT. IMINYR) IMINYR = IRCVRY(I) 06300000 C IF (IRCVRX(I) .GT. IMAXXR) IMAXXR = IRCVRX(I) 06310000 C IF (IRCVRY(I) .GT. IMAXYR) IMAXYR = IRCVRY(I) 06320000 C ENDIF 06330000 C 53 CONTINUE 06340000 C 06350000 C GO TO 52 06360000 C 06370000 C 06380000 ENDIF 06390000 C 06400000 C READ THE SHOTPOINT STATIC PARAMETER CARDS 06410000 C AND STORE DATA INTO ARRAYS 06420000 C ========================================== 06430000 NOC = 0 06440000 DA1 = 1 06450000 C 06460000 60 CALL FORC(KPNA,KPRNO,DA1,CARD, *160 ) 06470000 IF (S1CPCH(CARD,8,' ',1,3).NE.0) GO TO 160 06480000 NOC = NOC + 1 06490000 C FIND THE RCVR POINT INDEX 06500000 C 06510000 SPT = S1CVBN (CARD,11,5) 06520000 C 06530000 DO 70 06540000 * I = 1, INDEX 06550000 IF (SPT .NE. ASPNO(I)) GO TO 70 06560000 SPINDX = I 06570000 GO TO 80 06580000 C 06590000 70 CONTINUE 06600000 C 06610000 GO TO 1000 06620000 C 06630000 C STORE THE NON BLANK DATA 06640000 C 06650000 80 CONTINUE 06660000 C 06670000 IF (S1CPCH(CARD,16,' ',1,5).EQ.0)GO TO 90 06680000 UPHOLE(SPINDX) = S1CVBN(CARD,16,5) 06690000 IF(SPINDX.LT.UPSNDX)UPSNDX = SPINDX 06700000 IF(SPINDX.GT.UPENDX)UPENDX = SPINDX 06710000 C 06720000 90 IF (S1CPCH(CARD,21,' ',1,5).EQ.0)GO TO 100 06730000 DSHOT (SPINDX) = S1CVBN(CARD,21,5) 06740000 IF(SPINDX.LT.DSSNDX)DSSNDX = SPINDX 06750000 IF(SPINDX.GT.DSENDX)DSENDX = SPINDX 06760000 C 06770000 100 IF (S1CPCH(CARD,26,' ',1,5).EQ.0)GO TO 110 06780000 SPE (SPINDX) = S1CVBN(CARD,26,5) 06790000 IF (SPINDX.LT.SESNDX)SESNDX = SPINDX 06800000 IF (SPINDX.GT.SEENDX)SEENDX = SPINDX 06810000 SPEFLG = 1 06820000 C 06830000 110 IF (S1CPCH(CARD,31,' ',1,5).EQ.0)GO TO 120 06840000 DATVEL(SPINDX) = S1CVBN(CARD,31,5) 06850000 IF(SPINDX.LT.DVSNDX)DVSNDX = SPINDX 06860000 IF(SPINDX.GT.DVENDX)DVENDX = SPINDX 06870000 C 06880000 120 IF (S1CPCH(CARD,36,' ',1,5).EQ.0)GO TO 130 06890000 DATELE(SPINDX) = S1CVBN(CARD,36,5) 06900000 IF(SPINDX.LT.DESNDX)DESNDX = SPINDX 06910000 IF(SPINDX.GT.DEENDX)DEENDX = SPINDX 06920000 C 06930000 130 IF (S1CPCH(CARD,41,' ',1,5).EQ.0)GO TO 140 06940000 WTHVEL(SPINDX) = S1CVBN(CARD,41,5) 06950000 IF(SPINDX.LT.WVSNDX)WVSNDX = SPINDX 06960000 IF(SPINDX.GT.WVENDX)WVENDX = SPINDX 06970000 C 06980000 140 IF (S1CPCH(CARD,46,' ',1,5).EQ.0)GO TO 150 06990000 DWTH (SPINDX) = S1CVBN(CARD,46,5) 07000000 IF(SPINDX.LT.DSSNDX)DSSNDX = SPINDX 07010000 IF(SPINDX.GT.DSENDX)DSENDX = SPINDX 07020000 DWTHFL = 1 07030000 C 07040000 150 IF (S1CPCH(CARD,51,' ',1,5).EQ.0)GO TO 155 07050000 TWTH (SPINDX) = S1CVBN(CARD,51,5) 07060000 IF(SPINDX.LT.UPSNDX)UPSNDX = SPINDX 07070000 IF(SPINDX.GT.UPENDX)UPENDX = SPINDX 07080000 TWTHFL = 1 07090000 C 07100000 155 IF (NOC .NE. 1) GO TO 60 07110000 IF (S1CPCH(CARD,56,' ',1,5).EQ.0) GO TO 157 07120000 IF (S1CPCH(CARD,58,'SUR',1,3) .NE. 0 .AND. 07130000 * S1CPCH(CARD,58,'SUB',1,3) .NE. 0) GO TO 1025 07140000 CALL S1MVCH (CARD,57,TYPE,1,4) 07150000 157 SOURCE = 0.0 07160000 IF (S1CPCH(CARD,58,'SUR',1,3) .EQ.0) SOURCE = 1.0 07170000 C 07180000 NSMTH = S1CVBN(CARD,61,5) 07190000 CALL USCHFT(CARD,66,5,FACTOR) 07200000 IF (NSMTH .EQ. 0 .AND. FACTOR .NE. 0.) GO TO 1028 07210000 IF (NSMTH .LT. 0 .OR. NSMTH .GT. 999) GO TO 1028 07220000 IF (NSMTH .GT. 0) NSMTH = NSMTH/2*2 + 1 07230000 IF (NSMTH .GT. 0 .AND. FACTOR .EQ. 0) FACTOR = .667 07240000 C 07250000 MDPDE = S1CVBN(CARD, 71, 5) 07260000 IF (MDPDE .NE. 0 .AND. DATELE(SPINDX) .EQ. -9999) THEN 07270000 DATELE(SPINDX) = 0 07280000 IF(SPINDX.LT.DESNDX)DESNDX = SPINDX 07290000 IF(SPINDX.GT.DEENDX)DEENDX = SPINDX 07300000 ENDIF 07310000 C 07320000 ELVFLG = 0 07330000 IF (S1CPCH(CARD,78,'RCE',1,3) .EQ. 0) ELVFLG = 1 07340000 IF (S1CPCH(CARD,78,'SHE',1,3) .EQ. 0) ELVFLG = 2 07350000 IF (S1CPCH(CARD,78,'RSE',1,3) .EQ. 0) ELVFLG = 3 07360000 C 07370000 GO TO 60 07380000 C 07390000 160 IF (NOC .EQ. 0) GO TO 980 07400000 C 07410000 C WEATHERING INPUT IMPLIES SURFACE SOURCE 07420000 C 07430000 IF (TWTHFL .EQ. 1 .OR. DWTHFL .EQ. 1) SOURCE = 1.0 07440000 C 07450000 C INPUT FROM GM3D -- SHOTPOINT ELEVATIONS 07460000 C 07470000 IF (ELVFLG .NE. 2 .AND. ELVFLG .NE. 3) GO TO 169 07480000 CTJT-------------- 07490000 C DAP = 1 07500000 C NOC = 0 07510000 C 07520000 C 161 CALL FORP (GM3D, 0, DAP, 104, DENTRY, *167) 07530000 C IF (DCTYP .NE. CHSPE) GO TO 161 07540000 C NOC = NOC + 1 07550000 C 07560000 C IF (NOC .NE. 1) GO TO 163 07570000 C 07580000 C DO 162 07590000 C * I = 1, INDEX 07600000 C IF (SRCV .NE. ASPNO(I)) GO TO 162 07610000 C SPINDX = I 07620000 C GO TO 164 07630000 C 162 CONTINUE 07640000 C 07650000 C 163 IF (SRCV .EQ. ASPNO(SPINDX)) GO TO 164 07660000 C GO TO 1035 07670000 C 07680000 C 164 DO 166 I = 1, NOPAR 07690000 C SPE(SPINDX) = DATTR(I) 07700000 C 07710000 C SESNDX = MIN(SPINDX, SESNDX) 07720000 C SEENDX = MAX(SPINDX, SEENDX) 07730000 C 07740000 C 07750000 C 165 SPINDX = SPINDX + 1 07760000 C IF (SPINDX .GT. INDEX) GO TO 168 07770000 C 166 CONTINUE 07780000 C 07790000 C GO TO 161 07800000 C 07810000 C 167 IF (NOC .NE. 0) GO TO 168 07820000 C WRITE (KPPRNT, 9250) 07830000 C GO TO 169 07840000 CTJT-------------- 07850000 168 SPEFLG = 1 07860000 WRITE (KPPRNT, 9260) 07870000 C 07880000 C READ 'SPE' OR 'SST' CARDS 07890000 C 07900000 169 DA1 = 1 07910000 C 07920000 170 CALL FORC (KPNA,KPRNO,DA1,CARD, *220 ) 07930000 IF (S1CPCH(CARD,8,'SPE',1,3).NE.0 .AND. 07940000 * S1CPCH(CARD,8,'SST',1,3).NE.0) GO TO 170 07950000 SPT = S1CVBN(CARD,11,5) 07960000 C 07970000 IF (S1CPCH(CARD,8,'SPE',1,3) .EQ. 0) SPEFLG = 1 07980000 IF (S1CPCH(CARD,8,'SST',1,3) .EQ. 0) SSTFLG = 1 07990000 C 08000000 C 08010000 C DONT ALLOW GM3D INFO IF CARD TYPES SPE OR SST 08020000 IF(ELVFLG.EQ.2 .OR. ELVFLG.EQ.3 .AND. NOC.NE.0) GO TO 1060 08030000 C 08040000 C 08050000 C FIND THE SHOTPOINT INDEX 08060000 C 08070000 DO 180 08080000 * I = 1,INDEX 08090000 IF (SPT .NE. ASPNO(I)) GO TO 180 08100000 SPINDX = I 08110000 GO TO 190 08120000 C 08130000 180 CONTINUE 08140000 C 08150000 GO TO 1000 08160000 C 08170000 C STORE THE NON BLANK DATA 08180000 C 08190000 190 DO 210 08200000 * I = 21, 80, 5 08210000 IF (S1CPCH(CARD,I,' ',1,5).EQ.0) GO TO 200 08220000 SPE (SPINDX) = S1CVBN(CARD,I,5) 08230000 IF(SPINDX .LT. SESNDX) SESNDX = SPINDX 08240000 IF(SPINDX .GT. SEENDX) SEENDX = SPINDX 08250000 C 08260000 200 SPINDX = SPINDX + 1 08270000 IF (SPINDX .GE. INDEX) GO TO 210 08280000 IF (SSTFLG .EQ. 1) GO TO 210 08290000 IF (REFNO(SPINDX) .EQ. REFNO(SPINDX-1)) GO TO 200 08300000 C 08310000 C 08320000 210 CONTINUE 08330000 C 08340000 GO TO 170 08350000 C 08360000 220 CONTINUE 08370000 C 08380000 C READ 'SDE' CARDS 08390000 C ================ 08400000 DA1 = 1 08410000 C 08420000 175 CALL FORC (KPNA,KPRNO,DA1,CARD, *225 ) 08430000 IF (S1CPCH(CARD,8,'SDE',1,3).NE.0) GO TO 175 08440000 C 08450000 SPT = S1CVBN(CARD,11,5) 08460000 C 08470000 C 08480000 C FIND THE SHOTPOINT INDEX 08490000 C 08500000 DO 185 08510000 * I = 1,INDEX 08520000 IF (SPT .NE. ASPNO(I)) GO TO 185 08530000 SPINDX = I 08540000 GO TO 195 08550000 C 08560000 185 CONTINUE 08570000 C 08580000 GO TO 1000 08590000 C 08600000 C STORE THE NON BLANK DATA 08610000 C 08620000 195 DO 215 08630000 * I = 21, 80, 5 08640000 IF (S1CPCH(CARD,I,' ',1,5).EQ.0) GO TO 205 08650000 DATELE (SPINDX) = S1CVBN(CARD,I,5) 08660000 IF(SPINDX .LT. DESNDX) DESNDX = SPINDX 08670000 IF(SPINDX .GT. DEENDX) DEENDX = SPINDX 08680000 C 08690000 205 SPINDX = SPINDX + 1 08700000 IF (SPINDX .GE. INDEX) GO TO 215 08710000 IF (REFNO(SPINDX) .EQ. REFNO(SPINDX-1)) GO TO 205 08720000 C 08730000 C 08740000 215 CONTINUE 08750000 C 08760000 GO TO 175 08770000 C 08780000 225 CONTINUE 08790000 C 08800000 C INPUT FROM GM3D -- SURVEY ELEVATIONS 08810000 C 08820000 IF (ELVFLG .NE. 1 .AND. ELVFLG .NE. 3) GO TO 2229 08830000 DAP = 1 08840000 NOC = 0 08850000 C 08860000 226 CALL FORP(GM3D,0,DAP,104,DENTRY, *229) 08870000 IF (DCTYP .NE. SVE) GO TO 226 08880000 NOC = NOC + 1 08890000 BGE = 1 08900000 RCV = SRCV 08910000 DO 2265 08920000 * I = 1, NOPAR 08930000 IF (RCV.GE.STSTAN.AND.RCV.LE.GPSTAN(NGPS)) GO TO 2227 08940000 WRITE (KPPRNT, 9000) RCV 08950000 RCV = RCV + 1 08960000 BGE = BGE + 1 08970000 2265 CONTINUE 08980000 C 08990000 GO TO 226 09000000 C 09010000 2227 RCVNDX = RCV * 100 09020000 SVENDX = RCV - STSTAN + 1 09030000 C 09040000 227 IF (RCVNDX .EQ. GPREFN(SVENDX)) GO TO 228 09050000 IF (RCVNDX .LT. GPREFN(SVENDX)) SVENDX = SVENDX - 1 09060000 IF (RCVNDX .GT. GPREFN(SVENDX)) SVENDX = SVENDX + 1 09070000 GO TO 227 09080000 C 09090000 228 J = 0 09100000 DO 2228 09110000 * I = BGE, NOPAR 09120000 J = J + 1 09130000 GPE(SVENDX+J-1) = DATTR(I) 09140000 C 09150000 C 09160000 2228 CONTINUE 09170000 C 09180000 GPEFLG = 1 09190000 IF (SVENDX .LT. GESNDX) GESNDX = SVENDX 09200000 IF (SVENDX+J-1 .GT. GEENDX) GEENDX = SVENDX + J - 1 09210000 GO TO 226 09220000 C 09230000 229 IF (NOC .NE. 0) GO TO 2291 09240000 WRITE (KPPRNT, 9240) 09250000 GO TO 1030 09260000 C 09270000 2291 WRITE (KPPRNT, 9270) 09280000 GO TO 2230 09290000 C 09300000 C 09310000 C 09320000 C READ 'SSE','SSD','GST' CARDS 09330000 C ============================ 09340000 C 09350000 2229 GPEFLG = 0 09360000 2230 SSDFLG = 0 09370000 DA1 = 1 09380000 C 09390000 230 CALL FORC (KPNA,KPRNO,DA1,CARD, *290 ) 09400000 IF(S1CPCH(CARD,8,'SSE',1,3).NE.0 .AND. 09410000 * S1CPCH(CARD,8,'SSD',1,3).NE.0 .AND. 09420000 * S1CPCH(CARD,8,'GST',1,3).NE.0)GO TO 230 09430000 C 09440000 C GET THE STARTING STATION NO. 09450000 C 09460000 STRTNO = S1CVBN(CARD,11,5) 09470000 GPREFX = STRTNO * 100 09480000 TSTFLG = 0 09490000 IF (S1CPCH(CARD,8,'SSE',1,3) .EQ. 0) GPEFLG = 1 09500000 IF (S1CPCH(CARD,8,'GST',1,3) .EQ. 0) GSTFLG = 1 09510000 IF (S1CPCH(CARD,8,'SSD',1,3) .EQ. 0) SSDFLG = 1 09520000 IF (S1CPCH(CARD,8,'SSD',1,3) .EQ. 0) TSTFLG = 1 09530000 C 09540000 C DONT ALLOW GM3D INFO IF CARD TYPES SSE OR GST 09550000 IF(ELVFLG.EQ.1 .OR. ELVFLG.EQ.3 .AND. NOC.NE.0 ) THEN 09560000 IF (GPEFLG.EQ.1 .OR. GSTFLG.EQ.1) GO TO 1070 09561000 ENDIF 09562000 C 09563000 C SET UP TO STORE ELEVATIONS AT STATIONS 09564000 C 09565000 STAINC = S1CVBN(CARD,16,5) 09566000 IF (STAINC .EQ. 0) STAINC = 1 09567000 STAINC = STAINC * 100 09568000 C 09569000 DO 280 09570000 * I = 21,80,5 09580000 C 09590000 IF(S1CPCH(CARD,I,' ',1,5) .EQ.0)GO TO 270 09600000 C 09610000 C 09620000 C 09630000 C FIND THE GEOPHONE STATION INDEX 09640000 C AND STORE THE ELEV 09650000 C 09660000 J = (GPREFX - STSTAN * 100) / 100 + 1 09670000 240 IF (GPREFX .EQ. GPREFN(J)) GO TO 250 09680000 IF(GPREFX .GT. GPREFN(J)) THEN 09690000 J = J + 1 09700000 ELSE IF(GPREFX .LT. GPREFN(J)) THEN 09710000 J = J - 1 09720000 END IF 09730000 IF (J .LT. 1 .OR. J .GT. NGPS) GO TO 260 09740000 GO TO 240 09750000 250 VALUE = S1CVBN (CARD,I,5) 09760000 IF (TSTFLG .EQ. 0) GO TO 258 09770000 SSD(J) = VALUE 09780000 IF(J .LT. SDSNDX) SDSNDX = J 09790000 IF(J .GT. SDENDX) SDENDX = J 09800000 GO TO 270 09810000 258 GPE(J) = VALUE 09820000 IF(J .LT. GESNDX) GESNDX = J 09830000 IF(J. GT. GEENDX) GEENDX = J 09840000 GO TO 270 09850000 C 09860000 260 STRTNO = GPREFX / 100 09870000 WRITE (KPPRNT, 9000 ) STRTNO 09880000 C 09890000 270 GPREFX = GPREFX + STAINC 09900000 C 09910000 280 CONTINUE 09920000 C 09930000 GO TO 230 09940000 C 09950000 290 CONTINUE 09960000 C 09970000 C READ 'SEW' CARD (WATER VELOCITY ) 09980000 C 'SEW' CARD PROVIDES THE ADJUSTMENT OF SHOT ELEVATIONS 09990000 C TO THE WATER BOTTOM FOR THE COMBINATION OF LAND AND 10000000 C MARINE ACQUISITION. 10010000 C 10020000 SEWFLG = 0 10021000 DA1 = 1 10022000 C 10023000 2910 CALL FORC (KPNA, KPRNO, DA1, CARD, *2950) 10024000 IF (S1CPCH(CARD, 8, 'SEW', 1, 3) .NE. 0) GO TO 2910 10025000 C 10026000 C GET THE WATER VELOCITY 10027000 C 10028000 IF (S1CPCH (CARD, 11, ' ', 1, 5) .EQ. 0) THEN 10029000 DFWV = 1 10029100 ELSE 10029200 DFWV = 0 10029300 WATV = S1CVBN (CARD, 11, 5) 10029400 ENDIF 10029500 SEWFLG = 1 10029600 2920 CONTINUE 10029700 IF (SEWFLG .NE. 0) THEN 10029800 DO 2940 I = 1, INDEX 10029900 CTJT DO 2930 J = 1, INDEX 10030000 DO 2930 J = 1, NSSP 10030100 DA1 = (J-1) * (LCTPSP) + 1 10030200 CALL USRHDR (TRCHDR, DA1 , *2950 ) 10030300 CALL USRTHV (TRCHDR, 'THSSP ', SPNO) 10030400 IF (ASPNO(I) .EQ. SPNO) THEN 10030500 CALL USRTHV (TRCHDR, 'THWDPS ', IWDPS(I)) 10030600 WDPS(I) = FLOAT(IWDPS(I)) 10030700 GO TO 2940 10030800 ENDIF 10030900 2930 CONTINUE 10031000 2940 CONTINUE 10031100 ENDIF 10031200 2950 CONTINUE 10031300 C 10031400 C 10031500 C CHECK FOR INPUT OF COMPUTED STATICS 10031600 C 10031700 IF (GSTFLG .EQ. 1 .OR. SSTFLG .EQ. 1) GO TO 465 10031800 C 10031900 C CHECK FOR 3D INTERPOLATION 10032000 C 10033000 IF (LINT .NE. 0.0) THEN 10034000 XMIN = IMINXS 10035000 XMAX = IMAXXS 10036000 YMIN = IMINYS 10037000 YMAX = IMAXYS 10038000 CALL SAINTS (KPPRNT, ISHOTX, ISHOTY, UPHOLE, INDEX, 10039000 * XMIN, XMAX, YMIN, YMAX, RVINT, LINT, *1030) 10040000 CALL SAINTS (KPPRNT, ISHOTX, ISHOTY, DSHOT, INDEX, 10050000 * XMIN, XMAX, YMIN, YMAX, RVINT, LINT, *1030) 10060000 CALL SAINTS (KPPRNT, ISHOTX, ISHOTY, DATVEL, INDEX, 10070000 * XMIN, XMAX, YMIN, YMAX, RVINT, LINT, *1030) 10080000 CALL SAINTS (KPPRNT, ISHOTX, ISHOTY, DATELE, INDEX, 10090000 * XMIN, XMAX, YMIN, YMAX, RVINT, LINT, *1030) 10100000 CALL SAINTS (KPPRNT, ISHOTX, ISHOTY, WTHVEL, INDEX, 10110000 * XMIN, XMAX, YMIN, YMAX, RVINT, LINT, *1030) 10120000 IF (SEWFLG .NE. 0) THEN 10130000 CALL SAINTS (KPPRNT, ISHOTX, ISHOTY, WDPS, INDEX, 10140000 * XMIN, XMAX, YMIN, YMAX, RVINT, LINT, *1030) 10150000 ENDIF 10160000 GO TO 300 10170000 ENDIF 10180000 C 10190000 C 10200000 C EXTRAPOLATE SHOTPOINT STATIC PARAMETERS 10210000 C 10220000 UPHOLE(1) = UPHOLE(UPSNDX) 10230000 UPHOLE(INDEX) = UPHOLE(UPENDX) 10240000 C 10250000 DSHOT (1) = DSHOT (DSSNDX) 10260000 DSHOT (INDEX) = DSHOT (DSENDX) 10270000 C 10280000 DATVEL(1) = DATVEL(DVSNDX) 10290000 DATVEL(INDEX) = DATVEL(DVENDX) 10300000 C 10310000 DATELE(1) = DATELE(DESNDX) 10320000 DATELE(INDEX) = DATELE(DEENDX) 10330000 C 10340000 WTHVEL(1) = WTHVEL(WVSNDX) 10350000 WTHVEL(INDEX) = WTHVEL(WVENDX) 10360000 C 10370000 C INTERPOLATE SHOTPOINT STATIC PARAMETERS 10380000 C 10390000 300 DO 460 10400000 * I = 1, INDEX 10410000 C 10420000 IF (I .EQ. 1) GO TO 450 10430000 C 10440000 IF(UPHOLE(I).NE.-9999 .OR. UPHOLE(1).EQ.-9999 )GO TO 330 10450000 IF (REFNO(I) .GT. REFNO(I-1)) GO TO 305 10460000 UPHOLE(I) = UPHOLE(I-1) 10470000 GO TO 330 10480000 C 10490000 305 DO 310 10500000 * J = I, INDEX 10510000 IF (UPHOLE(J) .NE. -9999 10520000 * .AND. REFNO(J) .GE. REFNO(I)) GO TO 320 10530000 310 CONTINUE 10540000 C 10550000 GO TO 330 10560000 C 10570000 320 VJ =UPHOLE(J) 10580000 VIM1 = UPHOLE(I-1) 10590000 RJ = REFNO(J) 10600000 RIM1 = REFNO(I-1) 10610000 RI = REFNO(I) 10620000 UPHOLE(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 10630000 C 10640000 330 IF (DSHOT(I) .NE. -9999 .OR. DSHOT(1) .EQ. -9999) 10650000 * GO TO 360 10660000 IF (REFNO(I) .GT. REFNO(I-1)) GO TO 335 10670000 C 10680000 DSHOT(I) = DSHOT(I-1) 10690000 GO TO 360 10700000 C 10710000 335 DO 340 10720000 * J = I, INDEX 10730000 IF (DSHOT(J) .NE. -9999 10740000 * .AND. REFNO(J) .GE. REFNO(I)) GO TO 350 10750000 340 CONTINUE 10760000 C 10770000 GO TO 360 10780000 C 10790000 350 VJ = DSHOT(J) 10800000 VIM1 =DSHOT(I-1) 10810000 RJ = REFNO(J) 10820000 RIM1 = REFNO(I-1) 10830000 RI = REFNO(I) 10840000 DSHOT(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 10850000 C 10860000 360 IF(DATVEL(I) .NE. -9999 .OR. DATVEL(1) .EQ. -9999) 10870000 * GO TO 390 10880000 IF (REFNO(I) .GT. REFNO(I-1)) GO TO 375 10890000 DATVEL(I) = DATVEL(I-1) 10900000 GO TO 390 10910000 C 10920000 375 DO 370 10930000 * J = I, INDEX 10940000 IF (DATVEL(J).NE. -9999 10950000 * .AND. REFNO(J) .GE. REFNO(I))GO TO 380 10960000 370 CONTINUE 10970000 C 10980000 GO TO 390 10990000 C 11000000 380 VJ = DATVEL(J) 11010000 VIM1 = DATVEL(I-1) 11020000 RJ = REFNO(J) 11030000 RIM1 = REFNO(I-1) 11040000 RI = REFNO (I) 11050000 DATVEL(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 11060000 C 11070000 390 IF(DATELE(I) .NE. -9999 .OR. DATELE(1) .EQ. -9999) 11080000 * GO TO 420 11090000 IF (REFNO(I) .GT. REFNO(I-1)) GO TO 395 11100000 DATELE(I) = DATELE(I-1) 11110000 GO TO 420 11120000 C 11130000 C 11140000 395 DO 400 11150000 * J = I, INDEX 11160000 IF (DATELE(J) .NE. -9999 11170000 * .AND. REFNO(J) .GE. REFNO(I)) GO TO 410 11180000 400 CONTINUE 11190000 C 11200000 GO TO 420 11210000 C 11220000 410 VJ = DATELE(J) 11230000 VIM1 = DATELE(I-1) 11240000 RJ = REFNO(J) 11250000 RIM1 = REFNO(I-1) 11260000 RI = REFNO(I) 11270000 DATELE(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 11280000 C 11290000 C 11300000 C 11310000 420 IF(WTHVEL(I) .NE.-9999 .OR. WTHVEL(1) .EQ. -9999) 11320000 * GO TO 450 11330000 IF (REFNO(I) .GT. REFNO(I-1)) GO TO 425 11340000 WTHVEL(I) = WTHVEL(I-1) 11350000 GO TO 450 11360000 C 11370000 425 DO 430 11380000 * J = I, INDEX 11390000 IF (WTHVEL(J) .NE. -9999 11400000 * .AND. REFNO(J) .GE. REFNO(I))GO TO 440 11410000 430 CONTINUE 11420000 C 11430000 GO TO 450 11440000 C 11450000 440 VJ =WTHVEL(J) 11460000 VIM1 = WTHVEL(I-1) 11470000 RJ = REFNO(J) 11480000 RIM1 = REFNO(I-1) 11490000 RI = REFNO(I) 11500000 WTHVEL(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 11510000 C 11520000 C COMPUTE DWTH OR TWTH IF NOT INPUT 11530000 C 11540000 450 IF (DWTHFL.EQ.1 .AND. WTHVEL(I) .GT. 0) 11550000 * TWTH(I) = DWTH(I)*1000.0/WTHVEL(I) 11560000 C 11570000 IF (TWTHFL.EQ.1 .AND. WTHVEL(I) .GT. 0) 11580000 * DWTH(I) = TWTH(I)/1000.0*WTHVEL(I) 11590000 C 11600000 C COMPUTE WTHVEL IF NOT INPUT 11610000 C 11620000 IF(DSHOT(1) .EQ. -9999 .OR. UPHOLE(1) .EQ. -9999) 11630000 * GO TO 460 11640000 IF(UPHOLE(I) .EQ. 0) GO TO 460 11650000 IF( DWTHFL .EQ. 1 .OR. TWTHFL .EQ. 1 ) GO TO 460 11660000 WTHVEL(I)=DSHOT(I)*1000./UPHOLE(I) 11670000 C 11680000 C 11690000 460 CONTINUE 11700000 C 11710000 C 11720000 C INTERPOLATE SHOTPOINT AND GEOPHONE ELEVATIONS 11730000 C OR SHOTPOINT AND GEOPHONE INPUT STATICS 11740000 C 11750000 465 IF (LINT .NE. 0.0) THEN 11760000 XMIN = MIN(IMINXS,IMINXR) 11770000 XMAX = MAX(IMAXXS,IMAXXR) 11780000 YMIN = MIN(IMINYS,IMINYR) 11790000 YMAX = MAX(IMAXYS,IMAXYR) 11800000 CALL SAINTS (KPPRNT, ISHOTX, ISHOTY, SPE, MAXSPS+MAXRVS, 11810000 * XMIN, XMAX, YMIN, YMAX, RVINT, LINT, *1030) 11820000 GO TO 770 11830000 ENDIF 11840000 C 11850000 IF (SSTFLG .EQ. 1) GO TO 468 11860000 IF (GSTFLG .EQ. 1) GO TO 680 11870000 IF (SPEFLG .EQ. 0 .AND. GPEFLG .EQ.0) GO TO 770 11880000 IF (SPEFLG .EQ. 0) GO TO 680 11890000 C 11900000 468 DO 560 11910000 * I = 1, INDEX 11920000 IF (SPE(I) .NE. -9999) GO TO 560 11930000 IF (GSTFLG .EQ. 1) GO TO 510 11940000 IF (GPEFLG .EQ. 0) GO TO 510 11950000 C 11960000 J = (REFNO(I) - STSTAN*100) / 100 + 1 11970000 IF (J .EQ. 1) J = 2 11980000 469 IF (REFNO(I) .NE. GPREFN(J-1))GO TO 470 11990000 IF (GPE(J-1) .EQ. -9999) GO TO 510 12000000 SPE(I) = GPE(J-1) 12010000 GO TO 560 12020000 C 12030000 470 IF(REFNO(I) .NE. GPREFN(J)) GO TO 480 12040000 IF (GPE(J) .EQ. -9999) GO TO 510 12050000 SPE(I) = GPE(J) 12060000 GO TO 560 12070000 C 12080000 480 IF(REFNO(I).GE.GPREFN(J-1) .AND. REFNO(I).LT. 12090000 * GPREFN(J)) GO TO 490 12100000 GO TO 500 12110000 C 12120000 490 IF(GPE(J-1) .EQ. -9999 .OR. GPE(J) .EQ. -9999) 12130000 * GO TO 510 12140000 GO TO 550 12150000 C 12160000 500 IF (J .EQ. 2 .OR. J .EQ. NGPS) GO TO 510 12170000 IF (REFNO(I) .GT. GPREFN(J)) THEN 12180000 J = J + 1 12190000 ELSE IF (REFNO(I) .LT. GPREFN(J-1)) THEN 12200000 J = J - 1 12210000 END IF 12220000 GO TO 469 12230000 12240000 C 12250000 510 IF (I .NE. 1) GO TO 515 12260000 SPE(1) = SPE(SESNDX) 12270000 GO TO 560 12280000 515 IF (REFNO(I) .GT. REFNO(I-1)) GO TO 518 12290000 SPE(I) = SPE(I-1) 12300000 GO TO 560 12310000 C 12320000 518 DO 520 12330000 * J = I, INDEX 12340000 IF(SPE(J) .NE. -9999 .AND. 12350000 * REFNO(J) .GE. REFNO(I)) GO TO 530 12360000 520 CONTINUE 12370000 SPE(I) = SPE(I-1) 12380000 GO TO 560 12390000 C 12400000 530 IF (I .NE. 1) GO TO 540 12410000 SPE(I) = SPE(J) 12420000 GO TO 560 12430000 C 520 12440000 C 12450000 540 VJ = SPE(J) 12460000 VIM1 = SPE (I-1) 12470000 RJ = REFNO(J) 12480000 RIM1 = REFNO(I-1) 12490000 RI = REFNO(I) 12500000 SPE(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 12510000 C 12520000 GO TO 560 12530000 C 12540000 550 VJ = GPE(J) 12550000 VJM1 = GPE(J-1) 12560000 RJM1 = GPREFN(J-1) 12570000 RJ = GPREFN(J) 12580000 RI = REFNO(I) 12590000 SPE(I) = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) + VJM1 12600000 C 12610000 560 CONTINUE 12620000 C 12630000 C 12640000 IF ( GSTFLG .EQ. 1 ) GO TO 680 12650000 IF ( GPEFLG .EQ. 1 ) GO TO 680 12660000 C 12670000 C INTERPOLATE GPE USING SPE OR GST USING SST 12680000 C 12690000 DO 670 12700000 * I = 1, NGPS 12710000 IF(GPE(I) .NE. -9999) GO TO 670 12720000 IF(GPREFN(I) .GT. REFNO(1)) GO TO 600 12730000 IF(GPREFN(I) .EQ. REFNO(1)) GO TO 580 12740000 C 12750000 DO 570 12760000 * J = I, NGPS 12770000 IF (GPREFN(J) .GT. REFNO(1)) GO TO 575 12780000 C 12790000 IF (GPE(J) .NE. -9999) GO TO 590 12800000 C 12810000 570 CONTINUE 12820000 C 12830000 575 IF (I .EQ. 1) GO TO 580 12840000 VIM1 =GPE(I-1) 12850000 VJ = SPE(1) 12860000 RJ = REFNO(1) 12870000 GO TO 635 12880000 C 12890000 580 GPE(I) = SPE(1) 12900000 GO TO 670 12910000 C 12920000 590 IF (I .NE. 1) GO TO 630 12930000 GPE(I) = GPE(J) 12940000 GO TO 670 12950000 C 12960000 600 IF(GPREFN(I).LT.REFNO(INDEX))GO TO 640 12970000 IF(GPREFN(I).EQ.REFNO(INDEX))GO TO 620 12980000 C 12990000 DO 610 13000000 * J = I, NGPS 13010000 IF (GPE(J) .NE. -9999) GO TO 630 13020000 C 13030000 610 CONTINUE 13040000 C 13050000 IF (GPREFN(I-1) .LE. REFNO(INDEX)) GO TO 620 13060000 GPE(I) = GPE(I-1) 13070000 GO TO 670 13080000 C 13090000 620 GPE(I) = SPE(INDEX) 13100000 GO TO 670 13110000 C 13120000 630 VJ = GPE(J) 13130000 VIM1 = GPE(I-1) 13140000 RJ = GPREFN(J) 13150000 635 RIM1 = GPREFN(I-1) 13160000 RI = GPREFN(I) 13170000 GPE(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 13180000 GO TO 670 13190000 C 13200000 640 CONTINUE 13210000 C 13220000 DO 650 13230000 * J = 2, INDEX 13240000 IF (GPREFN(I).GE.REFNO(J-1).AND.GPREFN(I).LT. 13250000 * REFNO(J)) GO TO 645 13260000 C 13270000 650 CONTINUE 13280000 IF (I .NE. 1) GPE(I) = GPE(I-1) 13290000 GO TO 670 13300000 C 13310000 645 VJ = SPE(J) 13320000 VJM1 = SPE(J-1) 13330000 RJM1 = REFNO(J-1) 13340000 RJ = REFNO(J) 13350000 RI = GPREFN(I) 13360000 GPE(I) = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) +VJM1 13370000 C 13380000 670 CONTINUE 13390000 C 13400000 GO TO 770 13410000 C 13420000 C INTERPOLATE GPE 13430000 C 13440000 680 GPE (1) = GPE (GESNDX) 13450000 GPE (NGPS) = GPE (GEENDX) 13460000 C 13470000 DO 710 13480000 * I = 1, NGPS 13490000 IF (GPE(I) .NE. -9999) GO TO 710 13500000 C 13510000 DO 690 13520000 * J = I, NGPS 13530000 IF (GPE(J) .NE. -9999) GO TO 700 13540000 C 13550000 690 CONTINUE 13560000 C 13570000 700 VJ = GPE(J) 13580000 VIM1 = GPE(I-1) 13590000 RJ = GPREFN(J) 13600000 RIM1 = GPREFN(I-1) 13610000 RI = GPREFN(I) 13620000 GPE(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 13630000 C 13640000 710 CONTINUE 13650000 C 13660000 IF (SSTFLG .EQ. 1) GO TO 770 13670000 C 13680000 C INTERPOLATE SPE USING GPE OR SST USING GST 13690000 C 13700000 DO 760 13710000 * I = 1, INDEX 13720000 IF (SPE(I) .NE. -9999) GO TO 760 13730000 IF (REFNO(I) .GT. GPREFN(1)) GO TO 720 13740000 SPE(I) = GPE(1) 13750000 GO TO 760 13760000 C 13770000 720 IF(REFNO(I) .LT. GPREFN(NGPS)) GO TO 730 13780000 SPE(I) = GPE(NGPS) 13790000 GO TO 760 13800000 C 13810000 730 J = (REFNO(I) - STSTAN * 100) / 100 + 1 13820000 IF (J .EQ. 1) J = 2 13830000 C 13840000 735 IF (REFNO(I) .NE. GPREFN(J-1)) GO TO 740 13850000 SPE(I) = GPE(J-1) 13860000 GO TO 760 13870000 C 13880000 740 IF (REFNO(I) .GT. GPREFN(J-1)) GO TO 745 13890000 J = J - 1 13900000 GO TO 735 13910000 C 13920000 745 IF (REFNO(I) .LT. GPREFN(J)) GO TO 750 13930000 J = J + 1 13940000 GO TO 735 13950000 C 13960000 C 13970000 C 13980000 C 13990000 750 VJ = GPE(J) 14000000 VJM1 = GPE(J-1) 14010000 RJM1 = GPREFN(J-1) 14020000 RJ = GPREFN(J) 14030000 RI = REFNO(I) 14040000 SPE(I) = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) + VJM1 14050000 C 14060000 760 CONTINUE 14070000 C 14080000 C 14090000 770 IF (SSDFLG .EQ. 0 .AND. DATELE(1) .EQ. -9999) GO TO 1770 14100000 IF ( SSDFLG .EQ. 1 ) GO TO 1680 14110000 C 14120000 C INTERPOLATE SSD USING DATELE 14130000 C 14140000 DO 1670 14150000 * I = 1, NGPS 14160000 IF(SSD(I) .NE. -9999) GO TO 1670 14170000 IF(GPREFN(I) .GT. REFNO(1)) GO TO 1600 14180000 IF(GPREFN(I) .EQ. REFNO(1)) GO TO 1580 14190000 C 14200000 DO 1570 14210000 * J = I, NGPS 14220000 IF (GPREFN(J) .GT. REFNO(1)) GO TO 1575 14230000 C 14240000 IF (SSD(J) .NE. -9999) GO TO 1590 14250000 C 14260000 1570 CONTINUE 14270000 C 14280000 1575 IF (I .EQ. 1) GO TO 1580 14290000 VIM1 =SSD(I-1) 14300000 VJ = DATELE(1) 14310000 RJ = REFNO(1) 14320000 GO TO 1635 14330000 C 14340000 1580 SSD(I) = DATELE(1) 14350000 GO TO 1670 14360000 C 14370000 1590 IF (I .NE. 1) GO TO 1630 14380000 SSD(I) = SSD(J) 14390000 GO TO 1670 14400000 C 14410000 1600 IF(GPREFN(I).LT.REFNO(INDEX))GO TO 1640 14420000 IF(GPREFN(I).EQ.REFNO(INDEX))GO TO 1620 14430000 C 14440000 DO 1610 14450000 * J = I, NGPS 14460000 IF (SSD(J) .NE. -9999) GO TO 1630 14470000 C 14480000 1610 CONTINUE 14490000 C 14500000 IF (GPREFN(I-1) .LE. REFNO(INDEX)) GO TO 1620 14510000 SSD(I) = SSD(I-1) 14520000 GO TO 1670 14530000 C 14540000 1620 SSD(I) = DATELE(INDEX) 14550000 GO TO 1670 14560000 C 14570000 1630 VJ = SSD(J) 14580000 VIM1 = SSD(I-1) 14590000 RJ = GPREFN(J) 14600000 1635 RIM1 = GPREFN(I-1) 14610000 RI = GPREFN(I) 14620000 SSD(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 14630000 GO TO 1670 14640000 C 14650000 C 14660000 1640 DO 1650 14670000 * J = 2, INDEX 14680000 IF (GPREFN(I).GE.REFNO(J-1).AND.GPREFN(I).LT. 14690000 * REFNO(J)) GO TO 1645 14700000 1650 CONTINUE 14710000 IF(I .NE. 1) SSD(I) = SSD(I-1) 14720000 GO TO 1670 14730000 C 14740000 C 14750000 1645 VJ = DATELE(J) 14760000 VJM1 = DATELE(J-1) 14770000 RJM1 = REFNO(J-1) 14780000 RJ = REFNO(J) 14790000 RI = GPREFN(I) 14800000 SSD(I) = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) +VJM1 14810000 C 14820000 1670 CONTINUE 14830000 C 14840000 GO TO 1770 14850000 C 14860000 C INTERPOLATE SSD 14870000 C 14880000 1680 IF (LINT .NE. 0.0) THEN 14890000 XMIN = IMINXR 14900000 XMAX = IMAXXR 14910000 YMIN = IMINYR 14920000 YMAX = IMAXYR 14930000 CALL SAINTS (KPPRNT, IRCVRX, IRCVRY, SSD, NGPS, 14940000 * XMIN, XMAX, YMIN, YMAX, RVINT, LINT, *1030) 14950000 GO TO 1715 14960000 ENDIF 14970000 C 14980000 SSD (1) = SSD (SDSNDX) 14990000 SSD (NGPS) = SSD (SDENDX) 15000000 C 15010000 DO 1710 15020000 * I = 1, NGPS 15030000 IF (SSD(I) .NE. -9999) GO TO 1710 15040000 C 15050000 DO 1690 15060000 * J = I, NGPS 15070000 IF (SSD(J) .NE. -9999) GO TO 1700 15080000 C 15090000 1690 CONTINUE 15100000 C 15110000 1700 VJ = SSD(J) 15120000 VIM1 = SSD(I-1) 15130000 RJ = GPREFN(J) 15140000 RIM1 = GPREFN(I-1) 15150000 RI = GPREFN(I) 15160000 SSD(I) = (VJ-VIM1) / (RJ-RIM1) * (RI-RIM1) + VIM1 15170000 C 15180000 1710 CONTINUE 15190000 C 15200000 C 15210000 C INTERPOLATE DATELE USING SSD 15220000 C 15230000 1715 DO 1760 15240000 * I = 1, INDEX 15250000 IF (DATELE(I) .NE. -9999) GO TO 1760 15260000 IF (REFNO(I) .GT. GPREFN(1)) GO TO 1720 15270000 DATELE(I) = SSD(1) 15280000 GO TO 1760 15290000 C 15300000 1720 IF(REFNO(I) .LT. GPREFN(NGPS)) GO TO 1730 15310000 DATELE(I) = SSD(NGPS) 15320000 GO TO 1760 15330000 C 15340000 C 15350000 1730 J = (REFNO(I) - STSTAN * 100) / 100 + 1 15360000 IF (J .EQ. 1) J = 2 15370000 C 15380000 1735 IF (REFNO(I) .NE. GPREFN(J-1)) GO TO 1740 15390000 DATELE(I) = SSD(J-1) 15400000 GO TO 1760 15410000 C 15420000 1740 IF (REFNO(I) .GT. GPREFN(J-1)) GO TO 1745 15430000 J = J - 1 15440000 GO TO 1735 15450000 C 15460000 1745 IF (REFNO(I) .LT. GPREFN(J)) GO TO 1750 15470000 J = J + 1 15480000 GO TO 1735 15490000 C 15500000 C 15510000 C 15520000 1750 VJ = SSD(J) 15530000 VJM1 = SSD(J-1) 15540000 RJM1 = GPREFN(J-1) 15550000 RJ = GPREFN(J) 15560000 RI = REFNO(I) 15570000 DATELE(I) = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) + VJM1 15580000 C 15590000 1760 CONTINUE 15600000 C 15610000 1770 CONTINUE 15620000 C 15630000 C COMPUTE AVERAGE SHOTPOINT DEPTH 15640000 C 15650000 SUM = 0 15660000 ASD = 0 15670000 DS = 0. 15680000 C 15690000 DO 1780 15700000 * N = 1, INDEX 15710000 IF (DSHOT(N) .EQ. -9999) GO TO 1780 15720000 DS = DS + DSHOT(N) 15730000 SUM = SUM + 1 15740000 C 15750000 1780 CONTINUE 15760000 C 15770000 C LOAD ARRAYS TO BE USED IN PRODUCING PRINTER PLOTS. 15780000 C 15790000 DO 1782 15800000 * I = 1, MAXRVS 15810000 IF (GPE(I) .GE. 0.0) IGPE(I) = GPE(I) + 0.5 15820000 IF (GPE(I) .LT. 0.0) IGPE(I) = GPE(I) - 0.5 15830000 IF (SSD(I) .GE. 0.0) ISSD(I) = SSD(I) + 0.5 15840000 IF (SSD(I) .LT. 0.0) ISSD(I) = SSD(I) - 0.5 15850000 1782 CONTINUE 15860000 C 15870000 IF (SUM .NE. 0) ASD = INT(DS / SUM + .5) 15880000 IF ( NSMTH .EQ. 0 ) GO TO 18000 15890000 C 15900000 C 2/3 DATUM OPTION COMPUTATION 15910000 C 15920000 IF (ISSD(1) .EQ. -9999) GO TO 18000 15930000 CALL MRDTM(IGPE, NGPS, NSMTH, FACTOR, ISSD) 15940000 C 15950000 DO 17600 15960000 * I = 1, INDEX 15970000 IF (REFNO(I) .GT. GPREFN(1)) GO TO 17200 15980000 DATELE(I) = ISSD(1) 15990000 GO TO 17600 16000000 C 16010000 17200 IF(REFNO(I) .LT. GPREFN(NGPS)) GO TO 17300 16020000 DATELE(I) = ISSD(NGPS) 16030000 GO TO 17600 16040000 C 16050000 C 16060000 17300 J = (REFNO(I) - STSTAN * 100) / 100 + 1 16070000 IF (J .EQ. 1) J = 2 16080000 C 16090000 17305 IF (REFNO(I) .NE. GPREFN(J-1)) GO TO 17400 16100000 DATELE(I) = ISSD(J-1) 16110000 GO TO 17600 16120000 C 16130000 17400 IF (REFNO(I) .GT. GPREFN(J-1)) GO TO 17405 16140000 J = J - 1 16150000 GO TO 17305 16160000 C 16170000 17405 IF (REFNO(I) .LT. GPREFN(J)) GO TO 17500 16180000 J = J + 1 16190000 GO TO 17305 16200000 C 16210000 C 16220000 C 16230000 17500 VJ = ISSD(J) 16240000 VJM1 = ISSD(J-1) 16250000 RJM1 = GPREFN(J-1) 16260000 RJ = GPREFN(J) 16270000 RI = REFNO(I) 16280000 DATELE(I) = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) + VJM1 16290000 C 16300000 17600 CONTINUE 16310000 18000 CONTINUE 16320000 C 16330000 C PRINT OUT TYPE OF SOURCE 16340000 C 16350000 WRITE (KPPRNT, 9140) TYPE 16360000 C 16370000 C COMPUTE THE STATICS FOR EACH TRACE OF EACH SHOT 16380000 C ================================================ 16390000 C 16400000 IF (MDPDE .EQ. 0) GO TO 18600 16410000 C 16420000 C MEAN DEPTH POINT DATUM ELEVATION OPTION 16430000 C 16440000 DA2 = 1 16450000 DO 18400 16460000 CTJT * N=1, INDEX 16470000 * N=1, NSSP 16480000 CTJT LOCATE SHOT INFO INDEX 16490000 C DO 18200 16500000 C * NS = 1, INDEX 16510000 C IF (SAVI(NS) .EQ. N) GO TO 18250 16520000 C18200 CONTINUE 16530000 C GO TO 1020 16540000 C 16550000 C18250 CONTINUE 16560000 CTJT 16570000 DO 18300 16580000 * I=1, LCTPSP 16590000 CALL USRHDR (TRCHDR, DA2, *18300) 16600000 CALL USRTHV (TRCHDR, 'THSSP ',TESTSP) 16610000 C LOCATE SHOT INFO INDEX 16620000 IF (I .EQ. 1) THEN 16630000 DO 18270 J = 1, INDEX 16640000 NS = J 16641000 IF (TESTSP .EQ. ASPNO(J)) GO TO 18275 16642000 18270 CONTINUE 16643000 GO TO 1020 16644000 18275 CONTINUE 16645000 ENDIF 16646000 C 16647000 IF (TESTSP .LT. 0) GO TO 18300 16648000 CALL USRTHV (TRCHDR, 'THCDPN ', CDPN) 16649000 CALL USRTHV (TRCHDR, 'THCDPL ', CDPL) 16650000 CALL USRTHV (TRCHDR, 'THRCLN ', RLOC) 16660000 RDPN = CDPN - STCDPN + 1 16670000 FOLD (RDPN) = FOLD (RDPN) + 1 16680000 STANDX = (RLOC - STSTAN * 100)/100 + 1 16690000 MDDE(RDPN) = MDDE(RDPN) + DATELE(NS)+ ISSD(STANDX) 16700000 CDPREF(RDPN) = CDPL 16710000 18300 CONTINUE 16720000 18400 CONTINUE 16730000 C 16740000 IF (FOLD(1) .GT. 0) GO TO 18315 16750000 DO 18310 16760000 * N=2,NDPS 16770000 IF (FOLD(N) .EQ. 0) GO TO 18310 16780000 MDDE(1) = MDDE(N) 16790000 FOLD(1) = FOLD(N) 16800000 GO TO 18315 16810000 18310 CONTINUE 16820000 GO TO 1029 16830000 18315 CONTINUE 16840000 DO 18325 16850000 * N=1,NDPS 16860000 IF(FOLD(N) .EQ. 0) GO TO 18320 16870000 LASTDE = MDDE(N) 16880000 LASTFD = FOLD(N) 16890000 GO TO 18325 16900000 18320 FOLD(N) = LASTFD 16910000 MDDE(N) = LASTDE 16920000 18325 CONTINUE 16930000 DO 18500 16940000 * I=1,NDPS 16950000 IF (FOLD(I) .EQ. 0) GO TO 18500 16960000 FOLDFW = FOLD(I) 16970000 FOLD(I) = (MDDE(I) + ISIGN(FOLDFW,MDDE(I)))/(2*FOLDFW) 16980000 18500 CONTINUE 16990000 C 17000000 C 17010000 CALL MRDTM(FOLD, NDPS, MDPDE, 1.0, MDDEHW) 17020000 C CHECK FOR NO PRINT OPTION 17030000 IF (KPBUGF .EQ. 3) GO TO 18600 17040000 CALL USPHD(1,ACLNAM,KPNA,KPRNO,'SPARC DEPTH POINT DATUM ELEVATION 17050000 *DISPLAY',41,KPPRNT) 17060000 COLD CALL SAPPLT(MDDEHW,NDPS,STCDPN,1,CDPS,KPPRNT) 17070000 CALL SAPPLT(MDDEHW,NDPS,STCDPN,1,SPDP,KPPRNT) 17080000 18600 CONTINUE 17090000 DA1 = 1 17100000 DA2 = 1 17110000 C 17120000 DO 930 17130000 CTJT * N = 1, INDEX 17140000 * N = 1, NSSP 17150000 CTJT------IF (KPBUGF .NE. 1) GO TO 773 17160000 C WRITE (KPPRNT, 9120) 17170000 C KNT = 0 17180000 C CALL ARSET (TSTAT(1), 24, 0) 17190000 C 17200000 C773 DO 775 17210000 C * NS = 1, INDEX 17220000 C IF (SAVI(NS) .EQ. N) GO TO 777 17230000 C775 CONTINUE 17240000 C GO TO 1020 17250000 C 17260000 C777 IF (SSTFLG .EQ. 0 .AND. GSTFLG .EQ. 0) GO TO 774 17270000 C SSTC = SST(NS) + SIGN(.5,SST(NS)) 17280000 C GO TO 776 17290000 C774 CONTINUE 17300000 C COMPUTE THE SHOT STATIC FIRST 17310000 C PT5 = .5 17320000 C DE = 0. 17330000 C DS = 0. 17340000 C UH = 0. 17350000 C DV = 0. 17360000 C EL = 0. 17370000 C 17380000 C IF(DATELE(1) .NE. -9999) DE = DATELE(NS) 17390000 C IF(DSHOT (1) .NE. -9999) DS = DSHOT (NS) 17400000 C IF(UPHOLE(1) .NE. -9999) UH = UPHOLE(NS) 17410000 C IF(DATVEL(1) .NE. -9999) DV = DATVEL(NS) 17420000 C IF(SPE (1) .NE. -9999) EL = SPE (NS) 17430000 C 17440000 C IF (DV .EQ. 0) GO TO 1100 17450000 C 17460000 C*********FSSTC = (DE + DS -EL) * 1000. / DV - SOURCE * UH 17470000 C FSSTC1 = 1000./DV 17480000 C FSSTC2 = (DS - EL) * 1000./DV - SOURCE * UH 17490000 C 17500000 C FSSTC = DE*FSSTC1 + FSSTC2 17510000 C 17520000 C IF (FSSTC .LT. 0.) PT5 = -.5 17530000 C SSTC = FSSTC + PT5 17540000 C776 CONTINUE 17550000 C 17560000 C COMPUTE THE SHOT STATIC DUE TO THE WATER DEPTH OF THE 17570000 C COMBINATION OF LAND AND MARINE DATA (ADJUST THE SHOT 17580000 C ELEVATIONS TO WATER BOTTOM IN MARINE AREA) 17590000 C 17591000 C IF (SEWFLG .NE. 0) THEN 17592000 C IF (DFWV .NE. 0) THEN 17593000 C DO 7700 M = 1, INDEX 17594000 C DA1 = (M-1) * LCTPSP + 1 17595000 C CALL USRHDR (TRCHDR, DA1, *1045) 17596000 C CALL USRTHV (TRCHDR, 'THSSP ', SPNO) 17597000 C IF (ASPNO(N) .EQ. SPNO) THEN 17598000 C CALL USRTHV (TRCHDR, 'THWATV ', WATVDF) 17598100 C ENDIF 17598200 C7700 CONTINUE 17598300 C IF (WATVDF .NE. 0) 17598400 C * SSTCWA = (WDPS(N) * 1000. / FLOAT(WATVDF)) + 0.5 17598500 C ELSE 17598600 C SSTCWA =(WDPS(N) * 1000./ FLOAT(WATV)) + 0.5 17598700 C WRITE (KPPRNT, 8000) ASPNO(N), WDPS(N), WATV, SSTCWA 17598800 C8000 FORMAT(1X,'ASPNO,WDPS,WATV,SSTCWA =', I5,2X,F7.1,2(2X,I5)) 17598900 C ENDIF 17599000 C 17599100 C SSTC = SSTC - SSTCWA 17599200 C ENDIF 17599300 C 17599400 C SHSTAT(NS)= SSTC 17599500 CTJT---------------- 17599600 C 17599700 C COMPUTE THE GEOPHONE STATIC FOR EACH TRACE 17599800 C 17599900 DO 920 17600000 * I = 1, LCTPSP 17610000 C 17620000 CALL USRHDR (TRCHDR, DA2, *920 ) 17630000 CALL USRTHV (TRCHDR, 'THSSP ', TESTSP) 17640000 IF ( I .EQ. 1) THEN 17650000 IF (KPBUGF .NE. 1) GO TO 773 17651000 WRITE (KPPRNT, 9120) 17652000 KNT = 0 17653000 CALL ARSET (TSTAT(1), 24, 0) 17654000 C 17655000 773 DO 775 J = 1, INDEX 17656000 NS = J 17657000 IF (TESTSP .EQ. ASPNO(J)) GO TO 777 17658000 775 CONTINUE 17659000 GO TO 1020 17659100 C 17659200 C777 IF (SSTFLG .EQ. 0 .AND. GSTFLG .EQ. 0) GO TO 774 17659300 777 CONTINUE 17659400 DSS = 0 17659500 IF(DSHOT (1) .NE. -9999) DSS = DSHOT (NS) 17659601 IF (SSTFLG .EQ. 0 .AND. GSTFLG .EQ. 0) GO TO 774 17659700 SSTC = SST(NS) + SIGN(.5,SST(NS)) 17659800 GO TO 776 17659900 774 CONTINUE 17660000 C COMPUTE THE SHOT STATIC FIRST 17660100 PT5 = .5 17660200 DE = 0. 17660300 DS = 0. 17660400 UH = 0. 17660500 DV = 0. 17660600 EL = 0. 17660700 C 17660800 IF(DATELE(1) .NE. -9999) DE = DATELE(NS) 17660900 IF(DSHOT (1) .NE. -9999) DS = DSHOT (NS) 17661000 IF(UPHOLE(1) .NE. -9999) UH = UPHOLE(NS) 17661100 IF(DATVEL(1) .NE. -9999) DV = DATVEL(NS) 17661200 IF(SPE (1) .NE. -9999) EL = SPE (NS) 17661300 C 17661400 IF (DV .EQ. 0) GO TO 1100 17661500 C 17661600 C*********FSSTC = (DE + DS -EL) * 1000. / DV - SOURCE * UH 17661700 FSSTC1 = 1000./DV 17661800 FSSTC2 = (DS - EL) * 1000./DV - SOURCE * UH 17661900 C 17662000 FSSTC = DE*FSSTC1 + FSSTC2 17662100 C 17662200 IF (FSSTC .LT. 0.) PT5 = -.5 17662300 SSTC = FSSTC + PT5 17662400 776 CONTINUE 17662500 C 17662600 C COMPUTE THE SHOT STATIC DUE TO THE WATER DEPTH OF THE 17662700 C COMBINATION OF LAND AND MARINE DATA (ADJUST THE SHOT 17662800 C ELEVATIONS TO WATER BOTTOM IN MARINE AREA) 17662900 C 17663000 IF (SEWFLG .NE. 0) THEN 17663100 IF (DFWV .NE. 0) THEN 17663200 SSTCWA = 0 17663300 CALL USRTHV (TRCHDR, 'THWATV ', WATVDF) 17663400 IF (WATVDF .NE. 0) 17663500 * SSTCWA = INT((WDPS(NS) * 1000. / FLOAT(WATVDF)) + 0.5) 17663600 ELSE 17663700 SSTCWA =INT((WDPS(NS) * 1000./ FLOAT(WATV)) + 0.5) 17663800 WRITE (KPPRNT, 8000) ASPNO(NS), WDPS(NS), WATV, SSTCWA 17663900 8000 FORMAT(1X,'ASPNO,WDPS,WATV,SSTCWA =', 17664000 * I5,2X,F7.1,2(2X,I5)) 17664100 ENDIF 17664200 C 17664300 SSTC = SSTC - SSTCWA 17664400 ENDIF 17664500 C 17664600 SHSTAT(NS)= SSTC 17664700 ENDIF 17664800 IF (TESTSP .LT. 0) GO TO 919 17664900 IF (TESTSP .NE. ASPNO(NS)) GO TO 1015 17665000 C 17665100 CALL USRTHV (TRCHDR, 'THCDPN ', CDPN ) 17665200 CALL USRTHV (TRCHDR, 'THSLN ', SLOC) 17665300 CALL USRTHV (TRCHDR, 'THRCLN ', RLOC) 17665400 CALL USRTHV (TRCHDR, 'THCDPL ', CDPL) 17666000 STANDX = (RLOC - STSTAN * 100)/100 + 1 17667000 C 17668000 IF (SSTFLG .EQ. 0 .AND. GSTFLG .EQ. 0 ) GO TO 778 17669000 GSTC = IGPE(STANDX) 17670000 GPSTAT(STANDX) = GSTC 17680000 GO TO 915 17690000 C 17700000 778 DE = 0. 17710000 DS = 0. 17720000 UH = 0. 17730000 EL = 0. 17740000 C 17750000 XNDX = 1 17760000 C 17770000 C CODE ADDED TO CALCULTAE 'GST' CORRECTLY FOR SHOTPOINTS AT THE 17780000 C SAME SHOT POINT LOCATION (SLOC). 17790000 C 17800000 C IF ( NS .EQ. 1 ) GO TO 779 17810000 C IF ((ASPNO(NS) .NE. ASPNO(NS - 1)) .AND. 17820000 C * (REFNO(NS) .EQ. REFNO(NS - 1))) GO TO 791 17830000 C 779 CONTINUE 17840000 C 17850000 IF(RLOC .LE. REFNO(1)) GO TO 780 17860000 IF(RLOC .LT. REFNO(INDEX)) GO TO 790 17870000 791 XNDX = INDEX 17880000 C 17890000 780 IF(DATELE(1) .NE. -9999) DE = DATELE(XNDX) 17900000 IF(DSHOT (1) .NE. -9999) DS = DSHOT(XNDX) 17910000 IF(UPHOLE(1) .NE. -9999) UH = UPHOLE(XNDX) 17920000 IF(DATVEL(1) .NE. -9999) DV = DATVEL(XNDX) 17930000 GO TO 860 17940000 C 17950000 C WE NEED TO INTERPOLATE 17960000 C 17970000 790 CONTINUE 17980000 C 17990000 J = INDEX / 2 18000000 INCR = INT(J / 2.0 + 0.5) 18010000 800 IF (RLOC .GT. REFNO(J) .AND. 18020000 * RLOC .LT. REFNO(J+1)) GO TO 830 18030000 C 18040000 IF (RLOC .NE. REFNO(J)) GO TO 805 18050000 801 IF (DSHOT(1) .NE. -9999) DS = DSHOT(J) 18060000 IF (UPHOLE(1) .NE. -9999) UH = UPHOLE(J) 18070000 IF (DATVEL(1) .NE. -9999) DV = DATVEL(J) 18080000 GO TO 860 18090000 C 18100000 805 IF (RLOC .NE. REFNO(J+1)) GO TO 810 18110000 J = J + 1 18120000 GO TO 801 18130000 C 18140000 810 IF (J .EQ. 1 .OR. J+1 .EQ. INDEX) GO TO 820 18150000 IF (RLOC .LT. REFNO(J)) J = J - INCR 18160000 IF (RLOC .GT. REFNO(J+1)) J = J + INCR 18170000 INCR = INCR / 2 18180000 IF (INCR .LT. 1) INCR = 1 18190000 GO TO 800 18200000 C 18210000 820 IF (RLOC .LT. REFNO(1)) J = 1 18220000 IF (RLOC .GT. REFNO(INDEX)) J = INDEX - 1 18230000 IF (REFNO(J) .EQ. REFNO(J+1)) GO TO 801 18240000 C 18250000 830 RJ = REFNO(J+1) 18260000 RJM1 = REFNO(J) 18270000 RI = RLOC 18280000 C 18290000 C 18300000 C INTERPOLATE DS FOR THIS RECEIVER LOCATION 18310000 C 18320000 IF (DSHOT(1) .EQ. -9999) GO TO 840 18330000 VJ = DSHOT(J+1) 18340000 VJM1 = DSHOT(J) 18350000 DS = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) + VJM1 18360000 C 18370000 C INTERPOLATE UH FOR THIS RECEIVER LOCATION 18380000 C 18390000 840 IF(UPHOLE(1) .EQ. -9999) GO TO 850 18400000 VJ = UPHOLE(J+1) 18410000 VJM1 = UPHOLE(J) 18420000 UH = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) + VJM1 18430000 C 18440000 C INTERPOLATE DV FOR THIS RECEIVER LOCATION 18450000 C 18460000 850 IF (DATVEL(1) .EQ. -9999) GO TO 860 18470000 VJ = DATVEL(J+1) 18480000 VJM1 = DATVEL(J) 18490000 DV = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) + VJM1 18500000 C 18510000 C INTERPLOATE EL FOR THIS RECEIVER LOCATION 18520000 C 18530000 860 IF (IGPE(1) .EQ. -9999) GO TO 910 18540000 XNDX = 1 18550000 IF (RLOC .LE. GPREFN(1)) GO TO 870 18560000 IF (RLOC .LT. GPREFN(NGPS)) GO TO 880 18570000 XNDX = NGPS 18580000 C 18590000 870 IF (IGPE(1) .NE. -9999) EL = IGPE(XNDX) 18600000 GO TO 910 18610000 C 18620000 880 J = STANDX 18630000 C 18640000 885 IF (RLOC .NE. GPREFN(J-1)) GO TO 890 18650000 EL = IGPE(J-1) 18660000 GO TO 910 18670000 C 18680000 890 IF (RLOC .GT. GPREFN(J-1)) GO TO 895 18690000 J = J - 1 18700000 GO TO 885 18710000 C 18720000 895 IF (RLOC .LT. GPREFN(J)) GO TO 900 18730000 J = J + 1 18740000 GO TO 885 18750000 C 18760000 C 18770000 C 18780000 900 RJ = GPREFN(J) 18790000 RJM1 = GPREFN(J-1) 18800000 RI = RLOC 18810000 VJ = IGPE(J) 18820000 VJM1 = IGPE(J-1) 18830000 EL = (VJ-VJM1) /(RJ-RJM1) * (RI-RJM1) + VJM1 18840000 C 18850000 C COMPUTE THE GEOPHONE STATIC 18860000 C 18870000 910 CONTINUE 18880000 C 18890000 IF (DATELE(1) .NE. -9999)DE = ISSD(STANDX) 18900000 IF (MDPDE .EQ. 0) GO TO 912 18910000 RDPN = CDPN - STCDPN + 1 18920000 IF (RDPN .GT. MAXDPS) MAXDPS = RDPN 18930000 C 18940000 K = NDPS / 2 18950000 INCR = INT(K / 2.0 + .5) 18960000 C 18970000 9111 IF (SLOC .GT. CDPREF(K) .AND. 18980000 * SLOC .LT. CDPREF(K+1)) GO TO 9115 18990000 C 19000000 IF (SLOC .NE. CDPREF(K)) GO TO 9112 19010000 DELS = MDDEHW(K) 19020000 GO TO 9116 19030000 C 19040000 9112 IF (SLOC .NE. CDPREF(K+1)) GO TO 9113 19050000 DELS = MDDEHW(K+1) 19060000 GO TO 9116 19070000 C 19080000 9113 IF (K .EQ. 1 .OR. K+1 .EQ. NDPS) GO TO 9114 19090000 IF (SLOC .LT. CDPREF(K)) K = K - INCR 19100000 IF (SLOC .GT. CDPREF(K+1)) K = K + INCR 19110000 INCR = INCR / 2 19120000 IF (INCR .LT. 1) INCR = 1 19130000 GO TO 9111 19140000 C 19150000 9114 IF (SLOC .LT. CDPREF(1)) DELS = MDDEHW(1) 19160000 IF (SLOC .GT. CDPREF(NDPS)) DELS = MDDEHW(NDPS) 19170000 GO TO 9116 19180000 C 19190000 9115 RJ = CDPREF(K+1) 19200000 RJM1 = CDPREF(K) 19210000 RI = SLOC 19220000 VJ = MDDEHW(K+1) 19230000 VJM1 = MDDEHW(K) 19240000 DELS = INT((VJ-VJM1)/(RJ-RJM1) * (RI-RJM1) + VJM1) 19250000 C 19260000 C COMPUTE SHOTPOINT STATIC 19270000 C 19280000 9116 DE = MDDEHW(RDPN) 19290000 FSSTC = DE * FSSTC1 + FSSTC2 19300000 SSTC = FSSTC + SIGN(.5,FSSTC) 19310000 SHSTAT(NS) = SSTC 19320000 C 19330000 C INTERPOLATE DATUM ELEVATION AT RECEIVER 19340000 C 19350000 K = NDPS / 2 19360000 INCR = INT(K / 2.0 + .5) 19370000 C 19380000 9117 IF (RLOC .GT. CDPREF(K) .AND. 19390000 * RLOC .LT. CDPREF(K+1)) GO TO 9122 19400000 C 19410000 IF (RLOC .NE. CDPREF(K)) GO TO 9118 19420000 DELR = MDDEHW(K) 19430000 GO TO 912 19440000 C 19450000 9118 IF (RLOC .NE. CDPREF(K+1)) GO TO 9119 19460000 DELR = MDDEHW(K+1) 19470000 GO TO 912 19480000 C 19490000 9119 IF (K .EQ. 1 .OR. K+1 .EQ. NDPS) GO TO 9121 19500000 IF (RLOC .LT. CDPREF(K)) K = K - INCR 19510000 IF (RLOC .GT. CDPREF(K+1)) K = K + INCR 19520000 INCR = INCR / 2 19530000 IF (INCR .LT. 1) INCR = 1 19540000 GO TO 9117 19550000 C 19560000 9121 IF (RLOC .LT. CDPREF(1)) DELR = MDDEHW(1) 19570000 IF (RLOC .GT. CDPREF(NDPS)) DELR = MDDEHW(NDPS) 19580000 GO TO 912 19590000 C 19600000 9122 RJ = CDPREF(K+1) 19610000 RJM1 = CDPREF(K) 19620000 RI = RLOC 19630000 VJ = MDDEHW(K+1) 19640000 VJM1 = MDDEHW(K) 19650000 DELR = INT((VJ-VJM1)/(RJ-RJM1) * (RI-RJM1) + VJM1) 19660000 C 19670000 C COMPUTE GEOPHONE STATIC 19680000 C 19690000 912 CONTINUE 19700000 PT5 = .5 19710000 IF (DV .EQ. 0) GO TO 1100 19720000 C WRITE(KPPRNT,9997) I,RLOC,DE,DS,EL,DV,UH 19730000 C9997 FORMAT(3X,'I/RLOC/DE/DS/EL/DV/UH',2I8,5F10.3) 19740000 FGSTC = (DE + DS - EL) * 1000.0 /DV - UH 19750000 IF (FGSTC .LT. 0.) PT5 = -.5 19760000 GSTC = FGSTC + PT5 19770000 GPSTAT (STANDX) = GSTC 19780000 C 19790000 C FIND THE ELEVATION AND DATUM ELEVATION OF DEPTHPOINT 19800000 C 19810000 DPDE = 0. 19820000 DPEL = 0. 19830000 XNDX = 1 19840000 IF(LCMXLN .GT. 1) GO TO 1310 19850000 IF(CDPL .LE. GPREFN(1)) GO TO 1180 19860000 IF(CDPL .LT. GPREFN(NGPS)) GO TO 1190 19870000 XNDX = NGPS 19880000 C 19890000 1180 IF(ISSD(1) .NE. -9999) DPDE = ISSD(XNDX) 19900000 GO TO 1260 19910000 C 19920000 C 19930000 C WE NEED TO INTERPOLATE 19940000 C 19950000 1190 CONTINUE 19960000 IF (MDPDE .NE. 0) GO TO 1260 19970000 C 19980000 C 19990000 J = (CDPL - STSTAN * 100) / 100 + 1 20000000 IF (J .EQ. 1) J = 2 20010000 C 20020000 1195 IF (CDPL .NE. GPREFN(J-1)) GO TO 1200 20030000 DPDE = ISSD(J-1) 20040000 GO TO 1260 20050000 C 20060000 1200 IF (CDPL .GT. GPREFN(J-1)) GO TO 1202 20070000 J = J - 1 20080000 GO TO 1195 20090000 C 20100000 1202 IF (CDPL .LT. GPREFN(J)) GO TO 1205 20110000 J = J + 1 20120000 GO TO 1195 20130000 C 20140000 C 20150000 C 20160000 1205 RJ = GPREFN(J) 20170000 RJM1 = GPREFN(J-1) 20180000 RI = CDPL 20190000 C 20200000 C INTERPOLATE DPDE FOR THIS DEPTH POINT 20210000 C 20220000 1220 IF(ISSD(1) .EQ. -9999) GO TO 1260 20230000 VJ = ISSD(J) 20240000 VJM1 = ISSD(J-1) 20250000 DPDE = (VJ-VJM1) / (RJ-RJM1) * (RI-RJM1) + VJM1 20260000 1260 CONTINUE 20270000 IF (MDPDE .EQ. 0) GO TO 1265 20280000 DPDE = MDDEHW(RDPN) 20290000 1265 CONTINUE 20300000 C 20310000 C INTERPOLATE DPEL FOR THIS DEPTH POINT 20320000 C 20330000 C 20340000 IF (IGPE(1) .EQ. -9999) GO TO 1310 20350000 XNDX = 1 20360000 IF (CDPL .LE. GPREFN(1)) GO TO 1270 20370000 IF (CDPL .LT. GPREFN(NGPS)) GO TO 1280 20380000 XNDX = NGPS 20390000 C 20400000 1270 IF (IGPE(1) .NE. -9999)DPEL= IGPE(XNDX) 20410000 GO TO 1310 20420000 1280 J = (CDPL - STSTAN * 100) / 100 + 1 20430000 IF (J .EQ. 1) J = 2 20440000 C 20450000 1285 IF (CDPL .NE. GPREFN(J-1)) GO TO 1290 20460000 DPEL = IGPE(J-1) 20470000 GO TO 1310 20480000 C 20490000 1290 IF (CDPL .GT. GPREFN(J-1)) GO TO 1295 20500000 J = J - 1 20510000 GO TO 1285 20520000 C 20530000 1295 IF (CDPL .LT. GPREFN(J)) GO TO 1300 20540000 J = J + 1 20550000 GO TO 1285 20560000 C 20570000 C 20580000 C 20590000 1300 RJ = GPREFN(J) 20600000 RJM1 = GPREFN(J-1) 20610000 RI = CDPL 20620000 VJ = IGPE(J) 20630000 VJM1 = IGPE(J-1) 20640000 DPEL=(VJ-VJM1) /(RJ-RJM1) * (RI-RJM1) + VJM1 20650000 C 20660000 C 20670000 C 20680000 1310 CONTINUE 20690000 C EDIT THE TRACE HEADER 20700000 C ===================== 20710000 C 20720000 1320 IF (DPEL .GE. 0.0) VALUE = DPEL + 0.5 20730000 IF (DPEL .LT. 0.0) VALUE = DPEL - 0.5 20740000 CALL USSTHV (TRCHDR, 'THDPEL ', VALUE) 20750000 C 20760000 IF (DPDE .GE. 0.0) VALUE = DPDE + 0.5 20770000 IF (DPDE .LT. 0.0) VALUE = DPDE - 0.5 20780000 CALL USSTHV (TRCHDR, 'THDPDE ', VALUE) 20790000 C 20800000 IF (DPDE .GE. 0.0) VALUE = DPDE + 0.5 20810000 IF (DPDE .LT. 0.0) VALUE = DPDE - 0.5 20820000 CALL USSTHV (TRCHDR, 'THSMDE ', VALUE) 20830000 C 20840000 IF (EL .GE. 0.0) VALUE = EL + 0.5 20850000 IF (EL .LT. 0.0) VALUE = EL - 0.5 20860000 CALL USSTHV (TRCHDR, 'THRGEL ', VALUE) 20870000 C 20880000 IF (SEWFLG .NE. 0) THEN 20890000 IF (SPE(NS) .GE. 0.0) VALUE = SPE(NS)-WDPS(NS)+0.5 20900000 IF (SPE(NS) .LT. 0.0) VALUE = SPE(NS)-WDPS(NS)-0.5 20910000 ELSE 20920000 IF (SPE(NS) .GE. 0.0) VALUE = SPE(NS) + 0.5 20930000 IF (SPE(NS) .LT. 0.0) VALUE = SPE(NS) - 0.5 20940000 ENDIF 20950000 CALL USSTHV (TRCHDR, 'THSSEL ', VALUE) 20960000 C 20970000 C IF (DS .GE. 0.0) VALUE = DS + 0.5 20980000 C IF (DS .LT. 0.0) VALUE = DS - 0.5 20990000 IF (DSS .GE. 0.0) VALUE = DSS + 0.5 20991000 IF (DSS .LT. 0.0) VALUE = DSS - 0.5 20992000 CALL USSTHV (TRCHDR, 'THSDPT ', VALUE) 21000000 C 21010000 CALL USSTHV (TRCHDR, 'THASD ', ASD) 21020000 C 21030000 IF (DE .GE. 0.0) VALUE = DE + 0.5 21040000 IF (DE .LT. 0.0) VALUE = DE - 0.5 21050000 IF (MDPDE .NE. 0) THEN 21060000 IF (DELR .GE. 0.0) VALUE = DELR + 0.5 21070000 IF (DELR .LT. 0.0) VALUE = DELR - 0.5 21080000 END IF 21090000 CALL USSTHV (TRCHDR, 'THDELR ', VALUE) 21100000 C 21110000 IF (DATELE(NS) .GE. 0.0) VALUE = DATELE(NS) + 0.5 21120000 IF (DATELE(NS) .LT. 0.0) VALUE = DATELE(NS) - 0.5 21130000 IF (MDPDE .NE. 0) THEN 21140000 IF (DELS .GE. 0.0) VALUE = DELS + 0.5 21150000 IF (DELS .LT. 0.0) VALUE = DELS - 0.5 21160000 END IF 21170000 CALL USSTHV (TRCHDR, 'THDELS ', VALUE) 21180000 C 21190000 IF (WTHVEL(NS) .GE. 0.0) VALUE = WTHVEL(NS) + 0.5 21200000 IF (WTHVEL(NS) .LT. 0.0) VALUE = WTHVEL(NS) - 0.5 21210000 CALL USSTHV (TRCHDR, 'THWV ', VALUE) 21220000 C 21230000 IF (DV .GE. 0.0) VALUE = DV + 0.5 21240000 IF (DV .LT. 0.0) VALUE = DV - 0.5 21250000 CALL USSTHV (TRCHDR, 'THSWV ', VALUE) 21260000 C 21270000 IF (UPHOLE(NS) .GE. 0.0) VALUE = UPHOLE(NS) + 0.5 21280000 IF (UPHOLE(NS) .LT. 0.0) VALUE = UPHOLE(NS) - 0.5 21290000 CALL USSTHV (TRCHDR, 'THSTUH ', VALUE) 21300000 C 21310000 IF (UH .GE. 0.0) VALUE = UH + 0.5 21320000 IF (UH .LT. 0.0) VALUE = UH - 0.5 21330000 CALL USSTHV (TRCHDR, 'THRTUH ', VALUE) 21340000 C 21350000 915 CALL USSTHV (TRCHDR, 'THCSST ', SSTC) 21360000 C 21370000 CALL USSTHV (TRCHDR, 'THCRST ', GSTC) 21380000 C 21390000 IF (KPBUGF .NE. 1) GO TO 918 21400000 KNT = KNT + 1 21410000 TRCNO(KNT) = I 21420000 RSTAT(KNT) = GSTC 21430000 SSTAT(KNT) = SSTC 21440000 TSTAT(KNT) = SSTC + GSTC 21450000 IF(KNT .NE. 24 .AND. I .NE. LCTPSP) GO TO 918 21460000 IF(MDPDE .GT. 0) GO TO 917 21470000 WRITE (KPPRNT, 9080) ASPNO(NS),(TRCNO(L), L= 1,KNT) 21480000 WRITE (KPPRNT, 9090) (TSTAT(L), L= 1,KNT) 21490000 KNT = 0 21500000 GO TO 918 21510000 917 WRITE (KPPRNT, 9200) ASPNO(NS),(TRCNO(L),L=1,KNT) 21520000 WRITE (KPPRNT, 9205) (SSTAT(L),L=1,KNT) 21530000 WRITE (KPPRNT, 9210) (RSTAT(L),L=1,KNT) 21540000 WRITE (KPPRNT, 9215) (TSTAT(L),L=1,KNT) 21550000 KNT = 0 21560000 918 CALL USWHDR (TRCHDR, DA1, *960 ) 21570000 919 DA1 = DA2 21580000 920 CONTINUE 21590000 C 21600000 930 CONTINUE 21610000 C 21620000 931 CONTINUE 21621000 C 21622000 21623000 C 21624000 C GO TO MEAN DEPTH POINT PLOT 21625000 C 21626000 C LOAD ARRAYS TO BE USED IN PRODUCING PRINTER PLOTS. 21627000 C 21628000 DO 932 21629000 * I = 1, MAXSPS 21630000 IF (SPE(I) .GE. 0.0) ISPE(I) = SPE(I) + 0.5 21640000 IF (SPE(I) .LT. 0.0) ISPE(I) = SPE(I) - 0.5 21650000 IF (UPHOLE(I) .GE. 0.0) IUPHOL(I) = UPHOLE(I) + 0.5 21660000 IF (UPHOLE(I) .LT. 0.0) IUPHOL(I) = UPHOLE(I) - 0.5 21670000 IF (DSHOT(I) .GE. 0.0) IDSHOT(I) = DSHOT(I) + 0.5 21680000 IF (DSHOT(I) .LT. 0.0) IDSHOT(I) = DSHOT(I) - 0.5 21690000 IF (DATVEL(I) .GE. 0.0) IDATVL(I) = DATVEL(I) + 0.5 21700000 IF (DATVEL(I) .LT. 0.0) IDATVL(I) = DATVEL(I) - 0.5 21710000 IF (DATELE(I) .GE. 0.0) IDATEL(I) = DATELE(I) + 0.5 21720000 IF (DATELE(I) .LT. 0.0) IDATEL(I) = DATELE(I) - 0.5 21730000 IF (WTHVEL(I) .GE. 0.0) IWTHVL(I) = WTHVEL(I) + 0.5 21740000 IF (WTHVEL(I) .LT. 0.0) IWTHVL(I) = WTHVEL(I) - 0.5 21750000 932 CONTINUE 21760000 C 21770000 IF (MDPDE .NE. 0) GO TO 9650 21780000 C 21790000 C SET UP FOR PRINTER PLOT OF STATICS INFO 21800000 C ======================================= 21810000 C 21820000 C ZERO ALL NULL DATA 21830000 C 21840000 DO 940 21850000 * I = 1, MAXGPS 21860000 IF (ISSD(I) .EQ. -9999) ISSD(I) = 0 21870000 IF (I .GT. INDEX) GO TO 940 21880000 IF(IUPHOL(I) .EQ. -9999) IUPHOL(I) = 0 21890000 IF(IDSHOT (I) .EQ. -9999) IDSHOT (I) = 0 21900000 IF(IDATVL(I) .EQ. -9999) IDATVL(I) = 0 21910000 IF(IDATEL(I) .EQ. -9999) IDATEL(I) = 0 21920000 IF(IWTHVL(I) .EQ. -9999) IWTHVL(I) = 0 21930000 C 21940000 940 CONTINUE 21950000 C 21960000 IF (GSTFLG .EQ. 0 .AND.SSTFLG .EQ. 0) GO TO 955 21970000 C 21980000 DO 945 21990000 * I = 1, MAXGPS 22000000 IGPE(I) = 0 22010000 IF (I .GT. MAXSPS) GO TO 945 22020000 ISPE(I) = 0 22030000 945 CONTINUE 22040000 C 22050000 955 CONTINUE 22060000 C CHECK FOR NO PRINT OPTION 22070000 IF (KPBUGF .EQ. 3) GO TO 965 22080000 CALL USPHD (1,ACLNAM,KPNA,KPRNO,'SPARC STATICS DISPLAY', 22090000 *21,KPPRNT) 22100000 IF(TWTHFL .EQ. 0. AND. DWTHFL .EQ. 0) GO TO 950 22110000 C 22120000 C 22130000 C 22140000 CALL USSPLT (ASPNO , REFNO , INDEX , GPSTAN , GPREFN, 22150000 * NGPS , SHSTAT, PLOTZ , PLOTZ , ISPE , IDATVL, 22160000 * IDATEL, IWTHVL, IDSHOT, IUPHOL, IGPE , ISSD , GPSTAT,KPPRNT) 22170000 C 22180000 GO TO 965 22190000 C 22200000 950 CALL USSPLT (ASPNO , REFNO , INDEX , GPSTAN , GPREFN, 22210000 * NGPS , SHSTAT, IUPHOL, IDSHOT, ISPE , IDATVL, 22220000 * IDATEL, IWTHVL, PLOTZ , PLOTZ , IGPE , ISSD , GPSTAT,KPPRNT) 22230000 GO TO 965 22240000 C 22250000 9650 CONTINUE 22260000 C CHECK FOR NO PRINT OPTION 22270000 IF (KPBUGF .EQ. 3) GO TO 965 22280000 CALL USPHD (1,ACLNAM,KPNA,KPRNO,'SPARC DEPTH POINT DATUM ELEVATION22290000 * DISPLAY',41,KPPRNT) 22300000 C 22310000 CALL SAPLDE (ASPNO, REFNO, INDEX, ISPE, 22320000 * GPSTAN, GPREFN, NGPS, IGPE, 22330000 * STCDPN, CDPREF, MAXDPS, MDDEHW, KPPRNT) 22340000 C 22341000 IF (KPBUGF .EQ. 0) GO TO 965 22342000 WRITE (KPPRNT, 9225) (MDDEHW(L),L=1,NDPS) 22343000 C 22344000 965 WRITE (KPPRNT, 9010 ) KPNA, KPRNO 22345000 GO TO 1040 22346000 C 22347000 960 WRITE (KPPRNT, 9020 ) 22348000 GO TO 1030 22349000 C 22350000 970 WRITE (KPPRNT, 9030 ) 22360000 GO TO 1030 22370000 C 22380000 980 WRITE (KPPRNT, 9040 ) 22390000 GO TO 1030 22400000 C 22410000 1000 WRITE (KPPRNT, 9045 ) CARD 22420000 GO TO 1030 22430000 C 22440000 1010 WRITE (KPPRNT, 9070) 22450000 GO TO 1030 22460000 C 22470000 1015 WRITE (KPPRNT, 9110) TESTSP , ASPNO(NS) 22480000 GO TO 1030 22490000 C 22500000 1020 WRITE (KPPRNT, 9100) TESTSP 22510000 GO TO 1030 22520000 C 22530000 1025 WRITE (KPPRNT, 9130) CARD 22540000 GO TO 1030 22550000 C 22560000 1028 WRITE (KPPRNT, 9150) CARD 22570000 GO TO 1030 22580000 C 22590000 1029 WRITE (KPPRNT, 9155) 22600000 GO TO 1030 22610000 C 22620000 1035 WRITE (KPPRNT, 9050) ASPNO(SPINDX), SRCV 22630000 GO TO 1030 22640000 C 22650000 1045 WRITE (KPPRNT, 9300) 22660000 GO TO 1030 22670000 C 22680000 1060 WRITE (KPPRNT, 9330) 22690000 WRITE (KPPRNT, 9310) 22700000 GO TO 1030 22710000 C 22720000 1070 WRITE (KPPRNT, 9330) 22730000 WRITE (KPPRNT, 9320) 22740000 GO TO 1030 22750000 C 22751000 1100 WRITE (KPPRNT, 9280) 22752000 C 22753000 1030 KPRTF = -1 22754000 C 22755000 1040 IF(KPBUGF.NE.2) GO TO 1050 22756000 C 22757000 C DUMP THE TRACE HEADERS 22758000 C 22759000 CALL USDTHS (TRCHDR) 22760000 C 22770000 1050 RETURN 22780000 C 22790000 9000 FORMAT(/' *** STATION NOT FOUND IN GEOMETRY FOR STATION ', I5) 22800000 C 22810000 9010 FORMAT (/' *** ',A4,I1,' COMPLETED -- NO ERRORS', 22820000 * /' *** TRACE HEADERS HAVE BEEN UPDATED WITH STATICS') 22830000 C 22840000 9020 FORMAT (/' *** I/O ERROR ON PARMETER FILE') 22850000 C 22860000 9030 FORMAT(/' *** NO GEOMETRY TRACE HEADERS PRESENT ') 22870000 C 22880000 9040 FORMAT(/' *** NO SHOTPOINT STATIC PARAMETER CARDS PRESENT') 22890000 C 22900000 9045 FORMAT(/' *** SHOTPOINT NUMBER NOT FOUND IN THE GEOMETRY FILE', 22910000 * /,1X,A80) 22920000 C 22930000 9050 FORMAT(/' *** ELEVATIONS FROM GEOMETRY FILE OUT OF SEQUENCE.', 22940000 * ' EXPECTING SHOTPOINT ',I4,' FOUND SHOTPOINT',I4) 22950000 C 22960000 9060 FORMAT(/' *** ILLEGAL TRACE NUMBER ',/,1X,A80) 22970000 C 22980000 9070 FORMAT(/' *** ONLY ONE "STAT" PROCESS PER JOB IS ALLOWED') 22990000 C 23000000 9080 FORMAT(' S ',I5, 24I5) 23010000 C 23020000 9090 FORMAT(' STATIC ',24I5) 23030000 C 23040000 9100 FORMAT(/' *** INDEX NOT FOUND FOR N = ', I5) 23050000 C 23060000 9110 FORMAT(/' ***MIS-MATCH OF SHOTPOINTS SEE PROGR. ***',2I5) 23070000 C 23080000 9120 FORMAT(/) 23090000 C 23100000 9130 FORMAT(/' *** ONLY SUB OR SUR SOURCE TYPES ALLOWED ***',A80) 23110000 C 23120000 9140 FORMAT(/6X,'TYPE OF SOURCE IS ',A4) 23130000 C 23140000 9150 FORMAT(/' *** ILLEGAL REFERENCE DATUM FACTOR'/1X,A80) 23150000 C 23160000 9155 FORMAT(/' *** ALL DEPTH POINT ARE DEAD') 23170000 C 23180000 9200 FORMAT(/' SHOT =',I6,6X,24I4) 23190000 9205 FORMAT( ' SHOT STATICS',5X,24I4) 23200000 9210 FORMAT( ' GEOS STATICS',5X,24I4) 23210000 9215 FORMAT( ' TOTAL STATICS',4X,24I4) 23220000 9225 FORMAT(/' SMOOTHED DEPTH POINT MEAN DATUM ELEVATIONS'/(2X,24I5)) 23230000 C 23240000 9240 FORMAT(/' *** NO "SVR" OR "XYE" RECEIVER ELEVATIONS FROM', 23250000 * ' GM3D WERE FOUND ***') 23260000 C 23270000 9245 FORMAT(/' *** NO "XYP" RECEIVER X-YS FROM GM3D WERE FOUND ***') 23280000 C 23290000 9250 FORMAT(/' *** NO "XYE" SHOTPOINT ELEVATIONS FROM GM3D WERE ', 23300000 * 'FOUND ***') 23310000 C 23320000 9260 FORMAT(/6X,'SHOTPOINT ELEVATIONS FROM GM3D WERE USED ') 23330000 C 23340000 9270 FORMAT(/6X,'RECEIVER ELEVATIONS FROM GM3D WERE USED ') 23350000 C 23360000 9275 FORMAT(/6X,'RECEIVER X-YS FROM GM3D WERE USED ') 23370000 C 23380000 9280 FORMAT(/' *** DATUM VELOCITY MUST BE CODED *** ') 23390000 C 23400000 9300 FORMAT(/' *** NO WATER VELOCITY WAS FOUND *** ') 23410000 C 23420000 9310 FORMAT(/' *** IF OPTION SHE OR RSE FOR GM3D ON CARD ONE,', 23430000 * ' CARD TYPE SPE OR SST NOT ALLOWED.') 23440000 C 23450000 9320 FORMAT(/' *** IF OPTION RCE OR RSE FOR GM3D ON CARD ONE,', 23460000 * ' CARD TYPE SSE OR GST NOT ALLOWED.') 23470000 9330 FORMAT(/' *** STAT CARD ERROR ***') 23480000 C 23490000 C 23500000 C DEBUG UNIT(6),INIT(THL,THL96,SPDP,NDPS,CDPS,STSTAN,NGPS, 23510000 C * DATVEL,DV,SPINDX,SPT,ASPNO,DVSNDX,DESNDX,MAXSPS,DSSNDX,DSENDX) 23520000 C 23530000 C 23540000 END 23550000