SUBROUTINE AT (RETCD)
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	INCLUDE 'VKLUGPRM.FTN'
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32
C RRW=MAX REAL ROWS
C RCL=MAX REAL COLS
C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS
C VBLS AND TYPE DIMENSIONED RRW,RCL
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C   +                                                +
C   +            CALC    VERSION  X01-06             +
C   +                                                +
C   +  PETER BAUM  1-SEP-77                          +
C   +                                                +
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C *******************************************************
C *                                                     *
C *           SUBROUTINE  AT                            *
C *                                                     *
C *******************************************************
C
C
C SUBROUTINE AT IS CALLED WHEN THE  *@  CALC COMMAND IS ENCOUNTERED.
C IT CHANGES  THE  VALUE  OF LEVEL  WHICH  HOLDS THE  NUMBER OF THE
C LOGICAL  I/O  UNIT WHERE INPUT COMMAND LINES ARE TO BE OBTAINED.
C THE FILE ASSOCIATED WITH THAT I/O UNIT IS OPENED UNDER THE PROPER
C CONDITIONS.
C
C
C
C
C MODIFICATION CLASSES: M1,M2,M9
C
C      MODIFIED 3-OCT-77 P.B.
C      MODIFIED 10-JAN-78 P.B.  TO PUT SY: BEFORE FILENAMES
C         WITH NO DEVICE SPECIFIED SO THAT DEFAULT IS USER'S SY:
C         AND NOT THE SYSTEM SY:
C
C
C
C
C
C
C    AT CALLS
C
C  ASSIGN  (TO ASSOCIATE A FILE NAME WITH A LOGICAL I/O UNIT)
C  ERRMSG  (TO PRINT ERROR MESSAGES)
C  GETNNB  (TO GET NEXT NON-BLANK FROM THE INPUT LINE)
C  ZNEG    (TO TEST IF A VARIABLE IS POSITIVE)
C
C
C
C   AT IS CALLED BY ROUTINE CMND WHICH IS THE MODULE THAT DETERMINES
C   WHAT CALC COMMAND WAS REQUESTED.
C
C
C
C         VARIABLE          USE
C
C   ALPHA(27)         HOLDS LEGAL VARIABLE NAMES.
C   I,J               HOLD TEMPORARY VALUES.
C   IPT               POINTS TO NEXT NON-BLANK CHARACTER IN LINE(80).
C   ITCNTV(6)         INDEXED BY LEVEL. HOLDS 0 IF NO ITERATION ON THAT
C                     LEVEL, OTHERWISE INDEX INTO VBLS FOR THE VARIABLE
C                     THAT CONTROLS ITERATION.
C   LEVEL             HOLDS NUMBER OF LOGICAL I/O UNIT WHERE NEXT INPUT
C                     LINE IS EXPECTED.
C   LINE(80)          HOLDS COMMAND INPUT LINE.
C   NBLINE(78)        HOLDS THE INPUT FILE NAME WITHOUT BLANKS.
C   NONBLK            POINTS TO THE LAST NON-BLANK CHARACTER IN LINE(80).
C   RETCD             RETURN CODE: 1=O.K.  2=ERROR.
C   SY                "SY:" USED TO OPEN FILES WITH A DEFAULT OF
C                     USER'S SY: (OTHERWISE SYSTEM SY: IS USED) P.B.
C                     10-JAN-78
C
C
C
C
C
C	SUBROUTINE AT (RETCD)
C
	INTEGER*2 IPT,J,I
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2 RETCD,VIEWSW,BASED
	INTEGER*2 ITCNTV(6),ZNEG
C
	LOGICAL*1  LINE(80),NBLINE(78)
	LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ
	LOGICAL*1 SY(3)
C
C
	COMMON  LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
	COMMON /CONS/ ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
	COMMON/ITERA/ITCNTV
C
	DATA SY/'S','Y',':'/
C
C
C
C UPON ENTRANCE, NONBLK POINTS TO THE CHARACTER @
C
C  MODIFICATION CLASSES:  M1,M2,M9
C
C PICK UP FIRST NON-BLANK AFTER THE @
	CALL GETNNB(IPT,RETCD)
	GO TO (10,1050),RETCD
	STOP 10
