CTITLECPBFSP -- BUILD CPSPCL SUBROUTINE 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK 00020000 CA DESIGNER DANIEL POLAK 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM 00050000 CA WRITTEN 04-24-87 00060000 C REVISED 08/20/87 REM. ADD MXPROC AND CHANGE VARIABLE NAMES. 00070000 C REVISED 11/02/87 REM. EXTEND FORMAT STMTS SO EACH RECORD IS 80 00080000 C BYTES. INCREASE DIMENSION OF PROCLI AND 00090000 C USE VARIABLES FOR INDEXING. 00100000 C REVISED 12/02/87 REP. CHANGED TO NOT DUPLICATE PROCESS. 00110000 C REVISED 12/11/87 REP. ADD PRCNDX TO ARG LIST AND FIX ERROR WHEN 00120004 C DUPLICATE DUMMY PTAB ENTRIES EXIST. 00130004 CA 00140004 CA CALL CPBFSP (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, UNIT) 00150003 CA 00160000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00170000 CA 00180000 CA IN PROCLC CH4 CHARACTER VARIABLES OF THE PROCESSING LIST00190000 CA IN PROCLI I4 INTEGER VARIABLES OF THE PROCESSING LIST 00200000 CA IN PRCNDX I4 ALPHABETIC INDEX TO PROCLC/PROCLI 00210003 CA IN MXPROC I4 MAXIMUM NUMBER OF PROCESSES ALLOWED 00220000 CA IN NPROC I4 NUMBER OF PROCESSES 00230000 CA IN UNIT I4 FORTRAN I/O UNIT NUMBER FOR SOURCE FILE 00240000 CA 00250000 CA THIS SUBROUTINE BUILDS THE FORTRAN SOURCE CODE FOR SUBROUTINE 00260000 CA CPSPCL. 00270000 CA 00280000 C EJECT 00290000 C 00300000 SUBROUTINE CPBFSP (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, UNIT) 00310003 C 00320000 IMPLICIT INTEGER (A-Z) 00330000 C 00340000 PARAMETER (IXNA=1, IXPTAB=4) 00350000 C 00360000 C COMMON AREA DECLARATIONS 00370000 C 00380000 COMMON /MPTABI/ NPTAB, PTABI(14, 250) 00390000 COMMON /MPTABC/ PTABC(5, 250) 00400000 CHARACTER*4 PTABC 00410000 INTEGER PTABI 00420000 C 00430000 C CHARACTER ARRAY IN PARAMETER LIST 00440003 C 00450000 CHARACTER*4 PROCLC (6, MXPROC) 00460000 C 00470000 C INTEGER ARRAY IN THE PARAMETER LIST 00480000 C 00490000 INTEGER PROCLI (15, MXPROC) 00500000 INTEGER PRCNDX (MXPROC) 00510003 C 00520003 C CHARACTER VARIABLES 00530003 C 00540003 CHARACTER*4 NAMSVE 00550003 C 00560000 C PROGRAM PROLOGUE 00570000 C 00580000 WRITE (UNIT, 1000) 00590000 C 00600000 C PROGRAM BODY (NO DUPLICATES) 00610000 C 00620000 NAMSVE = '@#$%' 00630003 DO 10 J = 1, NPROC 00640003 I = PRCNDX(J) 00650004 IPTAB = PROCLI(IXPTAB, I) 00660004 IF (PTABI(1, IPTAB) .GT. 0 .AND. 00670004 + PROCLC(IXNA, I) .NE. NAMSVE ) THEN 00680004 WRITE (UNIT, 1010) PROCLC(IXNA, I), PROCLC(IXNA, I) 00690004 NAMSVE = PROCLC(IXNA, I) 00700004 END IF 00710000 10 CONTINUE 00720000 C 00730000 C PROGRAM EPILOGUE 00740000 C 00750000 WRITE (UNIT, 1020) 00760000 C 00770000 RETURN 00780000 C 00790000 C FORMAT STATEMENTS 00800000 C 00810000 1000 FORMAT (' SUBROUTINE CPSPCL (PROCN, *)',46(' ')/ 00820000 * ' CHARACTER*4 PROCN',56(' ')/ 00830000 * ' IF (0 .EQ. 1) CALL CPPREP',49(' ')) 00840000 C 00850000 1010 FORMAT (' IF (PROCN .EQ. ''',A4,''') THEN',47(' ')/ 00860000 * ' CALL SP',A4,63(' ')/ 00870000 * ' GO TO 10',66(' ')/ 00880000 * ' END IF',68(' ')) 00890000 C 00900000 1020 FORMAT (' RETURN1',67(' ')/ 00910000 * ' 10 RETURN',68(' ')/ 00920000 * ' END',71(' ')) 00930000 END 00940000