CTITLECPPROC -- FOREGROUND PREP ROUTINE TO SETUP PROCESS TABLE 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK (D. HIMMEL, 6/1/87 ADAPTED FROM FJPROC) 00020000 CA DESIGNER DANIEL POLAK 00030000 CA LANGUAGE VSFORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 08-30-84 00060000 C REVISED 06-18-86 REM. COPIED R&D PROGRAM FGCARD AND MADE 00070000 C SIGNIFICANT CHANGES. 00080000 C REVISED 05-05-87 REM. ADD CODE TO COPY PTABMSTR VARIABLES TO 00090000 C PROCLC TABLES USING NEW FORTRAN PTABMSTR. 00100000 C REVISED 05-18-87 REM. CORRECT RETRIEVAL OF KPDBG FROM PTABI ARRAY00110000 C REVISED 05-18-87 DJP. ADDED THE PREP MODULE FLAG FROM PTABMSTR 00120000 C TO THE PROCLT ARRAY AND THE PRINTER UNIT 00130000 C NUMBER TO THE ARGUMENT LIST. 00140000 C REVISED 06-01-87 DPH. ADAPTED FROM FJPROC IN ORDER TO READ CARDS 00150000 C WITH FORC INSTEAD OF FROM FT01F001. 00160000 C REVISED 08-17-87 REM. INCREASE DIMENSIONS OF PROCLC AND PROCLT. 00170000 C REVISED 09-01-87 REM. CHANGE VARIABLE NAMES:NPROCS TO MXPROC;. 00180000 C TOTENT TO NPROC;PROCLT TO PROCLI. 00190000 C REVISED 11-04-87 REM. INCREASE DIMENSION OF PROCLI AND INDEX 00200000 C ARRAYS USING VARIABLE NAMES. 00210000 C REVISED 12-01-87 REM. CHANGE FIRST OCCURRENCE CHECK FROM 0 TO 1. 00211000 CA 00220000 CA CALL CPPROC (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, NCARDS, 00230000 CA * PROCCD, NPROCC, IPR, IER) 00240000 CA 00250000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00260000 CA 00270000 CA OUT PROCLC CH4 PROCESSING LIST TABLE: CHARACTER VARIABLES00280000 CA OUT PROCLI I4 PROCESSING LIST TABLE: INTEGER VARIABLES 00290000 CA OUT PRCNDX I4 INDEXES OF PROCESSES IN ALPABETIC ORDER 00300000 CA IN MXPROC I4 MAXIMUM NUMBER OF PROCESSES ALLOWED 00310000 CA OUT NPROC I4 TOTAL NUMBER OF ENTRIES PLACED INTO THE 00320000 CA PROCESSING LIST TABLE 00330000 CA OUT NCARDS I4 TOTAL NUMBER OF CARDS READ 00340000 CA OUT PROCCD CH80 10 ELEMENT ARRAY TO HOLD PROC CARDS 00350000 CA OUT NPROCC I4 TOTAL NUMBER OF PROC CARDS (MAY EXCEED 10)00360000 CA IN IPR I4 PRINTER UNIT NUMBER 00370000 CA IN/OUT IER I4 ERROR FLAG 00380000 CA 00390000 CA 00400000 CA THIS SUBROUTINE READ THE SPARC DATA CARD FILE AND BUILDS THE 00410000 CA PROCESSING LIST TABLE BASED UPON THE PROCESSES CODED ON THE 00420000 CA 'PROC' CARD FOR FOREGROUND PREPS. IT ALSO SAVES UP TO 10 PROC 00430000 CA CARDS IN ARRAY PROCCD. 00440000 CA 00450000 CA SEE PROGRAM ISPARC FOR FULL DESCRIPTION OF ARRAYS PROCLC AND 00460000 CA PROCLI. PROGRAM FJSETP CONTAINS THE DESCRIPTIONS OF PTABC AND 00470000 CA PTABI. 00480000 C 00490000 SUBROUTINE CPPROC (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, NCARDS,00500000 * PROCCD, NPROCC, IPR, IER) 00510000 C 00520000 IMPLICIT INTEGER (A-Z) 00530000 C 00540000 PARAMETER (IXNA=1, IXMODE=2, IXRNO=1, IXOCUR=2, IXPTAB=4) 00550000 C 00560000 C COMMON AREA DECLARATIONS 00570000 C 00580000 COMMON /MPTABI/ NPTAB, PTABI(14, 250) 00590000 COMMON /MPTABC/ PTABC(5, 250) 00600000 CHARACTER*4 PTABC 00610000 INTEGER PTABI 00620000 C 00630000 C INTEGER ARRAYS IN THE PARAMETER LIST 00640000 C 00650000 INTEGER PRCNDX (MXPROC) 00660000 INTEGER PROCLI (15, MXPROC) 00670000 C 00680000 C CHARACTER ARRAYS IN THE PARAMETER LIST 00690000 C 00700000 CHARACTER*80 PROCCD (10) 00710000 CHARACTER*4 PROCLC (6, MXPROC) 00720000 C 00730000 C CHARACTER VARIABLES AND CONSTANTS -- LOCAL 00740000 C 00750000 CHARACTER*4 ACCT 00760000 CHARACTER*80 BLANKS 00770000 CHARACTER*80 CARD 00780000 CHARACTER*4 DLM 00790000 CHARACTER*7 DLMCRD 00800000 CHARACTER*2 DLMTR 00810000 CHARACTER JCL 00820000 CHARACTER*4 KPNA 00830000 CHARACTER*4 PROC 00840000 C 00850000 DATA ACCT /'ACCT'/ 00860000 DATA BLANKS /' '/ 00870000 DATA DLM /'DLM='/ 00880000 DATA DLMCRD /'//SEIS.'/ 00890000 DATA DLMTR /' '/ 00900000 DATA JCL /'/'/ 00910000 DATA PROC /'PROC'/ 00920000 C 00930000 C INITIALIZATION 00940000 C 00950000 IER = 0 00960000 NULIB = 0 00970000 NPROC = 0 00980000 NCARDS = 0 00990000 NPROCC = 0 01000000 C 01010000 C READ THE DATA CARDS LOOKING FOR THE PROC CARDS 01020000 C 01030000 DA = 1 01040000 10 CALL FORC ('PROC', 0, DA, CARD, *130) 01050000 NCARDS = NCARDS + 1 01060000 NPROCC = NPROCC + 1 01070000 IF (NPROCC .LE. 10) PROCCD(NPROCC) = CARD 01080000 C 01090000 C DECODE THE PROC CARD -- BUILDING THE PROCESSING LIST 01100000 C 01110000 START = 5 01120000 END = 0 01130000 C 01140000 100 NPROC = NPROC + 1 01150000 IF (NPROC .GT. MXPROC) GO TO 200 01160000 CALL FGFPNA (CARD, START, END, PROCLC(IXNA, NPROC), 01170000 * PROCLI(IXRNO, NPROC)) 01180000 IF (END .EQ. 1) THEN 01190000 NPROC = NPROC - 1 01200000 GO TO 10 01210000 END IF 01220000 C 01230000 DO 110 J = 3, 15 01240001 PROCLI(J, NPROC) = 0 01250000 C 01260000 110 CONTINUE 01270000 C 01280000 PROCLI(IXOCUR, NPROC) = 1 01290000 PROCLC(IXMODE, NPROC) = BLANKS(:4) 01291000 IF (NPROC .EQ. 1) GO TO 100 01300000 C 01310000 C UPDATE THE OCCURENCE NUMBER 01320000 C 01330000 ENDTRY = NPROC - 1 01340000 C 01350000 DO 120 J = 1, ENDTRY 01360000 IF (PROCLC(IXNA, J) .EQ. PROCLC(IXNA, NPROC) .AND. 01370000 * PROCLI(IXRNO, J) .EQ. PROCLI(IXRNO, NPROC)) 01380000 * PROCLI(IXOCUR, NPROC) = PROCLI(IXOCUR, NPROC) + 1 01390000 C 01400000 120 CONTINUE 01410000 C 01420000 C NEXT PROCESS ON THE PROC CARD 01430000 C 01440000 GO TO 100 01450000 C END OF DATA CARDS 01460000 130 CONTINUE 01470000 C 01480000 IF (NPROC .EQ. 0) GO TO 210 01490000 C 01500000 C SORT THE PROC NAMES ALPHABETICALLY 01510000 C 01520000 DO 140 I = 1, NPROC 01530000 PRCNDX(I) = I 01540000 140 CONTINUE 01550000 C 01560000 IF (NPROC .EQ. 1) GO TO 190 01570000 ENDLUP = NPROC - 1 01580000 C 01590000 DO 160 N = 1, NPROC 01600000 XCHANG = 0 01610000 C 01620000 DO 150 NA = 1, ENDLUP 01630000 IF (PROCLC(IXNA, PRCNDX(NA)) .LE. 01640000 * PROCLC(IXNA, PRCNDX(NA+1))) GO TO 150 01650000 NEWNDX = PRCNDX(NA) 01660000 PRCNDX(NA) = PRCNDX(NA+1) 01670000 PRCNDX(NA+1) = NEWNDX 01680000 XCHANG = 1 01690000 C 01700000 150 CONTINUE 01710000 C 01720000 C CHECK NEXT PROCLI PAIR 01730000 C 01740000 IF (XCHANG .EQ. 0) GO TO 190 01750000 C 01760000 160 CONTINUE 01770000 C 01780000 C NOW GET INDEX INTO PTABMSTR 01790000 C 01800000 190 J = 1 01810000 C******************************************* 01820000 C 01830000 C FIND PROCESS IN MASTER PTABMSTR TABLE 01840000 C 01850000 DO 450 I = 1, NPROC 01860000 KPNA = PROCLC(IXNA, PRCNDX(I)) 01870000 C 01880000 310 IF (KPNA .EQ. PTABC(1,J)) GO TO 320 01890000 C 01900000 C IF J IS AT THE MAX VALUE OF NPTAB, IT IS POINTING TO THE DUMMY 01910000 C ENTRY AND THE PROCESS MUST BE UNKNOWN. 01920000 C 01930000 IF (J .EQ. NPTAB) GO TO 330 01940000 C 01950000 C SINCE PTABC IS IN ALPHABETICAL ORDER, IF KPNA IS LESS THAN 01960000 C THE PTABC VALUE WE MUST USE THE DUMMY ENTRY. 01970000 C 01980000 IF (KPNA .LT. PTABC(1,J)) GO TO 330 01990000 C 02000000 C NOW INCREMENT J TO THE NEXT PROCESS IN THE MASTER TABLE 02010000 C 02020000 J = J + 1 02030000 GO TO 310 02040000 C 02050000 C WE HAVE FOUND THE PROCESS SO: SAVE THE INDEX 02060000 C 02070000 320 PROCLI(IXPTAB,PRCNDX(I)) = J 02080000 GO TO 450 02090000 C 02100000 C PROCESS IS NOT FOUND SO RETRIEVE FOLLOWING VALUES FROM DUMMY 02110000 C ENTRY: USE DUMMY ENTRY 02120000 C 02130000 330 PROCLI(IXPTAB,PRCNDX(I)) = NPTAB 02140000 GO TO 450 02150000 C 02160000 450 CONTINUE 02170000 C 02180000 RETURN 02190000 C 02200000 200 WRITE (IPR, 9050) MXPROC 02210000 IER = 2506 02220000 GO TO 190 02230000 C 02240000 210 WRITE (IPR, 9060) 02250000 IER = 2507 02260000 GO TO 190 02270000 C 02280000 C FORMAT STATEMENTS 02290000 C 02300000 9000 FORMAT (A80) 02310000 C 02320000 9010 FORMAT (A7) 02330000 C 02340000 9050 FORMAT (/5X,'*** THE NUMBER OF PROCESSES EXCEEDS ARRAY ', 02350000 * 'SIZE LIMIT OF',I3,' SEE PROGRAMMER FOR SOFTWARE UPDATE') 02360000 C 02370000 9060 FORMAT (/5X,'*** NO PROC CARDS FOUND OR NO PROCESSES FOUND ON ', 02380000 * 'THE PROC CARD') 02390000 END 02400000