CTITLESDMERJ -- SIMULATE COLOR PLOT INPUT FROM SYNTHETIC LOG TRACES 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHORS K. GRAY 00020000 CA DESIGNER K. GRAY 00030000 CA LANGUAGE VS FORTRAN 00040000 CA SYSTEM IBM ONLY 00050001 CA WRITTEN 12-12-84 00060000 C REVISED 11-08-85 RKG ADDED VARIABLES TO DLOCAL. 00070000 C REVISED 10-02-89 ESN. CLOSE/UNALLOCATE FILE, CORRECT SUMMARY 00080000 C PRINT. 00090000 CA 00100000 CA 00110000 CA CALL SDMERJ (INH, INTR, OH, OTR) 00120000 CA INPUT INH = INPUT HEADER MIXED I2, I4, R4, R8 00130000 CA INPUT INTR = INPUT TRACE R4 00140000 CA OUTPUT OH = OUTPUT HEADER MIXED I2, I4, R4, R8 00150000 CA OUTPUT OTR = OUTPUT TRACE R4 00160000 CA 00170000 CA 00180000 CA SIMULATE COLOR PLOT INPUT FOR QULR COLOR PLOT PROGRAM FOR SINGLE 00190000 CA TRACE INPUT OF SYNTHETIC LOGS (OR OTHER TYPE TRACES). 00200000 CAEND 00210000 C 00220000 C LOCAL OR INTERNAL ARRAYS. 00230000 C 00240000 C DATTR ( 96) = DATA ATTRIBUTES, DATTR(1) EQUIV. DENTRY(9) I4 00250000 C DENTRY ( 104) = ARRAY TO HOLD PARAMETER RECORD. I4 00260000 C DLOCAL ( 31) = LOCAL VARIABLES SAVED TO MAKE PROGRAM REUSABLEI4 00270000 C ELOCAL ( 1) EQUIVALENT TO DLOCAL FOR DOUBLE-WORD ALIGNMENT. R8 00280000 C PSHOT ( 24) = LIST OF PROCESSED DEPTH POINTS FOR PRINTING. I4 00290000 C 00300000 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00310000 C 00320000 C CBSPT = BEGINNING DEPTH POINT FOR CURRENT DATA. I4 00330000 C CDP = COMMON DEPTH POINT ENSEMBLE NUMBER. I4 00340000 C CESPT = ENDING DEPTH POINT FOR CURRENT DATA. I4 00350000 C DAP = COUNTER FOR PARAMETER READ AND WRITE SUBROUTINE. I4 00360000 C IC = UNRESERVED SCRATCH TRACE-BLOCK INDEX. I4 00370000 C LLOCAL = LENGTH OF DLOCAL, WORDS. I4 00380000 C NOPAR = NUMBER OF PARAMETERS. I4 00390000 C NOWDS = NUMBER OF WORDS OF BLANK COMMON NEEDED. I4 00400000 C NSHOT = NUMBER OF SHOTPOINTS OR DEPTH POINTS IN PSHOT ARRAY. I4 00410000 C RANGS = POINTER TO PROCESSING RANGE. I4 00420000 C RANGE = POINTER TO END OF PROCESSING RANGE. I4 00430000 C TICD = TRACE IDENTIFICATION CODE FROM TRACE HEADER. I4 00440000 C TNS = TOTAL NUMBER OF SHOT OR DEPTH POINTS PROCESSED. I4 00450000 C 00460000 C 00470000 C THE PARAMETER RECORD FORMATS CAN BE MERGED FROM 00480000 C THE PREPARATION PROGRAM. 00490000 C 00500000 C***********************************************************************00510000 C DEBUG UNIT(6), TRACE, INIT 00520000 C 00530000 C AT 1 00540000 C TRACE ON 00550000 C AT 1150 00560000 C TRACE OFF 00570000 C 00580000 C END DEBUG 00590000 C***********************************************************************00600000 C 00610000 SUBROUTINE SDMERJ (INH, INTR, OH, OTR) 00620000 C 00630000 IMPLICIT INTEGER (A-Z) 00640000 C 00650000 COMMON COM(1) 00660000 C 00670000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/26/84 00680000 COMMON /P/ STARTP ( 2) , M00000( 11) 00690000 COMMON /P/ LCRL , M00052 00700000 COMMON /P/ LCPI , M00060( 15) 00710000 COMMON /P/ ACLNAM ( 5) , M00124( 68) 00720000 COMMON /P/ KPNA 00730000 COMMON /P/ KPRNO , M00420( 5) 00740000 COMMON /P/ KPWRKS 00750000 COMMON /P/ KPWRKD , M00448( 4) 00760000 COMMON /P/ KPFCF 00770000 COMMON /P/ KPIRSM 00780000 COMMON /P/ KPNRSM 00790000 COMMON /P/ KPIUSM 00800000 COMMON /P/ KPNUSM , M00484 00810000 COMMON /P/ KPRTF , M00492( 6) 00820000 COMMON /P/ KPLOTF 00830000 COMMON /P/ KPMITF 00840000 COMMON /P/ KPPRNT , M00528( 2) 00850000 COMMON /P/ KPBUGF , M00540( 192) 00860000 COMMON /P/ PTTHL , M01312( 33) 00870000 COMMON /P/ ENDP 00880000 C 00890000 C ARRAYS IN PARAMETER LIST. 00900000 C 00910000 INTEGER INH (1) 00920000 REAL INTR (1) 00930000 INTEGER OH (1) 00940000 REAL OTR (1) 00950000 C 00960000 C ARRAYS--LOCAL 00970000 C 00980000 INTEGER DATTR ( 96) 00990000 INTEGER DENTRY (104) 01000000 INTEGER DLOCAL ( 40) 01010000 REAL *8 ELOCAL ( 1) 01020000 INTEGER PSHOT ( 24) 01030000 C 01040000 INTEGER TICDOP ( 6) / 20, 21, 15, 16, 17, 18 / 01050000 INTEGER LLOOP / 6 / 01060000 C 01070000 CHARACTER*8 DDNAM1 01080000 C 01090000 C INTEGER DENTRY (104) HOLDS ONE PARAMETER RECORD. 01100000 C INTEGER DATTR ( 96) IS USUALLY USED TO ADDRESS THE LAST 96 WORDS 01110000 C OF DENTRY. DATTR(1) EQUIVALENT TO DENTRY(9).01120000 C THE DEFINITIONS OF THE FIRST EIGHT WORDS OF DENTRY ARE FIXED-- 01130000 C THEY ARE THE SAME FOR ALL PARAMETER RECORDS IN ALL PROGRAMS. 01140000 C THE DEFINITIONS OF THE LAST 96 WORDS DEPEND ON THE PROGRAM AND THE01150000 C PARAMETER RECORD. 01160000 C THE LENGTH OF DENTRY IS LIMITED TO 104 BY THE I/O ROUTINES. 01170000 C 01180000 EQUIVALENCE (DCTYP, DENTRY (03)) 01190000 EQUIVALENCE (DENTR4, DENTRY (04)) 01200000 EQUIVALENCE (DENTR5, DENTRY (05)) 01210000 EQUIVALENCE (NOPAR, DENTRY (06)) 01220000 EQUIVALENCE (DENTR7, DENTRY (07)) 01230000 EQUIVALENCE (DENTR8, DENTRY (08)) 01240000 EQUIVALENCE (DATTR(1), DENTRY (09)) 01250000 C 01260000 C INTEGER DLOCAL (40) HOLDS VARIABLES THAT ARE UNIQUE TO ONE 01270000 C OCCURRENCE OF THE PROCESS. THIS ARRAY IS SAVED IN BLANK COMMON 01280000 C BEFORE EACH EXIT FROM THE PROGRAM AND RECOVERED FROM BLANK 01290000 C COMMON AFTER EACH ENTRANCE TO THE PROGRAM. 01300000 C 01310000 EQUIVALENCE (ELOCAL(1),DLOCAL ( 1)) 01320000 C 01330000 EQUIVALENCE (BLKSIZ, DLOCAL ( 1)) 01340000 EQUIVALENCE (CBSPT, DLOCAL ( 2)) 01350000 EQUIVALENCE (CESPT, DLOCAL ( 3)) 01360000 EQUIVALENCE (DA, DLOCAL ( 4)) 01370000 EQUIVALENCE (DASEQ, DLOCAL ( 5)) 01380000 EQUIVALENCE (NSHOT, DLOCAL ( 6)) 01390000 EQUIVALENCE (TNS, DLOCAL ( 7)) 01400000 C 01410000 EQUIVALENCE (PSHOT(1), DLOCAL ( 8)) 01420000 EQUIVALENCE (CNCAT , DLOCAL (32)) 01430000 EQUIVALENCE (ILOOP , DLOCAL (33)) 01440000 EQUIVALENCE (FIRSTO , DLOCAL (34)) 01450000 EQUIVALENCE (RANGS , DLOCAL (35)) 01460000 EQUIVALENCE (RANGE , DLOCAL (36)) 01470000 EQUIVALENCE (IMPOPT , DLOCAL (37)) 01480000 CKG EQUIVALENCE ( , DLOCAL (38)) 01490000 CKG EQUIVALENCE ( , DLOCAL (39)) 01500000 EQUIVALENCE (ICOUNT , DLOCAL (40)) 01510000 C 01520000 C REAL VARIABLES AND CONSTANTS--LOCAL 01530000 C 01540000 C 01550000 C INTEGER VARIABLES AND CONSTANTS--LOCAL 01560000 C 01570000 INTEGER RANGE 01580000 INTEGER RANGS 01590000 INTEGER LLOCAL / 40 / 01600000 C 01610000 CHARACTER*4 DCTYP / ' ' / 01620000 CHARACTER*4 PTS / 'PTS ' / 01630000 C 01640000 C CHECK IF FIRST TIME THROUGH 01650000 C 01660000 1 IF (KPFCF .EQ. 0) GO TO 100 01670000 CALL USRTHV (INH, 'THTICD ', TICD) 01680000 IF (TICD .GT. 2) GO TO 1150 01690000 C 01700000 C 01710000 C PRINT HEADING 01720000 C ============= 01730000 C 01740000 CALL USPHD (2, ACLNAM,KPNA, KPRNO, 0, 0, KPPRNT) 01750000 C 01760000 CKG**************************************************** 01770000 C CALL USPHD (2, ACLNAM,KPNA, KPRNO, 0, 0, 6 ) 01780000 C L1 = LOC( INH) 01790000 C L2 = LOC(INTR) 01800000 C L3 = LOC( OH) 01810000 C L4 = LOC( OTR) 01820000 CKG**************************************************** 01830000 C 01840000 C INITIALIZATION SECTION 01850000 C ====================== 01860000 C 01870000 KPFCF = 0 01880000 CBSPT = -1 01890000 CESPT = -1 01900000 CDP = -1 01910000 DA = 0 01920000 DASEQ = 1 01930000 TNS = 0 01940000 NSHOT = 0 01950000 ILOOP = 0 01960000 FIRSTO = 0 01970000 C 01980000 C 01990000 C GET COMMON STORAGE REQUIRED FOR DLOCAL 02000000 C ====================================== 02010000 C 02020000 NOWDS = LLOCAL 02030000 CALL UPRESM (NOWDS) 02040000 IF (NOWDS .EQ. 0) GO TO 1000 02050000 C 02060000 C READ 'PTS' PARAMETER RECORDS, BUILD 02070000 C COMMON TABLE OF PROCESSING RANGES AND PARAMETERS. 02080000 C 02090000 RANGS = KPIUSM 02100000 IC = KPIUSM 02110000 DAP = 1 02120000 C 02130000 C******************************************* 02140000 C WRITE(6,99999) KPNA,KPRNO,DAP,DENTRY 02150000 C9999 FORMAT(1X,' KPNA ...',3Z9, /, (1X,10Z9) ) 02160000 C******************************************* 02170000 C 02180000 10 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, *20) 02190000 C******************************************* 02200000 C WRITE(6,99999) KPNA,KPRNO,DAP,DENTRY 02210000 C******************************************* 02220000 C 02230000 IF (DCTYP .NE. PTS) GO TO 10 02240000 IF (IC + NOPAR .GT. KPIUSM + KPNUSM) GO TO 1000 02250000 CALL ARMVE (DATTR, COM(IC), NOPAR) 02260000 IC = IC + NOPAR 02270000 GO TO 10 02280000 C 02290000 20 RANGE = IC - 1 02300000 NOWDS = IC - KPIUSM 02310000 CALL UPRESM (NOWDS) 02320000 IF (NOWDS .EQ. 0) GO TO 1000 02330000 C 02340000 C OPEN WORK FILE (TO BE CREATED SEQUENTIALLY). 02350000 C 02360000 NOSAMP = LCRL/LCPI 02370000 BLKSIZ = ( PTTHL + LCRL/LCPI ) * 4 02380000 IMPOPT = DENTR7 02390000 MAXDA = DENTR8 02400000 CKG**************************************************** 02410000 C WRITE(6,29995) BLKSIZ, MAXDA,KPWRKS,KPWRKD 02420000 C9995 FORMAT(1X,' BLKSIZ MAXDA KPWRKS KPWRKD ',4Z9) 02430000 CKG**************************************************** 02440000 C 02450000 CALL UPAWRK (MAXDA, BLKSIZ, 'A', KPWRKS, KPWRKD, DDNAM1, ERR,ERIN)02460000 CKG**************************************************** 02470000 C WRITE(6,29995) BLKSIZ, MAXDA,KPWRKS,KPWRKD 02480000 CKG**************************************************** 02490000 IF (ERR.NE.1) GO TO 990 02500000 C 02510000 CALL FOISSD (KPWRKS, BLKSIZ) 02520000 C 02530000 WRITE (KPPRNT, 9195) 02540000 GO TO 110 02550000 C 02560000 C PROCESS THE TRACE 02570000 C ================= 02580000 C 02590000 C RETRIEVE LOCAL VARIABLES 02600000 C 02610000 100 CALL ARMVE (COM(KPIRSM), DLOCAL, LLOCAL) 02620000 C IF NO MORE INPUT, START RELEASING COLLECTED RESULTS. 02630000 IF (KPMITF .EQ. 0) GO TO 600 02640000 C 02650000 110 IF (KPBUGF .GT. 1) WRITE (KPPRNT, 9110) DLOCAL 02660000 C 02670000 C RETRIEVE INFORMATION FROM THE TRACE HEADER. 02680000 C 02690000 CALL USRTHV (INH, 'THTICD ', TICD) 02700000 IF (TICD .NE. 1 .AND. TICD .NE. 2) GO TO 1110 02710000 CALL USRTHV (INH, 'THCDPN ', CDP ) 02720000 CALL USRTHV (INH, 'THCDPT ', CDPT) 02730000 CALL USRTHV (INH, 'THNS ', NS ) 02740000 C 02750000 CKG**************************************************** 02760000 C WRITE(6,99995) CDP,CDPT,CBSPT,CESPT 02770000 C9995 FORMAT(1X,' CDP CDPT CBSPT, CESPT ',4Z9) 02780000 CKG**************************************************** 02790000 C 02800000 C ARE PARAMETERS FOR THIS CDP ALREADY IN DLOCAL? 02810000 C 02820000 IF (CBSPT .LE. CDP .AND. CDP .LE. CESPT) GO TO 200 02830000 IF (CBSPT .GE. CDP .AND. CDP .GE. CESPT) GO TO 200 02840000 C 02850000 C PARAMETERS NOT IN DLOCAL. SEARCH THE 02860000 C RANGE-PARAMETER TABLE FOR THE INPUT CDP NUMBER. 02870000 C 02880000 DO 140 02890000 * J = RANGS, RANGE, 3 02900000 C 02910000 C**************************************************** 02920000 C WRITE(6,99993) RANGS,RANGE,J,COM(J),COM(J+1),CDP 02930000 C9993 FORMAT(1X,' RANGS,RANGE,J,COM(J),COM(J+1),CDP ',6Z9) 02940000 C**************************************************** 02950000 C 02960000 IF (COM(J) .LE. CDP .AND. CDP .LE. COM(J+1)) GO TO 150 02970000 IF (COM(J) .GE. CDP .AND. CDP .GE. COM(J+1)) GO TO 150 02980000 140 CONTINUE 02990000 C 03000000 C DEPTH POINT NOT IN ANY RANGE. DO NOT PROCESS. 03010000 C 03020000 GO TO 1110 03030000 C 03040000 150 CBSPT = COM(J) 03050000 CESPT = COM(J+1) 03060000 CNCAT = COM(J+2) 03070000 C**************************************************** 03080000 C WRITE(6,44993) CBSPT, CESPT, CNCAT 03090000 C4993 FORMAT('0 CBSPT CESPT CNCAT ',6Z9) 03100000 C**************************************************** 03110000 C 03120000 C KEEP LIST OF DEPTH POINTS PROCESSED (FOR PRINTING). 03130000 C 03140000 200 CONTINUE 03150000 C 03160000 C**************************************************** 03170000 C WRITE(6,99992) KPBUGF,NSHOT,PSHOT 03180000 C9992 FORMAT(1X,' KPBUGF,NSHOT PSHOT ',2Z9,24I3) 03190000 C**************************************************** 03200000 C 03210000 IF (KPBUGF .GT. 0) GO TO 211 03220000 IF (NSHOT .EQ. 0) GO TO 210 03230000 IF (PSHOT(NSHOT) .EQ. CDP) GO TO 220 03240000 IF (NSHOT .LT. 24) GO TO 210 03250000 WRITE (KPPRNT, 9200) TNS, PSHOT 03260000 C NORMAL PRINT INCREASED TO ONE LINE PER TRACE. 03270000 C LINE IS PRINTED AFTER ALL PROCESSING COMPLETED FOR TRACE. 03280000 NSHOT = 0 03290000 C 03300000 210 NSHOT = NSHOT + 1 03310000 211 TNS = TNS + 1 03320000 PSHOT(NSHOT) = CDP 03330000 C 03340000 220 CONTINUE 03350000 C 03360000 C WRITE TRACE TO DISK 03370000 C TO WORK FILE. 03380000 C 03390000 C**************************************************** 03400000 C IST = 1 03410000 C LAST = NS 03420000 C IS = 0 03430000 C IP = 0 03440000 C IZ = 0 03450000 C CALL LOCSSZ(INTR,IST,LAST,4,IS,IP,IZ,IERR) 03460000 C WRITE(6,99974) KPWRKS, DASEQ, IS,IP,IZ 03470000 C9974 FORMAT(1X,' KPWRKS DASEQ IS IP IZ ',12Z9) 03480000 C**************************************************** 03490000 C 03500000 CALL FOWSSD (KPWRKS, DASEQ, INH) 03510000 C 03520000 GO TO 1100 03530000 C 03540000 C LAST TRACE FINISHED. RETRIEVE RESULTS FROM 03550000 C WORK FILE AND PASS THEM TO NEXT PROCESS. 03560000 C 03570000 600 CONTINUE 03580000 C 03590000 C=======================================================================03600000 C 03610000 IF (FIRSTO .GT. 0) GO TO 610 03620000 C 03630000 FIRSTO = 1 03640000 DA = 1 03650000 CALL FOCSD (KPWRKS) 03660000 CALL FOIDSD (KPWRKD, BLKSIZ) 03670000 C 03680000 C FOR CONCAT OPTION - READ SAME RANGE TWICE, WRITE IT ALL OUT, THEN 03690000 C ONLY PASS THE FIRST HALF FOR LOOP 1-2, 4-6 03700000 C 03710000 IF (CNCAT.EQ.2) DASEQ = (DASEQ+1) / 2 03720000 C 03730000 C DUMP THE REST OF THE PRINT BUFFER 03740000 C 03750000 WRITE (KPPRNT, 9200) TNS, (PSHOT(IZ),IZ=1,NSHOT) 03760000 C 03770000 C=======================================================================03780000 C 03790000 C COMPUTE THE OPTIONAL IMPEDANCE TRACE 03800000 C 03810000 IF (IMPOPT.EQ.1) THEN 03820000 C 03830000 IC1 = KPIUSM 03840000 IC1T = IC1 + PTTHL 03850000 IC2 = IC1 + BLKSIZ 03860000 IC2T = IC2 + PTTHL 03870000 C 03880000 DA = 1 03890000 CALL FORDSD (KPWRKD, DA, COM(IC1) ) 03900000 C 03910000 C IZZZ = DA 03920000 C WRITE(KPPRNT,609) IZZZ, (COM(IGGG), IGGG=IC1T, IC1T+29) 03930000 CALL FORDSD (KPWRKD, DA, COM(IC2) ) 03940000 C IZZZ = DA 03950000 C WRITE(KPPRNT,609) IZZZ, (COM(IGGG), IGGG=IC2T, IC2T+29) 03960000 C 03970000 CALL ARMPFC (COM(IC2T), COM(IC2T), 1.0E06, NOSAMP) 03980000 C IZZZ = 4 03990000 C WRITE(KPPRNT,609) IZZZ, (COM(IGGG), IGGG=IC2T, IC2T+29) 04000000 CALL ARDVF (COM(IC2T), COM(IC1T), COM(IC1T), NOSAMP) 04010000 C IZZZ = 5 04020000 C WRITE(KPPRNT,609) IZZZ, (COM(IGGG), IGGG=IC1T, IC1T+29) 04030000 CALL ARMVE (COM(IC1T), COM(IC2T), NOSAMP) 04040000 C IZZZ = 6 04050000 C WRITE(KPPRNT,609) IZZZ, (COM(IGGG), IGGG=IC2T, IC2T+29) 04060000 C 04070000 DA = 1 04080000 CALL FOWDSD (KPWRKD, DA, COM(IC1) ) 04090000 CALL FOWDSD (KPWRKD, DA, COM(IC2) ) 04100000 C 04110000 609 FORMAT(1X,I5, (1X,12Z9) ) 04120000 C 04130000 ENDIF 04140000 C 04150000 C=======================================================================04160000 C 04170000 610 CONTINUE 04180000 C 04190000 IF (MOD(DA-1,DASEQ-1) .NE. 0) GO TO 620 04200000 C 04210000 ILOOP = ILOOP + 1 04220000 C 04230000 IF ( ILOOP .GT. LLOOP ) GO TO 1120 04240000 C 04250000 DA = 1 04260000 IF (CNCAT.EQ.2 .AND. ILOOP.EQ.3) DA = DASEQ 04270000 TICDST = TICDOP (ILOOP) 04280000 C 04290000 CKG**************************************************** 04300000 C WRITE(6,44494) DA,DASEQ,ILOOP,LLOOP,CNCAT,TICDST 04310000 C4494 FORMAT('0 DA,DASEQ,ILOOP,LLOOP,CNCAT,TICDST ',6I7) 04320000 CKG**************************************************** 04330000 C 04340000 C=======================================================================04350000 C 04360000 620 CALL FORDSD (KPWRKD, DA, OH) 04370000 C 04380000 CALL USSTHV ( OH, 'THTICD ', TICDST ) 04390000 C 04400000 CKG**************************************************** 04410000 C CALL USRTHV ( OH, 'THCDPN ', CDP) 04420000 C CALL USRTHV ( OH, 'THCDPT ', CDPT) 04430000 C IST = 1 04440000 C LAST = NS 04450000 C IS = 0 04460000 C IP = 0 04470000 C IZ = 0 04480000 C CALL LOCSSZ( OTR,IST,LAST,4,IS,IP,IZ,IERR) 04490000 C WRITE(6,99994) DA,CDP,CDPT,CBSPT,CESPT,IS,IP,IZ 04500000 C9994 FORMAT(1X,' DA CDP CDPT CBSPT, CESPT IS IP IZ ',8Z9) 04510000 CKG**************************************************** 04520000 C 04530000 ICOUNT = ICOUNT + 1 04540000 GO TO 1130 04550000 C 04560000 C=======================================================================04570000 C 04580000 C ERROR MESSAGE AND ERROR RETURN SECTION. 04590000 C 04600000 C NOT ENOUGH BLANK COMMON AVAILABLE. 04610000 1000 WRITE (KPPRNT, 91000) 04620000 KPRTF = -1 04630000 GO TO 1140 04640000 C 04650000 C NORMAL EXIT WHILE PROCESSING TRACES. 04660000 C 04670000 1100 CONTINUE 04680000 C 04690000 KPRTF = 0 04700000 C 04710000 GO TO 1130 04720000 C 04730000 C EXIT FOR TRACE NOT PROCESSED-- 04740000 C NOT IN RANGES OR IDENTIFICATION CODE INVALID. 04750000 C 04760000 1110 KPRTF = 0 04770000 GO TO 1130 04780000 C 04790000 C FINAL EXIT. 04800000 C 04810000 1120 KPRTF = 0 04820000 KPLOTF = 0 04830000 C 04840000 CALL FOCDD (KPWRKD) 04850000 CALL UGUWRK (KPWRKS, KPWRKD, ERR, ERIN) 04860000 IF (ERR .NE. 1) GO TO 990 04870000 C 04880000 GO TO 1140 04890000 C 04900000 C NORMAL EXIT WHILE RELEASING COLLECTED RESULTS. 04910000 C SAVE LOCAL VARIABLES. 04920000 C 04930000 1130 CALL ARMVE (DLOCAL, COM(KPIRSM), LLOCAL) 04940000 C 04950000 1140 CONTINUE 04960000 C 04970000 C***********************************************************************04980000 C WRITE(6,1141) KPNA,KPRNO 04990000 C1141 FORMAT('0 AT 1140 RETURNING FROM SDMERJ' ,A4,I1) 05000000 C***********************************************************************05010000 C 05020000 RETURN 05030000 C 05040000 C ERROR IN DYNAMIC ALLOCATION OF DISK WORK SPACE 05050000 990 WRITE(KPPRNT,9990) ERR, ERIN 05060000 9990 FORMAT('0 *** ERROR IN FILE ALLOCATION -- ERR, ERIN = ',2Z10) 05070000 KPRTF = -1 05080000 RETURN 05090000 C 05100000 C 05110000 1150 KPRTF = 0 05120000 GO TO 1140 05130000 C 05140000 C PRINT DLOCAL. DEBUG LEVEL > 1. 05150000 C 05160000 9110 FORMAT(1X, 20I5) 05170000 C 05180000 C NOT ENOUGH COMMON AVAILABLE 05190000 91000 FORMAT(5X, '*** NOT ENOUGH BLANK COMMON AVAILABLE ***') 05200000 C 05210000 9195 FORMAT('0COUNT DEPTH POINTS PROCESSED') 05220000 C 05230000 9200 FORMAT( 1X,I5,24I5) 05240000 C 05250000 END 05260000