CTITLECSPMAP -- PRINT PROCESS MAP WITH DATA SET INFORMATION 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. MCMILLAN 00020000 CA DESIGNER R. MCMILLAN 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 3-13-75 00060000 C REVISED 2-02-76 R. MCMILLAN TO PREVENT ABENDS WHEN SEARCHING 00070000 C BACK IN THE PAGE FOR A BRANCH AND NOT 00080000 C FINDING IT. 00090000 C REVISED 10-15-76 R. MCMILLAN TO CHECK FOR BRANX FOLLOWING NODEX. 00100000 C REVISED 03-09-77 REM. ADD CODE TO RECEIVE DATA SETS. 00110000 C REVISED 06-01-78 REM. CHANGE ABANDON CHECK TO <= -1 AND ADD 00120000 C NOTATION FOR WARNING MESSAGES. 00130000 C REVISED 06-19-78 REM. ADD CODE TO WRITE THE MAP TO A DISK 00140000 C FILE IF "SPARCMAP" DD STATEMENT IS PRESENT. 00150000 C REVISED 09-21-78 REM. ADD "ACCT" AND "LINE" CARDSWITH JOBNAME, 00160000 C DATE AND TIME TO THE "SPARCMAP" FILE. 00170000 C REVISED 07-02-79 SAS. UPGRADED TO PRINT OUT ALL INPUT DATA 00180000 C SET NO.S ON PROCESS FLOWCHART SUMMARY. 00190000 C REVISED 07-16-79 SAS. REFORMATTED PROCESS FLOWCHART SUMMARY 00200000 C ("(T)", "(V)", "(C)", "(B)") 00210000 C REVISED 10-31-79 REM. FIX SEARCH FOR NEW BRANCH. 00220000 C REVISED 11-26-79 REM. CHANGE FOR 7 DIGIT DSN'S. 00230000 C REVISED 12-19-79 REM. FIX TO PRINT TRANSMITTED DSN CORRECTLY. 00240000 C REVISED 12-20-79 REM. BLANK TEMP FIELD BEFORE MOVING DSN #. 00250000 C REVISED 04-07-80 HHL. ADDED CODE TO DO OWN PRINTING OF 00260000 C HEADER ON SECOND CALL OF CSPMAP FROM CSSMRY. 00270000 C REQUIRED SO HEADER CAN BE MOVED TO LEFT OF 00280000 C PERFORATIONS.PROJECT NUMBER ADDED TO HEADER. 00290000 C REVISED 04-24-80 SAS. SIMPLIFIED PROCESSING MAP RECEPTION AND 00300000 C PLOT CODES TO (R) AND (P) ONLY. 00310000 C ALSO ADDED CHECK FOR HOUSTON INSTRUMENTS 00320000 C PLOTTER OUTPUT TYPE. 00330000 C REVISED 05-12-80 HHL. USE DATIME FOR DATE AND TIME INSTEAD OF 00340000 C S1DATE AND S1TIME. 00350000 C REVISED 06-04-80 PKC. ADDED CHECK FOR APPLICON OUTPUT. 00360000 C REVISED 04-13-81 SAS. ADDED 'COMM' COMMENT CARD PRINTOUT TO 00370000 C PROCESS MAP. 00380000 C ALSO ADDED 'OFL' OFFLINE PLOT TO OUTPUT DATA 00390000 C SET OPTIONS. 00400000 C ALSO CORRECTED 'RECEIVE AND PLOT' MESSAGE. 00410000 C REVISED 08-20-81 PKC. CHANGED TO BE ABLE TO PRINT SEVEN DIGIT 00420000 C DATA SET NUMBERS. 00430000 C REVISED 12-14-81 DJP. REMOVED PLOT RECEPTION CODE AND CHANGED TO 00440000 C NEW PLOTTING CODES FOR ONLINE/OFFLINE PLOTTING. 00450000 C REVISED 11-28-83 NTS. MAKE LINE NAME FIELD ACLNAM AS 5A4. 00460000 C CHANGE FORMAT AT # 9130. 00470000 C REVISED 09-18-84 GEM. FIXED PRINTING OF DATA SET NUMBERS WHEN 00480000 C THERE ARE BOTH SIX AND SEVEN DIGIT NUMBERS. 00490000 C REVISED 10-XX-84 REP. VS FORTRAN CONVERSION. 00500000 C REVISED 11-06-84 LBL. DUAL PATH FOR IBM AND CRAY. 00510000 C REVISED 07-09-85 JBC. UPGRAD TO INCLUDE 'ONCOL'. 00520000 C REVISED 06-25-86 ESN. CHANGE COMPARE OF 'SYSTEM' TO 'IBM' FROM 00530000 C 'IBM '. 00540000 C REVISED 12-16-86 REM. SHOW ONFAP, ETC. AS DSN'S TO BE PLOTTED. 00550000 C DELETE CHECK FOR OFESP-NO LONGER USED. 00560000 C REVISED 03-19-87 REM. CHECK KPDSNS FOR I/O DATA SET NUMBERS. 00570000 C REVISED 06-03-87 DJP. MADE THE PRINT UNIT A VARIABLE COMING FROM 00580000 C THE CALLING PROGRAM. 00590000 C REVISED 12-14-87 REP. TAKE OUT REFERENCES TO FAT TABLE. 00600000 C REVISED 01-04-88 REM. ABORT ON INCORRECT NODES/BRANS INSTEAD OF 00610000 C JUST A WARNING. 00620000 C REVISED 03-07-89 ESN. IMPLEMENT SECOND PRINT UNIT. 00630000 C REVISED 03-23-92 ESN. DECREASE WIDTH OF SUMMARY FROM 83 COLUMNS 00640000 C TO 80 COLUMNS (9130 AND 9131 FORMATS). 00650001 CA 00660000 CA 00670000 CA CALL CSPMAP (IPR, JPR) 00680000 CA 00690000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00700000 CA IN IPR I4 PRINT UNIT NUMBER 00710000 CA IN JPR I4 SECOND PRINT UNIT NUMBER 00720000 CA 00730000 CA THIS ROUTINE PRINTS A MAP OF THE PROCESSES. IT GROUPS THE 00740000 CA PROCESSES INTO BRANCHES AND PRINTS THE BRANCHES IN COLUMNS. 00750000 CA THE PRINT OUT IS LIMITED TO 100 ROWS AND 11 COLUMNS OF PROCESSES. 00760000 CA ANY PROCESS THAT WAS ABANDONED WILL HAVE AN "A" PRINTED AFTER IT. 00770000 CA ANY PROCESS THAT ISSUES A WARNING MESSAGE WILL HAVE A "W" PRINTED 00780000 CA AFTER IT. 00790000 C 00800000 C EJECT 00810000 C 00820000 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). 00830000 C 00840000 C TEMP ( 3) = HOLDS AN INPUT DATA SET NO. FROM FAT I4 00850000 C CARD (20) = HOLDS A CARD IMAGE I4 00860000 C HDG (12) = HOLDS HEADING FOR FLOWCHART I4 00870000 C PAGE (100,44) = HOLDS A FULL PAGE OF PRINT I4 00880000 C C (10) = HOLDS OPTIONAL 'COMM' CARD MESSAGE R8 00890000 C 00900000 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00910000 C 00920000 C ABAND = 1 IF ANY PROCESS WAS ABANDONED (0 OTHERWISE) I4 00930000 C AMPSND = CHARACTER STRING " &" L4 00940000 C APAREN = CHARACTER STRING "(A) " L4 00950000 C BAR = CHARACTER STRING " | " L4 00960000 C BLNK = CHARACTER STRING " " L4 00970000 C BPAREN = CHARACTER STRING "(B) " L4 00980000 C BRAN = CHARACTER STRING "BRAN" L4 00990000 C COL = CURRENT COLUMN NUMBER IN "PAGE" I4 01000000 C COL1 = USED TO SEARCH "PAGE" FOR PREVIOUS BRANCH I4 01010000 C CPAREN = CHARACTER STRING "(C) " L4 01020000 C DASH = CHARACTER STRING "----" L4 01030000 C DASH3 = CHARACTER STRING "--- " L4 01040000 C I = DO LOOP VARIABLE I4 01050000 C IDRTF = INDEX IN A PROTAB ENTRY FOR KPRTF I4 01060000 C IDWARN = INDEX IN A PROTAB ENTRY FOR KPWARN I4 01070000 C IHANDL = TEMP OUTPUT DSN HANDLING KEY I4 01080000 C J = DO LOOP VARIABLE I4 01090000 C K = INDEX TO CURRENT PROTAB ENTRY I4 01100000 C KOL = COL SAVE VARIABLE FOR IO PROCESS LOOP I4 01110000 C LAST = INDEX OF LAST PROTAB ENTRY I4 01120000 C MAXROW = MAXIMUM ROW NUMBER USED I4 01130000 C N = TOTAL NO. DATA CARDS FOR A PROCESS I4 01140000 C NCHAR = NUMBER OF CHARACTERS IN HEADING I4 01150000 C NODE = CHARATCER STRING "NODE" L4 01160000 C PEND = CHARATCER STRING "PEND" L4 01170000 C ROW = CURRENT ROW NUMBER IN "PAGE" I4 01180000 C PPAREN = CHARACTER STRING "(P) " L4 01190000 C SRNO = DESIRED KPRNO WHEN SEARCHING BACK THROUGH "PAGE" I4 01200000 C FOR PREVIOUS BRANCH. 01210000 C WARN = 1 IF ANY PROCESS ISSUED A WARNING MESSAGE I4 01220000 C (O OTHERWISE) 01230000 C WPAREN = CHARACTER STRING "(W) " L4 01240000 C EJECT 01250000 C 01260000 C METHOD OF CALCULATION. 01270000 C 01280000 C 1. IF FIRST PROCESS IS NOT A NODE, GO TO STEP 7. 01290000 C 2. PUT NODE IN "PAGE". 01300000 C 3. PUT BRANCH IN "PAGE". 01310000 C 4. IF LAST PROCESS WAS AN I/O PROCESS, GET DSN NUMBER. 01320000 C 5. GET NEXT PROCESS. 01330000 C 6. IF A NODE, GO TO STEP 2. 01340000 C 7. IF A BRAN, GO TO STEP 9. 01350000 C 8. PUT PROCESS IN "PAGE" AND GO TO STEP 4. 01360000 C 9. SEARCH BACK IN "PAGE" UNTIL ANOTHER BRAN WITH SAME KPRNO IS 01370000 C FOUND. USE THIS ROW NUMBER. 01380000 C 10. INCREASE COLUMN COUNTER AND GO TO STEP 8. 01390000 C 01400000 C EJECT 01410000 SUBROUTINE CSPMAP (IPR, JPR) 01420000 C 01430000 IMPLICIT INTEGER (A-Z) 01440000 C 01450000 C 01460000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 3/19/87 01470000 COMMON /P/ STARTP ( 2) , M00000( 28) 01480000 COMMON /P/ ACPROJ 01490000 COMMON /P/ ACLNAM ( 5) , M00124( 11) 01500000 COMMON /P/ ACUSER ( 5) , M00188( 52) 01510000 COMMON /P/ KPNA 01520000 COMMON /P/ KPRNO , M00420( 17) 01530000 COMMON /P/ KPRTF , M00492( 12) 01540000 COMMON /P/ KPWARN , M00544( 5) 01550000 COMMON /P/ KPDSNS , M00568( 17) 01560000 COMMON /P/ MCJOB ( 2) 01570000 COMMON /P/ MCSTEP ( 2) , M00648( 5) 01580000 COMMON /P/ MCBTEM ( 2) , M00676( 2) 01590000 COMMON /P/ MCBDAT ( 2) , M00692( 8) 01600000 COMMON /P/ MCRTF , M00732( 3) 01610000 COMMON /P/ MCNKP , M00748( 134) 01620000 COMMON /P/ PTNCW , M01288( 2) 01630000 COMMON /P/ PTFATL , M01300( 34) 01640000 COMMON /P/ PROTAB ( 2) 01650000 COMMON /P/ ENDP 01660000 C 01670000 COMMON /SYSTEM/ SYSTEM 01680000 COMMON /SYSTEM/ SYBYPW 01690000 COMMON /SYSTEM/ SYLOCF 01700000 C 01710000 COMMON COM(2) 01720000 C 01730000 C INTEGER ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 01740000 C 01750000 INTEGER CARD (20) 01760000 INTEGER PAGE (100,44) 01770000 INTEGER TEMP (3) 01780000 INTEGER XX (35) 01790000 C 01800000 C CHARACTER VARIABLES--LOCAL (INTERNAL TO SUBROUTINE). 01810000 C 01820000 CHARACTER*80 C 01830000 CHARACTER*4 CPGE 01840000 CHARACTER*133 CXX 01850000 CHARACTER*8 DATE 01860000 CHARACTER*8 DDNAME 01870000 CHARACTER*8 DDNM 01880000 CHARACTER*48 HDG 01890000 CHARACTER*8 JOBNAM 01900000 CHARACTER*8 PRSNT 01910000 CHARACTER*8 TIME 01920000 C 01930000 C DATA STATEMENTS 01940000 C 01950000 DATA AMPSND /' &'/ 01960000 DATA APAREN /'(A) '/ 01970000 DATA BAR /' | '/ 01980000 DATA BLNK /' '/ 01990000 DATA BRAN /'BRAN'/ 02000000 DATA DASH /'----'/ 02010000 DATA DASH3 /'--- '/ 02020000 DATA DDNAME /'SPARCMAP'/ 02030000 DATA FCF /0/ 02040000 DATA HDG 02050000 * /'FLOWCHART OF PROCESSES FOR '/ 02060000 DATA NODE /'NODE'/ 02070000 DATA PEND /'PEND'/ 02080000 DATA PPAREN /'(P) '/ 02090000 DATA PRSNT /'PRESENT '/ 02100000 DATA TDUMM /0/ 02110000 DATA WPAREN /'(W) '/ 02120000 DATA X /0/ 02130000 DATA XX /'1 ',34*' '/ 02140000 DATA ZERO /'0000'/ 02150000 C 02160000 C PRINT HEADING 02170000 C 02180000 CALL S1MVCH (ACUSER, 1, HDG, 28, 18) 02190000 C 02200000 C TEST FOR SECOND CALL TO CSPMAP - IF YES, DO INTERNAL PRINTING 02210000 C OF HEADER W/O CALLING UDPHD. THIS IS NECESSARY IN ORDER TO 02220000 C MOVE HEADER TO LEFT OF PAPER PERFORATIONS. 02230000 C 02240000 IF (FCF .EQ. 0) GO TO 5 02250000 CALL DATIME (DATE, TIME, TDUMM) 02260000 C CALL S1TIME (TIME) *** USING DATIME *** 02270000 CALL S1JOB (JOBNAM) 02280000 C 02290000 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) THEN 02300000 WRITE (IPR, 9130) ACLNAM,DATE,TIME,KPRNO,ACUSER,JOBNAM,ACPROJ 02310000 IF (JPR .GT. 0) 02320000 * WRITE (JPR, 9130) ACLNAM,DATE,TIME,KPRNO,ACUSER,JOBNAM,ACPROJ 02330000 ENDIF 02340000 C 02350000 IF (S1CPCH(SYSTEM,1,'CRAY',1,4) .EQ. 0) THEN 02360000 WRITE (IPR, 9131) ACLNAM(1),ACLNAM(2),ACLNAM(3),DATE,TIME,KPRNO,02370000 * ACUSER(1),ACUSER(2),ACUSER(3), JOBNAM, ACPROJ 02380000 IF (JPR .GT. 0) 02390000 * WRITE (JPR, 9131) ACLNAM(1),ACLNAM(2),ACLNAM(3),DATE,TIME,KPRNO,02400000 * ACUSER(1),ACUSER(2),ACUSER(3), JOBNAM, ACPROJ 02410000 ENDIF 02420000 C 02430000 C CHECK FOR 'COMM' CARD MESSAGE 02440000 C 02450000 C CALL ARSET (C, 20, ' ') 02460000 WRITE (C,FMT='(80X)') 02470000 C 02480000 DA = 1 02490000 CALL FORC ('COMM', 0, DA, C, * 3 )02500000 CALL S1MVCH (C, 6, C, 1, 75) 02510000 CALL S1MVCH (' ', 1, C, 76, 5) 02520000 C 02530000 3 WRITE (IPR, 9135) C 02540000 IF (JPR .GT. 0) WRITE (JPR, 9135) C 02550000 GO TO 15 02560000 C 02570000 5 FCF = 1 02580000 C 02590000 NCHAR=49 02600000 10 NCHAR = NCHAR - 4 02610000 IF (S1CPCH(HDG,NCHAR,' ',1,4) .EQ. 0) GO TO 10 02620000 CALL USPHD (2, ACLNAM,'EXEC', 0, HDG, NCHAR+4-1, IPR) 02630000 IF (JPR .GT. 0) 02640000 * CALL USPHD (2, ACLNAM,'EXEC', 0, HDG, NCHAR+4-1, JPR) 02650000 C 02660000 15 IDRTF = (LOC(KPRTF) - LOC(KPNA)) / SYLOCF 02670000 IDWARN = (LOC(KPWARN) - LOC(KPNA)) / SYLOCF 02680000 IDDSNS = (LOC(KPDSNS) - LOC(KPNA)) / SYLOCF 02690000 LAST = PTNCW * MCNKP 02700000 MAXROW = 0 02710000 ABAND = 0 02720000 WARN = 0 02730000 PLTF = 0 02740000 ROW = -1 02750000 COL = 2 02760000 C 02770000 C BLANK THE ENTIRE PAGE 02780000 C 02790000 DO 20 02800000 * I = 1, 100 02810000 C 02820000 DO 20 02830000 * J = 1, 44 02840000 PAGE(I, J) = BLNK 02850000 C 02860000 20 CONTINUE 02870000 C 02880000 K = 1 02890000 IF (PROTAB(K) .NE. NODE) GO TO 140 02900000 C 02910000 C HAVE FOUND A NODE 02920000 C 02930000 30 IF (ROW .EQ. 100) GO TO 70 02940000 ROW = ROW + 2 02950000 PAGE(ROW, COL) = PROTAB(K) 02960000 PAGE(ROW+1, COL) = BAR 02970000 WRITE (CPGE, 9000) PROTAB(K+1) 02980000 CALL S1MVCH(CPGE,1,PAGE(ROW,COL+1),1,4) 02990000 IF (PROTAB(K+IDRTF) .GE. 0) GO TO 40 03000000 PAGE(ROW, COL+2) = APAREN 03010000 ABAND = 1 03020000 GO TO 50 03030000 C 03040000 40 IF (PROTAB(K+IDWARN) .GE. 0) GO TO 50 03050000 PAGE(ROW, COL+2) = WPAREN 03060000 WARN = 1 03070000 C 03080000 C NOW GET BRANCH 03090000 C 03100000 50 K = K + PTNCW 03110000 IF (ROW .EQ. 100) GO TO 70 03120000 ROW = ROW + 2 03130000 IF (PROTAB(K) .NE. BRAN) GO TO 310 03140000 IF (PROTAB(K+1) .NE. PROTAB(K-PTNCW+1)) GO TO 330 03150000 PAGE(ROW, COL) = PROTAB(K) 03160000 WRITE (CPGE, 9000) PROTAB(K+1) 03170000 CALL S1MVCH(CPGE,1,PAGE(ROW,COL+1),1,4) 03180000 IF (PROTAB(K+IDRTF) .GE. 0) GO TO 60 03190000 PAGE(ROW, COL+2) = APAREN 03200000 ABAND = 1 03210000 GO TO 70 03220000 C 03230000 60 IF (PROTAB(K+IDWARN) .GE. 0) GO TO 70 03240000 PAGE(ROW, COL+2) = WPAREN 03250000 WARN = 1 03260000 C 03270000 C CHECK FOR AN I/O PROCESS IN PROC STEP 03280000 C 03290000 70 IF (S1CPCH (MCSTEP, 1, 'PROC', 1, 4) .NE. 0) GO TO 130 03300000 C 03310000 C CHECK KPDSNS FOR I/O NUMBERS 03320000 C 03330000 111 IF (PROTAB(K+IDDSNS) .EQ. 0) GO TO 130 03340000 C 03350000 C LOOP FOR I/O NUMBERS CONTAINED IN BLANK COMMON (KPDSNS) 03360000 C 03370000 N = COM(PROTAB(K+IDDSNS)) 03380000 J = PROTAB(K+IDDSNS) + 2 03390000 KOL = COL 03400000 ROW = ROW + 1 03410000 C 03420000 DO 119 03430000 * I = 1, N 03440000 TEMP(1) = BLNK 03450000 TEMP(2) = BLNK 03460000 TEMP(3) = BLNK 03470000 IF (S1CPCH(COM(J), 2, ZERO, 1, 2) .EQ. 0) GO TO 114 03480000 C 03490000 C HAVE A 6 OR 7 DIGIT NUMBER 03500000 C 03510000 IF (S1CPCH(COM(J), 2, ZERO, 1, 1) .NE. 0) GO TO 113 03520000 CALL S1MVCH (COM(J), 3, TEMP, 1, 6) 03530000 GO TO 115 03540000 C 03550000 113 CALL S1MVCH (COM(J), 2, TEMP, 1, 6) 03560000 CALL S1MVCH (COM(J), 8, TEMP(3), 1, 1) 03570000 GO TO 115 03580000 C 03590000 C HAVE A 5 DIGIT NUMBER 03600000 C 03610000 114 CALL S1MVCH (COM(J), 4, TEMP, 1, 5) 03620000 C 03630000 115 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .NE. 0) GO TO 116 03640000 PAGE(ROW, KOL) = TEMP(1) 03650000 PAGE(ROW, KOL+1) = TEMP(2) 03660000 PAGE(ROW, KOL+2) = TEMP(3) 03670000 GO TO 117 03680000 C 03690000 116 CONTINUE 03700000 CALL S1MVCH(TEMP ,1,PAGE(ROW, KOL ),1,4) 03710000 CALL S1MVCH(TEMP ,5,PAGE(ROW, KOL+1),1,4) 03720000 CALL S1MVCH(TEMP(3),1,PAGE(ROW, KOL+2),1,4) 03730000 C 03740000 117 CONTINUE 03750000 IF (I .GT. 1) CALL S1MVCH (AMPSND, 4, PAGE(ROW, KOL-2), 4, 1) 03760000 C 03770000 IF (KOL .GE. 42) GO TO 120 03780000 KOL = KOL + 4 03790000 C 03800000 118 J = J + 2 03810000 C 03820000 119 CONTINUE 03830000 C 03840000 120 IF (ROW .GT. MAXROW) MAXROW = ROW 03850000 C 03860000 C IS DATA TO BE PLOTTED 03870000 C 03880000 IF (PAGE(ROW-1,COL+2) .NE. BLNK) GO TO 130 03890000 IHANDL = BLNK 03900000 C 03910000 IF (PROTAB(K+IDDSNS) .NE. 0) THEN 03920000 IF (COM(PROTAB(K+IDDSNS)+1) .EQ. 1) IHANDL = PPAREN 03930000 GO TO 125 03940000 END IF 03950000 C 03960000 DA = 1 03970000 CALL FORC (PROTAB(K), PROTAB(K+1), DA, CARD, * 130 )03980000 C 03990000 IF (S1CPCH (CARD, 76, 'OFTAD', 1, 5) .EQ. 0) IHANDL = PPAREN 04000000 IF (S1CPCH (CARD, 76, 'ONFAP', 1, 5) .EQ. 0) IHANDL = PPAREN 04010000 IF (S1CPCH (CARD, 76, 'OFEBR', 1, 5) .EQ. 0) IHANDL = PPAREN 04020000 IF (S1CPCH (CARD, 76, 'OFFAP', 1, 5) .EQ. 0) IHANDL = PPAREN 04030000 IF (S1CPCH (CARD, 76, 'ONESP', 1, 5) .EQ. 0) IHANDL = PPAREN 04040000 IF (S1CPCH (CARD, 76, 'OFCOL', 1, 5) .EQ. 0) IHANDL = PPAREN 04050000 IF (S1CPCH (CARD, 76, 'ONCOL', 1, 5) .EQ. 0) IHANDL = PPAREN 04060000 C 04070000 125 IF (IHANDL .EQ. BLNK) GO TO 130 04080000 PAGE(ROW-1, COL+2) = IHANDL 04090000 IF (IHANDL .EQ. PPAREN) PLTF = 1 04100000 C 04110000 C GET NEXT PROCESS 04120000 C 04130000 130 K = K + PTNCW 04140000 IF (K .GT. LAST) GO TO 210 04150000 IF (PROTAB(K) .EQ. NODE) GO TO 30 04160000 IF (PROTAB(K) .EQ. BRAN) GO TO 160 04170000 C 04180000 C REGULAR PROCESS - PUT IT IN THE PAGE 04190000 C 04200000 140 IF (ROW .EQ. 100 .OR. PROTAB(K) .EQ. PEND) GO TO 130 04210000 ROW = ROW + 2 04220000 IF (ROW .GT. MAXROW) MAXROW = ROW 04230000 C 04240000 150 PAGE(ROW, COL) = PROTAB(K) 04250000 WRITE (CPGE, 9000) PROTAB(K+1) 04260000 CALL S1MVCH(CPGE,1,PAGE(ROW,COL+1),1,4) 04270000 IF (PROTAB(K+IDRTF) .GE. 0) GO TO 60 04280000 PAGE(ROW, COL+2) = APAREN 04290000 ABAND = 1 04300000 GO TO 70 04310000 C 04320000 C HAVE ENDED A BRANCH - MUST SEARCH BACK AND FIND WHERE THIS 04330000 C NEW BRANCH SHOULD GO 04340000 C 04350000 160 IF (ROW .GT. MAXROW) MAXROW = ROW 04360000 SRNO = BLNK 04370000 CALL S1BNCV (PROTAB(K+1), SRNO, 1, 1) 04380000 COL1 = COL 04390000 C 04400000 170 ROW = ROW - 1 04410000 IF (ROW .LE. 0) GO TO 320 04420000 IF (PAGE(ROW, COL1) .EQ. BRAN .AND. 04430000 * PAGE(ROW, COL1+1) .EQ. SRNO) GO TO 190 04440000 IF (PAGE(ROW, COL1) .NE. BAR) GO TO 170 04450000 C 04460000 180 IF (PAGE(ROW-1, COL1) .EQ. NODE) GO TO 170 04470000 C 04480000 COL1 = COL1 - 4 04490000 IF (COL1 .LE. 0) GO TO 320 04500000 GO TO 180 04510000 C 04520000 190 COL = COL + 4 04530000 IF (COL .GE. 44) GO TO 210 04540000 IF (PAGE(ROW-2, COL1) .EQ. NODE) COL1 = COL1 + 2 04550000 C 04560000 DO 200 04570000 * I = COL1, COL 04580000 C 04590000 200 PAGE(ROW-2, I) = DASH 04600000 C 04610000 PAGE(ROW-2, COL) = DASH3 04620000 PAGE(ROW-1, COL) = BAR 04630000 GO TO 150 04640000 C 04650000 C NOW PRINT THE PROCESS MAP 04660000 C 04670000 210 IF (COL .GE. 41) GO TO 250 04680000 C 04690000 C HAVE LESS THAN 11 COLUMNS OF PROCESSES 04700000 C 04710000 DO 220 04720000 * I = 1, MAXROW 04730000 C 04740000 WRITE (IPR, 9010) (PAGE(I, J), J = 1, 40) 04750000 IF (JPR .GT. 0) 04760000 * WRITE (JPR, 9010) (PAGE(I, J), J = 1, 40) 04770000 220 CONTINUE 04780000 C## 04790000 X = X + 1 04800000 IF (X .LE. 1) GO TO 290 04810000 DDNM = DDNAME 04820000 CALL CKDD (DDNM) 04830000 IF (DDNM .NE. PRSNT) GO TO 290 04840000 CALL S1MVCH(HDG, 1, XX, 3, 48) 04850000 CALL FOPMAP (XX) 04860000 XX(1) = BLNK 04870000 DA = 1 04880000 CALL FORC ('ACCT', 0, DA, XX(2), * 290 )04890000 CALL FOPMAP (XX) 04900000 DA = 1 04910000 CALL FORC ('LINE', 0, DA, XX(2), * 290 )04920000 CALL FOPMAP (XX) 04930000 XX(2) = MCJOB(1) 04940000 XX(3) = MCJOB(2) 04950000 XX(4) = BLNK 04960000 XX(5) = MCBDAT(1) 04970000 XX(6) = MCBDAT(2) 04980000 XX(7) = BLNK 04990000 XX(8) = MCBTEM(1) 05000000 XX(9) = MCBTEM(2) 05010000 C 05020000 DO 230 05030000 * I = 10, 22 05040000 C 05050000 230 XX(I) = BLNK 05060000 C 05070000 CALL FOPMAP (XX) 05080000 C 05090000 DO 240 05100000 * I = 1, MAXROW 05110000 WRITE (CXX, 9010) (PAGE(I, J), J = 1, 40) 05120000 CALL S1MVCH(CXX,1,XX,1,133) 05130000 CALL FOPMAP (XX) 05140000 C 05150000 240 CONTINUE 05160000 C## 05170000 C 05180000 GO TO 290 05190000 C 05200000 C 05210000 C HAVE 11 COLUMNS - CANNOT INDENT 05220000 C 05230000 C 05240000 250 DO 260 05250000 * I = 1, MAXROW 05260000 C 05270000 WRITE (IPR, 9020) (PAGE(I, J), J = 1, 44) 05280000 IF (JPR .GT. 0) 05290000 * WRITE (JPR, 9020) (PAGE(I, J), J = 1, 44) 05300000 260 CONTINUE 05310000 C## 05320000 X = X + 1 05330000 IF (X .LE. 1) GO TO 290 05340000 DDNM = DDNAME 05350000 CALL CKDD (DDNM) 05360000 IF (DDNM .NE. PRSNT) GO TO 290 05370000 CALL S1MVCH(HDG, 1, XX, 3, 48) 05380000 CALL FOPMAP (XX) 05390000 XX(1) = BLNK 05400000 DA = 1 05410000 CALL FORC ('ACCT', 0, DA, XX(2), * 290 )05420000 CALL FOPMAP (XX) 05430000 DA = 1 05440000 CALL FORC ('LINE', 0, DA, XX(2), * 290 )05450000 CALL FOPMAP (XX) 05460000 XX(2) = MCJOB(1) 05470000 XX(3) = MCJOB(2) 05480000 XX(4) = BLNK 05490000 XX(5) = MCBDAT(1) 05500000 XX(6) = MCBDAT(2) 05510000 XX(7) = BLNK 05520000 XX(8) = MCBTEM(1) 05530000 XX(9) = MCBTEM(2) 05540000 C 05550000 DO 270 05560000 * I = 10, 22 05570000 C 05580000 270 XX(I) = BLNK 05590000 C 05600000 CALL FOPMAP (XX) 05610000 C 05620000 DO 280 05630000 * I = 1, MAXROW 05640000 WRITE (CXX, 9020) (PAGE(I, J), J = 1, 44) 05650000 CALL S1MVCH(CXX,1,XX,1,133) 05660000 CALL FOPMAP (XX) 05670000 C 05680000 280 CONTINUE 05690000 C## 05700000 C 05710000 GO TO 290 05720000 C 05730000 290 IF (ABAND .EQ. 1) THEN 05740000 WRITE (IPR, 9030) 05750000 IF (JPR .GT. 0) WRITE (JPR, 9030) 05760000 ENDIF 05770000 IF (WARN .EQ. 1) THEN 05780000 WRITE (IPR, 9040) 05790000 IF (JPR .GT. 0) WRITE (JPR, 9040) 05800000 ENDIF 05810000 IF (PLTF .EQ. 1) THEN 05820000 WRITE (IPR, 9060) 05830000 IF (JPR .GT. 0) WRITE (JPR, 9060) 05840000 ENDIF 05850000 C 05860000 300 RETURN 05870000 C 05880000 310 WRITE (IPR, 9100) 05890000 IF (JPR .GT. 0) WRITE (JPR, 9100) 05900000 MCRTF = -20 05910000 GO TO 300 05920000 C 05930000 320 WRITE (IPR, 9110) 05940000 IF (JPR .GT. 0) WRITE (JPR, 9110) 05950000 MCRTF = -23 05960000 GO TO 300 05970000 C 05980000 C 05990000 330 WRITE (IPR, 9120) PROTAB(K-PTNCW+1), PROTAB(K-PTNCW+1) 06000000 IF (JPR .GT. 0) 06010000 * WRITE (JPR, 9120) PROTAB(K-PTNCW+1), PROTAB(K-PTNCW+1) 06020000 MCRTF = -20 06030000 GO TO 300 06040000 C 06050000 C FORMAT STATEMENTS 06060000 C 06070000 9000 FORMAT (I1,3X) 06080000 C 06090000 9010 FORMAT (3X,10(A3,A4,A2,A4)) 06100000 C 06110000 9020 FORMAT (1X,11(A2,A4,A2,A4)) 06120000 C 06130000 9030 FORMAT ('0 (A) MEANS THE PROCESS WAS ABANDONED.') 06140000 C 06150000 9040 FORMAT ('0 (W) MEANS THE PROCESS ISSUED A WARNING MESSAGE.') 06160000 C 06170000 9060 FORMAT ('0 (P) MEANS TO PLOT THE DATA SET.') 06180000 C 06190000 9100 FORMAT ('0*** PROCESS FLOWCHART ABORTED BECAUSE A NODE ', 06200000 * 'IS NOT FOLLOWED BY A BRANCH ***') 06210000 C 06220000 9110 FORMAT ('0*** ERROR - PROCESS FLOWCHART ABORTED. CHECK NODES', 06230000 * ' AND BRANCHES FOR CORRECTNESS. ***') 06240000 C 06250000 9120 FORMAT ('0*** PROCESS FLOWCHART ABORTED BECAUSE NODE',I1, 06260000 * ' IS NOT FOLLOWED BY A BRAN',I1,' ***'/ 06270000 * '0*** CORRECT PROC CARDS BEFORE RESUBMITTING ***') 06280000 C 06290000 9130 FORMAT ('1',80('=')/1X, 5A4, '|',2X, 06300001 * 'FLOWCHART OF PROCESSES FOR',2X,'| DATE ',A8,' TIME ', 06310001 * A8/1X,'EXEC',I1,' PROC ',7X,'|',5X,5A4, 5X, 06320001 * '| JOB ',A8,1X,'PROJECT ',I5/1X,80('=')) 06330001 C 06340000 9131 FORMAT ('1',80('=')/1X, 2A8,A4, '|',2X, 06350000 * 'FLOWCHART OF PROCESSES FOR',2X,'| DATE ',A8,' TIME ', 06360000 * A8/1X,'EXEC',I1,' PROC ',7X,'|',5X,2A8,A4,5X, 06370000 * '| JOB ',A8,1X,'PROJECT ',I5/1X,80('=')) 06380000 C 06390000 9135 FORMAT (1X,A80,/) 06400000 C 06410000 END 06420000