Return to SETPD.f CVS log

Up to [Research Unix] / researchv10no / cmd / pfort

researchv10 Norman

      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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.