CTITLEJSEQMO -- JOBGEN REGION AND BLANK COMMMON ALGORITHM C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA AUTHOR P. C. LUH CA DESIGNER P. C. LUH CA LANGUAGE VS FORTRAN VS CA SYSTEM IBM / CRAY CA WRITTEN 06-14-90 CA REVISED 02-12-92 JJC - FOR SPARC PRODUCTION CA CA CA CALL JSEQMO (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) CA CA INPUT KPNA = PROCESS NAME A4 CA INPUT KPRNO = PROCESS NUMBER I4 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 CA KPRNO CA OUTPUT PSIZE = REGION SIZE OF PROGRAM IN K-BYTES I4 CA OUTPUT CSIZE = BLANK COMMON SIZE IN K-BYTES I4 CA OUTPUT ERCODE= ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 CA THE REQUIRED PARAMETERS) CA CA CA COMPUTES THE PROGRAM SIZE AND AMOUNT OF BLANK COMMON NEEDED FOR CA PROCESSES REQUIRING SPECIAL CALCULATIONS. CA CA EJECT C SUBROUTINE JSEQMO (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, + ERCODE ) C CXX IMPLICIT INTEGER (A-Z) EXTERNAL FOIP C C INTEGER ARRAYS -- LOCAL C INTEGER OCCUR INTEGER PSIZE INTEGER CSIZE INTEGER ERCODE INTEGER RLENG C C CHARACTER CONSTANTS -- LOCAL C CHARACTER*80 CARD CHARACTER*4 KPNA CHARACTER*4 PMODE C C INTEGER CONSTANTS -- LOCAL C INTEGER IPR INTEGER THL, TRL C CRAY INTEGER ID,ISY,IC,LCTYP CHARACTER*1 ID,ISY,IC,LCTYP,IBMCRA,MODE CHARACTER*8 THHEAD C INTEGER YES,NO C REAL LCGRPI CHARACTER*5 FNMO,ERR*80,CHKCD2*80 C C DATA YES,NO / 1, 0 / DATA IPR,THL/ 6,190/,CON/1.E30/,ALN2/1.442695041/ DATA ID,ISY,IC/'D','S','C'/ C C ERCODE = 0 C C GET ACCT CARD PARAMETERS C IDA = 1 CALL FORC ('ACCT', 0, IDA, CARD, * 8000 ) C IBMCRA=CARD(12:12) C C GET LINE CARD PARAMETERS C IDA = 1 CALL FORC ('LINE', 0, IDA, CARD, * 8000 ) C READ(CARD,4)LCTYP,LCBGSP,LCENSP,LCNSP,LCTPSP,LCRL,LCSI,LCPI, + LCGRPI,LCMXFD,LCANSP,LCMXLN C 4 FORMAT(6X,A1,3X,2I5,10X,9I5) 4 FORMAT(6X,A1,3X,2I5,10X,5I5,F5.0,3I5) C C IF (LCPI .EQ. 0) THEN WRITE(IPR,1119) 1119 FORMAT(' ***** STOP ***** LINE CARD PROCESSING INTERVAL IS 0') GO TO 9800 ENDIF C C GET PROC CARD PARAMETERS C IDA = 1 1120 CONTINUE CALL FORC ('PROC', 0, IDA, CARD, * 1123 ) C N=0 DO 1122 I=6,77 IF(CARD(I:I+3).EQ.KPNA) THEN N=N+1 IF(N.GT.1) THEN WRITE(IPR,1121)KPNA 1121 FORMAT(' ***** STOP ***** ',A4,' IS NOT A RE-ENTRANT ', + 'PROCESS; CAN''T APPEAR MORE THAN ONCE PER PROC!') GO TO 9800 ENDIF ENDIF 1122 CONTINUE GO TO 1120 C 1123 CONTINUE IF(IDA.EQ.1) GO TO 8001 C C GET PARM CARD PARAMETERS C IDA = 1 CALL FORC ('PARM', 0, IDA, CARD, * 1125 ) WRITE(IPR,1124) 1124 FORMAT(' ***** USE USER-SUPPLIED ''PARM'' CARD *****') GO TO 9900 C 1125 CONTINUE C IF(1.EQ.2) CALL S1ATP C C COMPUTE THE REQUIRED BLANK COMMON C ================================= C C ********************************************************************* C GET THE NUMBER OF SAMPLES/TRACE AND THE SAMPLE RATE FROM THE LINE C HEADER C ********************************************************************* C C MODIFIED CODE ,NEW CODE C C CALL USRTHV(INH, 'THL ', ITHL) C CALL USRTHV(INH, 'THSI ', IDT) C ITHL=THL IF(IBMCRA.EQ.IC) ITHL=ITHL/2 C IS=LCPI*1000 LON=LCRL/LCPI C DT=(FLOAT(IS))/1000000. C C READ INPUT CARDS C C NOTE: USE CARD; GO TO 78 TO ERROR-OFF; GO TO 9800 TO ABORT C COMMENT USRTHV; INTEGER TRL C LA = 1 CALL FORC(KPNA,KPRNO,LA,CARD,*78) READ(CARD,100)MODE,IBEG,IEND,XNR,XFR,DX,BN,DP,DR,F3,F4, + IFLAG,JFLAG 100 FORMAT(6X,A1,3X,2I5,8F5.0,2I5) C IF(MODE.NE.'D') THEN WRITE(IPR,'(''0***** STOP ***** ONLY CDP-GATHERS ALLOWED'') + ') GO TO 9800 ENDIF C IF(IBEG.LE.0.OR.IEND.LE.0) THEN WRITE(IPR,*)'0***** STOP ***** BEGIN OR END INDEX <= 0 ' GO TO 9800 ENDIF C IF(DX.LT.0.) THEN WRITE(IPR,*)'0***** STOP ***** TRACE INTERVAL < 0' GO TO 9800 ELSEIF(DX.EQ.0.) THEN WRITE(IPR,*)'0***** WARNING ***** TRACE INTERVAL SET TO LCGRPI' DX=LCGRPI ENDIF C IF(XNR.GE.XFR) THEN WRITE(IPR,*)'0***** STOP ***** NEAR OFFSET >= FAR OFFSET' GO TO 9800 C-12/06/90IF(XNR.LE.0..OR.XFR.LE.0.) THEN ELSEIF(XNR.LT.0..OR.XFR.LE.0.) THEN WRITE(IPR,*)'0***** STOP ***** NEAR OFFSET OR FAR OFFSET <= 0' GO TO 9800 ELSEIF(XFR.LE.DX*2) THEN WRITE(IPR,*)'0***** STOP ***** FAR OFFSET <= 2*(TRACE INTRVL)' GO TO 9800 ENDIF C IF(DP.LE.0.) DP=320. IF(DP.LT.100..OR.DP.GT.500.) THEN WRITE(IPR,*)'0***** STOP ***** DIP RANGE IN MSEC IS (100,500)' GO TO 9800 ENDIF IF(DR.EQ.0.) DR=-DP IF(DR.GT.0.) THEN WRITE(IPR,*)'0***** WARNING ***** REVERSE TIME DIP SHOULD BE ' + //'NEGATIVE; CHANGED ITS SIGN.' DR=-DR ENDIF IF(DR.LT.-500..OR.DR.GT.-100.) THEN WRITE(IPR,*)'0***** STOP ***** REVERSE DIP RANGE: (-100,-500)' GO TO 9800 ENDIF C C-05/07/91 KFLAG=0 IF(IABS(IFLAG).GT.10) KFLAG=10 C IF(IABS(IFLAG)-KFLAG.LT.0.OR.IABS(IFLAG)-KFLAG.GT.3) THEN WRITE(IPR,*)'0***** STOP ***** FLAG (COL 61:65) RANGE IS (0,3)' GO TO 9800 ENDIF C IF(JFLAG.LT.0.OR.JFLAG.GT.3) THEN WRITE(IPR,*)'0***** STOP ***** FLAG2(COL 66:70) RANGE IS (0,3)' GO TO 9800 ENDIF C IF(BN.LE.1.) BN=2. IF(BN.GT.4.) THEN WRITE(IPR,*)'0***** STOP ***** BIN (COL 36:40) RANGE : (1.,4.)' GO TO 9800 ENDIF IF(JFLAG.EQ.0.AND.BN.GT.2.) THEN WRITE(IPR,*)'0***** WARNING ***** ' + //' BIN .GT. 2.*DX FOR SELECTING NEAREST TRACE.' + //' RESET BIN TO DX!' BN=2. ENDIF C C CALL USRTHV(OH,'THNS ',LON) C CALL USRTHV(OH,'THSI ',IS) C CALL USRTHV(OH,'THL ',THL) MXFOLD=MAX0(LCTPSP,LCMXFD) LON=MAX0(LON,LCRL/LCPI) KBUGF=KPBUGF C IF(IBEG.LE.IEND) GO TO 123 J=IBEG IBEG=IEND IEND=J 123 CONTINUE C XFR2=XFR*XFR C-10/31/90 IF(INT(XFR2/(XFR2-(XFR-DX-DX)**2)+1).LE.8) THEN WRITE(IPR,*)'0***** STOP ***** FAR-OFFSET RANGE TOO SHORT OR ' + //'TRACE-INTERVAL TOO WIDE?' GO TO 9800 ENDIF C NTX=1 C NTX=2 C-10/31/90 NX=MIN0(16,INT(XFR2/(XFR2-(XFR-DX-DX)**2)+1))*NTX C-12/06/90 NX= INT(XFR2/(XFR2-(XFR-DX-DX)**2)+1) NX= 2 * INT(XFR2/(XFR2-(XFR-DX-DX)**2)+1) 10 CONTINUE IF(NX.GE.MXFOLD) THEN NX=NX/2 GO TO 10 ENDIF C KLN=ALOG(FLOAT(NX-1))*ALN2+1. KNX=2**KLN C KLEN=ALOG(FLOAT(LON-1))*ALN2+1. KLON=2**KLEN C DT=0.000001*IS DF=0.5/DT DW=1./(KLON*DT) C IF(F3.LE.0.) F3=64. IF(F3.GT.DF) THEN WRITE(IPR,*)'0***** WARNING ***** F3 (=',F3,') > FNYQ (=', + DF,'); RESET F3 TO FNYQ!' F3=DF ENDIF IF(F4.LE.0.) F4=80. IF(F3.GT.F4) THEN WRITE(IPR,*)'0***** STOP ***** F3 (=',F3,') > F4 (=',F4,')' GO TO 9800 ENDIF IF(F4.GT.DF) THEN WRITE(IPR,*)'0***** WARNING ***** F4 (=',F4,') > FNYQ (=', + DF,'); RESET F4 TO FNYQ!' F4=DF ENDIF C TOLR=DX*0.5 C TRL=LON+THL C IF(NSHOTT.EQ.0) NSHOTT=1 NSHOTT=(NSHOTT/2)*2+1 IF(NSHOT.EQ.0) NSHOT=1 C NSHOT=MIN0(NSHOT,7) C NSHOT=MAX0(NSHOT,3,NSHOTT) NSHHF=NSHOT/2 NSHOT=2*NSHHF+1 NSHO1=NSHHF+1 NSHO2=MIN0(NSHOT,NSHHF+2) C C ----------------------------------- IHDR,RA IN11=1 C ----------------------------------- TEMP IND5=MXFOLD*TRL+IN11 C ----------------------------------- X IND1= TRL+IND5 C ----------------------------------- XX IND2=IND1+NX*LON C ----------------------------------- YY IND6=IND2+KNX*LON C ----------------------------------- Y IND3=IND6+KNX*LON C ----------------------------------- Z IND4=IND3+KNX*KLON C ----------------------------------- ILCD INLD=IND4+KNX*KLON C------------------------------------ KICE INXE=INLD+MXFOLD C------------------------------------ X1 INX1=INXE+MXFOLD C------------------------------------ X2 INX2=INX1+MXFOLD C------------------------------------ X3 INX3=INX2+MXFOLD C------------------------------------ STK ISTK=INX3+MXFOLD C ----------------------------------- STL JSTK=ISTK+KNX C------------------------------------ KUNT IKUN=JSTK+KNX C ----------------------------------- KBG IKBG=IKUN+KNX C------------------------------------ KED IKED=IKBG+KNX C ----------------------------------- KICD IKIC=IKED+KNX C ----------------------------------- KICC IKIE=IKIC+KNX C ----------------------------------- KONT IKON=IKIE+KNX C------------------------------------ MX IMX =IKON+KNX C ----------------------------------- KLOC IKLO=IMX +KNX C ----------------------------------- XO IXO =IKLO+KNX C ----------------------------------- IND0=IXO +KNX*2 C C WRITE(IPR,109)IN11,IND5,IND1,IND2,IND6,IND3,INLD,INX1,INX2,INX3, C + ISTK,JSTK,IKUN,IKBG,IKED,IKIC,IKON,IMX ,IKLO,IXO , C + IND0 109 FORMAT(1X,15I8) C ICC=IND0+KNX C CPRNT WRITE(IPR,128)IBEG,IEND,XNR,XFR,DX,BN,DP,DR,F3,F4,DF,IFLAG,JFLAG, CPRNT+ NX,NTX,KNX,MXFOLD,LON,KLON,DT,KBUGF,ICC 128 FORMAT(/10X,'BEGINNING CDP NUMBER =',I18,51X,'VERSION 05-31-90'// + 10X,'ENDING CDP NUMBER =',I21// + 10X,'MINIMUM NEAR OFFSET =',F19.1// + 10X,'MAXIMUM FAR OFFSET =',F20.1// + 10X,'TRACE INTERVAL WITH GATHER =',F12.2// + 10X,'MINIMUM TRACES PER BIN = ',F12.2// + 10X,'TIME DIP AT MAXIMUM FAR OFFSET =',F8.1// + 10X,'REVERSE TIME DIP AT FAR OFFSET =',F8.1// + 10X,'HIGH-CUT FREQUENCIES (HZ) = ',2F12.2,F38.2// + 10X,'FLAG (0,1,2,3) = ',I12// + 10X,'FLAG2 (0,1,2,3) = ',I12// + 10X,'OUTPUT FOLD = ',I12,I40,I10// + 10X,'MAXIMUM FOLD =',I26// + 10X,'NUMBER OF SAMPLES/TRACE =',I15,I50// + 10X,'TIME SAMPLING RATE =',F20.4,' (SEC)'// + 20X,'KPBUGF =',I22// + 20X,'ICC =',I25//) C C======================================================================= C KILO=ICC/256+1 C C ROUND UP TO THE NEXT 10 KILOBYTES C CSIZE = ( (KILO-1) / 10 + 1) * 10 C C SET PROGRAM SIZE TO 300 KILOBYTES C CSIZE = CSIZE*256 PSIZE = 300 UCSIZE = 0 C WRITE(IPR,'(/10X,''PARM FOR EQMO ='',I10/)') CSIZE C GO TO 9900 C 9800 ERCODE = 16 WRITE(IPR,9801)KPNA,KPRNO 9801 FORMAT(' ***** ABORT FOR PROC =',A4,I1//) C 9900 RETURN C C*********************************************************************** C C ERROR MESSAGES C C*********************************************************************** C 8000 WRITE (IPR, 9000 ) KPNA,KPRNO GO TO 9800 C 9000 FORMAT (/' *** NO LINE OR ACCT CARD IN JSCORE FOR PROC = ', * A4,I1) C 8001 WRITE(IPR,9001) 9001 FORMAT (/' *** NO PROC CARD PRESENT ') GO TO 9800 C 9010 FORMAT (/' *** NO PROCESS FOUND IN JSCORE PROC = ',A4,I1) C 9020 FORMAT (/' *** NO CARD PRESENT IN JSCORE FOR PROC = ',A4,I1) C 78 IABORT=YES WRITE(IPR,1000) 1000 FORMAT(' NO PARAMETER CARD(1) INFORMATION FOR EQMO0 ') C RETURN GO TO 9800 C END