CTITLE JSMLRS - JOBGEN REGION & BLANK COMMMON ALGORITHM FOR MLRS C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA AUTHOR M. COADY AND J. V. S. HARVEY CA LANGUAGE VS FORTRAN (77) CA SYSTEM IBM ONLY CA REWRITTEN 05 OCT 1988 CA REVISED 12-22-88 JJC. REMOVED LINCOM COMMON AREA, CA ADDED GET LINE CARD PARAMETER CA AND CHANGED MLNS TO MLRS. CA CA CA THIS SUBROUTINE CALCULATES MEMORY REQUIREMENTS FOR MLRS CA ( USING GM3D CARDS AS WELL AS MLRS CARDS) CA CA CA CALL JSMLRS( KPNA, KPRNO, OCCUR, CA PSIZE, CSIZE, UCSIZE, CA ERCODE ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN KPNA CH4 PROCESS NAME CA IN KPRNO I4 PROCESS NUMBER CA IN OCCUR I4 OCCURRANCE NUMBER CA CA OUT PSIZE I4 REGION SIZE OF PROGRAM IN K-BYTES CA OUT CSIZE I4 RESERVED BLANK COMMON SIZE IN WORDS CA OUT UCSIZE I4 UNRESERVED BLANK COMMON SIZE IN WORDS CA CA OUT ERCODE I4 ERROR CODE CA 16 FOR PARAMETER CALC. ERROR CA CA********************************************************************** CA CA JSMLRS IS AN EXTENSION OF SUBROUTINE JSRND. CA C*********************************************************************** C C SUBROUTINES CALLED: FOIP -- (DUMMY CALL) C C FORC -- READ CARD C C*********************************************************************** C SUBROUTINE JSMLRS( KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, * ERCODE ) IMPLICIT INTEGER (A-Z) C EXTERNAL FOIP C CHARACTER*4 KPNA CHARACTER*4 GM3D /'GM3D'/ C CHARACTER*4 PLCODE CHARACTER*4 PLIMIT CHARACTER*4 FBFLAG CHARACTER*8 FBNLAB CHARACTER*80 CARD C ------------------------------------------- C C INTEGER CONSTANTS -- LOCAL C CCC INTEGER FCF / 1 / INTEGER IPR / 6 / CCC INTEGER THL / 190 / C PARAMETER ( MNRVI = 452 ) PARAMETER ( BIGNUM = 9999999 ) C PARAMETER ( LLOCAL = 84 ) C ------------------------------------------- C REAL LCGRPI C ------------------------------------------- C C LOCAL REAL VARIABLES C REAL CDFI REAL CDFPRV REAL RVADV REAL RVADV$ REAL RVINC REAL RVINT REAL SPADV REAL SPADV$ C REAL ABS REAL SIGN C C*********************************************************************** C*** **** C*** PROGRAM SIZE **** C*** **** C*********************************************************************** C C SET PROGRAM SIZE (KBYTE) C CCC SPMLRS = 47 CCC SAROLDF = 1 < 48> CCC SARGEOM = 25 < 73> CCC SARFBNF = 7 < 80> CCC SARFBNA = 2 < 82> CCC SARFBNI = 2 < 84> CCC SARFBNM = 14 < 98> CCC SARFBNO = 7 <105> CCC SARHCHA = 3 <108> CCC SARDSVA = 2 <110> C CCC SDMLRS = 29 <139> CCC SARINIT = 1 <140> CCC SARFBNR = 2 <142> CCC SARRMAP = 15 <157> CCC SARHCHK = 3 <160> CCC SARMVPK = 1 <161> CCC SARZAPP = 5 <166> CCC SARRERR = 3 <169> CCC SARBULL = 3 <172> CCC SARCANC = 1 <173> CCC SARPHAN = 5 <178> C CCC SARSAVE = 4 <182> CCC UPNCIF = 8 <190> C CCC SARINVT = 28 <218> CCC SARGRMR = 59 <277> CCC SARFILL = 10 <287> C CCC SACMLRS = 23 <310> CCC SACNEWP = 9 <319> CCC SACGRID = 2 <321> CCC SACPICK = 9 <330> CCC SACRTQC = 11 <341> CCC SACRMOD = 14 <355> CCC SACENDP = 2 <357> C CCC SARAPPL = 11 <368> CCC ---------------------- CCC TOTAL = 368 C PSIZE = 375 C 01730000 C GET LINE CARD PARAMETERS 01740000 C 01750000 DA = 1 01760000 CALL FORC ('LINE', 0, DA, CARD, * 5300 )01770000 C 01780000 LCTPSP = S1CVBN (CARD, 36, 5) 01790000 LCMXFD = S1CVBN (CARD, 61, 5) 01800000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 01810000 CALL S1MVCH ('LS', 1, PMODE, 1, 2) 01820000 IF (S1CPCH (CARD, 6, ' ', 1, 1) .NE. 0) 01830000 * CALL S1MVCH (CARD, 6, PMODE, 1, 1) 01840000 IF (S1CPCH (CARD, 7, ' ', 1, 1) .NE. 0) 01850000 * CALL S1MVCH (CARD, 7, PMODE, 2, 1) 01860000 C 01870000 LCBGSP = S1CVBN (CARD, 11, 5) 01880000 LCENSP = S1CVBN (CARD, 16, 5) 01890000 LCNSP = S1CVBN (CARD, 31, 5) 01900000 LCRLEN = S1CVBN (CARD, 41, 5) 01910000 LCSI = S1CVBN (CARD, 46, 5) 01920000 LCPI = S1CVBN (CARD, 51, 5) 01930000 C 01940000 IF (LCPI .EQ. 0) LCPI = LCSI 01950000 C 01970000 CALL USCHFT (CARD, 56, 5, LCGRPI) 01990000 02000000 NOSAMP = LCRLEN / LCPI 02010000 LCANSP = S1CVBN (CARD, 66, 5) 02020000 LCMXLN = S1CVBN (CARD, 71, 5) 02030000 IF (LCMXLN .EQ. 0) LCMXLN = 1 02040000 C C*********************************************************************** C*** **** C*** DECODE GM3D PARAMETER CARDS **** C*** **** C*********************************************************************** C C READ IN CARD 1 C NCARD = 1 CALL FORC( GM3D, 0, NCARD, CARD, *5000 ) IF( CARD(8:10) .NE. ' ' ) GOTO 5000 C---------------------------------------------------------------------- C C RECEIVER STATION INTERVAL C IF( CARD(11:15) .EQ. ' ' ) THEN RVINT = 1.0 ELSE RVINT = 0.01*S1CVBN( CARD, 11, 5 ) ENDIF C ------------------------------------------- C C CDP INTERVAL C IF( CARD(16:20) .EQ. ' ' ) THEN CDFI = 50.0 ELSE CALL USCHFT( CARD, 16, 5, CDFI ) IF( CDFI .EQ. 0.0 ) CDFI = 50.0 ENDIF C CDFPRV = 100.0*RVINT/CDFI C====================================================================== C C READ IN 'CFS' OR 'COS' CARDS C RCMIN = BIGNUM RCMAX = 0 C STFIL$ = 0 SPADV$ = 0 RVADV$ = 0 INKNT$ = 0 C NCARD = 1 150 CALL FORC( GM3D, 0, NCARD, CARD, *195 ) C IF( CARD(8:10) .NE. 'CFS' .AND. * CARD(8:10) .NE. 'COS' ) GOTO 150 C---------------------------------------------------------------------- C C STARTING INPUT FILE NO. C IF( CARD(21:25) .EQ. ' ' ) THEN STFILE = STFIL$ ELSE STFILE = S1CVBN( CARD, 21, 5 ) ENDIF C ------------------------------------------- C C ENDING INPUT FILE NO. C IF( CARD(26:30) .EQ. ' ' ) THEN ENFILE = STFILE ELSE ENFILE = S1CVBN( CARD, 26, 5 ) ENDIF C ------------------------------------------- C C SHOTPOINT ADVANCE C IF( CARD(31:35) .EQ. ' ' ) THEN SPADV = SPADV$ ELSE SPADV = 0.01*S1CVBN( CARD, 31, 5 ) ENDIF C ------------------------------------------- C C RECEIVER ADVANCE C IF( CARD(36:40) .EQ. ' ' ) THEN RVADV = RVADV$ ELSE RVADV = 0.01*S1CVBN( CARD, 36, 5 ) ENDIF C ------------------------------------------- C C RECEIVER STATION PREVIOUS TO STARTING SHOT C IF( CARD(46:50) .NE. ' ' ) THEN RCF1 = S1CVBN( CARD, 46, 5 ) C ELSE IF( ABS(SPADV) .GT. ABS(RVADV) ) THEN RCF1 = RCL2 + ( SPADV + SIGN(0.5,SPADV) ) ELSE RCF1 = RCL2 + ( RVADV + SIGN(0.5,RVADV) ) ENDIF C ------------------------------------------- C C RECEIVER ADVANCE DELAY C IF( CARD(76:80) .EQ. ' ' ) THEN INKNTR = INKNT$ ELSE INKNTR = S1CVBN( CARD, 76, 5 ) ENDIF IF( INKNTR .EQ. 0 ) INKNTR = 1 C ------------------------------------------- C C UPDATE LAST RECEIVER C RVINC = RVADV/RVINT IF( RVINC .EQ. 0.0 ) RVINC = 1.0 C RCL1 = RCF1 + RVINC*( ENFILE - STFILE )/INKNTR C ------------------------------------------- C C UPDATE MIN. RECEIVER C IF( RCF1 .LT. RCMIN ) RCMIN = RCF1 IF( RCL1 .LT. RCMIN ) RCMIN = RCL1 C ------------------------------------------- C C UPDATE MAX. RECEIVER C IF( RCL1 .GT. RCMAX ) RCMAX = RCL1 IF( RCF1 .GT. RCMAX ) RCMAX = RCF1 C ------------------------------------------- C C UPDATE DEFAULTS C RCL2 = RCL1 C STFIL$ = STFILE SPADV$ = SPADV RVADV$ = RVADV INKNT$ = INKNTR GO TO 150 C====================================================================== C C ADD 2 TIMES NO. OF TRACES IN CABLE (START AND END) IN CASE OF C WEIRD SHOOTING GEOMETRY, AND A FUDGE FACTOR OF 452 (MNRVI) C 195 IF( RCMIN .GT. RCMAX ) GOTO 5050 C NGPS = IABS( RCMAX - RCMIN ) + 2*LCTPSP + MNRVI NDPS = NGPS*CDFPRV + 0.5 C C*********************************************************************** C*** **** C*** DECODE MLRS PARAMETER CARDS **** C*** **** C*********************************************************************** C C READ IN CARD 1 C NCARD = 1 CALL FORC( KPNA, KPRNO, NCARD, CARD, *5100 ) IF( CARD(8:10) .NE. ' ' ) GOTO 5100 C---------------------------------------------------------------------- C C PLOTTER SELECTION FLAG C PLCODE = 'XXXX' C IF( CARD(76:80) .EQ. ' ' ) PLCODE = 'NONE' C====================================================================== C C READ IN CARD FOR REFERENCE CONSTANTS C NCARD = 1 210 CALL FORC( KPNA, KPRNO, NCARD, CARD, *5200 ) IF( CARD(8:10) .NE. 'REF' ) GOTO 210 C---------------------------------------------------------------------- C C PROCESSING OPTION C PLIMIT = 'NONE' C IF( CARD(11:15) .EQ. ' ' ) PLIMIT = 'DISP' C IF( CARD(11:15) .EQ. ' DISP' ) PLIMIT = 'DISP' IF( CARD(11:15) .EQ. 'DISP ' ) PLIMIT = 'DISP' C IF( CARD(11:15) .EQ. ' PHAN' ) PLIMIT = 'PHAN' IF( CARD(11:15) .EQ. 'PHAN ' ) PLIMIT = 'PHAN' C IF( CARD(11:15) .EQ. ' INVT' ) PLIMIT = 'INVT' IF( CARD(11:15) .EQ. 'INVT ' ) PLIMIT = 'INVT' C IF( CARD(11:15) .EQ. ' STAT' ) PLIMIT = 'STAT' IF( CARD(11:15) .EQ. 'STAT ' ) PLIMIT = 'STAT' C---------------------------------------------------------------------- C C PROCESSING MODE FOR FBN CARDS C FBFLAG = 'SHOT' C IF( CARD(16:20) .EQ. ' CDPN' ) FBFLAG = 'CDPN' IF( CARD(16:20) .EQ. 'CDPN ' ) FBFLAG = 'CDPN' C IF( CARD(16:20) .EQ. ' FILE' ) FBFLAG = 'FILE' IF( CARD(16:20) .EQ. 'FILE ' ) FBFLAG = 'FILE' C====================================================================== C C MAXIMUM POSSIBLE HORIZONS C IF( FBFLAG .EQ. 'FILE' ) THEN NUMFBN = 8 NUMHRZ = 7 C ELSE NUMFBN = 2 FBNLAB = '*@ ' C---------------------------------------------------------------------- C C READ IN FBN CARD(S) C NCARD = 1 410 CALL FORC( KPNA, KPRNO, NCARD, CARD, *495 ) IF( CARD(8:10) .NE. 'FBN' ) GOTO 410 C CURFBN = 0 C COL = 15 IF( CARD(14:14) .NE. ' ' ) COL = 14 IF( CARD(13:13) .NE. ' ' ) COL = 13 IF( CARD(12:12) .NE. ' ' ) COL = 12 IF( CARD(11:11) .NE. ' ' ) COL = 11 C IF( NUMFBN .GT. 2 ) THEN DO 450 I = 3, NUMFBN IF( CARD(COL:COL) .EQ. FBNLAB(I:I) ) CURFBN = I 450 CONTINUE ENDIF C IF( CURFBN .EQ. 0 ) THEN NUMFBN = NUMFBN + 1 C IF( NUMFBN .LE. 7 ) THEN FBNLAB(NUMFBN:NUMFBN) = CARD(COL:COL) ENDIF ENDIF GOTO 410 C 495 NUMHRZ = NUMFBN - 1 ENDIF C C*********************************************************************** C*** **** C*** BLANK COMMON ALLOCATION **** C*** **** C*********************************************************************** C WRITE( IPR, 8000 ) LCNSP, LCTPSP, LCMXFD, NOSAMP C ------------------------------------------- C C ROUGH GUESS FOR GEOMETRIC SIZES C NSHOT = LCNSP NRECV = NGPS NCDPN = NDPS C NGRID = 2*NCDPN C WRITE( IPR, 8500 ) NSHOT, NRECV, NCDPN, NGRID, NUMHRZ C====================================================================== C C RESERVED BLANK COMMON C SHOTNO = LLOCAL SHOTID = SHOTNO + NSHOT/2 + 1 RECVID = SHOTID + 5*NSHOT CDPNUM = RECVID + 5*NRECV CDPNID = CDPNUM + NCDPN/2 + 1 CDPREF = CDPNID + 2*NCDPN CSPREF = CDPREF + 3*LCMXFD*NCDPN ENDCOM = CSPREF + LCTPSP*NSHOT C ------------------------------------------- C C DEFINE ADDRESSING FOR INVERSION C IF( PLIMIT .NE. 'DISP' .AND. PLIMIT .NE. 'PHAN' ) THEN CMODEL = ENDCOM SMODEL = CMODEL + 18*NCDPN RMODEL = SMODEL + 10*NSHOT SRESID = RMODEL + 10*NRECV RRESID = SRESID + 2*NSHOT ZMODEL = RRESID + 2*NRECV PMODEL = ZMODEL + 2*NGRID*NUMFBN STATIC = PMODEL + 2*NGRID*NUMFBN ENDCOM = STATIC + LCTPSP*NSHOT C ------------------------------------------- C C DEFINE ADDRESSING FOR STATIC APPLICATION C IF( PLIMIT .NE. 'INVT' ) THEN COEF = ENDCOM ENDCOM = COEF + 1212 ENDIF ENDIF C ------------------------------------------- C C DEFINE ADDRESSING FOR PLOT ATTIBUTE TABLE C IF( PLCODE .NE. 'NONE' ) THEN KPDSNS = ENDCOM ENDCOM = KPDSNS + 4 ENDIF C ------------------------------------------- C C RESERVED BLANK COMMON SIZE IN WORDS C (INCLUDING AREA FOR UGALPF) C CSIZE = ENDCOM + 50 C====================================================================== C C UNRESERVED BLANK COMMON C SPNODE = 0 DPNODE = SPNODE + 8*NSHOT ORTNSR = DPNODE + 8*NCDPN AVGOFF = ORTNSR + NRECV*NSHOT CCC ENDCOM = AVGOFF + 2*LCMXFD C ------------------------------------------- C C DEFINE ADDRESSING FOR TIME PICKS C IOCREF = AVGOFF FBREAK = IOCREF + 3*NCDPN*NUMHRZ RTIMES = FBREAK + LCTPSP*NSHOT PHSCAT = RTIMES + LCTPSP*NSHOT*NUMHRZ ENDXXX = PHSCAT + LCTPSP*NSHOT*NUMHRZ ENDCOM = ENDXXX C ------------------------------------------- C C DEFINE ADDRESSING FOR DUMP FILE OUTPUT BUFFER C RECORD = ENDXXX ENDCOM = RECORD + NGRID C ------------------------------------------- C C DEFINE ADDRESSING FOR PLOT WORK ARRAYS C IF( PLCODE .NE. 'NONE' ) THEN WORKXC = ENDXXX WORKYC = WORKXC + 999 PLTWRK = WORKYC + 999 ENDCOM = PLTWRK + 8192 ENDIF C ------------------------------------------- C C DEFINE ADDRESSING FOR INVERSION C IF( PLIMIT .NE. 'DISP' .AND. PLIMIT .NE. 'PHAN' ) THEN NWORK = MAX( NCDPN, NRECV, NSHOT ) C MTIMES = ENDXXX MINELV = MTIMES + LCTPSP*NSHOT*NUMHRZ MAXELV = MINELV + NUMFBN MINSLW = MAXELV + NUMFBN MAXSLW = MINSLW + NUMFBN MODTMP = MAXSLW + NUMFBN LSFOLD = MODTMP + 14*NWORK ENDNV1 = LSFOLD + NWORK + 1 C MODTMP = ENDNV1 WORKAR = MODTMP + 16*NWORK ENDINV = WORKAR + 10*NWORK C IF( ENDINV .GT. ENDCOM ) ENDCOM = ENDINV C ------------------------------------------- C C ALLOCATE AREA FOR STATIC APPLICATION (OVERLAY) C IF( PLIMIT .NE. 'INVT' ) THEN STWORK = SPNODE ENDCM2 = STWORK + 3*NOSAMP C IF( ENDCM2 .GT. ENDCOM ) ENDCOM = ENDCM2 ENDIF ENDIF C ------------------------------------------- C C UNRESERVED BLANK COMMON SIZE IN WORDS C UCSIZE = ENDCOM C====================================================================== C C DEBUG PRINT C WRITE( IPR, 8900 ) PSIZE, CSIZE, UCSIZE RETURN C C*********************************************************************** C*** **** C*** ERROR MESSAGES **** C*** **** C*********************************************************************** C C MISSING GM3D CARD 1 C 5000 WRITE( IPR, 9000 ) ERCODE = 16 RETURN C C MISSING GM3D CFS CARDS C 5050 WRITE( IPR, 9050 ) ERCODE = 16 RETURN C C MISSING INPUT CARD 1 C 5100 WRITE( IPR, 9100 ) ERCODE = 16 RETURN C C MISSING REF CARD C 5200 WRITE( IPR, 9200 ) ERCODE = 16 RETURN C 5300 WRITE(IPR, 9300) ERCODE = 16 RETURN C C*********************************************************************** C*** **** C*** FORMAT STATEMENTS **** C*** **** C*********************************************************************** C C OUTPUT C 8000 FORMAT('0LINE CARD VALUES USED BY MULTI-LAYER REFRACTION STATICS'/ * ' -------------------------------------------------------'/ * ' NUMBER OF SHOTPOINTS IN LINE = ',I5/ * ' NUMBER OF TRACES PER SHOT = ',I5/ * ' MAXIMUM FOLD = ',I5// * ' NUMBER OF SAMPLES PER TRACE = ',I5) C 8500 FORMAT('0MULTI-LAYER REFRACTION STATICS GEOM. PARAMETERS'/ * ' -----------------------------------------------'/ * ' NUMBER OF SHOTPOINTS = ',I5/ * ' EST. NUMBER OF RECEIVERS = ',I5/ * ' EST. NUMBER OF CDP LOCATIONS = ',I5/ * ' EST. NUMBER OF ANALYSIS GRID POINTS = ',I5// * ' NUMBER OF HORIZONS EXPECTED = ',I5) C 8900 FORMAT('0 MLRS ALLOCATION: PSIZE = ',I5,' CSIZE = ',I10, * ' UCSIZE = ',I10) C ------------------------------------------- C C ERROR MESSAGES C 9000 FORMAT(2(/1X,130('*'))/' *****',120X,'*****'/ * ' *****',44X,'ERROR: MISSING GM3D FIRST CARD',44X, * ' *****'/' *****',120X,'*****'/ * ' *****',44X,'(OCCURRANCE NUMBER MUST BE ZERO)',43X, * ' *****'/' *****',120X,'*****',2(/1X,130('*'))) C 9050 FORMAT(2(/1X,130('*'))/' *****',120X,'*****'/ * ' *****',44X,'ERROR: MISSING GM3D CFS CARDS ',44X, * '*****'/' *****',120X,'*****',2(/1X,130('*'))) C 9100 FORMAT(2(/1X,130('*'))/' *****',120X,'*****'/ * ' *****',44X,'ERROR: FIRST INPUT CARD INVALID',44X, * '*****'/' *****',120X,'*****',2(/1X,130('*'))) C 9200 FORMAT(2(/1X,130('*'))/' *****',120X,'*****'/ * ' *****',45X,'FATAL ERROR: MISSING REF CARD',45X, * '*****'/' *****',120X,'*****',2(/1X,130('*'))) C 9300 FORMAT(2(/1X,130('*'))/' *****',120X,'*****'/ * ' *****',45X,'FATAL ERROR: MISSING LINE CARD',45X, * '*****'/' *****',120X,'*****',2(/1X,130('*'))) END