CTITLEJSPAC1 -- SEARCH PROC CARDS FOR A PREVIOUS PROCESS 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. E. MCMILLAN 00000200 CA DESIGNER R. E. MCMILLAN 00000300 CA LANGUAGE FORTRAN 00000400 CA SYSTEM CRAY AND IBM 00000500 CA WRITTEN 01-06-76 00000600 C REVISED 09-21-76 BY R. MCMILLAN TO CHECK OCCURRENCE 00000700 C NUMBER FOR .LT. 0 RATHER THAN 00000800 C .LE. 0. 00000900 C REVISED 11-16-76 BY R. MCMILLAN TO CHANGE OCCURRENCE 00001000 C NUMBER CHECK BACK TO .LE. 0 00001100 C SINCE ALL OCCUR NUMBERS NOW START00001200 C AT 1. 00001300 C REVISED 11-07-77 BY REM. FIX PROBLEM WHERE PROCESS 00001400 C NAME IS IN COL'S 77-80 WITH NO 00001500 C PROCESS NUMBER. 00001600 C REVISED 01-25-85 BY RDK. MODIFIED FOR DUAL PATH IBM/ 00001700 C CRAY. 00001800 C REVISED 09-10-85 BY ESN. RELEASED ON IBM/CRAY. 00001900 CA 00002000 CA 00002100 CA CALL JSPAC1 (KPNA, KPRNO, OCCUR, SKPNA, SKPRNO) 00002200 CA INPUT KPNA = PROCESS TO START SEARCH I 00002300 CA INPUT KPRNO = PROCESS NUMBER FOR KPNA I 00002400 CA INPUT OCCUR = OCCURRENCE OF KPNA WITH KPRNO I 00002500 CA INPUT SKPNA = KPNA TO USE IN SEARCH I 00002600 CA OUTPUT SKPRNO = PROCESS NUMBER IF SKPNA IS FOUND, I 00002700 CA = -1 IF SKPNA IS NOT FOUND 00002800 CA = -2 IF KPNA WITH KPRNO IS NOT FOUND 00002900 CA = -3 IF OTHER FATAL ERROR IS FOUND 00003000 CA 00003100 CA 00003200 CA THIS ROUTINE SEARCHES THE PROC CARDS TO FIND THE PARTICULAR 00003300 CA OCCURRENCE OF KPNA AND KPRNO. FROM THAT POINT IT SEARCHES THE 00003400 CA PROC CARDS IN REVERSE ORDER TO FIND SKPNA IN THE PROCESSING 00003500 CA SEQUENCE. NODES AND BRANCHES ARE CONSIDERED. IF PROCESS SKPNA 00003600 CA IS FOUND, SKPRNO WILL BE SET TO THAT PROCESS NUMBER. IF PROCESS 00003700 CA SKPNA IS NOT FOUND, SKPRNO WILL BE -1. IF PROCESS KPNA WITH 00003800 CA PROCESS NUMBER KPRNO IS NOT FOUND, THEN SKPRNO WILL BE -2. IF 00003900 CA A FATAL ERROR OCCURS, SUCH AS NOT FINDING A NODE CORRESPONDING 00004000 CA TO A BRANCH, THEN SKPRNO WILL BE -3. A MESSAGE IS PRINTED FOR 00004100 CA THIS TYPE OF ERROR. 00004200 C EJECT 00004300 C 00004400 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). 00004500 C 00004600 C CARD = DATA CARD ARRAY A80 00004700 C NUM = CHARACTER ARRAY OF NUMBERS A10 00004800 C 00004900 C 00005000 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00005100 C 00005200 C ANUM = PROCESS NUMBER IN CHARACTER FORM A1 00005300 C DA = DISK ADDRESS I4 00005400 C I = INDEXING VARIABLE I4 00005500 C IPR = PRINT UNIT I4 00005600 C OCCUR1 = TEMPORARY OCCURRENCE NUMBER I4 00005700 C EJECT 00005800 C 00005900 SUBROUTINE JSPAC1 (KPNA, KPRNO, OCCUR, SKPNA, SKPRNO) 00006000 C 00006100 IMPLICIT INTEGER (A-Z) 00006200 C 00006300 C 00006400 C INTEGER ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 00006500 C 00006600 C 00006700 C INTEGER VARIABLES AND CONSTANTS--LOCAL (INTERNAL TO SUBROUTINE). 00006800 INTEGER IPR 00006900 C 00007000 C 00007100 C CHARACTER ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 00007200 CHARACTER*80 CARD 00007300 CHARACTER*10 NUM 00007400 C 00007500 C 00007600 C CHARACTER VARIABLES --LOCAL (INTERNAL TO SUBROUTINE). 00007700 CHARACTER*1 ANUM 00007800 C 00007900 C INITIALIZATION 00008000 DATA IPR / 6/ 00008100 DATA NUM /'0123456789'/ 00008200 C 00008300 C 00008400 DA = 1 00008500 OCCUR1 = OCCUR 00008600 CIX = KPRNO + 1 00008700 C 00008800 C GET A PROC CARD 00008900 C 00009000 20 CALL FORC ('PROC',0,DA,CARD, *8030) 00009100 C 00009200 DO 40 00009300 * I = 6, 77 00009400 IF (S1CPCH(CARD,I,' ',1,1) .EQ. 0) GO TO 40 00009500 IF (S1CPCH(CARD,I,KPNA,1,4) .NE. 0) GO TO 40 00009600 IF (KPRNO .EQ. 0 .AND. 00009700 * (I .EQ. 77 .OR. 00009800 * S1CPCH(CARD,I+4,' ',1,1) .EQ. 0 .OR. 00009900 * S1CPCH(CARD,I+4,',',1,1) .EQ. 0)) GO TO 30 00010000 IF (I .EQ. 77 .OR. 00010100 * S1CPCH(CARD,I+4,NUM,CIX, 1) .NE. 0) GO TO 40 00010200 CX 00010300 CX THE PROCESS HAS BEEN FOUND - CHECK OCCURRENCE NUMBER 00010400 CX 00010500 30 OCCUR1 = OCCUR1 - 1 00010600 IF (OCCUR1 .LE. 0) GO TO 50 00010700 C 00010800 40 CONTINUE 00010900 C 00011000 GO TO 20 00011100 C 00011200 C HAVE FOUND THE CORRECT PROCESS - 00011300 C NOW START LOOKING BACK FOR SKPRNO 00011400 C 00011500 50 I = I - 5 00011600 60 IF (S1CPCH(CARD,I,' ',1,1) .EQ. 0) GO TO 70 00011700 IF (S1CPCH(CARD,I,'BRAN',1,4) .EQ. 0) GO TO 80 00011800 IF (S1CPCH(CARD,I,SKPNA,1,4) .EQ. 0) GO TO 110 00011900 C 00012000 70 I = I - 1 00012100 IF (I .GT. 5) GO TO 60 00012200 DA = DA - 2 00012300 IF (DA .LE. 0) GO TO 120 00012400 CALL FORC ('PROC',0,DA,CARD, *120) 00012500 I = 77 00012600 GO TO 60 00012700 C 00012800 80 CALL S1MVCH(CARD,I+4,ANUM,1,1) 00012900 IF (S1CPCH(CARD,I+4,' ',1,1) .EQ. 0 .OR. 00013000 * S1CPCH(CARD,I+4,',',1,1) .EQ. 0) ANUM = NUM(1:1) 00013100 I = I - 5 00013200 C 00013300 C HAVE A BRANCH - SEARCH FOR CORRESPONDING NODE 00013400 C 00013500 90 IF (S1CPCH(CARD,I,' ',1,1) .EQ. 0) GO TO 100 00013600 IF (S1CPCH(CARD,I,'NODE',1,4) .NE. 0) GO TO 100 00013700 IF (I .NE. 77 .AND. 00013800 * S1CPCH(CARD,I+4,ANUM,1,1) .EQ. 0) GO TO 50 00013900 IF (S1CPCH(ANUM,1,NUM ,1,1) .EQ. 0 .AND. 00014000 * (I .EQ. 77 .OR. 00014100 * S1CPCH(CARD,I+4,' ',1,1) .EQ. 0 .OR. 00014200 * S1CPCH(CARD,I+4,',',1,1) .EQ. 0)) GO TO 50 00014300 C 00014400 100 I = I - 1 00014500 IF (I .GT. 5) GO TO 90 00014600 DA = DA - 2 00014700 IF (DA .LE. 0) GO TO 8040 00014800 CALL FORC ('PROC',0,DA,CARD, *8040) 00014900 I = 77 00015000 GO TO 90 00015100 C 00015200 C RETURN PROCESS NUMBER OF THE PROCESS THAT 00015300 C WAS FOUND 00015400 C 00015500 110 SKPRNO = S1CVBN(CARD,I+4,1) 00015600 GO TO 130 00015700 C 00015800 C SEARCH PROCESS WAS NOT FOUND 00015900 C 00016000 120 SKPRNO = -1 00016100 C 00016200 130 RETURN 00016300 C KPNA WITH KPRNO WAS NOT FOUND ON PROC CARDS 00016400 8030 SKPRNO = -2 00016500 GO TO 130 00016600 C NODE NOT FOUND TO CORRESPOND WITH A BRANCH 00016700 8040 WRITE (IPR, 9040 ) ANUM 00016800 SKPRNO = -3 00016900 GO TO 130 00017000 C 00017100 9040 FORMAT (/' *** PROC CARDS DO NOT CONTAIN A NODE',A1) 00017200 END 00017300