C	FUNCTIONS TO HANDLE VARIABLES FOR RPTTAB.
C
C  Submitted by:
C  
C  	R. N. Stillwell
C  	Institute for Lipid Research
C  	Baylor College of Medicine
C  	Houston, Texas 77030
C  	
C  (who would be glad to receive comments, suggestions, bug fixes, etc., but
C  who promises no support whatever).
C  
C  Literature reference:
C  
C  	R. N. Stillwell.  A low-overhead laboratory data management system
C  	for the PDP11.  Comput. Biomed. Res., 15, 29-38(1982).
C  
C  Acknowledgement:
C
C  	This software was developed under National Institutes of Health grants
C  	GM-13901 and GM-26611.
C 
C  General permission is hereby granted to copy, modify, or distribute this
C  program, but not for profit.  Copyright to this software is and shall
C  remain in the public domain.
C
C	THE VARIABLE DATA STRUCTURE IS IN COMMON BLOCK /VARBLK/.
C
C	REVISED JAN, 1982 TO HASH THE NAMES OF VARIABLES.
C
C	THE FOLLOWING ROUTINES ARE PROVIDED:
C
C	ADDVAR (NAME, VALUE, LEN)   !ADD OR REPLACE A VARIABLE
C	    NAME    REAL*8         NAME OF VARIABLE
C	    VALUE   BYTE ARRAY     VALUE TO BE STORED
C	    LEN     INTEGER        LENGTH OF (VALUE); MUST BE >0
C	   (ADDVAR) INTEGER        RETURNS 1 = SUCCESS: NEW VARIABLE
C	                                   0 = SUCCESS: OLD VARIABLE REPLACED
C	                                  -1 = FAILURE: LEN .LE. 0
C	                                  -2 = FAILURE: NO ROOM IN HEAP
C	                                  -3 = FAILURE: NO ROOM IN INDEX
C	                                  -4 = FAILURE: ILLEGAL NAME
C
C	GETVAR (NAME, VALUE, LEN)   !GET A VARIABLE
C	    NAME    REAL*8         NAME OF VARIABLE
C	    VALUE   BYTE ARRAY     ARRAY FOR RESULT TO BE RETURNED
C	    LEN     INTEGER        LENGTH OF (VALUE); MUST BE >0
C	   (GETVAR) INTEGER        RETURNS LENGTH OF VARIABLE (SUCCESS)
C	                                   -1 = FAILURE: LEN .LE. 0
C	                                   -2 = FAILURE: NO SUCH VARIABLE
C
C
C	BLOCK DATA TO INITIALIZE /VARBLK/.
C	THE FIRST (MINVAR-1) "VARIABLES" ARE ACTUALLY PREDEFINED
C	CONSTANTS.
C
	BLOCK DATA
	COMMON /VARBLK/ MINVAR,NVAR,VARNAM,VARPTR,VARLEN,ENDHP,HEAP
	INTEGER MINVAR      !INDEX OF FIRST REPLACEABLE VARIABLE
	INTEGER NVAR        !CURRENT NUMBER OF VARIABLES
	REAL*8  VARNAM(200) !NAMES OF VARIABLES
	INTEGER VARPTR(200) !POINTERS INTO HEAP
	INTEGER VARLEN(200) !LENGTHS
	INTEGER ENDHP       !CURRENT END OF HEAP
	BYTE HEAP(1000)     !STORAGE FOR VARIABLES
	DATA MAXVAR/200/    !DIMENSION OF VARNAM,VARPTR,VARLEN
	DATA MAXHP /1000/   !DIMENSION OF HEAP
C
	DATA MINVAR/11/
	DATA NVAR /10/
	DATA VARNAM / 'FALSE','NO','no','N','n',
	1 'TRUE','YES','yes','Y','y',190*0.0D0/
	DATA VARPTR /5*1,5*4,190*8/
	DATA VARLEN /5*3,5*4,190*0/
	DATA HEAP /'0','.','0','-','1','.','0',1993*0/
	DATA ENDHP /7/
	END
C
	FUNCTION ADDVAR(NAME, VALUE, LEN)
	INTEGER ADDVAR,HASHV
	REAL*8 NAME
	BYTE VALUE(LEN)
C
	COMMON /VARBLK/ MINVAR,NVAR,VARNAM,VARPTR,VARLEN,ENDHP,HEAP
	INTEGER MINVAR      !INDEX OF FIRST REPLACEABLE VARIABLE
	INTEGER NVAR        !CURRENT NUMBER OF VARIABLES
	REAL*8  VARNAM(200) !NAMES OF VARIABLES
	INTEGER VARPTR(200) !POINTERS INTO HEAP
	INTEGER VARLEN(200) !LENGTHS
	INTEGER ENDHP       !CURRENT END OF HEAP
	BYTE HEAP(1000)     !STORAGE FOR VARIABLES
	DATA MAXVAR/200/    !DIMENSION OF VARNAM,VARPTR,VARLEN
	DATA MAXHP /1000/   !DIMENSION OF HEAP
