CTITLESDMSAM -- MASTER AND SLAVE DATASET MERGES 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. J. CHEN 00020001 CA DESIGNER J. J. CHEN 00030001 CA LANGUAGE FORTRAN 00040001 CA SYSTEM IBM 00050001 CA WRITTEN 10-89 00060001 C REVISED 02-10-90 JJC - CORRECTED THE FLAG PROBLEM AND 00070001 C ADDED MORE DEBUG STATEMENTS. 00080001 C 00090001 CA 00100001 CA 00110001 CA CALL SDMSAM (INH, INTR, OH, OTR) 00120001 CA INPUT INH = INPUT HEADER MIXED I2, I4, R4, R8 00130001 CA INPUT INTR = INPUT TRACE R4 00140001 CA OUTPUT OH = OUTPUT HEADER MIXED I2, I4, R4, R8 00150001 CA OUTPUT OTR = OUTPUT TRACE R4 00160001 CA 00170001 CA 00180001 CA THIS PROGRAM MERGES TRACES FROM TWO DATASETS (MASTER AND SLAVE) 00190001 CA BASED ON FILE NUMBER AND PASSES THE MERGED TRACES AS OUTPUT. 00200001 CA THE UNMERGED TRACES AND THE UNSEISMIC TRACES ARE NOT BEEN PASSED 00210001 CA OUT. 00220001 CA 00230001 CA 00240001 C 00250001 C EJECT IF ABSTRACT NEEDS A PAGE EJECT PUT 'A' IN COLUMN 2. 00260001 C IF THE DESCRIPTION WILL NOT FIT ON THE PRECEEDING PAGE, 00270001 C CONTINUE IT ON THIS PAGE. REMEMBER TO PUT 'A' IN COLUMN 2. 00280001 C 00290001 C EJECT A NEW PAGE MAY BE DESIRABLE HERE. PUT EJECT IN COL. 7. 00300001 C 00310001 C LOCAL OR INTERNAL ARRAYS. 00320001 C 00330001 C DATTR ( 96) = DATA ATTRIBUTES STORAGE I4 00340001 C DENTRY ( 104) = PARAMETER STORAGE I4 00350001 C DLOCAL ( 90) = LOCAL VARIABLES STORAGE I4 00360001 C INH ( 1) = INPUT TRACE HEADER I4 00370001 C INTR ( 1) = INPUT TRACE AREA R4 00380001 C OH ( 1) = OUTPUT TRACE HEADER I4 00390001 C OTR ( 1) = OUTPUT TRACE AREA R4 00400001 C 00410001 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00420001 C 00430001 C BFM = STARTING FILE NUMBER ON MASTER DATASET I4 00440001 C BFS = STARTING FILE NUMBER ON SLAVE DATASET I4 00450001 C CSAVE = SEQUENTIAL COUNTER TO CURRENT TRACE IN SAVE AREA I4 00460001 C DAP = COUNTER FOR PARAMETER READ AND WRITE SUBROUTINE I4 00470001 C DAWRK = WORK DISK ADDRESS I4 00480001 C DSKN1 = STARTING INDEX OF WORK FILE FOR EACH SLAVE FILE I4 00490001 C DSKN2 = ENDING INDEX OF WORK FILE FOR EACH SLAVE FILE I4 00500001 C DUMMY = DUMMY BUFFER TO FILL THE ZERO TRACE I4 00510001 C DUMY = THE OPTION TO FILL DUMMY TRACE FOR NO MATCH I4 00520001 C EFM = ENDING FILE NUMBER ON MASTER DATASET I4 00530001 C EFS = ENDING FILE NUMBER ON SLAVE DATASET I4 00540001 C FIRST = FLAG TO THE FIRST TIME TO RETRIEVE MASTER DATASET I4 00550001 C FOUND = FLAG TO FIND THE MATCH (0=NO, 1=YES) I4 00560001 C IC = UNRESERVED SCRATCH TRACE-BLOCK INDEX I4 00570001 C INCM = FILE INCREMENT ON MASTER DATASET I4 00580001 C INCS = FILE INCREMENT ON SLAVE DATASET I4 00590001 C ISKIP = FLAG TO THE NEW RANGE (0=NO, 1=YES) I4 00600001 C ISAVE = FLAG TO SAVE THE FIRST TRACE OF EACH MASTER FILE I4 00610001 C (0= NO, 1=YES) 00620001 C LEN = LENGTH OF BUFFERS IN BYTES FOR WORK FILE RECORDS I4 00630001 C LLOCAL = LENGTH OF DLOCAL ( = 90) I4 00640001 C NOPAR = NUMBER OF PARAMETERS I4 00650001 C NOSAMP = NUMBER OF SAMPLE POINTS I4 00660001 C NOWDS = APPROXIMATE NUMBER OF WORDS OF MEMORY NEEDED FOR I4 00670001 C THIS PROCESS 00680001 C NSEQ1 = SEQUENCE NUMBER OF THE SLAVE DATASET I4 00690001 C NSEQ2 = SEQUENCE NUMBER OF THE MASTER DATASET I4 00700001 C PASS = CURRENT ITERATION OF MIGRATION (1 <= PASS <= NPASS) I4 00710001 C PMODE = PROCESSING MODE I4 00720001 C PTS = CHARACTER STRING "PTS " I4 00730001 C SAMPR = SAMPLE RATE I4 00740001 C SHOT = ENERGY SOURCE POINT NUMBER I4 00750001 C SPLOCN = SHOT POINT LOCATION I4 00760001 C SPT = STARTING POINT I4 00770001 C STM = STARTING TRACE NUMBER OF EACH FILE ON MASTER DATASET I4 00780001 C STS = STARTING TRACE NUMBER OF EACH FILE ON SLAVE DATASET I4 00790001 C SPASS = FLAG TO PASS THE SLAVE TRACES (0=NO, 1=YES) I4 00800001 C MPASS = FLAG TO PASS THE MASTER TRACES I4 00810001 C TABLE = INDEX TO HOLD THE FILE NUMBER AND DISK ADDRESS FOR I4 00820001 C THE SLAVE DATASET 00830001 C TRCNM = TRACE COUNT OF EACH FILE IN MASTER DATASET I4 00840001 C TRCNS = TRACE COUNT OF EACH FILE IN SLAVE DATASET I4 00850001 C TFILE = TOTAL FILE NUMBERS ARE SAVED ON WORK FILE I4 00860001 C THL = TRACE HEADER LENGTH I4 00870001 C TICD = ID FLAG FROM TRACE HEADER I4 00880001 C 00890001 C EJECT 00900001 C ===================================================================== 00910001 C FORMAT OF INPUT PARAMETER RECORDS 00920001 C 00930001 C ****** SECOND RECORD ****** PARAMETERS ****** 00940001 C 00950001 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00960001 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 00970001 C | MSAM | INVOC. | PRM | NOT | NOT | # OF |N|P| NOT | NOT | 00980001 C |_______|_NUMBER_|_______|__USED_|__USED_|_PARMS_|_|M|_USED|__USED_| 00990001 C 01000001 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 WORD 16 01010001 C |_______|________|_______|_______|_______|_______|______|_______| 01020001 C | BFM | EFM | INCM | STM | BFS | EFS | INCS | STS | 01030001 C |_______|________|_______|_______|_______|_______|______|_______| 01040001 C 01050001 C WORD 17 WORD 18 WORD 19 WORD 20 WORD 21 WORD 22 WORD23 WROD 24 01060001 C |_______|_______|________|_______|_______|_______|______|_______| 01070001 C | DUMY | NEQ1 | NEQ2 | NOT | BFM | EFM | INCM | STM | 01080001 C |_______|_______|________|_USED__|_______|_______|______|_______| 01090001 C . . . 01100001 C . . . (CONTINUE FOR DIFFERENT RANGES) 01110001 C . . . (EACH RANGE HAS TEN PARAMETERS) 01120001 C 01130001 C WORD 89 WORD 90 WORD 91 WORD 92 WORD 93 WORD 94 WORD 95WORD 96 01140001 C |_______|_______|________|_______|_______|_______|______|_______| 01150001 C | DUMY | NEQ1 | NEQ2 | NOT | BFM | EFM | INCM | STM | 01160001 C |_______|_______|________|__USED_|_______|_______|______|_______| 01170001 C 01180001 C WORD 97 WORD 98 WORD 99 WORD 100 WORD 101WORD 102WORD103WORD 104 01190001 C |_______|_______|________|_______|_______|_______|______|_______| 01200001 C | BFS | EFS | INCS | STS | DUMY | NEQ1 | NEQ2 | NOT | 01210001 C |_______|_______|________|_______|_______|_______|______|_USED__| 01220001 C 01230001 C 01240001 C ==================================================================== 01250001 C EJECT 01260001 C ==================================================================== 01270001 C LAYOUT OF BLANK COMMON 01280001 C 01290001 C ________________________________ 01300001 C | 90 WORDS FOR | 01310001 C | LOCAL VARIABLES | 01320001 C | ("DLOCAL") | 01330001 C | | 01340001 C |______________________________| 01350001 C SBUF --> | SPACE FOR TRACE BUFFER | 01360001 C | (THL+NOSAMP) | 01370001 C | | 01380001 C |______________________________| 01390001 C TABLE --> | FILE & DISK ADDRESS CROSS | 01400001 C | REFERENCE | 01410001 C | (LCANSP*3) | 01420001 C |______________________________| 01430001 C 01440001 C ===================================================================== 01450001 C EJECT 01460001 C 01470001 SUBROUTINE SDMSAM (INH, INTR, OH, OTR) 01480001 C 01490001 IMPLICIT INTEGER (A-Z) 01500001 EXTERNAL FOSCDK 01510001 C 01520001 C 01530001 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 12/27/89 01540001 COMMON /P/ STARTP ( 2) , M00000( 10) 01550001 COMMON /P/ LCTPSP , M00048( 5) 01560001 COMMON /P/ LCANSP , M00072( 12) 01570001 COMMON /P/ ACLNAM ( 5) , M00124( 68) 01580001 COMMON /P/ KPNA 01590001 COMMON /P/ KPRNO , M00420( 5) 01600001 COMMON /P/ KPWRKS 01610001 COMMON /P/ KPWRKD , M00448( 4) 01620001 COMMON /P/ KPFCF 01630001 COMMON /P/ KPIRSM 01640001 COMMON /P/ KPNRSM 01650001 COMMON /P/ KPIUSM 01660001 COMMON /P/ KPNUSM , M00484 01670001 COMMON /P/ KPRTF , M00492 01680001 COMMON /P/ KPMOTF , M00500( 4) 01690001 COMMON /P/ KPLOTF 01700001 COMMON /P/ KPMITF 01710001 COMMON /P/ KPPRNT , M00528( 2) 01720001 COMMON /P/ KPBUGF 01730001 COMMON /P/ KPWARN , M00544( 225) 01740001 COMMON /P/ ENDP 01750001 C 01760001 COMMON COM (1) 01770001 C 01780001 C=================================================================== 01790001 C 01800001 C REAL ARRAYS IN PARAMETER LIST. 01810001 C 01820001 REAL INTR (1) 01830001 REAL OTR (1) 01840001 REAL INH (1) 01850001 REAL OH (1) 01860001 C 01870001 C INTEGER ARRAYS--LOCAL 01880001 C 01890001 INTEGER DATTR ( 96) 01900001 INTEGER DENTRY (104) 01910001 C 01920001 INTEGER DLOCAL ( 90) 01930001 C 01940001 C 01950001 C DENTRY IS AN ARRAY TO HOLD A PARAMETER RECORD. THE DEFINITIONS 01960001 C OF THE FIRST EIGHT WORDS ARE FIXED. THE REMAINING WORDS ARE 01970001 C FOR VARIABLE PARAMETERS AND ARE USUALLY ADDRESSED USING "DATTR". 01980001 C THE MAXIMUM LENGTH OF DENTRY IS 104 BECAUSE OF THE I/O ROUTINES. 01990001 C 02000001 EQUIVALENCE (DCTYP , DENTRY (03)) 02010001 EQUIVALENCE (SPT , DENTRY (04)) 02020001 EQUIVALENCE (EPT , DENTRY (05)) 02030001 EQUIVALENCE (NOPAR , DENTRY (06)) 02040001 EQUIVALENCE (PMODE , DENTRY (07)) 02050001 EQUIVALENCE (SPLOCN , DENTRY (08)) 02060001 EQUIVALENCE (DATTR(1) , DENTRY (09)) 02070001 C 02080001 C DLOCAL IS AN ARRAY USED TO HOLD PARAMETER VALUES THAT ARE UNIQUE 02090001 C TO EACH OCCURRENCE OF THE PROCESS. 02100001 C 02110001 EQUIVALENCE (BFM , DLOCAL (01)) 02120001 EQUIVALENCE (EFM , DLOCAL (02)) 02130001 EQUIVALENCE (INCM , DLOCAL (03)) 02140001 EQUIVALENCE (STM , DLOCAL (04)) 02150001 EQUIVALENCE (BFS , DLOCAL (05)) 02160001 EQUIVALENCE (EFS , DLOCAL (06)) 02170001 EQUIVALENCE (INCS , DLOCAL (07)) 02180001 EQUIVALENCE (STS , DLOCAL (08)) 02190001 EQUIVALENCE (DUMY , DLOCAL (09)) 02200001 EQUIVALENCE (NSEQ1 , DLOCAL (10)) 02210001 EQUIVALENCE (NSEQ2 , DLOCAL (11)) 02220001 EQUIVALENCE (SBUF , DLOCAL (12)) 02230001 C EQUIVALENCE ( , DLOCAL (13)) 02240001 EQUIVALENCE (TABLE , DLOCAL (14)) 02250001 EQUIVALENCE (LFILE , DLOCAL (15)) 02260001 EQUIVALENCE (LRANG , DLOCAL (16)) 02270001 EQUIVALENCE (CSAVE , DLOCAL (17)) 02280001 EQUIVALENCE (INDF , DLOCAL (18)) 02290001 EQUIVALENCE (DSKN1 , DLOCAL (19)) 02300001 EQUIVALENCE (DSKN2 , DLOCAL (20)) 02310001 EQUIVALENCE (FIRST , DLOCAL (21)) 02320001 EQUIVALENCE (FOUND , DLOCAL (22)) 02330001 EQUIVALENCE (SPASS , DLOCAL (23)) 02340001 EQUIVALENCE (TRCNM , DLOCAL (24)) 02350001 EQUIVALENCE (TRCNS , DLOCAL (25)) 02360001 EQUIVALENCE (NT , DLOCAL (26)) 02370001 EQUIVALENCE (PARM , DLOCAL (27)) 02380001 EQUIVALENCE (PARME , DLOCAL (28)) 02390001 EQUIVALENCE (TTL , DLOCAL (29)) 02400001 EQUIVALENCE (NTR , DLOCAL (30)) 02410001 EQUIVALENCE (MXTRC , DLOCAL (31)) 02420001 EQUIVALENCE (ISKIP , DLOCAL (32)) 02430001 EQUIVALENCE (LEN , DLOCAL (33)) 02440001 EQUIVALENCE (DAWRK , DLOCAL (34)) 02450001 EQUIVALENCE (ISAVE , DLOCAL (35)) 02460001 EQUIVALENCE (FSAVE , DLOCAL (36)) 02470001 EQUIVALENCE (MPASS , DLOCAL (37)) 02480001 C 02490001 CHARACTER*8 DDNAME 02500001 C 02510001 C INTEGER VARIABLES AND CONSTANTS--LOCAL 02520001 C 02530001 DATA LLOCAL / 90 / 02540001 DATA PRM /'PRM '/ 02550001 C 02560001 C 02570001 CC COMMON /SYSTEM/ SYSTEM 02580001 C 02590001 C 02600001 C 02610001 C CHECK IF FIRST TIME THROUGH 02620001 C 02630001 IF (KPFCF .EQ. 0) GO TO 100 02640001 C 02650001 C MAKE SURE THE INPUT IS A TRACE 02660001 C 02670001 CALL USRTHV (INH, 'THTICD ', TICD) 02680001 IF (TICD .NE. 1 .AND. TICD .NE. 2) GO TO 650 02690001 C 02700001 C FIRST TIME THROUGH 02710001 C 02720001 KPFCF = 0 02730001 DAP = 1 02740001 C 02750001 C PRINT HEADING 02760001 C 02770001 CALL USPHD (2, ACLNAM, KPNA, KPRNO, 0, 0, KPPRNT) 02780001 C 02790001 C APPROXIMATE THE AMOUNT OF MEMORY REQUIRED FOR 02800001 C THIS PROCESS. 02810001 C 02820001 NOWDS = LLOCAL 02830001 C 02840001 C GET LOCAL MEMORY REQUIREMENTS 02850001 C 02860001 CALL UPRESM (NOWDS) 02870001 IF (NOWDS .EQ. 0) GO TO 710 02880001 IC = KPIUSM 02890001 C 02900001 C EXTRACT SOME HEADER CONSTANTS 02910001 C 02920001 CALL USRTHV (INH, 'THNS ', NOSAMP) 02930001 CALL USRTHV (INH, 'THSI ', SAMPR) 02940001 CALL USRTHV (INH, 'THL ', THL) 02950001 SAMPR = SAMPR / 1000 02960001 TTL= THL + NOSAMP 02970001 C 02980001 C GET THE PROCESSING PARAMETERS 02990001 C 03000001 PARM = IC 03010001 PARME= PARM 03020001 DAP = 1 03030001 TFILE = 0 03040001 C 03050001 10 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 20 )03060001 IF (DCTYP .NE. PRM) GO TO 10 03070001 IF (IC+NOPAR.GT.KPIUSM+KPNUSM) GO TO 710 03080001 CALL ARMVE(DATTR,COM(IC),NOPAR) 03090001 DO 15 J = 1, NOPAR, 12 03100001 IX = IC + J -1 03110001 TFILE = TFILE + ABS( COM(IX+5)-COM(IX+4)) + 1 03120001 15 CONTINUE 03130001 IC = IC + NOPAR 03140001 NSEQ1 = DATTR(10) 03150001 NSEQ2 = DATTR(11) 03160001 PARME = IC - 1 03170001 C 03180001 GO TO 10 03190001 C 03200001 20 PARM1 = PARME - 1 03210001 IF(PARM1.LT.PARM) GO TO 730 03220001 C 03230001 C ALLOCATE SAVE AREA AND BUFFERS 03240001 C 03250001 SBUF = IC 03260001 IC = IC + TTL 03270001 TABLE = IC 03280001 IC = IC + TFILE*3 03290001 NOWDS = IC - KPIUSM 03300001 C 03310001 CALL UPRESM(NOWDS) 03320001 IF (NOWDS .EQ. 0) GO TO 710 03330001 C 03340001 MXTRC = LCTPSP / 2 03350001 C 03360001 C INITIALIZE WORKFILE 03370001 C 03380001 LEN = 4 * TTL 03390001 NTR = MXTRC*TFILE 03400001 CALL UPAWRK (NTR,LEN,'A',KPWRKS,KPWRKD,DDNAME,ERR,ERIN) 03410001 IF (ERR .NE. 1) GO TO 740 03420001 CALL FOISSD (KPWRKS, LEN, 2) 03430001 C 03440001 C INITIALIZE LOCAL VARIABLES 03450001 C 03460001 CSAVE = 0 03470001 NS = 0 03480001 INDF = 0 03490001 DSKN1 = 1 03500001 FIRST = 1 03510001 FOUND = 0 03520001 SPASS = 0 03530001 MPASS = 0 03540001 ISKIP = 0 03550001 ISAVE = 0 03560001 LFILE = -999999 03570001 LRANG = -999999 03580001 C 03590001 GO TO 110 03600001 C 03610001 C PROCESSES THE DATA 03620001 C ================== 03630001 C 03640001 C RETRIEVE LOCAL VARIABLES 03650001 C 03660001 100 CALL ARMVE (COM(KPIRSM), DLOCAL, LLOCAL) 03670001 C 03680001 C CHECK FOR NO MORE INPUT 03690001 IF (SPASS .EQ. 1) GO TO 250 03700001 IF (KPMITF .EQ. 0) GO TO 250 03710001 IF (ISAVE .NE. 1) GO TO 110 03720001 C 03730001 105 SPASS = 0 03740001 ISAVE = 0 03750001 CALL ARMVE (COM(SBUF), INH, TTL) 03760001 MPASS = 1 03770001 C 03780001 110 CALL ARMVE (INH, OH, TTL) 03790001 CALL USRTHV (INH, 'THTICD ', TICD) 03800001 IF (TICD .NE. 1 .AND. TICD .NE. 2) GO TO 650 03810001 CALL USRTHV (INH, 'THUSCD ', NSEQ) 03820001 CALL USRTHV (INH, 'THFN ', FILE) 03830001 IF (NSEQ .EQ. NSEQ1) GO TO 120 03840001 IF (NSEQ .EQ. NSEQ2) GO TO 160 03850001 GO TO 650 03860001 C 03870001 C GET SOME VARIABLE (FOR SLAVE) 03880001 C 03890001 120 IF (FILE .EQ. LFILE) GO TO 150 03900001 DO 130 I = PARM, PARME, 12 03910001 IF (COM(I+4).LE.FILE .AND. FILE.LE.COM(I+5)) GO TO 140 03920001 IF (COM(I+4).GE.FILE .AND. FILE.GE.COM(I+5)) GO TO 140 03930001 130 CONTINUE 03940001 C 03950001 GO TO 650 03960001 C 03970001 C NEW FILE FOR SLAVE DATASET 03980001 C SAVE FILE AND DISK ADDRESS REFERENCE 03990001 C 04000001 140 IF (LFILE .EQ. -999999) THEN 04010001 LFILE = FILE 04020001 GO TO 150 04030001 ENDIF 04040001 DSKN2 = CSAVE 04050001 INDF = INDF + 1 04060001 IX = (INDF-1) * 3 + 1 04070001 COM(TABLE+IX-1) = LFILE 04080001 COM(TABLE+IX ) = DSKN1 04090001 COM(TABLE+IX+1) = DSKN2 04100001 C 04110001 IF (KPBUGF.NE.0) WRITE(KPPRNT,9100) LFILE, DSKN1, DSKN2, TRCNS 04120001 DSKN1 = CSAVE + 1 04130001 LFILE = FILE 04140001 TRCNS = 0 04150001 C 04160001 C SAVE THE TRACE (SLAVE DATASET) ON WORK FILE 04170001 C 04180001 150 IF (TRCNS .GE. MXTRC) GO TO 650 04190001 DAWRK = CSAVE + 1 04200001 IF (DAWRK.GT.NTR) GO TO 750 04210001 CALL FOWSSD (KPWRKS, DAWRK, INH) 04220001 CSAVE = CSAVE + 1 04230001 TRCNS = TRCNS + 1 04240001 GO TO 650 04250001 C 04260001 C SAVE THE LAST FILE AND DISK ADDRESS REFERENCE 04270001 C 04280001 160 IF (FIRST .NE. 1) GO TO 170 04290001 DSKN2 = CSAVE 04300001 INDF = INDF + 1 04310001 IX = (INDF-1) * 3 + 1 04320001 COM(TABLE+IX-1) = LFILE 04330001 COM(TABLE+IX ) = DSKN1 04340001 COM(TABLE+IX+1) = DSKN2 04350001 FIRST = 0 04360001 LFILE = -999999 04370001 C 04380001 CALL FOCSD (KPWRKS) 04390001 CALL FOIDSD (KPWRKD, LEN) 04400001 C 04410001 C CHECK THE RANGE FOR MASTER DATASET 04420001 C 04430001 170 CONTINUE 04440001 IF (FILE .EQ. LFILE) GO TO 220 04450001 DO 180 I = PARM, PARME, 12 04460001 IF (COM(I+0).LE.FILE .AND. FILE.LE.COM(I+1)) GO TO 190 04470001 IF (COM(I+0).GE.FILE .AND. FILE.GE.COM(I+1)) GO TO 190 04480001 180 CONTINUE 04490001 C 04500001 GO TO 650 04510001 C 04520001 C NEW RANGE FOR MASTER DATASET 04530001 C 04540001 190 CONTINUE 04550001 IF (KPBUGF .NE. 0) 04560001 * WRITE(KPPRNT,9220) FILE,LFILE,SPASS,MPASS,ISAVE,ISKIP,FOUND 04570001 C 04580001 FSAVE = LFILE 04590001 LFILE = FILE 04600001 IF (ISKIP .EQ. 1) THEN 04610001 STM = COM(I+3) 04620001 STS = COM(I+7) 04630001 DUMY = COM(I+8) 04640001 LRANG = I 04650001 ISKIP = 0 04660001 SPASS = 0 04670001 GO TO 220 04680001 ENDIF 04690001 IF (I .EQ. LRANG) GO TO 200 04700001 BFM = COM(I+0) 04710001 EFM = COM(I+1) 04720001 INCM = COM(I+2) 04730001 STM = COM(I+3) 04740001 BFS = COM(I+4) 04750001 EFS = COM(I+5) 04760001 INCS = COM(I+6) 04770001 STS = COM(I+7) 04780001 DUMY = COM(I+8) 04790001 C 04800001 IF (KPBUGF.NE.0) WRITE(KPPRNT,9200) FILE, BFM, BFS 04810001 C 04820001 C MASTER TRACE FIRST TIME COME THROUGH, PASS MASTER 04830001 C 04840001 IF (LRANG .NE. -999999) THEN 04850001 LRANG = I 04860001 GO TO 205 04870001 ELSE 04880001 LRANG = I 04890001 GO TO 210 04900001 ENDIF 04910001 C 04920001 C NEW FILE FOR MASTER DATASET 04930001 C 04940001 200 CONTINUE 04950001 IF (MPASS .EQ. 1) GO TO 210 04960001 BFM = BFM + INCM 04970001 BFS = BFS + INCS 04980001 205 CALL ARMVE (INH, COM(SBUF), TTL) 04990001 SPASS = 1 05000001 ISAVE = 1 05010001 NT = 0 05020001 DAWRK = DSKN1 05030001 C 05040001 IF (KPBUGF.NE.0) WRITE(KPPRNT,9200) FILE, BFM, BFS 05050001 GO TO 250 05060001 C 05070001 210 TRCNM = 0 05080001 MPASS = 0 05090001 C 05100001 C BEGIN COMPARE OF DATASETS 05110001 C 05120001 220 CONTINUE 05130001 IF (FILE .NE. BFM) THEN 05140001 WRITE (KPPRNT, 9040) FILE, BFM 05150001 LFILE = BFM 05160001 BFS = BFS + ABS(FILE - BFM) * INCS 05170001 BFM = FILE 05180001 ISKIP = 1 05190001 GO TO 170 05200001 ENDIF 05210001 TRCNM = TRCNM + 1 05220001 IF (TRCNM .NE. 1) GO TO 240 05230001 C 05240001 C SEARCH SLAVE DATASET FOR BFS FILE NUMBER 05250001 C 05260001 DO 230 J = 1, INDF 05270001 IX = (J-1) * 3 + 1 05280001 IF (COM(TABLE+IX-1) .NE. BFS) GO TO 230 05290001 DSKN1 = COM(TABLE+IX) 05300001 DSKN2 = COM(TABLE+IX+1) 05310001 FOUND = 1 05320001 GO TO 240 05330001 230 CONTINUE 05340001 C 05350001 C MATCH, PASS THE TRACES OF MASTER DATASET 05360001 C 05370001 240 IF (TRCNM .GT. MXTRC) GO TO 650 05380001 CALL ARMVE (INH, OH, TTL) 05390001 CALL USRTHV (OH, 'THFN ', FN) 05400001 CALL USRTHV (OH, 'THORTN ', ORTN) 05410001 ORTN = ORTN + STM - 1 05420001 CALL USSTHV (OH, 'THORTN ', ORTN) 05430001 IF (KPBUGF.NE.0) WRITE(KPPRNT, 9240) FN, ORTN 05440001 GO TO 660 05450001 C 05460001 C GET THE SLAVE DATASET TRACES FROM WORKFILE 05470001 C 05480001 250 CONTINUE 05490001 IF (FOUND .NE. 1) GO TO 300 05500001 IF (KPMITF.EQ.0 .AND. DAWRK.GT.DSKN2) GO TO 640 05510001 IF (DAWRK .GT. DSKN2) GO TO 680 05520001 CALL FORDSD (KPWRKD, DAWRK, OH) 05530001 CALL USRTHV (OH, 'THORTN ', ORTN) 05540001 ORTN = ORTN + STS - 1 05550001 CALL USSTHV (OH, 'THORTN ', ORTN) 05560001 IF (KPMITF .NE. 0) THEN 05570001 CALL USSTHV (OH, 'THFN ', FSAVE) 05580001 IF (KPBUGF .NE. 0) WRITE(KPPRNT, 9230) FSAVE, ORTN 05590001 ELSE 05600001 CALL USSTHV (OH, 'THFN ', BFM) 05610001 IF (KPBUGF .NE. 0) WRITE(KPPRNT, 9230) BFM, ORTN 05620001 ENDIF 05630001 GO TO 670 05640001 C 05650001 C GET THE DUMMY TRACE FOR SLAVE DATASET 05660001 C 05670001 300 IF (DUMY .NE. 1) GO TO 680 05680001 NT = NT + 1 05690001 IF (KPMITF.EQ.0 .AND. NT.GT.LCTPSP) GO TO 640 05700001 IF (NT .GT. MXTRC) GO TO 680 05710001 CALL ARSET(OH, TTL, 0.) 05720001 ORTN = NT + STS - 1 05730001 CALL USSTHV(OH, 'THORTN ', ORTN) 05740001 CALL USSTHV(OH, 'THTICD ', 2 ) 05750001 IF (KPMITF .NE. 0) THEN 05760001 CALL USSTHV (OH, 'THFN ', FSAVE) 05770001 IF (KPBUGF .NE. 0) WRITE(KPPRNT, 9230) FSAVE, ORTN 05780001 ELSE 05790001 CALL USSTHV (OH, 'THFN ', BFM) 05800001 IF (KPBUGF .NE. 0) WRITE(KPPRNT, 9230) BFM, ORTN 05810001 ENDIF 05820001 GO TO 670 05830001 C 05840001 C CLOSE FILES 05850001 C 05860001 640 WRITE(KPPRNT, 9210) BFM 05870001 CALL FOCDD (KPWRKD) 05880001 CALL UGUWRK (KPWRKS, KPWRKD, ERR, ERIN) 05890001 IF (ERR .NE. 1) GO TO 770 05900001 C 05910001 KPRTF = 0 05920001 KPMOTF = 0 05930001 KPLOTF = 0 05940001 GO TO 700 05950001 C 05960001 650 KPRTF = 0 05970001 KPMOTF = 0 05980001 GO TO 690 05990001 C 06000001 660 KPRTF = 1 06010001 KPMOTF = 0 06020001 GO TO 690 06030001 C 06040001 670 KPRTF = 1 06050001 KPMOTF = 1 06060001 GO TO 690 06070001 C 06080001 680 KPRTF = 0 06090001 KPMOTF = 1 06100001 SPASS = 0 06110001 FOUND = 1 06120001 NT = 0 06130001 LFILE = FSAVE 06140001 IF (KPMITF .NE. 0) THEN 06150001 WRITE(KPPRNT, 9210) FSAVE 06160001 ELSE 06170001 WRITE(KPPRNT, 9210) BFM 06180001 ENDIF 06190001 C 06200001 GO TO 690 06210001 C 06220001 C SAVE LOCAL VARIABLE 06230001 C 06240001 690 CALL ARMVE (DLOCAL, COM(KPIRSM), LLOCAL) 06250001 700 RETURN 06260001 C 06270001 C MESSAGES, CODES, ERRORS 06280001 C 06290001 710 WRITE(KPPRNT, 9000) 06300001 C 06310001 720 KPRTF = -1 06320001 GO TO 700 06330001 C 06340001 730 WRITE(KPPRNT, 9010) KPNA, KPRNO 06350001 GO TO 720 06360001 C 06370001 740 WRITE(KPPRNT, 9020) ERR, DDNAME 06380001 GO TO 720 06390001 C 06400001 750 WRITE(KPPRNT, 9030) NTR 06410001 GO TO 720 06420001 C 06430001 770 WRITE(KPPRNT, 9050) ERR, ERIN 06440001 GO TO 720 06450001 C 06460001 9000 FORMAT (5X, ' *** NOT ENOUGH MEMORY AVAILABLE ***') 06470001 C 06480001 9010 FORMAT (5X, ' *** NO PARAMETER RECORDS FOR ', A4, I1) 06490001 C 06500001 9020 FORMAT (5X, ' *** WORK FILE ALLOCATION ERROR: ***',/, 06510001 * ' *** ERR = ', I2, ' DDNAME = ', A8) 06520001 C 06530001 9030 FORMAT (5X, ' *** SPACE ON DISK RAN OUT AFTER ', I6, 'TRACES',/, 06540001 * ' *** CHECK EQUIVALENT SHOTS ON LINE CARD ') 06550001 C 06560001 9040 FORMAT (/,5X, ' *** WARNING! FILE NUMBER NOT MATCH ***', /, 06570001 * ' *** CURRENT FILE NUMBER ', I5, ' EXPECTED ', I5,/, 06580001 * ' *** RESET TO CURRENT FILE NUMBER, PROCESS CONTINUE',06590001 * / ) 06600001 C 06610001 9050 FORMAT ('0*** WORK FILE CLOSING FAILED: ***',/, 06620001 1 '0*** ERR =',I2,' ERIN = ',I2) 06630001 C 06640001 9100 FORMAT (5X, ' LFILE, DSKN1, DSKN2, TRCNS ', 5X, I5, 2(I10,3X),I5) 06650001 C 06660001 9200 FORMAT (5X, ' FILE, BFM, BFS ', 5X, 3(I5,5X)) 06670001 C 06680001 9210 FORMAT (5X, ' FILE NUMBER ', I5, ' HAS BEEN MERGED ') 06690001 C 06700001 9220 FORMAT (5X, ' FILE, LFILE, SPASS, MPASS, ISAVE, ISKIP, FOUND ', 06710001 * 7(I5, 5X)) 06720001 C 06730001 9230 FORMAT (5X, ' PASS SLAVE TRACES. FILE NUMBER ', I5, ' TRACE ', I5)06740001 C 06750001 9240 FORMAT (5X, ' PASS MASTER TRACE. FILE NUMBER ', I5, ' TRACE ', I5)06760001 C 06770001 END 06780001