CTITLEJSZMIG -- CALCULATES SYSTEM RESOURCES NEEDED BY ZMIG 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. D. KNIGHT 00020001 CA DESIGNER R. D. KNIGHT 00030001 CA LANGUAGE VS FORTRAN 00040001 CA SYSTEM IBM AND CRAY 00050001 C WRITTEN MAY 1981 00060001 C REVISED AUG 84; RDK; INITIALIZE THL TO 190. 00070001 C REVISED 04/01/85 RKG REVISE BLANK COMMON ALLOCATIONS. 00080000 C CORRECT VS FORTRAN COMPILE ERRORS. 00090000 C REVISED 09/23/86 M.COADY REVISE BLANK COMMON ALLOCATIONS FOR 00100000 C MEMORY VEL FIELD & COMPLEX ARITHMETIC 00110000 C REVISED 09/30/86 S.NELAN FOR PRODUCTION RELEASE. 00120000 C REVISED 06/08/87 D.HIMMEL MODIFIED DATA STATEMENTS FOR CRAY. 00130001 C REVISED 06/16/87 D.HIMMEL CHANGE IPR SETTING FROM 6 TO 98. 00131001 C REVISED 04/28/88 J.TRULOCK MADE LCGRPI FLOATING POINT. 00132002 C REVISED 11/13/89 R.KNIGHT CFT77 COMPATIBILITY ON CRAY. 00132103 CA 00133002 CA CALL JSZMIG( KPNA,KPRNO,LCGRPI,LCPI,NOSAMP,ISCOM,IPCOM, 00134002 CA * NX,NZ,NZF,NFCPB,NTPB,NFB,NTB,NZB,NZCPB ) 00135002 CA 00136002 CA IN/OUT ARG TYPE DESCRIPTION 00137002 CA 00138002 CA IN KPNA A4 PROCESS NAME 00139002 CA IN KPRNO A4 PROCESS NUMBER 00140002 CA IN LCGRPI R4 GROUP INTERVAL FROM LINE CARD 00150002 CA IN LCPI I4 PROCESSING INTERVAL FROM LINE CARD 00160002 CA IN NOSAMP I4 TRACELENGTH IN SAMPLES 00170002 CA OUT ISCOM I4 NUMBER OF WORDS OF UNRESERVED COMMON REQUIRED 00180002 CA OUT IPCOM I4 NUMBER OF WORDS OF RESERVED COMMON REQUIRED 00190002 CA IN NX I4 NUMBER OF TRACES TO MIGRATE 00200002 CA OUT NZ I4 NUMBER OF DEPTH STEPS 00210002 CA OUT NZF I4 NUMBER OF DEPTH STEPS FOR MIGRATION 00220002 CA OUT NFCPB I4 NUMBER OF FREQUENCY COMPONENTS PER DATA BLOCK 00230002 CA OUT NTPB I4 NUMBER OF TRACES PER DATA BLOCK 00240002 CA OUT NFB I4 NUMBER OF FREQUENCY BLOCKS 00250002 CA OUT NTB I4 NUMBER OF TRACE BLOCKS 00260002 CA OUT NZB I4 NUMBER OF Z BLOCKS 00270002 CA OUT NZCPB I4 NUMBER OF Z COMPONENTS PER BLOCK 00280002 C 00290002 C 00300002 C THIS SUBROUTINE CALCULATES THE SIZE OF BLANK COMMON 00310002 C AND THE WORK FILE DCB ATTRIBUTES FOR PROCESS ZMIG. 00320002 C 00330002 C 00340002 SUBROUTINE JSZMIG( KPNA,KPRNO,LCGRPI,LCPI,NOSAMP,ISCOM,IPCOM, 00350002 * NX,NZ,NZF,NFCPB,NTPB,NFB,NTB,NZB,NZCPB ) 00360002 C 00370002 C REAL ARRAYS--INTERNAL 00380002 C 00390002 REAL LCGRPI 00400002 C 00410002 DIMENSION CARD ( 20) 00420002 DIMENSION VL ( 500) 00430002 DIMENSION VR ( 500) 00440002 DIMENSION ZL ( 500) 00450002 DIMENSION ZLAST ( 500) 00460002 DIMENSION ZR ( 500) 00470002 C 00480002 C 00490002 C INTEGER CONSTANT--LOCAL 00500002 C 00510002 INTEGER DA 00520002 INTEGER EDPT 00530002 INTEGER SDPT 00540002 INTEGER CHR 00550002 CHARACTER*4 BOTH 00560002 CHARACTER*4 ITYP 00570002 INTEGER PHR 00580002 INTEGER S1CPCH 00590002 INTEGER S1CVBN 00600002 INTEGER THL 00610002 INTEGER LLOCAL 00620002 INTEGER URKWDS 00630002 C 00640002 DATA BOTH / 'BOTH'/ 00650002 DATA THL / 190/ 00660002 DATA LLOCAL / 70/ 00670002 DATA URKWDS / 75000/ 00680002 C 00690002 C REAL CONSTANTS--LOCAL 00700002 C 00710002 DATA C4 / 1.0/ 00720002 DATA C5 / -.90556E-02/ 00730002 DATA C6 / .2611E-03/ 00740002 C 00750002 C 00760002 C 00770002 DA = 001 00780002 IPR = 98 00790002 PHR = -99 00800002 MXSEG = -99 00810002 MXHR = -99 00820002 VMIN = 999999. 00830002 MXPTS = -99 00840002 XP = -999. 00850002 CESN WRITE(IPR,9900) 00860002 C9900 FORMAT(// 5X,'TEST VERSION OF JSZMIG ') 00870002 C 00880002 DT = FLOAT(LCPI)*0.001 00890002 DIPC = 1.2 00900002 T = DT*NOSAMP 00910002 C 00920002 IXL = 0 00930002 IXR = 0 00940002 C 00950002 10 CALL FORC (KPNA, KPRNO, DA, CARD, *80) 00960002 C 00970002 IF(S1CPCH(CARD,8,' ',1,3).EQ.0) GO TO 20 00980002 IF(S1CPCH(CARD,8,'HRZ',1,3).EQ.0) GO TO 30 00990002 GO TO 10 01000002 C 01010002 C =============================================================== 01020002 C GET ANALYSIS PARAMETERS FROM PROCESS CARD 01030002 C =============================================================== 01040002 C 01050002 20 SDPT = S1CVBN( CARD, 11, 5) 01060002 EDPT = S1CVBN( CARD, 16, 5) 01070002 CALL USCHFT(CARD,21,5, DIP) 01080002 CALL USCHFT(CARD,26,5,WFRQ) 01090002 CALL USCHFT(CARD,31,5,HFRQ) 01100002 CALL S1MVCH(CARD,37,ITYP,1,4) 01110002 NZ = S1CVBN( CARD, 41, 5) 01120002 CALL USCHFT(CARD,46,5, DZ) 01130002 CALL USCHFT(CARD,51,5,DATUM) 01140002 IX = S1CVBN( CARD, 61, 5) 01150002 IPRNT= S1CVBN( CARD, 66, 5) 01160002 C 01170002 IDDATM = DATUM 01180002 C 01190002 NX = MAX0(SDPT,EDPT)-MIN0(SDPT,EDPT) + 1 01200002 NT = INT(NOSAMP*1.1) 01210002 IF(DATUM.NE.0.0) NT=NOSAMP 01220002 IF(DIP.LE.50.0) DIPC=C4+DIP*(C5+DIP*C6) 01230002 C 01240002 CALL S1FMAG(NT,NEXP,NTT) 01250002 C 01260002 DX = IX 01270002 IF(IX.EQ.0) DX = 0.5 * LCGRPI 01280002 BRD= DX*(NX-1) 01290002 BLDTH= 0.05*BRD 01300002 BRDTH= 0.95*BRD 01310002 C 01320002 DOM = 1.0/(NTT*DT) 01330002 NOMLO= INT(WFRQ/DOM)+1 01340002 NOMHI= INT(HFRQ/DOM)+1 01350002 NOM = NOMHI - NOMLO + 1 01360002 C 01370002 NFCPB = 10 01380002 IF(NOM.GT. 50) NFCPB = 20 01390002 IF(NOM.GT.100) NFCPB = 25 01400002 IF(NOM.GT.200) NFCPB = 50 01410002 NFB = (NOM-1)/NFCPB + 1 01420002 C 01430002 NTPB = 20 01440002 IF(NX.GT. 100) NTPB = 25 01450002 IF(NX.GT. 200) NTPB = 50 01460002 IF(NX.GT. 500) NTPB =100 01470002 IF(NX.GT.1000) NTPB =150 01480002 NTB = (NX-1)/NTPB + 1 01490002 C 01500002 NZB = 0 01510002 NZCPB = 0 01520002 C 01530002 GO TO 10 01540002 C 01550002 C ================================================================ 01560002 C DECODE AND OBTAIN PARAMETERS FROM HRZ CARDS 01570002 C ================================================================ 01580002 C 01590002 30 CHR = S1CVBN(CARD,11,5) 01600002 MXSEG= MAX0(MXSEG,S1CVBN(CARD,16,5)) 01610002 MXHR = MAX0(MXHR,CHR) 01620002 IF(CHR.NE.PHR) IHC=0 01630002 IHC = IHC+1 01640002 MXPTS= MAX0(MXPTS,IHC) 01650002 PHR = CHR 01660002 C 01670002 CALL USCHFT(CARD, 21,10, X) 01680002 CALL USCHFT(CARD, 31,10, Z) 01690002 CALL USCHFT(CARD, 41,10, V) 01700002 C 01710002 IF(V.EQ.0.0) V = VP 01720002 VMIN = AMIN1(VMIN,V) 01730002 C 01740002 IF(DATUM.NE.0. .OR. IHC.NE.1 .OR. NZ.GT.0) GO TO 70 01750002 ISW = 1 01760002 V1 = V 01770002 C 01780002 40 IF(XP.LT.BRDTH) GO TO 50 01790002 IXR = IXR + 1 01800002 ZR(IXR) = ZP 01810002 VR(IXR) = VP 01820002 C 01830002 50 GO TO ( 60 , 90 ), ISW 01840002 C 01850002 60 IF(X.GT.BLDTH) GO TO 70 01860002 IXL = IXL + 1 01870002 ZL(IXL) = Z 01880002 VL(IXL) = V 01890002 C 01900002 70 VP = V 01910002 ZP = Z 01920002 XP = X 01930002 ZLAST(IHC) = ZP 01940002 GO TO 10 01950002 C 01960002 C ================================================================ 01970002 C CLOSE OUT AND PERFORM COMPUTATIONS 01980002 C ================================================================ 01990002 C 02000002 80 IF(DZ.GT.0.) GO TO 85 02010002 VMIN = AMAX1(VMIN,4500.) 02020002 DZ=0.25*VMIN/(HFRQ*DIPC) 02030002 C 02040002 85 IF(DATUM.NE.0. .OR. NZ.GT.0) GO TO 120 02050002 ISW = 2 02060002 GO TO 40 02070002 C 02080002 90 NZL = 0 02090002 NZR = 0 02100002 C 02110002 IF(IXL.LE.1) GO TO 105 02120002 C 02130002 TIME = 0.0 02140002 N = IXL-1 02150002 DO 100 I=1,N 02160002 100 TIME=TIME+2.*(ZL(I+1)-ZL(I))/VL(I) 02170002 SUMZ=ZL(IXL)+0.5*(T-TIME)*V1 02180002 NZL =INT(1.04*SUMZ/DZ) 02190002 C 02200002 105 IF(IXR.LE.1) GO TO 115 02210002 C 02220002 TIME = 0.0 02230002 N = IXR-1 02240002 DO 110 I=1,N 02250002 110 TIME=TIME+2.*(ZR(I+1)-ZR(I))/VR(I) 02260002 SUMZ=ZR(IXR)+0.5*(T-TIME)*VP 02270002 NZR =INT(1.04*SUMZ/DZ) 02280002 C 02290002 115 NZ = MAX0(NZL,NZR) 02300002 C 02310002 120 D = (NZ-1)*DZ 02320002 C 02330002 DO 130 I=1,IHC 02340002 IF(ZLAST(I).GT.D) NZ=INT(ZLAST(I)/DZ+3.) 02350002 130 CONTINUE 02360002 C 02370002 NZF = MIN0(NZ-1,NOSAMP) 02380002 C 02390002 IF(DATUM.EQ.0.) GO TO 140 02400002 ANZ = FLOAT(IDDATM)/DZ 02410002 INZ = INT(ANZ) 02420002 NZF = INZ + (ANZ-INZ) + 0.9999 02430002 NZ = MAX0(NZ,INZ+2) 02440002 C 02450002 C ================================================================ 02460002 C CALCULATE BLANK COMMON REQUIREMENTS 02470002 C ================================================================ 02480002 C 02490002 140 NL = NZF 02500002 IF(DATUM.NE.0.) NL = NOSAMP 02510002 C 02520002 COADY 02530002 IP1 = 3 * NZ * NX 02540002 IS1 = MXHR*(3*(MXPTS+1)+2*(MXSEG+NX)) + 02550002 * MAX0(THL,2*(MXPTS+NX),6*MXPTS) 02560002 IS1 = MAX0(IS1,NFCPB*NTPB) 02570002 IS1 = MAX0(IS1,NL ) 02580002 C 02590002 IP2 = 2*NFCPB*NFB*NTPB 02600002 IS2 = MAX0(2*NTT,NFCPB*NTPB) 02610002 C 02620002 IP3 = 0 02630002 IS3 = NFCPB*NTPB*(2*NFB+1) + 2*NTT 02640002 COADY 02650002 IS3 = MAX0(IS3, NZ + NOM + NX*30 + 2*NFCPB*NTB*NTPB + 4*NX*NFCPB) 02660002 IS3 = IS3 + NZ + NOM 02670002 C 02680002 IP4 = 0 02690002 IS4 = MAX0(IS1,IS2,IS3,URKWDS) 02700002 COADY 02710002 IS5 = 2 * NFCPB * NTB * NTPB 02720002 * + 2 * NFCPB * NFB * NTPB 02730002 * + 30 * NX 02740002 * + 4 * NX * NFCPB + NX + NOM + LLOCAL + THL + 50 02750002 C 02760002 C 02770002 C 02780002 IF(DATUM.NE.0.) GO TO 145 02790002 NZCPB = MIN0((IS4/2)/NX,NZF+1) 02800002 NZB = NZF/NZCPB + 1 02810002 IF(ITYP.EQ.BOTH) NZB = -NZB 02820002 C 02830002 145 ISCOM = 4 * MAX0(IS1,IS2,IS3,IS4,IS5) 02840002 COADY IPCOM = 4 * MAX0(IP1,IP2,IP3,IP4) 02850002 IPCOM = 4 * (IP1 + IP2) 02860002 C 02870002 COADY IF(IPRNT.EQ.0) GO TO 150 02880002 WRITE(IPR,9000)MXSEG,MXHR,MXPTS,NFCPB,NFB,NTPB,NTB,02890002 * NX,NT,NTT,IX,IXL,IXR,DX,DZ,NZ,NZF, 02900002 * NOM,NZB,NZCPB,ISCOM,IPCOM,IS5 02910002 WRITE(IPR,9001)MXSEG,MXHR,MXPTS,NFCPB,NFB,NTPB,NTB,02920002 * NX,NT,NTT,IX,IXL,IXR,DX,DZ,NZ,NZF, 02930002 * NOM,NZB,NZCPB,ISCOM,IPCOM,IS5 02940002 WRITE(IPR, 9010) 02950002 WRITE(IPR, 9020) (ZLAST(I),I=1,IHC) 02960002 C 02970002 9000 FORMAT(1H1,/,1H ,' MXSEG ',I5,/,1H ,' MXHR ',I6,/,1H ,' MXPTS ',I502980002 * ,/,1H ,' NFCPB ',I5,/,1H ,' NFB ',I6,/,1H ,' NTPB ',I502990002 * ,/,1H ,' NTB ',I5,/,1H ,' NX ',I6,/,1H ,' NT ',I503000002 * ,/,1H ,' NTT ',I5,/,1H ,' IX ',I6,/,1H ,' IXL ',I503010002 * ,/,1H ,' IXR ',I5,/,1H ,' DX ',F6.1,/,1H ,' DZ ',F6.1 03020002 * ,/,1H ,' NZ ',I5,/,1H ,' NZF ',I6,/,1H ,' NOM ',I503030002 * ,/,1H ,' NZB ',I5,/,1H ,' NZCPB',I6 03040002 * ,/,1H ,' ISCOM ',I9,/,1H ,' IPCOM',I9,/,1X,' IS5',I9) 03050002 C 03060002 9001 FORMAT(1H1,/,1H ,' MXSEG ',Z9,/,1H ,' MXHR ',Z9,/,1H ,' MXPTS ',Z903070002 * ,/,1H ,' NFCPB ',Z9,/,1H ,' NFB ',Z9,/,1H ,' NTPB ',Z903080002 * ,/,1H ,' NTB ',Z9,/,1H ,' NX ',Z9,/,1H ,' NT ',Z903090002 * ,/,1H ,' NTT ',Z9,/,1H ,' IX ',Z9,/,1H ,' IXL ',Z903100002 * ,/,1H ,' IXR ',Z9,/,1H ,' DX ',F6.1,/,1H ,' DZ ',F6.1 03110002 * ,/,1H ,' NZ ',Z9,/,1H ,' NZF ',Z9,/,1H ,' NOM ',Z903120002 * ,/,1H ,' NZB ',Z9,/,1H ,' NZCPB',Z9 03130002 * ,/,1H ,' ISCOM ',Z9,/,1H ,' IPCOM',Z9,/,1X,' IS5',Z9) 03140002 C 03150002 9010 FORMAT( 1H ,' ZLAST:') 03160002 C 03170002 9020 FORMAT( 1H ,10F12.1) 03180002 C 03190002 150 RETURN 03200002 C 03210002 END 03220002