CTITLEJSFRAN -- JOBGEN SPACE ALGORITHM FOR FRAN 00010002 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR S. SVATEK 00020002 CA DESIGNER S. SVATEK 00030002 CA LANGUAGE FORTRAN 00040002 CA SYSTEM IBM AND CRAY 00050002 CA WRITTEN 07-03-80 00060002 CA REVISED 4-27-87 DPH. CONVERT TO CRAY. 00070002 CA 00080002 CA CALL JSFRAN (KPNA,KPRNO,OCCUR,BLKSIZ,PRIMRY,SECDRY, 00090002 CA RLSE,CONTG,ERCODE) 00100002 CA INPUT KPNA = PROCESS NAME A4 00110000 CA INPUT KPRNO = PROCESS NUMBER I4 00120002 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 00130002 CA 00140002 CA I / O BLKSIZ= BLOCK SIZE (BYTES) I4 00150002 CA I / O PRIMRY= PRIMARY ALLOCATION (BLOCKS) I4 00160002 CA I / O SECDRY= SECONDARY ALLOCTION (BLOCKS) I4 00170002 CA I / O RLSE = RELEASE PARAMETER I4 00180002 CA I / O CONTG = CONTIGUOUS SPACE PARAMETER I4 00190002 CA I / O ERCODE= ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 00200002 CA THE REQUIRED PARAMETERS) 00210000 CA 00220002 CA 00230002 CA COMPUTES DISK SPACE ATTRIBUTES FOR FRAN 00240002 C 00250002 C EJECT 00260002 C INTEGER ARRAYS -- LOCAL 00270002 C 00280002 C CARD(20) = DATA CARD ARRAY 00290002 C 00300002 C EJECT 00310000 C 00320002 SUBROUTINE JSFRAN(KPNA,KPRNO,OCCUR,BLKSIZ,PRIMRY,SECDRY, 00330002 * RLSE,CONTG,ERCODE) 00340002 C 00350002 IMPLICIT INTEGER (A-Z) 00360002 C 00370002 C INTEGER ARRAYS -- LOCAL 00380002 INTEGER CARD (20) 00390002 INTEGER WINID ( 4) 00400002 C 00410000 C INTEGER CONSTANTS -- LOCAL 00420002 C 00430002 INTEGER IPR 00440002 INTEGER BLNK 00450002 REAL TRCIPS 00460002 REAL XX 00470002 REAL XTRC 00480002 REAL XFRP 00490002 REAL MXFRLN 00500002 C 00510002 DATA IPR / 6 / 00520002 DATA BLNK /' '/ 00530002 DATA TRCIPS / 4.0 / 00540002 C 00550000 C GET LINE CARD PARAMETERS 00560002 C 00570002 DA = 1 00580002 CALL FORC ('LINE',0,DA,CARD, *150 ) 00590002 C 00600002 RLENG = S1CVBN(CARD,41,5) 00610002 C 00620002 10 DA = 1 00630002 MXFRLN = 0.0 00640002 NFRAME = 0 00650000 NOC = 0 00660002 C 00670002 20 CALL FORC (KPNA, KPRNO, DA, CARD, *100 ) 00680002 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 20 00690002 NOC = NOC + 1 00700002 C 00710002 SDP = S1CVBN (CARD,11,5) 00720002 EDP = S1CVBN (CARD,16,5) 00730002 IF ( EDP .EQ. 0 ) EDP = SDP 00740002 NDP = EDP - SDP 00750000 IF (NDP .LT. 0) NDP = - NDP 00760002 NDP = NDP + 1 00770002 C 00780002 CALL S1MVCH( CARD, 22, ANALID, 1, 4) 00790002 C 00800002 C GET 'ANA' CARD 00810002 C 00820002 DA1 = 1 00830002 C 00840002 30 CALL FORC (KPNA, KPRNO, DA1, CARD, *170 ) 00850000 IF (S1CPCH(CARD, 8, 'ANA', 1, 3) .NE. 0) GO TO 30 00860002 IF (S1CPCH(CARD, 12, ANALID, 1, 4) .NE. 0) GO TO 30 00870002 C 00880002 CALL S1MVCH (CARD, 22, TRCID, 1, 4) 00890002 C 00900002 FRSW = 0 00910002 TRSW = 0 00920002 IF (S1CPCH(CARD, 28, 'POW', 1, 3) .EQ. 0) FRSW = 1 00930002 IF (S1CPCH(CARD, 28, 'AMP', 1, 3) .EQ. 0) FRSW = 2 00940002 IF (S1CPCH(CARD, 28, 'AAP', 1, 3) .EQ. 0) FRSW = 3 00950000 C 00960002 IF (S1CPCH(CARD, 68, 'WTP', 1, 3) .EQ. 0) TRSW = 1 00970002 IF (S1CPCH(CARD, 68, 'FTP', 1, 3) .EQ. 0) TRSW = 2 00980002 C 00990002 NWIN = 0 01000002 C 01010002 DO 40 01020002 * I = 41, 60, 5 01030002 IF (S1CPCH(CARD, I+1, BLNK, 1, 4) .EQ. 0) GO TO 40 01040002 NWIN = NWIN + 1 01050000 CALL S1MVCH(CARD, I+1, WINID(NWIN), 1, 4) 01060002 C 01070002 40 CONTINUE 01080002 C 01090002 C GET 'TRC' CARD 01100002 C 01110002 DA1 = 1 01120002 NTRC = 0 01130002 JTRC = 1 01140002 FOUND = 0 01150000 C 01160002 50 CALL FORC (KPNA, KPRNO, DA1, CARD, *70 ) 01170002 IF (S1CPCH(CARD, 8, 'TRC', 1, 3) .NE. 0) GO TO 50 01180002 IF (S1CPCH(CARD, 12, TRCID, 1, 4) .NE. 0) GO TO 50 01190002 FOUND = 1 01200002 C 01210002 DO 60 01220002 * I = 21, 80, 5 01230002 IF (S1CPCH(CARD, I, ' ', 1, 5) .EQ. 0) GO TO 60 01240002 ITRC = S1CVBN (CARD, I, 5) 01250000 IF (ITRC .GT. 0) NTRC = NTRC + 1 01260002 IF (ITRC .LT. 0) NTRC = NTRC - (ITRC + JTRC) 01270002 C 01280002 60 CONTINUE 01290002 C 01300002 GO TO 50 01310002 C 01320002 70 IF (FOUND .EQ. 0) GO TO 180 01330002 C 01340002 C GET 'WIN' CARDS 01350000 C 01360002 CMWLEN = 0 01370002 C 01380002 DO 90 01390002 * I = 1, NWIN 01400002 CALL S1MVCH (WINID(I), 1, CWINID, 1, 4) 01410002 DA1 = 1 01420002 C 01430002 80 CALL FORC (KPNA, KPRNO, DA1, CARD, *190 ) 01440002 IF (S1CPCH(CARD, 8, 'WIN', 1, 3) .NE. 0) GO TO 80 01450000 IF (S1CPCH(CARD, 12, CWINID, 1, 4) .NE. 0) GO TO 80 01460002 C 01470002 WST = S1CVBN(CARD, 26, 5) 01480002 WEND = S1CVBN(CARD, 31, 5) 01490002 WLEN = WEND - WST 01500002 IF (WLEN .GT. CMWLEN) CMWLEN = WLEN 01510002 WST = S1CVBN(CARD, 41, 5) 01520002 WEND = S1CVBN(CARD, 46, 5) 01530002 WLEN = WEND - WST 01540002 IF (WLEN .GT. CMWLEN) CMWLEN = WLEN 01550000 C 01560002 90 CONTINUE 01570002 C 01580002 C CALCULATE MAX FRAME LEN FOR THIS RANGE 01590002 C 01600002 XX = 0.0 01610002 IF (TRSW .EQ. 1) XX = CMWLEN 01620002 IF (TRSW .EQ. 2) XX = RLENG 01630002 XTRC = (XX / 1000.) * TRCIPS 01640002 XX = FRSW 01650000 XFRP = XX * 7.0 01660002 IF (XTRC .GT. XFRP) XFRP = XTRC 01670002 IF (XFRP .GT. MXFRLN) MXFRLN = XFRP 01680002 C 01690002 C COUNT THE NO. FRAMES 01700002 C 01710002 NFRAME = NFRAME + (NDP * NTRC * NWIN) 01720002 GO TO 20 01730002 C 01740002 100 IF (NOC .EQ. 0) GO TO 160 01750000 C 01760002 C COMPUTE TOTAL OUTPUT SPACE 01770002 C 01780002 110 BLKSIZ = 8192 01790002 PRIMRY = (MXFRLN + 12) * 100 01800002 PRIMRY = (NFRAME * 328 * PRIMRY) / BLKSIZ + 1 01810002 SECDRY = 10 01820002 C 01830002 IF (NFRAME .GT. 0) GO TO 120 01840002 PRIMRY = 0 01850000 SECDRY = 0 01860002 C 01870002 120 RLSE = NO 01880002 GO TO 140 01890002 C 01900002 130 ERCODE = 16 01910002 C 01920002 140 RETURN 01930002 C 01940002 C ERROR MESSAGES 01950000 C 01960002 150 WRITE (IPR, 9000 ) KPNA,KPRNO 01970002 GO TO 130 01980002 C 01990002 160 WRITE (IPR, 9010 ) KPNA,KPRNO 02000002 GO TO 130 02010002 C 02020002 170 WRITE (IPR, 9020 ) KPNA,KPRNO 02030002 GO TO 130 02040002 C 02050000 180 WRITE (IPR, 9030 ) KPNA,KPRNO 02060002 GO TO 130 02070002 C 02080002 190 WRITE (IPR, 9040 ) KPNA,KPRNO,CWINID 02090002 GO TO 130 02100002 C 02110002 C 02120002 9000 FORMAT (/' *** JSSPAC DID NOT FIND LINE CARD') 02130002 C 02140002 9010 FORMAT (/' *** NO RANGE CARD FOUND FOR PROCESS = ',A4,I1) 02150000 C 02160002 9020 FORMAT (/' *** NO "ANA" CARD FOUND FOR PROCESS = ',A4,I1) 02170002 C 02180002 9030 FORMAT (/' *** NO "TRC" CARD FOUND FOR PROCESS = ',A4,I1) 02190002 C 02200002 9040 FORMAT (/' *** NO "WIN" CARD FOUND FOR ',A4,I1,' ID = ',A4) 02210002 END 02220002