CTITLECSCOMP -- SPARC COMMON /P/ SETUP 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK 00020000 CA DESIGNER DANIEL POLAK 00030000 CA LANGUAGE VSFORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 06-19-87 00060000 C REVISED 08-18-87 DJP - INCREASED THE DIMENSIONS OF PROCLC AND00070000 C PROCLI. 00080000 C REVISED 11-06-87 REP - ADD CALL TO CSSDAD TO SETUP KPA FOR 00090000 C EACH PROC & REVISE PROCLC/PROCLI UTILIZATION00100000 C REVISED 07-01-88 ESN - ENSURE THAT KPBUGF IS SET FOR ALL 00110000 C REPITITIONS OF A PROCESS. 00120000 C REVISED 03-10-89 ESN - OPEN FORTRAN FILES WITH NAME OF KPNA, 00130001 C KPRNO, AND KPOCUR. 00140001 C REVISED 04-11-90 RDK - CHANGE OPEN CALL TO REFERENCE SAME 00130001 C FILE ON CRAY. 00140001 CA 00150000 CA 00160000 CA CALL CSCOMP (IPR, IER) 00170000 CA 00180000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00190000 CA 00200000 CA IN IPR I4 PRINT UNIT NUMBER 00210000 CA OUT IER I4 ERROR FLAG, > 1 = ERROR 00220000 CA 00230000 CA 00240000 CA THIS SUBROUTINE BUILDS THE PROTAB ARRAY (PROCESS TABLE) AND 00250000 CA INITIALIZES OTHER VARIABLES IN COMMON /P/. 00260000 CA 00270000 C 00280000 C LOCAL VARIABLES AND CONSTANTS 00290000 C 00300000 C NAME TYPE DESCRIPTION 00310000 C 00320000 C BLANKS CH4 CHARACTER STRING ' ' 00330000 C CARD CH80 SPARC CARD IMAGE 00340000 C DLM CH4 CHARACTER STRING 'DLM=' 00350000 C DLMCRD CH7 CHARACTER STRING '//SEIS.' 00360000 C DLMTR CH2 JCL DELIMITER 00370000 C DUMMF I4 FLAG TO ALLOW DUMMY PROC TO BE USED IN FJPROC 00380000 C LENP I4 LENGTH OF COMMON /P/ IN WORDS 00390000 C NCARDS I4 NUMBER OF SPARC CARDS 00400000 C NKPVAR I4 NUMBER OF KP-VARIABLES 00410000 C NPROCC I4 NUMBER OF PROC CARDS 00420000 C MXPROC I4 MAXIMUM NUMBER OF PROCESSES ALLOWED IN A SPARC JOB 00430000 C NPTAB I4 NUMBER OF PROCESSES IN THE MASTER PROCESS TABLE 00440000 C PRCNDX I4 INDICES OF PROCESSES ON THE PROC CARD IN ALPHABETI- 00450000 C CAL ORDER 00460000 C PROCCD CH80 ARRAY OF PROC CARDS 00470000 C PROCLC CH4 CHARACTER VARIABLES OF THE PROCESSING LIST TABLE 00480000 C PROCLI I4 INTEGER VARIABLES OF THE PROCESSING LIST TABLE 00490000 C PROCN CH4 PROCESS NAME 00500000 C PRUNIT I4 PRINT UNIT NUMBER 00510000 C PTABC CH4 MASTER PROCESS TABLE - CHARACTER VARIABLES 00520000 C PTABI I4 MASTER PROCESS TABLE - INTEGER VARIABLES 00530000 C NPROC I4 TOTAL NUMBER OF ENTRIES IN THE PROCESSING LIST TABLE00540000 C 00550000 SUBROUTINE CSCOMP (IPR, IER) 00560000 C 00570000 IMPLICIT INTEGER (A-Z) 00580000 C 00590000 PARAMETER (INP=1, MXPROC=90, NKPVAR=56) 00600000 C 00610000 PARAMETER (IXNA=1, IXRNO=1, IXOCUR=2, IXBUGF=3, IXPTAB=4) 00620000 C 00630000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 12/07/87 00640000 COMMON /P/ STARTP ( 2) , M00000( 102) 00650000 COMMON /P/ KPNA 00660000 COMMON /P/ KPRNO 00670000 COMMON /P/ KPOCUR 00680000 COMMON /P/ KPA , M00428( 2) 00690000 COMMON /P/ KPDBGN , M00440( 6) 00700000 COMMON /P/ KPFCF , M00468( 5) 00710000 COMMON /P/ KPRTF 00720000 COMMON /P/ KPDRTF , M00496( 2) 00730000 COMMON /P/ KPIBN 00740000 COMMON /P/ KPITSV 00750000 COMMON /P/ KPTAMF 00760000 COMMON /P/ KPLOTF 00770000 COMMON /P/ KPMITF 00780000 COMMON /P/ KPPRNT , M00528( 2) 00790000 COMMON /P/ KPBUGF , M00540( 44) 00800000 COMMON /P/ MCBRNF 00810000 COMMON /P/ MCEOFF 00820000 COMMON /P/ MCMITF , M00728( 3) 00830000 COMMON /P/ MCIKPE 00840000 COMMON /P/ MCNKP 00850000 COMMON /P/ MCIUSM , M00752( 10) 00860000 COMMON /P/ MCNTAM , M00796( 22) 00870000 COMMON /P/ MCTANS ( 20) , M00888( 21) 00880000 COMMON /P/ MCMMOP , M01052( 20) 00890000 COMMON /P/ MCCOLR 00900000 COMMON /P/ MCPRTY , M01140( 20) 00910000 COMMON /P/ APUNN1 00920000 COMMON /P/ APUNN2 00930000 COMMON /P/ APUNN3 00940000 COMMON /P/ APUNN4 00950000 COMMON /P/ APUNN5 00960000 COMMON /P/ APUNN6 00970000 COMMON /P/ APUNN7 00980000 COMMON /P/ APREG1 00990000 COMMON /P/ APREG2 01000000 COMMON /P/ APREG3 01010000 COMMON /P/ APREG4 , M01264( 3) 01020000 COMMON /P/ PTNCON 01030000 COMMON /P/ PTNP 01040000 COMMON /P/ PTNCW , M01288( 3) 01050000 COMMON /P/ PTWBLK , M01304 01060000 COMMON /P/ PTTHL 01070000 COMMON /P/ PTTHLB , M01316( 30) 01080000 COMMON /P/ PROTAB (NKPVAR * MXPROC) 01090000 COMMON /P/ ENDP 01100000 C 01100100 COMMON /SYSTEM/ SYSTEM, SYBYPW, SYLOCF, JAPNMS 01100200 C 01110000 C MASTER PROCESS COMMON 01120000 C 01130000 COMMON /MPTABI/ NPTAB, PTABI(14, 250) 01140000 COMMON /MPTABC/ PTABC(5, 250) 01150000 C 01160000 CHARACTER*4 PTABC 01170000 INTEGER PTABI 01180000 C 01190000 C CHARACTER ARRAYS -- LOCAL 01200000 C 01210000 CHARACTER*80 PROCCD (10) 01220000 CHARACTER*4 PROCLC (6, MXPROC) 01230000 C 01240000 C INTEGER ARRAYS -- LOCAL 01250000 C 01260000 INTEGER PROCLI (15, MXPROC) 01270000 INTEGER PRCNDX (MXPROC) 01280000 C 01290000 C INTEGER VARIABLES 01300000 C 01310000 INTEGER BLANKS 01320000 INTEGER JAPNMS(4) 01320100 C 01330000 C CHARACTER VARIABLES 01340000 C 01350000 CHARACTER*80 CARD 01360000 CHARACTER*4 DLM 01370000 CHARACTER*7 DLMCRD 01380000 CHARACTER*2 DLMTR 01390000 CHARACTER*8 FILEN 01400000 CHARACTER*1 JCL 01410000 CHARACTER*4 PROCN 01420000 C 01430000 C DATA INITIALIZATION 01440000 C 01450000 DATA BLANKS /' '/ 01460000 DATA DLM /'DLM='/ 01470000 DATA DLMCRD /'//SEIS.'/ 01480000 DATA DLMTR /'@^'/ 01490000 DATA JCL /'/'/ 01500000 C 01510000 DUMMF = 1 01520000 IER = 0 01530000 PRUNIT = 7 01540000 C 01550000 C CLEAR THE COMMON AREA 01560000 C 01570000 LENP = 361 + NKPVAR * MXPROC 01580000 CALL ARSET (STARTP, LENP, 0) 01590000 C 01600000 C SET UP THE MASTER PROCESS TABLE 01610000 C 01620000 CALL FJPTAB (IER) 01630000 IF (IER .NE. 0) GO TO 100 01640000 C 01650000 C READ THE DATA CARDS TO FIND PROC CARDS AND BUILD THE PROC TABLE 01660000 C 01670000 CALL FJPROC (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, 01680000 * NCARDS, PROCCD, NPROCC, DUMMF, IPR, IER) 01690000 IF (IER .GE. 2) GO TO 100 01700000 C 01710000 C SET THE CONSTANTS AND THE VARIABLE DEFAULT VALUES 01720000 C 01730000 CALL S1MVCH ('COMMON P', 1, STARTP(1), 1, 8) 01740000 CALL S1MVCH ('ENDP', 1, ENDP, 1, 4) 01750000 MCBRNF = -86 01760000 MCEOFF = 1 01770000 MCMITF = 1 01780000 MCIKPE = 1 01790000 MCNKP = 0 01800000 MCIUSM = 1 01810000 MCNTAM = 20 01820000 MCMMOP = 20 01830000 MCCOLR = 1 01840000 MCPRTY = 1 01850000 APUNN1 = 91 01860000 APUNN2 = 92 01870000 APUNN3 = 93 01880000 APUNN4 = 94 01890000 APUNN5 = 95 01900000 APUNN6 = 96 01910000 APUNN7 = 97 01920000 APREG1 = 28 01930000 APREG2 = 56 01940000 APREG3 = 132 01950000 APREG4 = 400 01960000 PTNCON = 360 01970000 PTNCW = NKPVAR 01980000 PTWBLK = 13030 01990000 PTTHLB = 760 02000000 C 02010000 DO 10 I = 1, MCNTAM 02020000 MCTANS(I) = 1 02030000 C 02040000 10 CONTINUE 02050000 C 02060000 C READ THE DATA CARDS TO DETERMINE THE DEBUG LEVEL FOR EACH PROCESS 02070000 C 02080000 20 READ (INP, 9000, END=50) CARD 02090000 C 02100000 IF (CARD(:1) .EQ. JCL) THEN 02110000 IF (CARD(:7) .NE. DLMCRD) GO TO 20 02120000 C 02130000 C IDENTIFY THE DELIMITER ON THIS CARD 02140000 C 02150000 DO 30 I = 6, 75 02160000 C 02170000 IF (CARD(I:I+3) .EQ. DLM) THEN 02180000 DLMTR = CARD(I+4:I+5) 02190000 GO TO 20 02200000 END IF 02210000 C 02220000 30 CONTINUE 02230000 C 02240000 C STOP READING THE CARDS WHEN THE DELIMITER IS FOUND 02250000 C 02260000 ELSE 02270000 IF (CARD(:2) .EQ. DLMTR) GO TO 50 02280000 C 02290000 C GET THE DEBUG LEVEL ONLY FROM PROCESSES ON THE PROC CARD 02300000 C 02310000 DO 40 I = 1, NPROC 02320000 IF (CARD(:4) .NE. PROCLC(IXNA, I)) GO TO 40 02330000 C 02340000 IF (S1CVBN (CARD, 5, 1) .EQ. PROCLI(IXRNO, I)) THEN 02350000 IF (CARD(10:10) .EQ. '*') PROCLI(IXBUGF, I) = 1 02360000 IF (CARD(10:10) .EQ. '$') PROCLI(IXBUGF, I) = 2 02370000 IF (CARD(10:10) .EQ. '#') PROCLI(IXBUGF, I) = 3 02380000 END IF 02390000 C 02400000 40 CONTINUE 02410000 C 02420000 C READ THE NEXT DATA CARD 02430000 C 02440000 GO TO 20 02450000 C 02460000 END IF 02470000 C 02480000 C INITIALIZE THE PROTAB ARRAY 02490000 C 02500000 50 CONTINUE 02510000 DO 70 I = 1, NPROC 02520000 PROCN = PROCLC (IXNA, I) 02530000 IPTAB = PROCLI(IXPTAB, I) 02540000 C 02550000 C SKIP THE PROCESS IF IT HAS NO PROCESSING MODULE 02560000 C 02570000 IF (PTABI(2, IPTAB) .EQ. 0) GO TO 70 02580000 C 02590000 IF (PROCN .NE. 'BRAN' .AND. PROCN .NE. 'NODE' .AND. 02600000 * PROCN .NE. 'PEND') PRUNIT = PRUNIT + 1 02610000 C 02620000 C ASSIGN THE INITIAL/DEFAULT VALUES FOR THE KP-VARIABLES 02630000 C 02640000 KPNA = BLANKS 02650000 CALL S1MVCH (PROCN, 1, KPNA, 1, 4) 02660000 KPRNO = PROCLI(IXRNO, I) 02670000 KPOCUR = PROCLI(IXOCUR, I) 02680000 CALL CSSDAD (PROCN, KPA, *110) 02690000 KPDBGN = PTABI(5, IPTAB) 02700000 KPFCF = 1 02710000 KPRTF = 255 02720000 KPDRTF = PTABI(6, IPTAB) 02730000 KPIBN = 170 02740000 KPITSV = 187 02750000 KPTAMF = PTABI(9, IPTAB) 02760000 KPLOTF = PTABI(7, IPTAB) 02770000 KPMITF = PTABI(8, IPTAB) 02780000 KPPRNT = PRUNIT 02790000 KPBUGF = PROCLI(IXBUGF, I) 02800000 C 02810000 IF (PROCN .NE. 'BRAN' .AND. PROCN .NE. 'NODE' .AND. 02820001 * PROCN .NE. 'PEND') THEN 02830001 FILEN = ' ' 02840001 CALL S1MVCH (KPNA, 1, FILEN, 1, 4) 02850001 CALL S1BNCV (KPRNO, FILEN, 5, 1) 02860001 IF (KPOCUR .LE. 9) THEN 02870001 CALL S1MVCH ('0', 1, FILEN, 6, 1) 02880001 CALL S1BNCV (KPOCUR, FILEN, 7, 1) 02890001 ELSE 02900001 CALL S1BNCV (KPOCUR, FILEN, 6, 2) 02910001 ENDIF 02920001 IF(SYBYPW.EQ.4) OPEN (PRUNIT,FILE=FILEN) 02930001 IF(SYBYPW.EQ.8) OPEN (PRUNIT) 02930002 ENDIF 02940001 C 02950000 CALL ARMVE (KPNA, PROTAB(MCIKPE), PTNCW) 02960000 MCIKPE = MCIKPE + PTNCW 02970000 MCNKP = MCNKP + 1 02980000 C 02990000 70 CONTINUE 03000000 C 03010000 PTNP = MCNKP 03020000 MCIKPE = 0 03030000 C 03040000 100 RETURN 03050000 C 03060000 C ERRORS 03070000 C 03080000 110 CONTINUE 03090000 WRITE (6, 9900) PROCN 03100000 GO TO 100 03110000 C 03120000 C FORMAT STATEMENTS 03130000 C 03140000 9000 FORMAT (A80) 03150000 9900 FORMAT (/' ERROR - PROCESS NAME (',A4,') NOT FOUND IN TABLE') 03160000 END 03170000