CTITLECPBCOM -- CALCULATE SPACE REQUIRED FOR BLANK COMMON 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DAVE HIMMEL / LOGICAL SOFTWARE INC. 00020000 CA DESIGNER RALPH MCMILLAN 00030000 CA LANGUAGE VS FORTRAN 00040000 CA SYSTEM IBM & CRAY 00050000 CA WRITTEN 05-27-87 00060000 C REVISED 06-22-87 DPH. IF PROCESS NOT IN PTAB, ATTEMPT JSCORE 00070000 C CALCULATION OF SPACE BEFORE SET TO 0. 00080000 C REVISED 07-09-87 DPH. MAKE FORC ARGUMENT 'PARM' INTEGER FOR CRAY 00090000 C COMPATIBILITY. 00100000 C REVISED 08-17-87 REM. INCREASE DIMENSIONS ON PROCLC AND PROCLT. 00110000 C REVISED 08-17-87 REM. IGNORE PROCESS PEND AND CHANGE VARIABLES: 00120000 C NPROCS=MXPROC;TOTENT=NPROC;PROCLT=PROCLI. 00130000 C REVISED 11-04-87 REM. INCREASE DIMENSION OF PROCLI AND INDEX 00140000 C ARRAYS USING VARIABLE NAMES. 00150000 C REVISED 02-04-88 CMP. MODIFY SIN/COS TABLE ALLOCATION TO BE 00160000 C CONSISTENT WITH CSEXEC. 00170000 C REVISED 12-06-89 ESN. REMOVE FFT MEMORY ALLOCATION. 00180000 C REVISED 01-08-91 ESN. SET UP KPNA AND KPRNO. 00190000 CA 00200000 CA CALL CPBCOM (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, IPR, 00210000 CA BCOM, IER) 00220000 CA 00230000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00240000 CA 00250000 CA IN PROCLC C4 PROCESSING LIST TABLE: CHARACTER VARIABLES00260000 CA IN PROCLI I4 PROCESSING LIST TABLE: INTEGER VARIABLES 00270000 CA IN PRCNDX I4 INDEXES OF PROCESSES IN ALPHABETIC ORDER 00280000 CA IN MXPROC I4 MAXIMUM NUMBER OF PROCESSES ALLOWED 00290000 CA IN NPROC I4 TOTAL NUMBER OF ENTRIES IN THE PROCESSING 00300000 CA LIST TABLE 00310000 CA IN IPR I4 PRINTER UNIT NUMBER 00320000 CA OUT BCOM I4 SIZE OF BLANK COMMON - KILOBYTES 00330000 CA OUT IER I4 ERROR CODE (0 = OK, OTHERWISE = ERROR) 00340000 CA 00350000 CA THIS SUBROUTINE ACCUMULATES SPACE REQUIREMENTS FOR BLANK COMMON 00360000 CA OF ALL PROCESSES IN A JOB, INCLUDING AN OVERHEAD BLOCK. 00370000 CA 00380000 CA SEE PROGRAM ISPARC FOR A FULL DESCRIPTION OF ARRAYS PROCLC AND 00390000 CA PROCLI. PROGRAM FJSETP CONTAINS THE DESCRIPTIONS OF PTABI AND 00400000 CA PTABC. 00410000 C 00420000 C EJECT 00430000 C INTEGER ARRAYS -- LOCAL 00440000 C 00450000 C CARD(20) = BUFFER FOR CARD INPUT 00460000 C 00470000 C EJECT 00480000 C 00490000 SUBROUTINE CPBCOM (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, IPR, 00500000 * BCOM, IER) 00510000 C 00520000 IMPLICIT INTEGER (A-Z) 00530000 C 00540000 PARAMETER (IXNA=1, IXRNO=1, IXOCUR=2, IXPTAB=4) 00550000 C 00560000 C COMMON AREA DECLARATIONS 00570000 C 00580000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 6/16/87 00590000 COMMON /P/ STARTP ( 2) , M00000( 11) 00600000 COMMON /P/ LCRL 00610000 COMMON /P/ LCSI 00620000 COMMON /P/ LCPI , M00060( 15) 00630000 COMMON /P/ ACLNAM ( 5) , M00124( 68) 00640000 COMMON /P/ KPNA 00650000 COMMON /P/ KPRNO , M00420( 217) 00660000 COMMON /P/ PTTBLK , M01292( 38) 00670000 COMMON /P/ ENDP 00680000 C 00690000 COMMON /MPTABI/ NPTAB, PTABI(14, 250) 00700000 COMMON /MPTABC/ PTABC(5, 250) 00710000 COMMON /SYSTEM/ SYSTEM, SYBYPW, SYLOCF, JAPNMS 00720000 C 00730000 CHARACTER*4 PTABC 00740000 C 00750000 C INTEGER ARRAYS IN THE ARGUMENT LIST 00760000 C 00770000 INTEGER PROCLI (15, MXPROC) 00780000 INTEGER PRCNDX (MXPROC) 00790000 C 00800000 C CHARACTER ARRAYS IN THE ARGUMENT LIST 00810000 C 00820000 CHARACTER*4 PROCLC (6, MXPROC) 00830000 C 00840000 C INTEGER ARRAYS -- LOCAL 00850000 C 00860000 INTEGER CARD (20) 00870000 INTEGER JAPNMS (4) 00880000 C 00890000 C CHARACTER VARIABLES -- LOCAL 00900000 C 00910000 CHARACTER*8 FFT 00920000 CHARACTER*8 OVR 00930000 C 00940000 C INTEGER VARIABLES -- LOCAL 00950000 C 00960000 INTEGER CRAY 00970000 INTEGER IBM 00980000 INTEGER SYSTEM 00990000 C 01000000 DATA CRAY /'CRAY'/ 01010000 DATA FFT /' FFT'/ 01020000 DATA IBM /'IBM '/ 01030000 DATA OVR /'OVERHEAD'/ 01040000 DATA OVRHED /400/ 01050000 DATA PARM /'PARM'/ 01060000 C 01070000 C PRINT HEADER 01080000 C 01090000 CALL USPHD (2, ACLNAM, 'EXEC', 0, 'BLANK COMMON REQUIREMENTS', 01100000 * 25, IPR) 01110000 WRITE (IPR, 1020) 01120000 C 01130000 C LOOK FOR BLANK COMMON SIZE ON THE PARM CARD 01140000 C 01150000 DA = 1 01160000 CALL FORC (PARM, 0, DA, CARD, *10)01170000 BCOM = S1CVBN (CARD, 16, 5) 01180000 IER = 0 01190000 WRITE (IPR, 1030) BCOM 01200000 GO TO 800 01210000 C 01220000 C NO PARM CARD - COMPUTE BLANK COMMON SPACE REQUIREMENT 01230000 C 01240000 10 BCOM = 0 01250000 C 01260000 DO 100 J=1,NPROC 01270000 K = PRCNDX(J) 01280000 PRCCOM = 0 01290000 C 01300000 C SKIP PROCESS PEND 01310000 C 01320000 IF (PROCLC(IXNA,K) .EQ. 'PEND') GO TO 100 01330000 C 01340000 C CHECK PTABMSTR FOR JSCORE ENTRY 01350000 C 01360000 IPTAB = PROCLI(IXPTAB,K) 01370000 IF (PTABI(3,IPTAB) .LE. 0) THEN 01380000 C 01390000 C SET COMMON P PROCESS ENTRIES 01400000 C 01410000 KPRNO = PROCLI(IXRNO,K) 01420000 CALL ARMVE ( PROCLC(IXNA,K), KPNA, 1 ) 01430000 C 01440000 C COMPUTE BLOCK REQUIREMENTS FOR A PROCESS 01450000 C 01460000 CALL JSCORE(PROCLC(IXNA,K), PROCLI(IXRNO,K), PROCLI(IXOCUR,K),01470000 * PTTBLK, PSIZE, CSIZE, RSIZE, IER) 01480000 IF (IER .EQ. 0) THEN 01490000 BCOM = BCOM + CSIZE 01500000 PRCCOM = CSIZE 01510000 ELSE 01520000 C IF DUMMY ENTRY WAS USED THEN DO NOT PRINT ERROR MSG 01530000 IF (IPTAB .EQ. NPTAB) GO TO 100 01540000 WRITE (IPR, 1010) PROCLC(IXNA,K), IER 01550000 GO TO 800 01560000 ENDIF 01570000 ENDIF 01580000 C 01590000 C PRINT OUT PROCESS AND COMMON REQUIREMENT 01600000 C 01610000 WRITE (IPR, 1040) PROCLC(IXNA,K), PROCLI(IXRNO,K), PRCCOM 01620000 100 CONTINUE 01630000 C 01640000 C ADD COMMON OVERHEAD SPACE 01650000 C 01660000 WRITE (IPR, 1060) OVR, OVRHED 01670000 BCOM = BCOM + OVRHED 01680000 WRITE (IPR, 1050) BCOM 01690000 IER = 0 01700000 C 01710000 800 RETURN 01720000 C 01730000 C FORMAT STATEMENTS 01740000 C 01750000 1010 FORMAT (5X,' *** JSCORE CALCULATION FAILED FOR PROCESS ',A4, 01760000 * ' -- ERROR CODE = ',I8) 01770000 C 01780000 1020 FORMAT (5X,' COMMON SIZE',/, 01790000 * 5X,' PROCESS (KILOBYTES)',/, 01800000 * 5X,' ------- -----------') 01810000 C 01820000 1030 FORMAT (5X,' OVERRIDDEN',5X,I8) 01830000 C 01840000 1040 FORMAT (11X,A4,I1,5X,I8) 01850000 C 01860000 1050 FORMAT (5X,' ==== ',/, 01870000 * 5X,' TOTAL ',I8) 01880000 C 01890000 1060 FORMAT (8X,A8,5X,I8) 01900000 C 01910000 END 01920000