V10/cmd/pfort/GOTO.f

      SUBROUTINE GOTO
      INTEGER STMT, PSTMT
      LOGICAL TOKLAB, DONE, ERR, SYSERR, ABORT
      COMMON /DETECT/ ERR, SYSERR, ABORT
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
C
C     PROCESSES UNCONDITIONAL, ASSIGNED, AND COMPUTED GOTO  STMTS
C
      IF (PSTMT.GE.NSTMT) GO TO 100
      DONE = .FALSE.
C
C     UNCONDITIONAL GOTO
C
      IF (TOKLAB(1,K2,K,.FALSE.)) GO TO 110
C
C     COMPUTED GOTO
C
      IF (SYSERR) GO TO 110
      IF (STMT(PSTMT).EQ.65) GO TO 70
C
C     ASSIGNED GOTO:  GOTO <VAR> , ( <LAB> , ETC. )
C
   10 CALL NEXTOK(PSTMT, K2, K)
      IF (K.NE.0) GO TO 100
      K = LOOKUP(K2,.FALSE.)
      IF (SYSERR) GO TO 110
      I1 = IGATT1(K,1)
      IF (I1.NE.0) GO TO 20
      I1 = 1
      IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
      CALL SATT1(K, 1, I1)
   20 I2 = IGATT1(K,7)
      IF (MOD(I1,8).NE.2 .OR. I2.NE.0) CALL ERROR1(
     *    31H NOT AN INTEGER SCALAR VARIABLE, 31)
      I1 = IGATT1(K,8)
      IF (DONE) GO TO 40
C
C     CHECK FOR ASSIGN VARIABLE IN USAGE
C
      IF (I1.EQ.0) GO TO 30
      IF (I1.NE.8) CALL ERROR1(26H ID NOT AN ASSIGN VARIABLE, 26)
      GO TO 60
   30 CALL SATT1(K, 8, 8)
      GO TO 60
C
C     CHECK FOR VARIABLE IN USAGE
C
   40 IF (I1.EQ.0) GO TO 50
      IF (I1.NE.10) CALL ERROR1(19H ILLEGAL ID IN GOTO, 19)
      GO TO 130
   50 CALL SATT1(K, 8, 10)
      GO TO 130
C
C     LOOK FOR ","
C
   60 IF (STMT(K2).NE.68) GO TO 100
      K2 = K2 + 1
      DONE = .TRUE.
      IF (STMT(K2).NE.65) GO TO 100
      GO TO 80
   70 PSTMT = PSTMT + 1
      GO TO 90
   80 PSTMT = K2 + 1
C
C     LOOK FOR  ( <LAB> , ETC.)
C
   90 IF (PSTMT.GE.NSTMT) GO TO 100
      IF (.NOT.TOKLAB(1,K2,K,.FALSE.)) GO TO 100
      IF(SYSERR) GOTO 110
      IF (STMT(K2).EQ.68) GO TO 80
      IF (STMT(K2).NE.62) GO TO 100
      IF (DONE) GO TO 120
      DONE = .TRUE.
      IF (STMT(K2+1).NE.68) GO TO 100
      PSTMT = K2 + 2
      IF (PSTMT.LT.NSTMT) GO TO 10
  100 CALL ERROR1(15H ILLEGAL SYNTAX, 15)
  110 RETURN
C
C     CHECK END OF STMT IS REACHED
C
  120 K2 = K2 + 1
  130 IF (K2.NE.NSTMT) CALL ERROR1(
     *    34H EXTRANEOUS INFO AFTER END OF STMT, 34)
      GO TO 110
      END