	SUBROUTINE DECLR(ITYP,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 COMMERCIALLY.
C
C	CJD1	Oct-90, Chris Doran, Sira, SMG modifications
C
	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 *       SUBROUTINE  DECLR (ITYP,RETCD)           *
C *                                                *
C **************************************************
C
C
C ANALYZES VECTOR LINE TO DETERMINE WHAT VARIABLES GET THEIR
C TYPES CHANGED. THE NEW TYPE IS SPECIFIED AS AN ARGUMENT IN
C THE CALL:
C
C
C  TYPE CODE
C	1  ASCII
C	2  DECIMAL (REAL BUT DECIMAL POINT FOR OUTPUT)
C	3  HEXADECIMAL
C	4  INTEGER
C	5  MULTIPLE PRECISION (BASE 10)
C	6  MULTIPLE PRECISION (BASE 8)
C	7  MULTIPLE PRECISION (BASE 16)
C	8  OCTAL
C	9  REAL
C
C  IF NEGATIVE, TYPE IS DEFINED BUT VARIABLE HAS
C  NOT BEEN ASSIGNED A VALUE
C
C
C  RETCD     MEANING
C  1    =    O.K.
C  2    =    ERROR
C
C  NOTE:  AS IN FORTRAN, VARIABLES IN DECLARATIONS MUST BE SEPARATED
C         BY COMMAS
C
C
C  MODIFICATION CLASSES: M1, M2
C
C
C
C
C DECLR CALLS:
C
C  ERRMSG   PRINTS ERROR MESSAGES
C
C
C
C DECLR IS CALLED BY CMND, THE ROUTINE THAT DECODES COMMANDS.
C
C
C
C
C       VARIABLE        USE
C
C    ALPHA           LIST OF LEGAL VARIABLE NAMES. THE FIRST 26 ARE
C                    ALPHABETIC, THE 27TH IS THE CHARACTER '%'.
C    BLANK           ' '
C    I,I2,I3         TEMPORARY VALUES.
C    ITYP            CODE THAT GIVES THE TYPE OF VARIABLE FOR A
C                    PARTICULAR CALL TO THIS ROUTINE. VARIABLES ARE
C                    EITHER DECLARED TO BE OF THIS TYPE OR, IF NO
C                    VARIABLES ARE SPECIFIED, A LIST OF ALL THE
C                    VARIABLES OF THAT TYPE ARE GIVEN.
C    LEND            LAST NON-BLANK IN VECTOR LINE(80).
C    LINE(80)        HOLDS INPUT COMMAND LINE. IF DECLARATION HAS
C                    NO ARGUMENT, THIS VECTOR IS THEN USED TO OUTPUT
C                    A LIST OF VARIABLES OF THE TYPE SPECIFIED.
C    NONBLK          START SCAN OF VARIABLE LIST.
C    TYPE            HOLDS THE TYPE CODE FOR EACH VARIABLE.
C
C
C
C
C
C
C 
C	SUBROUTINE DECLR(ITYP,RETCD)
	PARAMETER NEL = 14						!CJD1
	InTEgeR*4 LEVEL,NONBLK,LEND
	InTEgeR*4  RETCD,VIEWSW,BASED,VLEN(9)
	InTEgeR*4 TYPE(RRWP,RCLP)
	InTEgeR*4 I,I2,I3,ITYP
C
	LOGICAL*1  LINE(80),AVBLS(20,27),VBLS(8,RRWP,RCLP)
	LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ
C
	COMMON  /V/TYPE,AVBLS,VBLS,VLEN
	COMMON  /CONS/ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
	COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
C
C
C
	IF(NONBLK.EQ.LEND)GO TO 500
C
C
C **************************************************
C ****** DECLARE VARIABLES TO BE OF TYPE ITYP ******
C **************************************************
	I2=NONBLK+1
10	CONTINUE
C10	IF (LINE(I2).EQ.BLANK) GOTO 60
C	DO 20 I3=1,26
C	IF (LINE(I2).EQ.ALPHA(I3)) GOTO 30
C20	CONTINUE
C *****&&&&& ADD VARIABLE SIZE SUPPORT - GCE
	CALL VARSCN(LINE,I2,LEND,LSTCHR,ID1,ID2,IVALID)
C VARSCN SEARCHES FOR VALID VARIABLE NAME STRINGS INCLUDING C$+EXPR
C AND R$+EXPR FOR LOC-RELATIVE NAMES IN ABSOLUTE AND C@+N, R@+N FOR RELATIVE
C NAMES IN DISPLAY SYSTEM. IT RETURNS THE ID1, ID2 INDICES FOR
C THE VARIABLES IN VBLS ARRAY AND TYPE ARRAY. FOR SINGLE ALPHAS
C A-Z, ID1 RETURNS 1-26 AND ID2=1. % RETURNS ID1=27, ID2=1.
	IF(IVALID.EQ.0) GOTO 22
C VALID FLAG IS NONZERO IF VARIABLE NAME IS VALID, ELSE 0.
	I2=LSTCHR
C LSTCHR RETURNS LAST CHARACTER OF NAME
	GOTO 30
C
C  ILLEGAL CHARACTER IN DECLARATION'S VARIABLE LIST
22	I=4
C
C
C
C ******* ERROR RETURN *******
25	RETCD=2
	CALL ERRMSG(I)
	RETURN
C
C
C
C
30	CONTINUE
C IF OLD VARIABLE WAS UNDEFINED, MAKE NEW TYPE LESS THAN 0 ALSO.
C THIS ALLOWS ONE TO EXAMINE INTERNAL VALUES FOR DIFFERENT DATA
C TYPES. IF THIS IS NOT NEEDED, IT WOULD BE CLEANER TO ALWAYS MAKE
C VARIABLES UNDEFINED WHEN THEIR DATA TYPE IS CHANGED. TO DO THIS
C JUST USE THE STATEMENT
C	I=-ITYP
	I=ITYP
C ****&&&&&& NOTE TYPE NOW 2-DIM
	CALL TYPGET(ID1,ID2,TYPE(1,1))
	IF(TYPE(1,1).LE.0)I=-I
	CALL TYPSET(ID1,ID2,I)
C	TYPE(ID1,ID2)=I
	I3=I2+1
	IF (I3.GT.LEND) GOTO 1000
	DO 40 I2=I3,LEND
	IF (LINE(I2).EQ.BLANK) GOTO 40
	IF (LINE(I2).EQ.COMMA) GOTO 45
C
C VARIABLES NOT SEPARATED BY COMMAS
	I=5
	GO TO 25
40	CONTINUE
	GOTO 1000
45	IF (I2.EQ.LEND) GOTO 22
60	I2=I2+1
	IF (I2.LE.LEND) GOTO 10
	GO TO 1000
C
C
C
C
C
C
C **********************************************************************
C ** NO ARGUMENTS SO SHOW WHAT VARIABLES HAVE BEEN DECLARED THAT TYPE **
C **********************************************************************
500	CONTINUE
	IF(VIEWSW.EQ.0) GO TO 1000
C PERHAPS THE ABOVE LINE SHOULD BE REMOVED (???)
C
C
C BLANK OUT OUTPUT LINE.
	DO 510 I=1,80
510	LINE(I)=BLANK
C
C
C SEARCH FOR VARIABLES OF TYPE ITYP. PUT THEM IN LINE(I2) WHEN FOUND FOR
C LATER PRINTING.
	I2=0
	DO 550 I=1,27
C FAKE UP DISPLAY
C ****&&&&&
	CALL TYPGET(I,1,TYPE(1,1))
	IF(IABS(TYPE(1,1)).NE.ITYP)GO TO 550
	I2=I2+1
	LINE(I2)=ALPHA(I)
550	CONTINUE
C
C
C GO TO SECTION APPROPRIATE FOR PRINTING EITHER THE LIST OF VARIABLES OR
C A MESSAGE INDICATING THAT NO VARIABLES ARE OF THAT TYPE.
	IF(I2.EQ.0) GO TO 600
C
C
C OUTPUT A LIST OF VARIABLES OF TYPE ITYP
	CALL LWRITE(1,24HVariables so declared = ,24)			!CJD1
	CALL LWRITE(1,LINE,I2)						!CJD1
	CALL UVT100(NEL)						!CJD1
	GO TO 1000
C
C
C
C
C NO VARIABLES OF THAT TYPE
600	CALL LWRITE(1,25HNo variables of that type,25)			!CJD1
	CALL UVT100(NEL)						!CJD1
C
C
C
C **** NORMAL RETURN ****
1000	RETCD=1
	RETURN
	END
