CTITLESDTDIF -- TRACE DIFFERENCING ROUTINE 00010008 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. D. KNIGHT 00020008 CA DESIGNER R. D. KNIGHT 00030008 CA LANGUAGE FORTRAN 00040008 CA SYSTEM IBM AND CRAY 00050008 CA WRITTEN 03-87 00060008 C REVISED 05-26-87 R. KNIGHT: ADD 'DIV' OPTION FOR 00070008 C DIVIDING TWO TRACES. 00080008 C REVISED 11-06-89 LWC - DELETE EXTERNAL S1ATP 00090008 C REVISED 01-11-90 ESN - ADD IN HEADER DIFFERENCING. 00100008 C REVISED 10-12-90 ESN - SET OUTPUT TICD=1. 00110008 C REVISED 12-12-90 ESN - DO NOT UNALLOCATE FILES MULTIPLE 00120008 C TIMES. 00130008 C 00140008 CA 00150008 CA 00160008 CA CALL SDTDIF (INH, INTR, OH, OTR) 00170008 CA INPUT INH = INPUT HEADER MIXED I2, I4, R4, R8 00180008 CA INPUT INTR = INPUT TRACE R4 00190008 CA OUTPUT OH = OUTPUT HEADER MIXED I2, I4, R4, R8 00200008 CA OUTPUT OTR = OUTPUT TRACE R4 00210008 CA 00220008 CA 00230008 CA THIS PROGRAM DIFFERENCES CORRESPONDING TRACES FROM TWO DATASETS 00240008 CA AND PASSES THE DIFFERENCE TRACES AS OUTPUT. 00250008 CA 00260008 CA 00270008 C 00280008 C EJECT IF ABSTRACT NEEDS A PAGE EJECT PUT 'A' IN COLUMN 2. 00290008 C IF THE DESCRIPTION WILL NOT FIT ON THE PRECEEDING PAGE, 00300008 C CONTINUE IT ON THIS PAGE. REMEMBER TO PUT 'A' IN COLUMN 2. 00310008 C 00320008 C EJECT A NEW PAGE MAY BE DESIRABLE HERE. PUT EJECT IN COL. 7. 00330008 C 00340008 C LOCAL OR INTERNAL ARRAYS. 00350008 C 00360008 C DATTR ( 96) = DATA ATTRIBUTES STORAGE I4 00370008 C DENTRY ( 104) = PARAMETER STORAGE I4 00380008 C DLOCAL ( 100) = LOCAL VARIABLES STORAGE I4 00390008 C INH ( 1) = INPUT TRACE HEADER I4 00400008 C INTR ( 1) = INPUT TRACE AREA R4 00410008 C OH ( 1) = OUTPUT TRACE HEADER I4 00420008 C OTR ( 1) = OUTPUT TRACE AREA R4 00430008 C PSHOT ( 24) = PROCESSED DEPTH POINTS I4 00440008 C COUNT ( 24) = ARRAY OF TRACES PROCESSED WITHIN EACH DP I4 00450008 C 00460008 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00470008 C 00480008 C CDP = COMMON DEPTH POINT ENSEMBLE NUMBER I4 00490008 C CDPL = LAST DEPTH POINT I4 00500008 C CDPS = CDP SPACING I4 00510008 C CDPT = CDP TRACE NUMBER - USED TO DETERMINE IF DATA IS I4 00520008 C STACKED OR NOT 00530008 C CSAVE = SEQUENTIAL COUNTER TO CURRENT TRACE IN SAVE AREA I4 00540008 C DAP = COUNTER FOR PARAMETER READ AND WRITE SUBROUTINE I4 00550008 C DAWRK = WORK DISK ADDRESS I4 00560008 C ECDPN = ENDING DEPTH POINT FOR MIGRATION I4 00570008 C SAVTRC = POINTER TO BLANK COMMON FOR SAVING A TRACE AND HEADERI4 00580008 C IC = UNRESERVED SCRATCH TRACE-BLOCK INDEX I4 00590008 C BLOCK 00600008 C LBUF = LENGTH OF BUFFERS FOR WORK FILE RECORDS I4 00610008 C LEN = LENGTH OF BUFFERS IN BYTES FOR WORK FILE RECORDS I4 00620008 C LLOCAL = LENGTH OF DLOCAL ( = 100) I4 00630008 C NOPAR = NUMBER OF PARAMETERS I4 00640008 C NOSAMP = NUMBER OF SAMPLE POINTS I4 00650008 C NOWDS = APPROXIMATE NUMBER OF WORDS OF MEMORY NEEDED FOR I4 00660008 C THIS PROCESS 00670008 C NS = NUMBER OF SHOT OR DEPTH POINTS IN PSHOT I4 00680008 C NSAVE = CAPACITY (IN # OF TRACES) OF SAVE AREA I4 00690008 C NTR = NUMBER OF TRACES USED IN INITIALIZATION I4 00700008 C PASS = CURRENT ITERATION OF MIGRATION (1 <= PASS <= NPASS) I4 00710008 C PMODE = PROCESSING MODE I4 00720008 C PTS = CHARACTER STRING "PTS " I4 00730008 C SAMPR = SAMPLE RATE I4 00740008 C SAVEPT = STARTING INDEX OF SAVE AREA IN BLANK COMMON I4 00750008 C SHOT = ENERGY SOURCE POINT NUMBER I4 00760008 C SPLOCN = SHOT POINT LOCATION I4 00770008 C SPT = STARTING POINT I4 00780008 C TCNT = TRACE COUNT OF TRACES TO BE MIGRATED AT ONE TIME I4 00790008 C THL = TRACE HEADER LENGTH I4 00800008 C TICD = ID FLAG FROM TRACE HEADER I4 00810008 C TNS = TOTAL NUMBER OF SHOT OR DEPTH POINTS PROCESSED I4 00820008 C WBUF = STARTING INDEX OF WORK FILE BUFFERS IN BLANK COMMON I4 00830008 C 00840008 C EJECT 00850008 C ===================================================================== 00860008 C FORMAT OF INPUT PARAMETER RECORDS 00870008 C 00880008 C ****** FIRST RECORD ****** PROCESSING RANGES ****** 00890008 C 00900008 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00910008 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 00920008 C | TDIF | INVOC. | PTS | NOT | NOT | # OF |N|P| NOT | NOT | 00930008 C |_______|_NUMBER_|_______|__USED_|__USED_|_PARMS_|_|M|_USED|__USED_| 00940008 C 00950008 C WORD 9 WORD 10 00960008 C |_______|________| 00970008 C | START | END | 00980008 C |__CDP__|___DP___| 00990008 C 01000008 C WORD 11 WORD 12 01010008 C |_______|________| 01020008 C | START | END | 01030008 C |__CDP__|___DP___| 01040008 C 01050008 C . 01060008 C . 01070008 C . 01080008 C 01090008 C WORD 103WORD 104 01100008 C |_______|________| 01110008 C | START | END | 01120008 C |__CDP__|___DP___| 01130008 C 01140008 C 01150008 C ****** SECOND RECORD ****** PARAMETERS ****** 01160008 C 01170008 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 01180008 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 01190008 C | TDIF | INVOC. | PRM | NOT | NOT | # OF |N|P| NOT | NOT | 01200008 C |_______|_NUMBER_|_______|__USED_|__USED_|_PARMS_|_|M|_USED|__USED_| 01210008 C 01220008 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 01230008 C |_______|________|_______|_______|_______|______|______| 01240008 C | MIN | MAX | NORMAL| ID OF | ID OF | BEGIN| END | 01250008 C |___DP__|___DP___|_-IZE__|_DSN_1_|_DSN_2_|_LINE_|_LINE_| 01260008 C 01270008 C WORD 16 WORD 104 01280008 C |_______| ..... |_______| 01290008 C | NOT | ..... | NOT | 01300008 C |_USED__| ..... |_USED__| 01310008 C 01320008 C 01330008 C 01340008 C ==================================================================== 01350008 C EJECT 01360008 C ==================================================================== 01370008 C LAYOUT OF BLANK COMMON 01380008 C 01390008 C ________________________________ 01400008 C | 80 WORDS FOR | 01410008 C | LOCAL VARIABLES | 01420008 C | ("DLOCAL") | 01430008 C | | 01440008 C |______________________________| 01450008 C SAVHDR --> | TEMPORARY SPACE FOR HEADER | 01460008 C |______________________________| 01470008 C SAVTRC --> | TEMPORARY SPACE FOR TRACE | 01480008 C | | 01490008 C |______________________________| 01500008 C 01510008 C ===================================================================== 01520008 C EJECT 01530008 C 01540008 SUBROUTINE SDTDIF (INH, INTR, OH, OTR) 01550008 C 01560008 IMPLICIT INTEGER (A-Z) 01570008 C EXTERNAL S1ATP 01580008 EXTERNAL FOSCDK 01590008 C 01600008 C 01610008 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/23/83 01620008 COMMON /P/ STARTP ( 2) 01630008 COMMON /P/ LCNAME 01640008 COMMON /P/ LC5 01650008 COMMON /P/ LCINT 01660008 COMMON /P/ LCTYP 01670008 COMMON /P/ LC10 01680008 COMMON /P/ LCBGSP 01690008 COMMON /P/ LCENSP , M00032( 2) 01700008 COMMON /P/ LCNSP 01710008 COMMON /P/ LCTPSP 01720008 COMMON /P/ LCRL 01730008 COMMON /P/ LCSI 01740008 COMMON /P/ LCPI 01750008 COMMON /P/ LCGRPI 01760008 COMMON /P/ LCMXFD 01770008 COMMON /P/ LCANSP 01780008 COMMON /P/ LCMXLN 01790008 COMMON /P/ LCDRYF , M00080( 3) 01800008 COMMON /P/ ACNAME 01810008 COMMON /P/ AC0506 01820008 COMMON /P/ AC64BC 01830008 COMMON /P/ ACOPCD 01840008 COMMON /P/ ACQCF 01850008 COMMON /P/ ACDIST 01860008 COMMON /P/ ACPROJ 01870008 COMMON /P/ ACLNAM ( 5) 01880008 COMMON /P/ ACCOM ( 8) 01890008 COMMON /P/ AC7274 01900008 COMMON /P/ ACTYPE 01910008 COMMON /P/ ACNSP 01920008 COMMON /P/ ACUSER ( 5) , M00188( 4) 01930008 COMMON /P/ ACMIGR , M00224( 7) 01940008 COMMON /P/ LHJBNO 01950008 COMMON /P/ LHLNO 01960008 COMMON /P/ LHRLNO 01970008 COMMON /P/ LHTPSP 01980008 COMMON /P/ LHATSP 01990008 COMMON /P/ LHSI 02000008 COMMON /P/ LHORSI 02010008 COMMON /P/ LHST 02020008 COMMON /P/ LHORST 02030008 COMMON /P/ LHDFCD 02040008 COMMON /P/ LHEXFD 02050008 COMMON /P/ LHTSCD 02060008 COMMON /P/ LHVSCD 02070008 COMMON /P/ LHSWFS 02080008 COMMON /P/ LHSWFE 02090008 COMMON /P/ LHSWL 02100008 COMMON /P/ LHSWCD 02110008 COMMON /P/ LHTSNO 02120008 COMMON /P/ LHSWTS 02130008 COMMON /P/ LHSWTE 02140008 COMMON /P/ LHSWTT 02150008 COMMON /P/ LHTCF 02160008 COMMON /P/ LHBGRF 02170008 COMMON /P/ LHARCD 02180008 COMMON /P/ LHMS 02190008 COMMON /P/ LHSGPL 02200008 COMMON /P/ LHVPCD 02210008 COMMON /P/ LHNSP 02220008 COMMON /P/ LHNDP 02230008 COMMON /P/ LHNSL 02240008 COMMON /P/ LHMTPR , M00376( 9) 02250008 COMMON /P/ KPNA 02260008 COMMON /P/ KPRNO , M00420 02270008 COMMON /P/ KPA 02280008 COMMON /P/ KPDBGS 02290008 COMMON /P/ KPDBGA 02300008 COMMON /P/ KPDBGN 02310008 COMMON /P/ KPWRKS 02320008 COMMON /P/ KPWRKD 02330008 COMMON /P/ KPWKS2 02340008 COMMON /P/ KPWKD2 , M00456( 2) 02350008 COMMON /P/ KPFCF 02360008 COMMON /P/ KPIRSM 02370008 COMMON /P/ KPNRSM 02380008 COMMON /P/ KPIUSM 02390008 COMMON /P/ KPNUSM 02400008 COMMON /P/ KPTIME 02410008 COMMON /P/ KPRTF 02420008 COMMON /P/ KPDRTF 02430008 COMMON /P/ KPMOTF 02440008 COMMON /P/ KPNBR 02450008 COMMON /P/ KPIBN 02460008 COMMON /P/ KPITSV 02470008 COMMON /P/ KPTAMF 02480008 COMMON /P/ KPLOTF 02490008 COMMON /P/ KPMITF 02500008 COMMON /P/ KPPRNT 02510008 COMMON /P/ KPPLOT 02520008 COMMON /P/ KPPLTA 02530008 COMMON /P/ KPBUGF , M00540( 226) 02540008 COMMON /P/ ENDP 02550008 C 02560008 COMMON COM (1) 02570008 REAL XCOM(1) 02580008 EQUIVALENCE (COM(1),XCOM(1)) 02590008 C 02600008 C=================================================================== 02610008 C 02620008 C REAL ARRAYS IN PARAMETER LIST. 02630008 C 02640008 REAL INTR (1) 02650008 REAL OTR (1) 02660008 REAL INH (1) 02670008 REAL OH (1) 02680008 C 02690008 C REAL ARRAYS--LOCAL 02700008 C 02710008 REAL XATTR ( 96) 02720008 C 02730008 C INTEGER ARRAYS--LOCAL 02740008 C 02750008 INTEGER DATTR ( 96) 02760008 INTEGER DENTRY (104) 02770008 C 02780008 INTEGER DLOCAL (100) 02790008 INTEGER PSHOT ( 24) 02800008 INTEGER COUNT ( 24) 02810008 INTEGER RECMNE ( 2) 02820008 INTEGER TAB3 ( 12) 02830008 INTEGER TRCMNE ( 2) 02840008 C 02850008 C 02860008 C DENTRY IS AN ARRAY TO HOLD A PARAMETER RECORD. THE DEFINITIONS 02870008 C OF THE FIRST EIGHT WORDS ARE FIXED. THE REMAINING WORDS ARE 02880008 C FOR VARIABLE PARAMETERS AND ARE USUALLY ADDRESSED USING "DATTR". 02890008 C THE MAXIMUM LENGTH OF DENTRY IS 104 BECAUSE OF THE I/O ROUTINES. 02900008 C 02910008 EQUIVALENCE (DCTYP , DENTRY (03)) 02920008 EQUIVALENCE (SPT , DENTRY (04)) 02930008 EQUIVALENCE (EPT , DENTRY (05)) 02940008 EQUIVALENCE (NOPAR , DENTRY (06)) 02950008 EQUIVALENCE (PMODE , DENTRY (07)) 02960008 EQUIVALENCE (SPLOCN , DENTRY (08)) 02970008 EQUIVALENCE (DATTR(1) , DENTRY (09)) 02980008 C 02990008 EQUIVALENCE (DATTR(1) , XATTR (01)) 03000008 C 03010008 C DLOCAL IS AN ARRAY USED TO HOLD PARAMETER VALUES THAT ARE UNIQUE 03020008 C TO EACH OCCURRENCE OF THE PROCESS. 03030008 C 03040008 EQUIVALENCE (RECMNE(1) , DLOCAL (01)) 03050008 EQUIVALENCE (TRCMNE(1) , DLOCAL (03)) 03060008 EQUIVALENCE (GATH , DLOCAL (05)) 03070008 EQUIVALENCE (RANG , DLOCAL (06)) 03080008 EQUIVALENCE (RANGM1 , DLOCAL (07)) 03090008 EQUIVALENCE (SLINE , DLOCAL (08)) 03100008 EQUIVALENCE (ELINE , DLOCAL (09)) 03110008 EQUIVALENCE (TWO , DLOCAL (10)) 03120008 EQUIVALENCE (READ , DLOCAL (11)) 03130008 EQUIVALENCE (DAWRK , DLOCAL (12)) 03140008 EQUIVALENCE (CSAVE , DLOCAL (13)) 03150008 EQUIVALENCE (CDP1 , DLOCAL (14)) 03160008 EQUIVALENCE (TRC1 , DLOCAL (15)) 03170008 EQUIVALENCE (NORMT , DLOCAL (16)) 03180008 EQUIVALENCE (SAVHDR , DLOCAL (17)) 03190008 EQUIVALENCE (SAVTRC , DLOCAL (18)) 03200008 EQUIVALENCE (THL , DLOCAL (19)) 03210008 EQUIVALENCE (NOSAMP , DLOCAL (20)) 03220008 EQUIVALENCE (NS , DLOCAL (21)) 03230008 EQUIVALENCE (TNS , DLOCAL (22)) 03240008 EQUIVALENCE (FLAG3D , DLOCAL (23)) 03250008 EQUIVALENCE (NSEQ1 , DLOCAL (24)) 03260008 EQUIVALENCE (NSEQ2 , DLOCAL (25)) 03270008 EQUIVALENCE (LLINE , DLOCAL (26)) 03280008 EQUIVALENCE (J , DLOCAL (27)) 03290008 EQUIVALENCE (LEN , DLOCAL (28)) 03300008 C EQUIVALENCE (UNUSED , DLOCAL (29)) 03310008 C EQUIVALENCE (UNUSED , DLOCAL (30)) 03320008 C EQUIVALENCE (UNUSED , DLOCAL (31)) 03330008 C EQUIVALENCE (UNUSED , DLOCAL (32)) 03340008 C 03350008 EQUIVALENCE (PSHOT(1) , DLOCAL (33)) 03360008 EQUIVALENCE (COUNT(1) , DLOCAL (57)) 03370008 EQUIVALENCE (TAB3(1) , DLOCAL (81)) 03380008 EQUIVALENCE (NINT , DLOCAL (93)) 03390008 EQUIVALENCE (NREAL , DLOCAL (94)) 03400008 C 03410008 C LOGICAL CONSTANTS & VARIABLES 03420008 LOGICAL FLAG3D 03430008 LOGICAL NORM 03440008 LOGICAL TWO 03450008 LOGICAL READ 03460008 C 03470008 C CHARACTER CONSTANTS & VARIABLES 03480008 CHARACTER*8 DDNAME 03490008 CHARACTER*8 TICMNE 03500008 CHARACTER*8 THSSP 03510008 CHARACTER*8 THCDPN 03520008 CHARACTER*8 THORTN 03530008 CHARACTER*8 THCDPT 03540008 CHARACTER*8 THLNNO 03550008 CHARACTER*8 THSEQL 03560008 CHARACTER*8 THFLV 03570008 CHARACTER*8 THFN 03580008 CHARACTER*12 DEPTH 03590008 CHARACTER*12 SHOT 03600008 CHARACTER*12 FILE 03610008 CHARACTER*8 NAME 03620008 C 03630008 REAL RVALU1 03640008 REAL RVALU2 03650008 REAL XMAX 03660008 C 03670008 C INTEGER VARIABLES AND CONSTANTS--LOCAL 03680008 C 03690008 DATA TICMNE / 'THTICD '/ 03700008 DATA THSSP / 'THSSP '/ 03710008 DATA THCDPN / 'THCDPN '/ 03720008 DATA THORTN / 'THORTN '/ 03730008 DATA THCDPT / 'THCDPT '/ 03740008 DATA THFN / 'THFN '/ 03750008 DATA THLNNO / 'THLNNO '/ 03760008 DATA THSEQL / 'THUSCD '/ 03770008 DATA THFLV / 'THFLV '/ 03780008 DATA NAME / 'TH '/ 03790008 DATA DEPTH / 'DEPTH POINTS'/ 03800008 DATA SHOT / 'SHOT POINTS'/ 03810008 DATA FILE / 'FILE NUMBERS'/ 03820008 DATA S / 'S ' / 03830008 DATA D / 'D ' / 03840008 DATA F / 'F ' / 03850008 DATA LLOCAL / 100 / 03860008 DATA NAM / 'NAM '/ 03870008 DATA PRM / 'PRM '/ 03880008 DATA PTS / 'PTS '/ 03890008 C 03900008 C 03910008 CC COMMON /SYSTEM/ SYSTEM 03920008 C 03930008 C 03940008 C 03950008 C CHECK IF FIRST TIME THROUGH 03960008 C 03970008 IF (KPFCF .EQ. 0) GO TO 260 03980008 C 03990008 C MAKE SURE THE INPUT IS A TRACE 04000008 C 04010008 CALL USRTHV (INH, 'THTICD ', TICD) 04020008 IF (TICD .NE. 1 .AND. TICD .NE. 2) GO TO 555 04030008 C 04040008 C FIRST TIME THROUGH 04050008 C 04060008 KPFCF = 0 04070008 DAP = 1 04080008 C 04090008 C PRINT HEADING 04100008 C 04110008 CALL USPHD (2, ACLNAM, KPNA, KPRNO, 0, 0, KPPRNT) 04120008 C 04130008 C APPROXIMATE THE AMOUNT OF MEMORY REQUIRED FOR 04140008 C THIS PROCESS. 04150008 C 04160008 NOWDS = LLOCAL 04170008 C 04180008 C GET LOCAL MEMORY REQUIREMENTS 04190008 C 04200008 CALL UPRESM (NOWDS) 04210008 IF (NOWDS .EQ. 0) GO TO 710 04220008 IC = KPIUSM 04230008 C 04240008 C EXTRACT SOME HEADER CONSTANTS 04250008 C 04260008 CALL USRTHV (INH, 'THNS ', NOSAMP) 04270008 CALL USRTHV (INH, 'THSI ', SAMPR) 04280008 CALL USRTHV (INH, 'THLNNO ', LINE ) 04290008 CALL USRTHV (INH, 'THL ', THL) 04300008 SAMPR = SAMPR / 1000 04310008 LBUF= THL + NOSAMP 04320008 FLAG3D = .FALSE. 04330008 IF (LINE.NE.0) FLAG3D = .TRUE. 04340008 C 04350008 C GET THE PROCESSING RANGES 04360008 C 04370008 RANG = IC 04380008 RANGE= RANG 04390008 DAP = 1 04400008 C 04410008 10 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 20 )04420008 IF (DCTYP .NE. PTS) GO TO 10 04430008 IF (IC+NOPAR.GT.KPIUSM+KPNUSM) GO TO 710 04440008 CALL ARMVE(DATTR,COM(IC),NOPAR) 04450008 IC = IC + NOPAR 04460008 RANGE = IC - 1 04470008 C 04480008 GO TO 10 04490008 C 04500008 20 RANGM1 = RANGE - 1 04510008 IF(RANGM1.LT.RANG) GO TO 740 04520008 C 04530008 C GET THE TRACE HEADER NAMES (IF ANY) 04540008 C 04550008 DAP = 1 04560008 NINT = 0 04570008 NREAL = 0 04580008 22 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 28 )04590008 IF (DCTYP .NE. NAM) GO TO 22 04600008 CALL ARMVE (DATTR(1), TAB3, NOPAR) 04610008 NINT = DATTR(21) 04620008 NREAL = DATTR(22) 04630008 GO TO 22 04640008 C 04650008 28 CONTINUE 04660008 C 04670008 C ALLOCATE SAVE AREA AND BUFFERS 04680008 C 04690008 30 DAP = 1 04700008 40 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, *740) 04710008 IF (DCTYP .NE. PRM) GO TO 40 04720008 C 04730008 IF (PMODE.EQ.D) THEN 04740008 CALL S1MVCH(THCDPN,1,RECMNE,1, 8) 04750008 CALL S1MVCH(THCDPT,1,TRCMNE,1, 8) 04760008 GATH=0 04770008 ENDIF 04780008 IF (PMODE.EQ.S) THEN 04790008 CALL S1MVCH(THSSP ,1,RECMNE,1, 8) 04800008 CALL S1MVCH(THORTN,1,TRCMNE,1, 8) 04810008 GATH=1 04820008 ENDIF 04830008 IF (PMODE.EQ.F) THEN 04840008 CALL S1MVCH(THFN ,1,RECMNE,1, 8) 04850008 CALL S1MVCH(THORTN,1,TRCMNE,1, 8) 04860008 GATH=2 04870008 ENDIF 04880008 C 04890008 C BCDPN = DATTR(1) 04900008 C ECDPN = DATTR(2) 04910008 NORMT = DATTR(3) 04920008 NORM = .FALSE. 04930008 IF(NORMT.EQ.1) NORM = .TRUE. 04940008 NSEQ1 = DATTR(4) 04950008 NSEQ2 = DATTR(5) 04960008 SLINE = DATTR(6) 04970008 ELINE = DATTR(7) 04980008 C 04990008 C NTR = ECDPN - BCDPN + 1 05000008 NLINE = ELINE - SLINE + 1 05010008 IF (.NOT.FLAG3D) NLINE = 1 05020008 C 05030008 SAVHDR = IC 05040008 IC = IC + THL 05050008 SAVTRC = IC 05060008 IC = IC + NOSAMP 05070008 NOWDS = IC - KPIUSM 05080008 C 05090008 CALL UPRESM(NOWDS) 05100008 IF (NOWDS .EQ. 0) GO TO 710 05110008 IF (LBUF .GT. KPNUSM) GO TO 710 05120008 WBUF = KPIUSM 05130008 C 05140008 C INITIALIZE WORKFILE 05150008 C 05160008 LEN = 4 * LBUF 05170008 CALL ARSET (COM(WBUF), LBUF, 0) 05180008 J = LCTPSP*LCANSP 05190008 CALL UPAWRK (J,LEN,'A',KPWRKS,KPWRKD,DDNAME,ERR,ERIN) 05200008 IF (ERR .NE. 1) GO TO 760 05210008 CALL FOISSD (KPWRKS, LEN, 10) 05220008 C DAWRK = 1 05230008 C DO 20 05240008 C * I = 1, J 05250008 C CALL FOWSSD (KPWRKS, DAWRK, COM(WBUF)) 05260008 C 05270008 C 20 CONTINUE 05280008 C CALL FOCSD (KPWRKS) 05290008 C CALL FOIDSD (KPWRKD, LEN) 05300008 C 05310008 CSAVE = 0 05320008 NS = 0 05330008 TNS = 0 05340008 TWO = .FALSE. 05350008 READ = .TRUE. 05360008 LLINE = -999999 05370008 C 05380008 GO TO 270 05390008 C 05400008 C PROCESSES THE DATA 05410008 C ================== 05420008 C 05430008 C RETRIEVE LOCAL VARIABLES 05440008 C 05450008 260 CALL ARMVE (COM(KPIRSM), DLOCAL, LLOCAL) 05460008 C 05470008 C CHECK FOR NO MORE INPUT 05480008 IF (KPMITF .EQ. 0) GO TO 600 05490008 C 05500008 270 CALL USRTHV (INH, TICMNE , TICD) 05510008 IF (TICD .NE. 1 .AND. TICD .NE. 2) GO TO 550 05520008 C 05530008 IF(.NOT. FLAG3D) GO TO 290 05540008 CALL USRTHV (INH, THLNNO , LINE ) 05550008 IF(SLINE.GT.LINE.OR. LINE.GT.ELINE) GO TO 550 05560008 C 05570008 290 CALL USRTHV (INH, RECMNE , CDP ) 05580008 C 05590008 C IS THIS REC WITHIN ANY RANGE? 05600008 C 05610008 DO 300 I=RANG,RANGM1,2 05620008 BCDPN = COM(I+0) 05630008 ECDPN = COM(I+1) 05640008 IF(BCDPN.LE.CDP .AND. CDP.LE.ECDPN) GO TO 320 05650008 IF(ECDPN.LE.CDP .AND. CDP.LE.BCDPN) GO TO 320 05660008 300 CONTINUE 05670008 GO TO 550 05680008 C 05690008 320 CALL USRTHV (INH, THSEQL , NSEQ ) 05700008 IF (NSEQ .EQ. NSEQ1) GO TO 340 05710008 IF (NSEQ .EQ. NSEQ2) GO TO 360 05720008 GO TO 550 05730008 C 05740008 C SAVE THE TRACES ON A WORK FILE 05750008 C 05760008 340 DAWRK = CSAVE + 1 05770008 IF (DAWRK.GT.J) GO TO 780 05780008 CALL FOWSSD (KPWRKS, DAWRK, INH) 05790008 CSAVE = CSAVE + 1 05800008 GO TO 550 05810008 C 05820008 C BEGIN COMPARE OF DATASET TWO 05830008 C 05840008 360 IF (.NOT. TWO) GO TO 370 05850008 IF ( READ ) GO TO 380 05860008 GO TO 390 05870008 C 05880008 C READ TRACES BACK AND CHECK FOR MATCH 05890008 C 05900008 370 CALL FOCSD (KPWRKS) 05910008 CALL FOIDSD (KPWRKD, LEN) 05920008 C 05930008 TWO = .TRUE. 05940008 DAWRK = 1 05950008 C 05960008 380 CONTINUE 05970008 C 05980008 IF (DAWRK.GT.CSAVE) GO TO 600 05990008 CALL FORDSD (KPWRKD, DAWRK, COM(SAVHDR)) 06000008 C 06010008 CALL USRTHV (COM(SAVHDR), RECMNE, CDP1) 06020008 CALL USRTHV (COM(SAVHDR), TRCMNE, TRC1) 06030008 C 06040008 390 CALL USRTHV (INH , RECMNE, CDP2) 06050008 CALL USRTHV (INH , TRCMNE, TRC2) 06060008 C 06070008 IF (BCDPN.LE.ECDPN) THEN 06080008 IF ( CDP1 .LT. CDP2 ) GO TO 380 06090008 IF ( CDP1 .GT. CDP2 ) GO TO 500 06100008 ENDIF 06110008 IF (BCDPN.GT.ECDPN) THEN 06120008 IF ( CDP1 .GT. CDP2 ) GO TO 380 06130008 IF ( CDP1 .LT. CDP2 ) GO TO 500 06140008 ENDIF 06150008 IF ( TRC1 .LT. TRC2 ) GO TO 380 06160008 IF ( TRC1 .GT. TRC2 ) GO TO 500 06170008 C 06180008 C WE HAVE FOUND A MATCH 06190008 READ = .TRUE. 06200008 CALL ARMVE ( COM(SAVHDR), OH, THL) 06210008 C 06220008 IF (NINT .GT. 0) THEN 06230008 DO 392 I = 1, NINT 06240008 CALL S1MVCH (TAB3(I), 1, NAME, 3, 4) 06250008 CALL USRTHV (INH , NAME, IVALU1) 06260008 CALL USRTHV (COM(SAVHDR), NAME, IVALU2) 06270008 IVALU1 = IVALU1 - IVALU2 06280008 CALL USSTHV (OH , NAME, IVALU1) 06290008 392 CONTINUE 06300008 ENDIF 06310008 IF (NREAL .GT. 0) THEN 06320008 DO 393 I = 1, NREAL 06330008 CALL S1MVCH (TAB3(NINT+I), 1, NAME, 3, 4) 06340008 CALL USRTHV (INH , NAME, RVALU1) 06350008 CALL USRTHV (COM(SAVHDR), NAME, RVALU2) 06360008 RVALU1 = RVALU1 - RVALU2 06370008 CALL USSTHV (OH , NAME, RVALU1) 06380008 393 CONTINUE 06390008 ENDIF 06400008 C 06410008 IF (NORMT.EQ.0) THEN 06420008 CALL ARSBF ( INTR, COM(SAVTRC), OTR, NOSAMP ) 06430008 ENDIF 06440008 C 06450008 IF (NORMT.EQ.1) THEN 06460008 CALL ARSBF ( INTR, COM(SAVTRC), OTR, NOSAMP ) 06470008 DO 395 06480008 * I = 1, NOSAMP 06490008 XCOM(SAVTRC+I-1)=0.01*ABS(XCOM(SAVTRC+I-1)) 06500008 395 CONTINUE 06510008 CALL ARDVF ( OTR, COM(SAVTRC), OTR, NOSAMP ) 06520008 ENDIF 06530008 C 06540008 IF (NORMT.EQ.2) THEN 06550008 CALL ARDVF ( INTR, COM(SAVTRC), OTR, NOSAMP ) 06560008 ENDIF 06570008 C 06580008 400 MUTE = NOSAMP 06590008 DO 405 I=1,NOSAMP 06600008 IF(OTR(I).EQ.0.0) GO TO 405 06610008 MUTE=I 06620008 GO TO 410 06630008 405 CONTINUE 06640008 C 06650008 410 CALL USSTHV (OH, THFLV, MUTE) 06660008 CALL USSTHV (OH, TICMNE, 1) 06670008 IF(MUTE.EQ.NOSAMP) CALL USSTHV (OH, TICMNE, 2) 06680008 C 06690008 C KEEP TRACK OF LINES, RECORDS PROCESSED 06700008 C 06710008 IF (.NOT.FLAG3D) GO TO 420 06720008 IF (LINE.EQ.LLINE) GO TO 430 06730008 IF (NS.GT.0) THEN 06740008 WRITE (KPPRNT, 9020 ) TNS,(PSHOT(I),I=1,NS) 06750008 WRITE (KPPRNT, 9030 ) (COUNT(I),I=1,NS) 06760008 ENDIF 06770008 NS = 0 06780008 TNS= 0 06790008 WRITE (KPPRNT, 9010 ) LINE 06800008 LLINE = LINE 06810008 C 06820008 420 IF (TNS.EQ.0 .AND. GATH.EQ.0) WRITE (KPPRNT, 9040) DEPTH 06830008 IF (TNS.EQ.0 .AND. GATH.EQ.1) WRITE (KPPRNT, 9040) SHOT 06840008 IF (TNS.EQ.0 .AND. GATH.EQ.2) WRITE (KPPRNT, 9040) FILE 06850008 IF (NS .EQ. 0) GO TO 440 06860008 430 IF (PSHOT(NS) .EQ. CDP1)GO TO 460 06870008 IF (NS .LT. 24) GO TO 450 06880008 WRITE (KPPRNT, 9020 ) TNS,(PSHOT(I),I=1,NS) 06890008 WRITE (KPPRNT, 9030 ) (COUNT(I),I=1,NS) 06900008 NS = 0 06910008 C 06920008 440 CALL ARSET ( COUNT, 24, 0 ) 06930008 450 NS = NS + 1 06940008 TNS = TNS + 1 06950008 PSHOT(NS) = CDP1 06960008 460 COUNT(NS) = COUNT(NS) + 1 06970008 C 06980008 480 KPRTF = 1 06990008 KPMOTF = 0 07000008 CALL ARMVE ( DLOCAL, COM(KPIRSM), LLOCAL ) 07010008 RETURN 07020008 C 07030008 500 READ = .FALSE. 07040008 C 07050008 550 CALL ARMVE ( DLOCAL, COM(KPIRSM), LLOCAL ) 07060008 555 KPRTF = 0 07070008 KPMOTF = 0 07080008 RETURN 07090008 C 07100008 C END PROCESSING - PRINT REMAINING BUFFERS 07110008 C 07120008 600 CONTINUE 07130010 KPMOTF = 0 07140010 KPRTF = 0 07150010 IF( KPLOTF .EQ. 0) GO TO 700 07160010 IF( NS .NE. 0) WRITE (KPPRNT, 9020) TNS, (PSHOT(I), I = 1, NS) 07170008 IF( NS .NE. 0) WRITE (KPPRNT, 9030) (COUNT(I), I = 1, NS) 07180008 IF(TNS .EQ. 0) WRITE (KPPRNT, 9070) 07190008 KPLOTF = 0 07200008 C 07210008 C CLOSE FILES 07220008 C 07230008 CALL FOCDD (KPWRKD) 07240008 CALL UGUWRK (KPWRKS,KPWRKD,ERR,ERIN) 07250008 IF (ERR .NE. 1) GO TO 770 07260008 700 RETURN 07270008 C 07280008 C MESSAGES, CODES, ERRORS, ETC. 07290008 C 07300008 710 WRITE (KPPRNT, 9050 ) 07310008 C 07320008 720 KPRTF = -1 07330008 GO TO 700 07340008 C 07350008 740 WRITE (KPPRNT, 9060 ) KPNA, KPRNO 07360008 GO TO 720 07370008 C 07380008 760 WRITE (KPPRNT, 9090 ) ERR, DDNAME 07390008 GO TO 720 07400008 C 07410008 770 WRITE (KPPRNT, 9100 ) ERR, ERIN 07420008 GO TO 700 07430008 C 07440008 780 WRITE (KPPRNT, 9110 ) J 07450008 GO TO 720 07460008 C 07470008 C 07480008 9000 FORMAT (8(2X,E14.8)) 07490008 C 07500008 9010 FORMAT ('0 3-D LINE NUMBER ',I5,/) 07510008 C 07520008 9020 FORMAT (1X,I4,4(2X,6I5)) 07530008 C 07540008 9030 FORMAT (5X, 4(2X,6I5)) 07550008 C 07560008 9040 FORMAT ('0COUNT ',A12,' PROCESSED') 07570008 C 07580008 9050 FORMAT (5X,'*** NOT ENOUGH MEMORY AVAILABLE') 07590008 C 07600008 9060 FORMAT (5X,'*** NO PARAMETER RECORDS FOR ',A4,I1) 07610008 C 07620008 9070 FORMAT (5X,'*** NO TRACE MATCHES WERE FOUND ***',/, 07630008 * 5X,'*** CHECK YOUR SEQUENCE NUMBERS AND PROCESSING ',/, 07640008 * 5X,' RANGES FOR CORRECTNESS ***') 07650008 C 07660008 9090 FORMAT ('0*** WORK FILE ALLOCATION ERROR: ***',/, 07670008 1 '0*** ERR =',I2,' DDNAME = ',A8) 07680008 C 07690008 9100 FORMAT ('0*** WORK FILE CLOSING FAILED: ***',/, 07700008 1 '0*** ERR =',I2,' ERIN = ',I2) 07710008 C 07720008 9110 FORMAT (' *** SPACE ON DISK RAN OUT AFTER ',I6,' TRACES',/, 07730008 1 ' *** CHECK EQUIVALENT SHOTS ON LINE CARD ' ) 07740008 END 07750008