CTITLEJSZM2D - JOBGEN REGION & BLANK COMMMON CALCULATION C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. C. SUN CA DESIGNER J. C. SUN CA LANGUAGE FORTRAN CA SYSTEM IBM AND CRAY CA WRITTEN 11-05-87 C REVISED 01-20-90 JJC - MODIFIED TO MEET EDP STANDARDS. C REVISED 02-21-90 JJC - RENAMED SAZM2DV TO SAFFTL. C REVISED 07-23-90 CLJ - ALLOW PREP TO RUN ON THE IBM CA CA CA CALL JSZM2D (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 -KBYTES I4 CA OUTPUT CSIZE = RESERVED BLANK COMMON SIZE IN WORDS I4 CA OUTPUT UCSIZE = UNRESERVED BLANK COMMON SIZE IN WORDS I4 CA OUTPUT ERCODE = ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 CA THE REQUIRED PARAMETERS) CA CA CA COMPUTES THE PROGRAM SIZE (PSIZE) AND AMOUNT OF BLANK COMMON CA (CSIZE) NEEDED BY SPARC PROCESS ZM2D REQUIRING SPECIAL CA CALCULATIONS. C C EJECT C SUBROUTINE JSZM2D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, * ERCODE) C IMPLICIT INTEGER (A-Z) C EXTERNAL FOIP C CHARACTER*4 KPNA CHARACTER*80 CARD C C INTEGER CONSTANTS -- LOCAL C INTEGER FCF INTEGER IPR INTEGER THL C C REAL CONSTANTS -- LOCAL C REAL PI2,DT,DW,WLO,WHI,DZ DATA FCF / 1 / DATA IPR / 98 / DATA THL / 190 / C WRITE(IPR,8000) C 00700000 C GET LINE CARD PARAMETERS 00710000 C 00720000 DA = 1 00730000 CALL FORC ('LINE', 0, DA, CARD, * 180 ) 00740000 C 00750000 LCRLEN = S1CVBN (CARD, 41, 5) 00760000 LCSI = S1CVBN (CARD, 46, 5) 00770000 LCPI = S1CVBN (CARD, 51, 5) 00780000 IF (LCPI .EQ. 0) LCPI = LCSI 00790000 C 00800010 C IF (LCPI .EQ. 0) GO TO 9800 00810000 C ABOVE LINE IS COMMENTED BUT INTENTIONALY LEFT FOR CLARITY. 00820000 C THE LCPI NON ZERO CHECK SHOULD BE DONE IN JSCORE OR JSRND AND 00830010 C THEREFORE IS REDUNDANT HERE. 00840010 C 00850010 NS = LCRLEN/LCPI 00860010 C C ====================================================================== C INITIALIZATION C ====================================================================== C PSIZE = 20 C ICC = 0 C C ====================================================================== C READ INPUT CARD (1) C ====================================================================== C DAC = 1 100 CALL FORC (KPNA, KPRNO, DAC, CARD, * 160) C IXBEG = S1CVBN(CARD,11,5) IXEND = S1CVBN(CARD,16,5) IDIP = S1CVBN(CARD,21,5) IFLO = S1CVBN(CARD,26,5) IFHI = S1CVBN(CARD,31,5) CALL USCHFT(CARD,36,5,DZ) IZMAX = S1CVBN(CARD,41,5) ITMAX = S1CVBN(CARD,46,5) KBUFF = S1CVBN(CARD,51,5) NTRNC = S1CVBN(CARD,66,5) LOPR = S1CVBN(CARD,71,5) C IF (IXBEG .EQ. 0) GO TO 200 IF (IXEND .EQ. 0) GO TO 220 IF (IFLO .EQ. 0) GO TO 240 IF (IFHI .EQ. 0) GO TO 260 IF (DZ .EQ. 0) GO TO 280 IF (IZMAX .EQ. 0) GO TO 300 C IF (ITMAX .EQ. 0) ITMAX=LCRLEN NT=ITMAX/LCPI C NTRNC=MIN0(NTRNC,4) NTRNC=MAX0(NTRNC,2) C IF (KBUFF .EQ. 0) KBUFF=5000 C C ===================================================================== C ICC C ===================================================================== C DT = FLOAT(LCPI)*1.E-3 C NX=IXEND-IXBEG+1 CJJ NZ=INT((FLOAT(IZMAX)+0.00001)/DZ) C PI2=3.1415926*2 CALL SAFFTL(NT,NW) NWD2=NW/2 NWP2=NW+2 NWD21=NWD2+1 WLO=FLOAT(IFLO)*PI2 WHI=FLOAT(IFHI)*PI2 DW=PI2/DT/FLOAT(NW) CJJ IW1=INT((WLO+0.00001)/DW)+1 IW1=MAX0(IW1,1) CJJ IW2=INT((WHI+0.00001)/DW)+1 IW2=MIN0(IW2,NWD2) LW=IW2-IW1+1 LW2=LW*2 C NX2=NX*2 C KX = 1 KY = KX + NZ+1 +2*NX KZ = KY + NZ+1 KA = KZ + NZ+1 KBV = KA + LW KB= KBV+ NZ+1 KB=KB+3*NW/2+1 IBLK=1 NTB=NT NWB=NW C 120 IF(NWB.LE.64 .OR. IBLK.GE.5) GO TO 140 IBLK=IBLK+1 NTB=NWB*(1.-1./FLOAT(NTRNC)) CALL SAFFTL(NTB,NWB) KB= KB+ 13+3*NWB/2+1 GO TO 120 CJJ 140 KIZDX = KB + 13 KSEQDX = KIZDX + 100 KC = KSEQDX + 100 KE = KC + NX2*2 KF = KE + NX2*2 KG = KF + NX2*2 KH = KG + NX2*2 KS = KH + NX2*2 KT = KS + NX2*2 C ICC = KT + NX2*2 IF(IDIP.GT.65) ICC = ICC + NX2*10 ICC=ICC+NX ICC=ICC+MIN0(KBUFF*256,2*NX*NZ) C ICCLFT=ICC-KC MXBF=ICCLFT/2/NWP2 MXBF=MAX0(MXBF,100) MXBF=MIN0(MXBF,NX) JCC = KC + 2*NWP2*MXBF ICC = MAX0(ICC,JCC) C IF(ICC.EQ.0) GO TO 320 C C======================================================================= C NORMAL EXIT C======================================================================= C CSIZE = ICC C C PART 3. COMPUTE UNRESERVED BLANK COMMON SIZE IN WORDS (UCSIZE) C C C THIS VALUE IS THE TOTAL NUMBER OF WORDS USED IN UNRESERVED BLANK C COMMON I.E. SCRATCH AREA OR 'SA' FOR SPARC 'SHELLS'. C UCSIZE = 0 C WRITE(IPR,8020) PSIZE, CSIZE, UCSIZE C RETURN C C ================================================================= C ERROR EXIT C ================================================================= C 160 WRITE (IPR, 8040 ) KPNA, KPRNO GO TO 320 C 180 WRITE (IPR, 8060 ) GO TO 320 C 200 WRITE (IPR, 8080 ) GO TO 320 C 220 WRITE (IPR, 8100 ) GO TO 320 C 240 WRITE (IPR, 8120 ) GO TO 320 C 260 WRITE (IPR, 8140 ) GO TO 320 C 280 WRITE (IPR, 8160 ) GO TO 320 C 300 WRITE (IPR, 8180 ) GO TO 320 C C ERROR EXIT C 320 ERCODE = 16 WRITE(IPR,8200) RETURN C C ================================================================= C FORMAT STATEMENTS C ================================================================= C C C 8000 FORMAT(' ** ENTERING JSZM2D ***') C 8020 FORMAT(/5X,'JSZM2D COMPLETED PSIZE = ',I5,' CSIZE = ',I10, + ' UCSIZE = ',I5) C 8040 FORMAT(/,' *** NO CARD(1) FOUND FOR ',A4,I1) C 8060 FORMAT(/,' *** LINE CARD READING ERROR IN ZM2D') C 8080 FORMAT(/,' STARTING DEPTHPOINT MISSING; IT IS REQUIRED') C 8100 FORMAT(/,' ENDING DEPTHPOINT MISSING; IT IS REQUIRED') C 8120 FORMAT(/,' LOWEST FREQENCY MISSING; IT IS REQUIRED') C 8140 FORMAT(/,' HIGHEST FREQENCY MISSING; IT IS REQUIRED') C 8160 FORMAT(/,' Z (DEPTH) STEP SIZE MISSING; IT IS REQUIRED') C 8180 FORMAT(/,' MAXIMUM DEPTH MISSING; IT IS REQUIRED') C 8200 FORMAT (/,' *** ERROR IN JSZM2D CALCULATION ***') C END