C
	INTEGER NOHEAP,NOINDX,ILLNAM,LENZRO,SUCADD,SUCRPL   !RETURN CODES
	DATA NOHEAP,NOINDX,ILLNAM,LENZRO,SUCADD,SUCRPL/-2,-3,-4,-1,1,0/
D	WRITE (5,9901) NAME,LEN,(VALUE(I),I=1,LEN)
D9901	FORMAT (' ENTER ADDVAR WITH NAME = ',T50,A8/
D	1 ' LEN, VALUE:',I5,(1X,40A1))

	IF (LEN.LE.0)
	ADDVAR = LENZRO
	RETURN
	FIN
C
C	HASH AND FIND VARIABLE NAME
C
	IVAR = HASHV(NAME)
	CONDITIONAL
	(IVAR.EQ.0) ADDVAR = NOINDX
	(IVAR.LT.MINVAR) ADDVAR = ILLNAM
	(VARNAM(IVAR).EQ.NAME)
C	VARIABLE EXISTS
	WHEN (LEN.EQ.VARLEN(IVAR)) REPLACE-VARIABLE-IN-PLACE
	ELSE                       REPLACE-VARIABLE-AT-END
	ADDVAR = SUCRPL
	FIN
	(OTHERWISE)
C	VARIABLE DOES NOT EXIST.
	ADD-VARIABLE-TO-END
	NVAR = NVAR+1
	ADDVAR = SUCADD
	FIN
	FIN
	RETURN

	TO REPLACE-VARIABLE-IN-PLACE
	IOFS = VARPTR(IVAR)-1
D	WRITE (5,9902) VARNAM(IVAR),IOFS
D9902	FORMAT (' REPLACE ',A8,' IN PLACE, IOFS:',I5)
D	WRITE (5,9912) (VALUE(I),I=1,LEN)
D9912	FORMAT (' VALUE: ',60A1)
	DO (I=1,LEN) HEAP(I+IOFS) = VALUE(I)
	FIN

	TO REPLACE-VARIABLE-AT-END
D	WRITE (5,9903) VARNAM(IVAR)
D9903	FORMAT (' REPLACE ',A8,' AT END.')
C
C	REMOVE THE PREVIOUS CONTENTS OF THE VARIABLE FROM THE
C	HEAP AND ADJUST ALL POINTERS TO THE UPPER PART OF THE HEAP.
C
	IHOLE = VARPTR(IVAR)
	LENHOL = VARLEN(IVAR)
	WHEN (IHOLE+LENHOL-1.EQ.ENDHP)
C	VARIABLE WAS STORED AT END OF HEAP: NO PROBLEM
C
	ENDHP = IHOLE-1
	FIN
	ELSE
C	VARIABLE WAS STORED IN MIDDLE: COLLAPSE THE HEAP
	DO (I=IHOLE,ENDHP-LENHOL) HEAP(I) = HEAP(I+LENHOL)
	ENDHP = ENDHP-LENHOL
	DO (I = MINVAR,MAXVAR)
	IF (VARPTR(I).GT.IHOLE) VARPTR(I) = VARPTR(I) - LENHOL
	FIN
	FIN
	ADD-VARIABLE-TO-END
	FIN

	TO ADD-VARIABLE-TO-END
D	WRITE (5,9904) NVAR+1,ENDHP
D9904	FORMAT (' ADD VARIABLE ',I5,' AT END (OFFSET=).',I7)
D	WRITE (5,9912) (VALUE(I),I=1,LEN)
	IF (ENDHP+LEN .GT. MAXHP)
	ADDVAR = NOHEAP
	RETURN
	FIN
	VARNAM(IVAR) = NAME
	VARPTR(IVAR) = ENDHP+1
	VARLEN(IVAR) = LEN
	DO (I=1,LEN) HEAP(ENDHP+I) = VALUE(I)
	ENDHP = ENDHP+LEN
	RETURN
	FIN

	END
C
	FUNCTION GETVAR(NAME,VALUE,LEN)
	REAL*8 NAME
	BYTE VALUE(LEN)
	INTEGER GETVAR,HASHV
