CTITLEJSPRCP - 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 CRAY/IBM CA WRITTEN 06-07-90 CA CA CA CALL JSPRCP (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 COMPUTES THE PROGRAM SIZE (PSIZE) AND AMOUNT OF BLANK COMMON CA (CSIZE) NEEDED BY SPARC PROCESS PRCP REQUIRING SPECIAL CA CALCULATIONS. C C************************************************************** C * C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE * C * C FORC S1CVBN S1CPCH USCHFT SAVKGET * C * C************************************************************** C C EJECT C SUBROUTINE JSPRCP (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 DX DATA FCF / 1 / DATA IPR / 98 / DATA THL / 190 / C WRITE ( IPR, 9010 ) C C GET LINE CARD PARAMETERS 00710000 C 00720000 DA = 1 CALL FORC ( 'LINE', 0, DA, CARD, *130 ) C 00750000 LCRLEN = S1CVBN ( CARD,41,5 ) LCSI = S1CVBN ( CARD,46,5 ) LCPI = S1CVBN ( CARD,51,5 ) IF (LCPI .EQ. 0) LCPI = LCSI C 00800010 C 00850010 NS = LCRLEN / LCPI C C ====================================================================== C INITIALIZATION C ====================================================================== C PSIZE = 20 C ICC = 0 C C ====================================================================== C READ INPUT CARD (1) C ====================================================================== C DAC = 1 100 CONTINUE CALL FORC ( KPNA, KPRNO, DAC, CARD, *120 ) IF (S1CPCH ( CARD,8,' ',1,3 ) .NE. 0) GO TO 100 C IXBEG = S1CVBN ( CARD,11,5 ) IXEND = S1CVBN ( CARD,16,5 ) CALL USCHFT ( CARD, 21, 5, DX ) C IF (IXBEG .EQ. 0) GO TO 140 IF (IXEND .EQ. 0) GO TO 150 IF (DX .EQ. 0.0) GO TO 160 C IF (IXEND .GE. IXBEG) THEN IXINC = 1 ELSE IXINC = -1 ENDIF C C ====================================================================== C READ INPUT CARD 'MOD' C ====================================================================== C DAC = 1 110 CONTINUE CALL FORC ( KPNA, KPRNO, DAC, CARD, *170 ) IF (S1CPCH ( CARD,8,'MOD',1,3 ) .NE. 0) GO TO 110 C C NUMH = S1CVBN ( CARD,11,5 ) IF (NUMH .EQ. 0) GO TO 180 C C ===================================================================== C ICC C ===================================================================== C KA = 1 C CC WRITE ( IPR, 9100 ) IXBEG, IXEND, IXINC, DX, NUMH C CALL SAVKGET ( IXBEG, IXEND, IXINC, DX, NUMH, NXMOD, INDXA, INDXB 1 , KA, KB, KC, KD, KE, KF, KG, KH, KO, KP, KQ, KR, KS, KT, ICC, 2 KPNA, KPRNO, CARD, IABT, IPR ) C ICC = MAX0 ( ICC,KC+2*NS ) C CC WRITE(IPR,9000)KA,KB,KC,KD,KE,KF,KG,KH,KO,KP,KQ,KR,KS,KT,ICC 9000 FORMAT(' KA =',I8,/, 1 ' KB =',I8,/, 2 ' KC =',I8,/, 3 ' KD =',I8,/, 4 ' KE =',I8,/, 5 ' KF =',I8,/, 6 ' KG =',I8,/, 7 ' KH =',I8,/, 8 ' KO =',I8,/, 9 ' KP =',I8,/, . ' KQ =',I8,/, 1 ' KR =',I8,/, 2 ' KS =',I8,/, 3 ' KT =',I8,/, 4 ' ICC=',I8) C C IF (ICC .EQ. 0) GO TO 190 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, 9020 ) PSIZE, CSIZE, UCSIZE C RETURN C C ================================================================= C ERROR EXIT C ================================================================= C 120 CONTINUE WRITE ( IPR, 9030 ) KPNA, KPRNO GO TO 190 C 130 CONTINUE WRITE ( IPR, 9040 ) GO TO 190 C 140 CONTINUE WRITE ( IPR, 9050 ) GO TO 190 C 150 CONTINUE WRITE ( IPR, 9060 ) GO TO 190 C 160 CONTINUE WRITE ( IPR, 9070 ) GO TO 190 C 170 CONTINUE WRITE ( IPR, 9080 ) KPNA, KPRNO GO TO 190 C 180 CONTINUE WRITE ( IPR, 9090 ) C C ERROR EXIT C 190 CONTINUE ERCODE = 16 WRITE ( IPR, 9110 ) RETURN C C ================================================================= C FORMAT STATEMENTS C ================================================================= C C C 9010 FORMAT(' ** ENTERING JSPRCP ***') C 9020 FORMAT(/5X,'JSPRCP COMPLETED PSIZE = ',I5,' CSIZE = ',I10, 1 ' UCSIZE = ',I5) C 9030 FORMAT(/,' *** NO CARD(1) FOUND FOR ',A4,I1) C 9040 FORMAT(/,' *** LINE CARD READING ERROR IN PRCP') C 9050 FORMAT(/,' STARTING DEPTHPOINT MISSING; IT IS REQUIRED') C 9060 FORMAT(/,' ENDING DEPTHPOINT MISSING; IT IS REQUIRED') C 9070 FORMAT(/,' TRACE SPACING MISSING; IT IS REQUIRED') C 9080 FORMAT(/,' *** NO (MOD) CARD FOUND FOR ',A4,I1) C 9090 FORMAT(/,' NUMBER OF HORIZON MISSING; IT IS REQUIRED') C 9100 FORMAT(/,' IXBEG,IXEND =',2I5,' IXINC =',I3,'DX =',F8.3,'NUMH =', 1 I3) C 9110 FORMAT (/,' *** ERROR IN JSPRCP CALCULATION ***') C END