SUBROUTINE DECLR(ITYP,RETCD) 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) INTEGER*2 LEVEL,NONBLK,LEND INTEGER*2 RETCD,VIEWSW,BASED,VLEN(9) INTEGER*2 TYPE(RRW,RCL) INTEGER*2 I,I2,I3,ITYP C LOGICAL*1 LINE(80),AVBLS(100,27),VBLS(8,RRW,RCL) 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(VALID.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 IF(TYPE(ID1,ID2).LE.0)I=-I 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 ****&&&&& IF(IABS(TYPE(I,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 WRITE(1,560) (LINE(I),I=1,I2) 560 FORMAT(' VARIABLES SO DECLARED = ',30A1) GO TO 1000 C C C C C NO VARIABLES OF THAT TYPE 600 WRITE(1,610) 610 FORMAT(' NO VARIABLES OF THAT TYPE') C C C C **** NORMAL RETURN **** 1000 RETCD=1 RETURN END