	BLOCK DATA
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	PARAMETER RCP = 1024
C	PARAMETER RCPM27 = 997
C RCP = RRW*RCL
C RCPM27=RCP-27
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   ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C *******************************************************
C *                                                     *
C *            BLOCK  DATA  MODULE                      *
C *                                                     *
C *******************************************************
C
C
C COMMON AREAS ARE INITIALIZED BY THIS MODULE.
C
C
C
C  MODIFICATION CLASSES: M2,M3,M9,M10
C
C
C MODIFIED 18-MAY-1981 P.B. SET % TO VERSION 6
C
C
C
C   VARIABLE      USE
C
C  ALPHA(27)    HOLDS LEGAL VARIABLE NAMES: ALPHABETIC CHARACTERS
C               OR THE CHARACTER %.
C  BASED     HOLDS DEFAULT BASE.
C  BLANK        ' '
C  COMMA        ','
C  DIGITS(16,3) HOLDS DECIMAL, OCTAL, AND HEXADECIMAL DIGITS. THE
C               SECOND SUBSCRIPT IS
C                     1 FOR DECIMAL
C                     2 FOR OCTAL
C                     3 FOR HEXADECIMAL
C  DTBL1(9,9,8) CONTROLS THE DECISION PROCESS WHEN EVALUATING A
C               BINARY OPERATION. SEE BELOW FOR DETAILS.
C  EQ           '='
C  ITCNTV(6)    INDEXED BY LEVEL. 0 INDICATES THAT NO ITERATION ON THE
C               INDIRECT COMMAND FILE IS TO TAKE PLACE. IF POSITIVE, IT
C               HOLDS THE INDEX INTO VBLS AND REPRESENTS THE VARIABLE
C               USED TO CONTROL ITERATION.
C  LINE(80)     COMMAND INPUT LINE
C  LPAR         '('
C  RPAR         ')'
C  ST1LIM       HOLDS THE SIZE OF STACK 1 (ALWAYS CONSTANT)
C  ST2LIM       HOLDS THE SIZE OF STACK 2 (ALWAYS CONSTANT)
C  ST1PT        POINTS TO THE TOP OF STACK 1 (CHANGES AS STACK IS USED)
C  ST2PT        POINTS TO THE TOP OF STACK 2 (CHANGES AS STACK IS USED)
C  ST1TYP(40)       DATA TYPE FOR EACH ELEMENT IN STACK 1
C  ST2TYP(40)       DATA TYPE FOR EACH ELEMENT IN STACK 2
C  STACK1(20,40)   UTILITY STACKS USED WHEN EVALUATING EXPRESSIONS. THE FIRST
C  STACK2(20,40)   SUBSCRIPT CONTROLS INDEXING ACROSS THE BYTES OF A SINGLE
C                   VARIABLE. THE SECOND SUBSCRIPT CONTROLS STACK ELEMENTS.
C  TYPE(27)         HOLDS THE DATA TYPES FOR EACH OF THE 27 VARIABLES. SEE
C                   CODES.FTN FOR THE POSSIBLE VALUES.
C  VIEWSW           VIEW SWITCH
C                    0 = OUTPUT ERROR MESSAGES
C                    1 = OUTPUT ERROR MESSAGES AND FILE COMMAND LINES
C                    2 = OUTPUT ERROR MESSAGES AND VALUE OF EXPRESSIONS
C                        EVALUATED.
C                    3 = OUTPUT EVERYTHING
C  VLEN(9)      INDEXED BY DATA TYPE. GIVES THE NUMBER OF BYTES USED
C               BY THAT DATA TYPE.
C  AVBLS(20,27)      HOLDS THE VALUES OF THE 27 LEGAL VARIABLES.(ACCUMULATORS)
C  VBLS(8,RRW,RCL)    HOLDS VALUES OF ALL VARIABLES
C
C
C
C    CONSTANTS ARE STORED IN VBLS ACCORDING TO THEIR TYPE:
C
C
C
C <----------- MULTIPLE PRECISION (M10, M8, M16) ------------------------->
C !                        <------------- DECIMAL AND REAL --------------->
C !                        !                      <-- INTEGER HEX OCTAL -->
C !                                               !             ---> ASCII <---
C !                        !                      !                        !
C
C -------------     -------------------------------------------------------
C !     !     !     !     !     !     !     !     !     !     !     !     !
C ! 100 !  99 ! ... !  9  !  8  !  7  !  6  !  5  !  4  !  3  !  2  !  1  !
C !     !     !     !     !     !     !     !     !     !     !     !     !
C -------------     -------------------------------------------------------
C
C
C NOTE: BYTE 100 HOLDS THE SIGN FOR MULTIPLE PRECISION NUMBERS.
C       0 = POSITIVE, 1 = NEGATIVE
C
C
C
C
C
C	BLOCK DATA
	InTEgeR*4 LEVEL,NONBLK,LEND
	InTEgeR*4 LASTOP
	InTEgeR*4 ST1TYP(40),ST2TYP(40)
	InTEgeR*4 TYPE(RRWP,RCLP)
	InTEgeR*4 VIEWSW,BASED,VLEN(9)
	InTEgeR*4 ST1LIM,ST2LIM,ST1PT,ST2PT
	InTEgeR*4 ITCNTV(6)
