V10/cmd/pfort/SETPD.f
SUBROUTINE SETPD(I, K2)
INTEGER PDSA, DSA, PLAT, SYMLEN
LOGICAL ERR, SYSERR, ABORT
COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
COMMON /DETECT/ ERR, SYSERR, ABORT
COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
COMMON /CTABL/ LDSA, PDSA, DSA(5000)
C
C SUBROUTINE ADDS PGM UNIT AT LAT(I) ONTO K2 DESC-LIST
C ADDS K2 ONTO I PARENTS LIST
C
IF (PLAT+4.GT.LLAT) GO TO 20
C
C SEE THAT K2 IS NOT ALREADY ON I PARENTS LIST
C 0 RETURN INDICATES EMPTY LIST OR NO MATCH
C
J = I + SYMLEN + 3
IF (MATCH(LAT(J),1,K2).NE.0) GO TO 10
LAT(PLAT+1) = LAT(J)
LAT(PLAT) = K2
LAT(J) = PLAT
J = K2 + SYMLEN + 4
LAT(PLAT+3) = LAT(J)
LAT(PLAT+2) = I
LAT(J) = PLAT + 2
PLAT = PLAT + 4
10 RETURN
C
C ERROR RETURNS
C
20 SYSERR = .TRUE.
CALL ERROR1(32H IN SETPD, TABLE OVERFLOW OF LAT, 32)
GO TO 10
END