V10/cmd/pfort/ASSIGN.f

      SUBROUTINE ASSIGN
      INTEGER PSTMT, STMT
      LOGICAL TOKLAB, ERR, SYSERR, ABORT
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
      COMMON /DETECT/ ERR, SYSERR, ABORT
C
C      PROCESSES AN ASSIGN STMT: ASSIGN <LABEL> TO <VAR>
C
      IF (PSTMT.GE.NSTMT) GO TO 10
      IF (.NOT.TOKLAB(1,K2,KK,.FALSE.)) GO TO 80
      IF (SYSERR) GO TO 20
      PSTMT = K2
      IF (PSTMT+2.GE.NSTMT) GO TO 10
      IF (STMT(PSTMT).EQ.49 .AND. STMT(PSTMT+1).EQ.44) GO TO 30
   10 CALL ERROR1(15H ILLEGAL SYNTAX, 15)
   20 RETURN
   30 PSTMT = PSTMT + 2
      IF (PSTMT.GE.NSTMT) GO TO 10
      CALL NEXTOK(PSTMT, K2, K)
      IF (K.NE.0) GO TO 10
      K = LOOKUP(K2,.FALSE.)
      IF (SYSERR) GO TO 20
      I1 = IGATT1(K,1)
      I2 = IGATT1(K,7)
      I3 = IGATT1(K,8)
      IF (I3.EQ.0) GO TO 40
      IF (I3.NE.8) GO TO 90
      GO TO 50
   40 CALL SATT1(K, 8, 8)
   50 IF (I1.NE.0) GO TO 60
      I1 = 1
      IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
      CALL SATT1(K, 1, I1)
   60 IF (MOD(I1,8).EQ.2 .AND. I2.EQ.0) GO TO 70
      CALL ERROR1(35H ASSIGN VARIABLE NOT INTEGER SCALAR, 35)
      GO TO 20
   70 IF (K2.NE.NSTMT) GO TO 10
      GO TO 20
   80 CALL ERROR1(14H MISSING LABEL, 14)
      GO TO 20
   90 CALL ERROR1(23H ILLEGAL VARIABLE USAGE, 23)
      GO TO 20
      END