C
	LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ,LINE(80)
	LOGICAL*1 STACK1(20,40),STACK2(20,40)
	LOGICAL*1 AVBLS(20,27)
	LOGICAL*1 VBLS(8,RRWP,RCLP)
	LOGICAL*1 DTBL1(9,9,8)
	LOGICAL*1 DIGITS(16,3)
C
C OARRY WILL BE USED TO HOLD OUTPUT VARIABLE IF OSWIT IS NONZERO
	InTEgeR*4 OSWIT
C OCNTR MAY HOLD BYTES VALID IN OARRY (UP TO 100, NO MORE...)
	InTEgeR*4 OCNTR
	LOGICAL*1 OARRY(100)
C
C ILINE IS PROGRAMMABLE LINE INPUT (I.E., NOT FROM CONSOLE)
	LOGICAL*1 ILINE(106)
	InTEgeR*4 ILNFG
	InTEgeR*4 ILNCT
	COMMON /ILN/ILNFG,ILNCT,ILINE
C ILINE IS PRESENT IF ILNFG <> 0 AND ILNCT HAS # BYTES IN IT.
	COMMON /OAR/OSWIT,OCNTR,OARRY
	COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
	COMMON /CONS/ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
	COMMON /STACK/ STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     ;         ST1LIM,ST2LIM
	COMMON /V/ TYPE,AVBLS,VBLS,VLEN
	COMMON /DECIDE/ DTBL1
	COMMON /DIGV/ DIGITS
	COMMON /ERROR/ LASTOP
	COMMON/ITERA/ ITCNTV
	LOGICAL*1 DVFMT(12)
	COMMON/DEFVBX/DVFMT
	REAL *8 AC(26)
	REAL*8 DERIV(8)
	REAL*8 DEL(8)
	REAL*8 OLDVV,OLDX,OLDA
	INTEGER ACV(8)
	INTEGER CAC
	INTEGER CCNT(8)
	COMMON/VRYDAT/AC,DERIV,DEL,CAC,CCNT,OLDVV,OLDX,OLDA,ACV
	DATA DERIV/8*1./,DEL/8*0./
	DATA CAC/1/,CCNT/8*0/
	DATA ACV/8*0/
	DATA OLDVV/1./
C INITIAL DEFAULT FORMAT FOR NUMERICS
	DATA DVFMT/'(','F','9','.','2',6*32,')'/
C
	DATA VIEWSW/0/
	DATA LEVEL/1/
	DATA LASTOP/0/
	DATA ITCNTV/6*0/
	DATA OSWIT/0/,OCNTR/0/,ILNFG/0/,ILNCT/0/
	DATA ALPHA/'A','B','C','D','E','F','G','H','I','J','K','L','M',
     ;       'N','O','P','Q','R','S','T','U','V','W','X','Y','Z','%'/
	DATA DIGITS/'1','2','3','4','5','6','7','8','9',7*'0',
     ;       '1','2','3','4','5','6','7',9*'0',
     ;  '1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','0'/
	DATA COMMA/','/, BLANK/' '/,RPAR/')'/,LPAR/'('/,EQ/'='/
C
C
C DEFAULT BASE IS 10
	DATA BASED/10/
C
C
C STACKS ARE CURRENTLY SET AT 40 ELEMENTS DEEP
	DATA ST1LIM/40/, ST2LIM/40/
C
C
C
C	DEFAULT TYPES
C	A,B,C,D,E,F,G,H  =  DECIMAL
C	I,J,K,L,M,N      =  INTEGER (BASE10)
C	O,P,Q,R,S,T,U,V,W,X,Y,Z  =  DECIMAL
C
C  % AS INTEGER TO HOLD CALC VERSION NUMBER
C
C	DATA TYPE/8*2,6*4,12*2,4,RCRM27*2/
c modify type array so ac's i-n are reals
C	DATA TYPE/8*2,6*2,12*2,2,RCRM27*2/
C
C
C GIVE VERSION # BY VALUE IN %
C
c don't bother with this; by the time user gets into calc,
c % already is clobbered most times, so no need for it.
c	DATA AVBLS(1,27)/6/
c	DATA AVBLS(2,27)/0/,AVBLS(3,27)/0/,AVBLS(4,27)/0/
C
C
C
C
C SPECIFY THE LENGTH USED BY EACH DATA TYPE
	DATA VLEN/1,8,4,4,20,20,20,4,8/