C
C
C START BUILDING FILE NAME AS A COMPRESSED VERSION (BLANKS REMOVED)
C OF THE REST OF LINE(80)
10	J=0
15	NONBLK=IPT
	J=J+1
	NBLINE(J)=LINE(NONBLK)
	CALL GETNNB(IPT,RETCD)
	GO TO (15,50),RETCD
	STOP 50
C
C
C SET RETURN CODE AND INDICATE THAT WE WILL BE AT A NEW LEVEL.
C J HOLDS THE COUNT OF THE NUMBER OF CHARACTERS IN NBLINE.
C IF J=1 THEN NO ITERATION IS POSSIBLE BECAUSE FILENAME IS THE
C SINGLE CHARACTER.
50	RETCD=1
	LEVEL=LEVEL+1
	IF (LEVEL.GT.6) GOTO 1000
C
C COMMENT OUT THE FOLLOWING LINE IF RSX-11M CODE ONLY IS USED
	IF(J.EQ.1) GO TO 200
CC
CC (RSX-11M CODE ONLY)  10-JAN-78  P.B.
CC   DETERMINE IF A DEVICE NAME IS PRESENT. IF NOT, PRECEED WITH SY: SO
CC   USER'S SY: IS USED AND NOT SYSTEM SY: (IF TASK IS INSTALLED)
	DO 52 I=3,5
	IF(J.LT.I)GO TO 54
	IF(NBLINE(I).EQ.SY(3)) GO TO 59
52	CONTINUE
C
54	DO 55 I=1,J
55	NBLINE(J-I+4)=NBLINE(J-I+1)

	DO 56 I=1,3
56	NBLINE(I)=SY(I)
	J=J+3
	IF(J.EQ.4) GO TO 200
59	CONTINUE
C
CC
CC END RSX-11M CODE 10-JAN-78    P.B.
CC
CC
C
C NBLINE HOLDS THE COMPRESSED FILENAME. NOW WE CHECK TO SEE IF AN
C ITERATION VARIABLE WAS SPECIFIED. THIS IS INDICATED BY A LEGAL
C VARIABLE NAME PRECEEDED BY A BLANK (IN LINE(80))
C NOTE THAT ONLY ONE OF THE ACCUMULATORS A-Z MAY BE USED FOR THIS.
	DO 60 I=1,27
C A-Z OR % LEGAL
	IF(ALPHA(I).EQ.LINE(NONBLK))GO TO 100
60	CONTINUE
	GO TO 200
100	IF(LINE(NONBLK-1).NE.BLANK)GO TO 200
C
C
C ITERATION INDICATOR IS PRESENT
C (ALPHABETIC CHARACTER OR % PRECEEDED BY A BLANK)
C IF THE VALUE OF THE VARIABLE IS NOT POSITIVE, THE FILE IS IGNORED.
	IF(ZNEG(I).EQ.1)GO TO 150
C
C
C RETAIN INDEX INTO VBLS AND DECREASE J SO THAT THE FILENAME
C DOES NOT INCLUDE THE ITERATION SPECIFICATION.
	ITCNTV(LEVEL)=I
	J=J-1
	GO TO 300
C
C
C FILE NOT ENTERED, ITERATION VARIABLE IS ZERO, NEGATIVE, OR UNDEFINED
150	LEVEL=LEVEL-1
	GO TO 350
C
C
C IF NO ITERATION, SET ITCNTV TO ZERO BECAUSE NOT ZEROED BY EXIT
C ROUTINES
200	ITCNTV(LEVEL)=0
300	CONTINUE
C COMMENT OUT THE FOLLOWING IF NOT AVAIL ON VAX:
c	CALL FDBSET(LEVEL,'READONLY','SHARE')
	CALL ASSIGN (LEVEL,NBLINE,J)
350	RETURN
C
C
C
C *** ERROR PROCESSING ***
C
C  TOO MANY LEVELS
1000	I=2
1010	CALL ERRMSG(I)
1020	RETCD=2
	RETURN
C
C
C UNIDENTIFIED COMMAND (ARGUMENT)
1050	I=3
	GO TO 1010
	END