C
	COMMON /VARBLK/ MINVAR,NVAR,VARNAM,VARPTR,VARLEN,ENDHP,HEAP
	INTEGER MINVAR      !INDEX OF FIRST REPLACEABLE VARIABLE
	INTEGER NVAR        !CURRENT NUMBER OF VARIABLES
	REAL*8  VARNAM(200) !NAMES OF VARIABLES
	INTEGER VARPTR(200) !POINTERS INTO HEAP
	INTEGER VARLEN(200) !LENGTHS
	INTEGER ENDHP       !CURRENT END OF HEAP
	BYTE HEAP(1000)     !STORAGE FOR VARIABLES
	DATA MAXVAR/200/    !DIMENSION OF VARNAM,VARPTR,VARLEN
	DATA MAXHP /1000/   !DIMENSION OF HEAP
C
	INTEGER LENZRO,NOVAR
	DATA LENZRO,NOVAR/-1,-2/
C
D	WRITE (5,9901) NAME,LEN,NVAR,ENDHP
D9901	FORMAT (' ENTER GETVAR WITH NAME ',T50,A8/
D	1 ' LEN, NVAR, ENDHP:',3I6)
	IF (LEN.LE.0)
	GETVAR = LENZRO
	RETURN
	FIN
C
C	HASH AND FIND THE NAME
C
	IVAR = HASHV(NAME)
C
	WHEN (IVAR.GT.0.AND.VARNAM(IVAR).EQ.NAME)
C	VARIABLE EXISTS
	RETURN-VARIABLE
	FIN
	ELSE
C	VARIABLE IS PRE-DEFINED OR DOES NOT EXIST
	DO (I=1,MINVAR-1)
	IVAR = I
	IF (NAME.EQ.VARNAM(IVAR)) RETURN-VARIABLE
	FIN
C	NO LUCK.
	GETVAR = NOVAR
D	WRITE (5,9903)
D9903	FORMAT (' VARIABLE NOT FOUND.')
	RETURN
	FIN

	TO RETURN-VARIABLE
	LVAR = MIN0(LEN,VARLEN(IVAR))
	IOFS = VARPTR(IVAR)-1
D	WRITE (5,9902) VARNAM(IVAR),IOFS,LVAR
D9902	FORMAT (' FOUND VARIABLE ',A8,' IOFS,LENGTH:',3I5)
	DO (I=1,LVAR) VALUE(I) = HEAP(IOFS+I)
D	WRITE (5,9912) (VALUE(I),I=1,LVAR)
D9912	FORMAT (' VALUE: ',60A1)
	GETVAR = LVAR
	RETURN
	FIN

	END
C
C	FUNCTION TO HASH AND FIND THE VARIABLE NAME.
C	RETURNS INDEX OF NAME, OR INDEX OF FIRST EMPTY SLOT, OR 0.
	INTEGER FUNCTION HASHV(NAME)
	REAL*8 NAME,RNAME
	BYTE RBYTE(8)
	EQUIVALENCE (RNAME,RBYTE)
	LOGICAL*1 DONE,FULL
	INTEGER HASHPR
	DATA HASHPR /199/    !HASHING PRIME (<= MAXVAR)
C
	COMMON /VARBLK/ MINVAR,NVAR,VARNAM,VARPTR,VARLEN,ENDHP,HEAP
	INTEGER MINVAR      !INDEX OF FIRST REPLACEABLE VARIABLE
	INTEGER NVAR        !CURRENT NUMBER OF VARIABLES
	REAL*8  VARNAM(200) !NAMES OF VARIABLES
	INTEGER VARPTR(200) !POINTERS INTO HEAP
	INTEGER VARLEN(200) !LENGTHS
	INTEGER ENDHP       !CURRENT END OF HEAP
	BYTE HEAP(1000)     !STORAGE FOR VARIABLES
	DATA MAXVAR/200/    !DIMENSION OF VARNAM,VARPTR,VARLEN
	DATA MAXHP /1000/   !DIMENSION OF HEAP
C
C	HASH THE NAME
C
	RNAME = NAME
	INAME = 0
	DO (I=1,8) INAME = INAME*2+RBYTE(I)
D	WRITE (5,9910) INAME
D9910	FORMAT (' HASHED NAME:',I8)
	INAME = MOD(INAME,HASHPR)+1
D	WRITE (5,9910) INAME
C
C	SEARCH THE VARIABLE LIST, STARTING AT THE HASH POSITION
C
	IVAR = INAME
	DONE = NAME.EQ.VARNAM(IVAR).OR.VARNAM(IVAR).EQ.0.0
	FULL = .FALSE.
	UNTIL (DONE.OR.FULL)
	IVAR = IVAR+1
	IF (IVAR.GT.MAXVAR) IVAR = 1
	FULL = IVAR.EQ.INAME 
	DONE  = NAME.EQ.VARNAM(IVAR) .OR. VARNAM(IVAR).EQ.0.0
	FIN
	HASHV = IVAR
	IF (FULL) HASHV = 0	
	RETURN
	END