C
C
C
C
C
C
C
C
C  DECISION TABLE FOR PERFORMING BINARY OPERATIONS
C
C  DTBL1(OPERAND2,OPERAND1,INDEX)
C
C  WHERE:					OPERATOR:
C  INDEX=1	MODIFY CODE FOR OPERAND 1	*/+-
C	 2	MODIFY CODE FOR OPERAND 2	*/+-
C	 3	FUNCTION VALUE TYPE		*/+-
C	 4	OPERATOR CLASS			*/+-
C
C	 5	MODIFY CODE FOR OPERAND 1	**
C	 6	MODIFY CODE FOR OPERAND 2	**
C	 7	FUNCTION VALUE TYPE		**
C	 8	OPERATOR CLASS			**
C
C
C  WHERE TYPE CODES (MODIFY CODES) ARE:
C	0	NO CHANGE
C	1	CONVERT TO ASCII
C	2	CONVERT TO DECIMAL
C	3	CONVERT TO HEXADECIMAL
C	4	CONVERT TO INTEGER
C	5	CONVERT TO M10
C	6	CONVERT TO M8
C	7	CONVERT TO M16
C	8	CONVERT TO OCTAL
C	9	CONVERT TO REAL
C
C  FOR */+- FUNCTION VALUE TYPES AND OPERATOR CLASS ARE PRESENTLY
C  IDENTICAL
C
C  FOR **  OPERATOR CLASSES FOLLOW:
C
C 	CODE	OPERATOR CLASS
C	1	REAL**REAL
C	2	REAL**INTEGER
C	3	INTEGER**REAL
C	4	INTEGER**REAL
C	5	M8**INTEGER
C	6	M10**INTEGER
C	7	M16**INTEGER
C
C
C
C
C
C
	DATA DTBL1 /4,2,3,4,5,6,7,8,9,
     ;  9*0,
     ;  0,2,0,0,3*7,0,9,
     ;  0,2,0,0,5,5,7,0,9,
     ;  0,2,7,0,0,0,7,0,9,
     ;  0,2,7,5,5,0,7,0,9,
     ;  0,2,6*0,9,
     ;  0,2,3,0,5,6,7,0,9,
     ;  0,2,7*0,
     ;  4,8*0,
     ;  2,0,6*2,0,
     ;  3,3*0,7,7,3*0,
     ;  4,4*0,5,3*0,
     ;  5,0,7,5,0,5,0,5,0,
     ;  6,0,7,5,3*0,6,0,
     ;  7,2,4*7,0,7,0,
     ;  8,8*0,
     ;  9,0,6*9,0,
     ;  4,2,3,4,5,6,7,8,9,
     ;  9*2,
     ;  3,2,3,3,3*7,3,9,
     ;  4,2,3,4,5,5,7,4,9,
     ;  5,2,7,3*5,7,5,9,
     ;  6,2,7,5,5,6,7,6,9,
     ;  7,2,6*7,9,
     ;  8,2,3,4,5,6,7,8,9,
     ;  9,2,7*9,
     ;  4,2,3,4,5,6,7,8,9,
     ;  9*2,
     ;  3,2,3,3,3*7,3,9,
     ;  4,2,3,4,5,5,7,4,9,
     ;  5,2,7,5,5,5,7,5,9,
     ;  6,2,7,5,5,6,7,6,9,
     ;  7,2,6*7,9,
     ;  8,2,3,4,5,6,7,8,9,
     ;  9,2,7*9,
     ;  4,2,3,6*4,
     ;  9*0,
     ;  9*0,
     ;  9*0,
     ;  0,9,6*0,9,
     ;  0,9,6*0,9,
     ;  0,9,6*0,9,
     ;  9*0,
     ;  9*0,
     ;  4,3*0,3*9,4,0,
     ;  4,3*0,3*9,0,0,
     ;  4,3*0,3*9,2*0,
     ;  4,3*0,3*9,2*0,
     ;  4,3*0,3*4,2*0,
     ;  4,3*0,3*4,2*0,
     ;  4,3*0,3*4,2*0,
     ;  4,3*0,3*9,2*0,
     ;  4,3*0,3*9,2*0,
     ;  4,2,3,6*4,
     ;  9*2,
     ;  9*3,
     ;  9*4,
     ;  5,9,6*5,9,
     ;  6,9,6,6,5,6,7,6,9,
     ;  7,9,6*7,9,
     ;  9*8,
     ;  9*9,
     ;  4,1,4,4,3,3,3,4,3,
     ;  2,1,2,2,3*1,2,1,
     ;  4,3,4,4,3*3,4,3,
     ;  4,3,4,4,3*3,4,3,
     ;  6,1,6*6,1,
     ;  5,1,6*5,1,
     ;  7,1,6*7,1,
     ;  4,3,4,4,3*3,4,3,
     ;  2,1,2,2,3*1,2,1/
	END
