CTITLECSPROC -- DEVELOP A LIST OF PREVIOUS PROCESSES 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. MCMILLAN 00000200 CA DESIGNER R. MCMILLAN 00000300 CA LANGUAGE VS FORTRAN 00000401 CA SYSTEM IBM AND CRAY 00000501 CA WRITTEN 3-09-77 00000600 C REVISED 3-21-77 REM. TAKE WRIT OUT OF LIST OF PROCESSES. 00000700 C REVISED 4-18-77 REM. TO FIX ERROR IN REVERSING THE ORDER 00000800 C WHEN THERE IS ONLY 1 PROCESS. 00000900 C REVISED 12-05-84 RDK. MODIFIED FOR DUAL IBM/CRAY. 00001000 CA 00001100 CA 00001200 CA CALL CSPROC (INDEX, &STMT) 00001300 CA INPUT INDEX = FORTRAN INDEX IN PROTAB FOR A GIVEN I4 00001400 CA PROCESS 00001500 CA OUTPUT &STMT = ERROR RETURN 00001600 CA 00001700 CA 00001800 CA THIS ROUTINE OBTAINS A LIST OF ALL PREVIOUS PROCESSES. THE LIST 00001900 CA IS BUILT IN THE UNRESERVED SCRATCH MEMORY. THE FIRST WORD IS 00002000 CA THE NUMBER OF PROCESSES IN THE LIST. EACH ENTRY IN THE LIST 00002100 CA CONSISTS OF TWO WORDS CONTAINING KPNA AND KPRNO. WHEN NOT ENOUGH 00002200 CA SCRATCH MEMORY IS AVAILABLE FOR THE ENTIRE LIST, A PARTIAL LIST 00002300 CA IS FORMED AND THE ERROR RETURN IS TAKEN. 00002400 CA 00002500 C 00002600 C EJECT 00002700 C 00002800 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00002900 C 00003000 C BRAN = CHARACTER STRING "BRAN" L4 00003100 C IC = INDEX TO BLANK COMMON I4 00003200 C IND1 = INDEX USED TO SORT PROCESSES I4 00003300 C IND2 = INDEX USED TO SORT PROCESSES I4 00003400 C INIBN = INDEX IN A PROTAB ENTRY FOR KPIBN I4 00003500 C NOWDS = NUMBER OF WORDS OF UNRESERVED SCRATCH MEMORY I4 00003600 C NPROC = NUMBER OF PROCESSES IN THE LIST I4 00003700 C NPROC2 = NPROC/2 I4 00003800 C PIND = TEMPORARY INDEX TO A PROTAB ENTRY I4 00003900 C WRIT = CHARACTER STRING "WRIT" L4 00004000 C 00004100 C EJECT 00004200 SUBROUTINE CSPROC (INDEX, *) 00004300 C 00004400 IMPLICIT INTEGER (A-Z) 00004500 C 00004600 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/23/83 00004700 CIBM COMMON /P/ STARTP , M00000( 102) 00004800 CIBM REAL*8 STARTP 00004900 COMMON /P/ STARTP ( 2) , M00000( 102) 00005000 COMMON /P/ KPNA , M00416( 22) 00005100 COMMON /P/ KPIBN , M00508( 60) 00005200 COMMON /P/ MCIUSM 00005300 COMMON /P/ MCNUSM , M00756( 132) 00005400 COMMON /P/ PTNCW , M01288( 37) 00005500 COMMON /P/ PROTAB ( 2) 00005600 COMMON /P/ ENDP 00005700 C 00005800 COMMON /SYSTEM/ SYSTEM, SYBYPW, SYLOCF 00005900 C 00006000 COMMON COM(2) 00006100 C 00006200 INTEGER BRAN 00006300 INTEGER NODE 00006400 INTEGER WRIT 00006500 C 00006600 C INITIALIZATION 00006700 DATA BRAN /'BRAN'/ 00006800 DATA NODE /'NODE'/ 00006900 DATA WRIT /'WRIT'/ 00007000 C 00007100 C 00007200 INIBN =(LOC(KPIBN) - LOC(KPNA)) / SYLOCF 00007300 NOWDS = MCNUSM - 1 00007400 IC = MCIUSM - 1 00007500 PIND = INDEX 00007600 NPROC = 0 00007700 C 00007800 C ELIMINATE ALL "WRIT" PROCESSES 00007900 C 00008000 10 IF (PROTAB(PIND) .EQ. WRIT) GO TO 20 00008100 C 00008200 C QUIT WHEN THERE IS NO MORE SCRATCH MEMORY 00008300 C 00008400 IF (NOWDS .LE. 1) GO TO 30 00008500 C 00008600 C ADD PROCESS TO LIST 00008700 C 00008800 IC = IC + 2 00008900 COM(IC) = PROTAB(PIND) 00009000 COM(IC+1) = PROTAB(PIND+1) 00009100 NPROC = NPROC + 1 00009200 NOWDS = NOWDS - 2 00009300 C 00009400 C GET THE NEXT PROCESS 00009500 C 00009600 20 PIND = PIND - PTNCW 00009700 IF (PIND .LE. 0) GO TO 30 00009800 C 00009900 C IF PROCESS IS A "BRAN", FIND "NODE" BEFORE 00010000 C CONTINUING 00010100 C 00010200 IF (PROTAB(PIND) .NE. BRAN) GO TO 10 00010300 PIND = PTNCW*(PROTAB(PIND+INIBN) - 1) + 1 00010400 IF (PROTAB(PIND) .NE. NODE) CALL XDUMPX 00010500 C 00010600 GO TO 20 00010700 C 00010800 30 IF (NPROC .EQ. 0) GO TO 60 00010900 COM(MCIUSM) = NPROC 00011000 IF (NPROC .EQ. 1) GO TO 50 00011100 NPROC2 = NPROC/2 00011200 C 00011300 C REVERSE THE ORDER OF THE PROCESSES 00011400 C 00011500 DO 40 00011600 * I = 1, NPROC2 00011700 IND1 = MCIUSM + 2*(I - 1) + 1 00011800 IND2 = MCIUSM + 2*(NPROC - I) + 1 00011900 H1 = COM(IND1) 00012000 H2 = COM(IND1+1) 00012100 COM(IND1) = COM(IND2) 00012200 COM(IND1+1) = COM(IND2+1) 00012300 COM(IND2) = H1 00012400 COM(IND2+1) = H2 00012500 C 00012600 40 CONTINUE 00012700 C 00012800 50 IF (NOWDS .GT. 1) RETURN 00012900 C 00013000 60 RETURN1 00013100 C 00013200 END 00013300