C	SUBROUTINES FOR RPTTAB: PRIMARILY I/O
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	FCS INTERFACE VERSION.  USES ROUTINES ADAPTED FROM
C	UIC [300,52] ON DECUS TAPE.
C
C	28-JAN-82 INCLUDE COMMON.FLX; REMOVE "TERM" ARGUMENT
C
	SUBROUTINE GETCHR(CHAR,EOF,FILERR)
	LOGICAL*1 EOF,FILERR
	BYTE CHAR
C	INCLUDE 'COMMON.FLX'
C
C	DECLARE COMMON BLOCKS
C
	COMMON      /TABDAT/  NREC,NCOLS,LENREC,IOFSET,IPTRD,TABREC,
	1                     DATA
	INTEGER     NREC,NCOLS,LENREC,IOFSET,IPTRD(41),TABREC
	BYTE        DATA(1000)

	COMMON      /LUN/     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN
	INTEGER     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN

	COMMON      /INPUT/   IREC,INPTR,LLINE,INLINE
	BYTE        INLINE(132)
	DATA        MAXIN/132/

	COMMON      /OUTPUT/  OUTLIN,OUTPTR,OUTEND
	BYTE        OUTLIN (132)
	INTEGER     OUTPTR,OUTEND
	DATA        MAXOUT /132/

	COMMON      /FILES/   FILNAM,MAXFNM,MODNAM,LFNAM,FLREC,
	1                     MAXLVL,INLVL,OLDLVL,ULBUF,CARCTL,TERM
	1                     ,OUTOPN,TBOPEN
C
C	FILE STACK
C
	BYTE        FILNAM(26,5)
	DATA        MAXFNM/26/
	REAL*4      MODNAM(5)                 !9-OCT-81 RAD50 MODULE NAMES
	INTEGER     LFNAM(5)                  !LENGTHS OF NAMES
C	                                      !POINTERS TO  START OF CURRENT
C	                                        !OR NEXT RECORD
  	REAL*4      FLREC(5)                  !9-OCT-81 CHANGED FROM
C	                                      !RECORD PTR TO BYTE PTR
C
D	INTEGER     IFLREC(2,5)
D	EQUIVALENCE (IFLREC,FLREC)
	DATA        MAXLVL/5/
	INTEGER     INLVL                     !CURRENT LEVEL POINTER
	INTEGER     OLDLVL                    !PREVIOUS LEVEL POINTER
	INTEGER     ULBUF (7)
	BYTE        CARCTL
	LOGICAL*1   TERM,OUTOPN,TBOPEN
C
C	SCRATCH MEMORY.  DEFINITIONS MAY DIFFER FROM SUBROUTINE TO SUBROUTINE,
C	OR MAY USE EQUIVALENCE STATEMENTS.
C
	COMMON      /SCRATC/  SCRATC
	BYTE        SCRATC (576)
C
C	LOCAL DECLARATIONS
C
	BYTE CARRET
	DATA CARRET/"15/
	IF (INPTR.EQ.0)
C	READ CURRENT INPUT
	CALL RDLINE(FILERR,EOF)
	IREC = IREC+1
	FIN
	INPTR = INPTR+1
	CONDITIONAL
	(INPTR.GT.LLINE)
	CHAR = CARRET
	INPTR = 0
	FIN
	(OTHERWISE) CHAR = INLINE(INPTR)
	FIN
	RETURN
	END
C
C	Subroutine to read a line from the current input file into
C	common block /INPUT/.  If standard input is a file (or module),
C	the current level pointer [FLREC(INLVL)] is updated to point
C	to the start of the record.
C
	SUBROUTINE RDLINE (FILERR,EOF)
	LOGICAL*1 PRFLAG,FILERR,EOF
C	INCLUDE 'COMMON.FLX'
C
C	DECLARE COMMON BLOCKS
C
	COMMON      /TABDAT/  NREC,NCOLS,LENREC,IOFSET,IPTRD,TABREC,
	1                     DATA
	INTEGER     NREC,NCOLS,LENREC,IOFSET,IPTRD(41),TABREC
	BYTE        DATA(1000)

	COMMON      /LUN/     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN
	INTEGER     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN

	COMMON      /INPUT/   IREC,INPTR,LLINE,INLINE
	BYTE        INLINE(132)
	DATA        MAXIN/132/

	COMMON      /OUTPUT/  OUTLIN,OUTPTR,OUTEND
	BYTE        OUTLIN (132)
	INTEGER     OUTPTR,OUTEND
	DATA        MAXOUT /132/

	COMMON      /FILES/   FILNAM,MAXFNM,MODNAM,LFNAM,FLREC,
	1                     MAXLVL,INLVL,OLDLVL,ULBUF,CARCTL,TERM
	1                     ,OUTOPN,TBOPEN
C
C	FILE STACK
C
	BYTE        FILNAM(26,5)
	DATA        MAXFNM/26/
	REAL*4      MODNAM(5)                 !9-OCT-81 RAD50 MODULE NAMES
	INTEGER     LFNAM(5)                  !LENGTHS OF NAMES
C	                                      !POINTERS TO  START OF CURRENT
C	                                        !OR NEXT RECORD
  	REAL*4      FLREC(5)                  !9-OCT-81 CHANGED FROM
C	                                      !RECORD PTR TO BYTE PTR
C
D	INTEGER     IFLREC(2,5)
D	EQUIVALENCE (IFLREC,FLREC)
	DATA        MAXLVL/5/
	INTEGER     INLVL                     !CURRENT LEVEL POINTER
	INTEGER     OLDLVL                    !PREVIOUS LEVEL POINTER
	INTEGER     ULBUF (7)
	BYTE        CARCTL
	LOGICAL*1   TERM,OUTOPN,TBOPEN
C
C	SCRATCH MEMORY.  DEFINITIONS MAY DIFFER FROM SUBROUTINE TO SUBROUTINE,
C	OR MAY USE EQUIVALENCE STATEMENTS.
C
	COMMON      /SCRATC/  SCRATC
	BYTE        SCRATC (576)
C
C	LOCAL DECLARATIONS
C
C	IF INPUT IS TI:, READ TERMINAL WITH PROMPT
	WHEN (TERM) CALL RDTERM(.TRUE.,MAXIN,LLINE,INLINE,FILERR,EOF)
	ELSE
C	STORE CURRENT POSITION
C 1-82 .MARK INCORPORATED IN RDFDB
	CALL RDFDB (INLUN,INLINE,MAXIN,LLINE,IERR,FLREC(INLVL))
	EOF = IERR.EQ.-10
	FILERR = .NOT. EOF .AND. (IERR.LT.0)
D	WRITE (5,9901) INLUN,IERR,IFLREC(1,INLVL),IFLREC(2,INLVL),
D	1 LLINE,(INLINE(I),I=1,LLINE)
D9901	FORMAT (' RDLINE: RDFDB ON LUN',I3,' RETURNS',I8,' FLREC =',
D	1 2O8,' LLINE =',I5/(1X,64A1))
C
C	"STANDARD" PDP11 FORTRAN VERSION:
C
C	CALL FPOSIT(INLUN,FLREC(INLVL))
C	CALL ERRSNS
C	READ (INLUN,10,ERR=11,END=12) LLINE,INLINE
C10	FORMAT (Q,132A1)
C	IREC = IREC+1
C11	CONTINUE
C	CALL ERRSNS(IERR)
C	FILERR = IERR.NE.0
C	IF (FILERR) RETURN
C	IF (.FALSE.)
C12	EOF = .TRUE.
C	FIN
	FIN
	RETURN
	END
C	Subroutine to read terminal.  First argument is .TRUE. if prompt
C	is to be given.
C
	SUBROUTINE RDTERM (PRFLAG,MAXLIN,LENLIN,INLINE,FILERR,EOF)
	LOGICAL*1 PRFLAG
	INTEGER MAXLIN,LENLIN
	BYTE INLINE(MAXLIN)
	LOGICAL*1 FILERR,EOF
C
C	INCLUDE 'COMMON.FLX'
C
C	Declare common blocks.
C
	COMMON      /TABDAT/  NREC,NCOLS,LENREC,OFFSET,IPTRD,TABREC,
	1                     DATA,IALT,IDUM
	INTEGER     NREC,NCOLS,LENREC,OFFSET,IPTRD(41),TABREC
	BYTE        DATA(1000)
	LOGICAL*1   IALT,IDUM    !1-82

	COMMON      /LUN/     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN
	INTEGER     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN

C
C	RDTERM GETS BUFFER ADDRESS AND LENGTH THROUGH ARGUMENTS, NOT COMMON,
C	BECAUSE IT MAY READ EITHER INTO A VARIABLE OR INTO /INPUT/.
C
C	COMMON      /INPUT/   IREC,INPTR,LLINE,INLINE
C	BYTE        INLINE(132)
C	DATA        MAXIN/132/

	COMMON      /OUTPUT/  OUTLIN,OUTPTR,OUTEND
	BYTE        OUTLIN (132)
	INTEGER     OUTPTR,OUTEND
	DATA        MAXOUT /132/

	COMMON      /FILES/   FILNAM,MAXFNM,MODNAM,LFNAM,FLREC,
	1                     MAXLVL,INLVL,OLDLVL,ULBUF,CARCTL,TERM
	1                     ,OUTOPN,TBOPEN
C
C	File stack.
C
	BYTE        FILNAM(26,5)
	DATA        MAXFNM/26/
	REAL*4      MODNAM(5)                 !9-OCT-81 RAD50 MODULE NAMES
	INTEGER     LFNAM(5)                  !LENGTHS OF NAMES
C	                                      !POINTERS TO  START OF CURRENT
C	                                        !OR NEXT RECORD
  	REAL*4      FLREC(5)                  !9-OCT-81 CHANGED FROM
C	                                      !RECORD PTR TO BYTE PTR
C
D	INTEGER     IFLREC(2,5)
D	EQUIVALENCE (IFLREC,FLREC)
	DATA        MAXLVL/5/
	INTEGER     INLVL                     !CURRENT LEVEL POINTER
	INTEGER     OLDLVL                    !PREVIOUS LEVEL POINTER
	INTEGER     ULBUF (7)
	BYTE        CARCTL
	LOGICAL*1   TERM,OUTOPN,TBOPEN
C
C	Scratch memory.  Definitions may differ from subroutine to subroutine,
C	or may use equivalence statements.
C
	COMMON      /SCRATC/  SCRATC
	BYTE        SCRATC (576)
C
C	Local declarations.
C
C	Force inclusion of IOWDS
	EXTERNAL IOWDS
C
C	IOWDS is filled in by a MACRO routine
C	IREAD = read-with-no-case-conversion
C	IRPR = read-with-prompt-and-no-case-conversion
C	IEEOF = IE.EOF
C
	COMMON/IOWDS/IREAD,IRPR,IEEOF
	INTEGER IPRM(6),ISTAT(2),IREAD,IRPR,IEEOF
C
	DATA PROMPT/"12,'R','P','T','>',' '/
	BYTE BSTAT(4),PROMPT(6)
	EQUIVALENCE (BSTAT,ISTAT)
	DATA LPRMPT/6/
	INTEGER TMOUT
C	Allow 2-minutes for reply
	DATA TMOUT/12/
	CALL GETADR(IPRM,INLINE)
	IPRM(2) = MAXLIN
	IPRM(3) = TMOUT
	WHEN (PRFLAG)
	CALL GETADR(IPRM(4),PROMPT)
	IPRM(5) = LPRMPT
	CALL WTQIO(IRPR,TILUN,1,,BSTAT,IPRM)
	FIN
	ELSE
	CALL WTQIO(IREAD,TILUN,1,,BSTAT,IPRM)
C	advance cursor to next line (i.e. echo <cr> by <crlf>)
	WRITE (TILUN,15)
15	FORMAT (1X)
	FIN
	IERR =BSTAT(1)
	EOF = IERR.EQ.IEEOF
	FILERR = .NOT.EOF .AND. (IERR.LT.0)
	LENLIN = ISTAT(2)
	END
C
C	Subroutine to get an operand from the current input.
C	The first argument gives the degree of indirection allowed:
C	0:        No indirection.
C	1:        One level...
C	-1:       "infinite"
C
	SUBROUTINE GETNAM (INDIR,NAME,MAXNAM,LNAME,FILERR,QUOTED,QUOTER)
	BYTE NAME(MAXNAM)
	LOGICAL*1 EOF,FILERR,QUOTED,QUOTER
C	INCLUDE 'COMMON.FLX'
C
C	DECLARE COMMON BLOCKS
C
	COMMON      /TABDAT/  NREC,NCOLS,LENREC,IOFSET,IPTRD,TABREC,
	1                     DATA
	INTEGER     NREC,NCOLS,LENREC,IOFSET,IPTRD(41),TABREC
	BYTE        DATA(1000)

	COMMON      /LUN/     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN
	INTEGER     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN

	COMMON      /INPUT/   IREC,INPTR,LLINE,INLINE
	BYTE        INLINE(132)
	DATA        MAXIN/132/

	COMMON      /OUTPUT/  OUTLIN,OUTPTR,OUTEND
	BYTE        OUTLIN (132)
	INTEGER     OUTPTR,OUTEND
	DATA        MAXOUT /132/

	COMMON      /FILES/   FILNAM,MAXFNM,MODNAM,LFNAM,FLREC,
	1                     MAXLVL,INLVL,OLDLVL,ULBUF,CARCTL,TERM
	1                     ,OUTOPN,TBOPEN
C
C	FILE STACK
C
	BYTE        FILNAM(26,5)
	DATA        MAXFNM/26/
	REAL*4      MODNAM(5)                 !9-OCT-81 RAD50 MODULE NAMES
	INTEGER     LFNAM(5)                  !LENGTHS OF NAMES
C	                                      !POINTERS TO  START OF CURRENT
C	                                        !OR NEXT RECORD
  	REAL*4      FLREC(5)                  !9-OCT-81 CHANGED FROM
C	                                      !RECORD PTR TO BYTE PTR
C
D	INTEGER     IFLREC(2,5)
D	EQUIVALENCE (IFLREC,FLREC)
	DATA        MAXLVL/5/
	INTEGER     INLVL                     !CURRENT LEVEL POINTER
	INTEGER     OLDLVL                    !PREVIOUS LEVEL POINTER
	INTEGER     ULBUF (7)
	BYTE        CARCTL
	LOGICAL*1   TERM,OUTOPN,TBOPEN
C
C	SCRATCH MEMORY.  DEFINITIONS MAY DIFFER FROM SUBROUTINE TO SUBROUTINE,
C	OR MAY USE EQUIVALENCE STATEMENTS.
C
	COMMON      /SCRATC/  SCRATC
	BYTE        SCRATC (576)
C
C	LOCAL DECLARATIONS
C
	INTEGER GETVAR
	REAL*8 VARNAM
	BYTE BVAR(8)
	EQUIVALENCE (BVAR,VARNAM)
	BYTE CHAR
	BYTE CARRET
	DATA CARRET/"15/
C
	QUOTED = .FALSE.
	FILERR = .FALSE.
	QUOTER = .FALSE.
	LNAME = 0
	REPEAT UNTIL (CHAR.NE.' ')
	GET-CHARACTER
	FIN
D	WRITE (5,9901) INDIR,CHAR
D9901	FORMAT (' GETNAM: INDIR =',I5,' FIRST NON-BLANK CHAR:',O8)
	SELECT (CHAR)
	('''')
	QUOTED = .TRUE.
	GET-CHARACTER
	UNTIL (CHAR.EQ.''''.OR.CHAR.EQ.CARRET.OR.LNAME.EQ.MAXNAM)
	LNAME = LNAME+1
	NAME(LNAME) = CHAR
	GET-CHARACTER
	FIN
	IF (CHAR.NE.'''') REPORT-UNBALANCED-QUOTES

	FIN
	('"')
	QUOTED = .TRUE.
	GET-CHARACTER
	UNTIL (CHAR.EQ.'"'.OR.CHAR.EQ.CARRET.OR.LNAME.EQ.MAXNAM)
	LNAME = LNAME+1
	NAME(LNAME) = CHAR
	GET-CHARACTER
	FIN
	IF (CHAR.NE.'"') REPORT-UNBALANCED-QUOTES
	FIN
	(OTHERWISE)
	UNTIL (CHAR.EQ.' '.OR.CHAR.EQ.CARRET.OR.LNAME.EQ.MAXNAM)
	LNAME = LNAME+1
	NAME(LNAME) = CHAR
	GET-CHARACTER
	FIN
	FIN
	FIN
	UNLESS (QUOTED .OR. (INDIR.EQ.0)) FIND-VARIABLE
D	WRITE (5,9902) LNAME,(NAME(I),I=1,LNAME)
D9902	FORMAT (' GETNAM RETURNS LENGTH, STRING:',I5/(1X,80A1))
	NAME (LNAME+1) = 0
	RETURN

	TO GET-CHARACTER
	CALL GETCHR(CHAR,EOF,FILERR)
	IF (FILERR) RETURN
	FIN

	TO REPORT-UNBALANCED-QUOTES
	WRITE (TILUN,90)
90	FORMAT (' Unbalanced quotes')
	QUOTER = .TRUE.
	RETURN
	FIN

	TO FIND-VARIABLE
	JINDIR = INDIR
	IF (JINDIR.LT.0) JINDIR = 32767
	LENVAR = 0
	IINDIR = 1
	WHILE (IINDIR.LE.JINDIR .AND. LENVAR.NE.-2 .AND. LNAME.LE.8)
	VARNAM = '        '
	DO (I=1,LNAME) BVAR(I) = NAME(I)
	LENVAR = GETVAR (VARNAM,NAME,MAXNAM)
	IF (LENVAR.GT.0) LNAME = LENVAR
D	WRITE (5,9903) IINDIR,VARNAM,LENVAR,(NAME(I),I=1,LENVAR)
D9903	FORMAT (' IN FIND-VARIABLE: IINDIR =',I3,' VARNAM = ',A8,
D	1 ' LENVAR = ',I4,' NAME ='/(1X,60A1))
	IINDIR = IINDIR + 1
	FIN
	FIN
	END
C	SUBROUTINE TO WRITE A LINE OF OUTPUT
	SUBROUTINE WRITLN
C
C	INCLUDE 'COMMON.FLX'
C
C	Declare common blocks.
C
	COMMON      /TABDAT/  NREC,NCOLS,LENREC,OFFSET,IPTRD,TABREC,
	1                     DATA,IALT,IDUM
	INTEGER     NREC,NCOLS,LENREC,OFFSET,IPTRD(41),TABREC
	BYTE        DATA(1000)
	LOGICAL*1   IALT,IDUM    !1-82

	COMMON      /LUN/     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN
	INTEGER     INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN

	COMMON      /INPUT/   IREC,INPTR,LLINE,INLINE
	BYTE        INLINE(132)
	DATA        MAXIN/132/

	COMMON      /OUTPUT/  OUTLIN,OUTPTR,OUTEND
	BYTE        OUTLIN (132)
	INTEGER     OUTPTR,OUTEND
	DATA        MAXOUT /132/

	COMMON      /FILES/   FILNAM,MAXFNM,MODNAM,LFNAM,FLREC,
	1                     MAXLVL,INLVL,OLDLVL,ULBUF,CARCTL,TERM
	1                     ,OUTOPN,TBOPEN,OUTFIL
C
C	File stack.
C
	BYTE        FILNAM(26,5)
	DATA        MAXFNM/26/
	REAL*4      MODNAM(5)                 !9-OCT-81 RAD50 MODULE NAMES
	INTEGER     LFNAM(5)                  !LENGTHS OF NAMES
C	                                      !POINTERS TO  START OF CURRENT
C	                                        !OR NEXT RECORD
  	REAL*4      FLREC(5)                  !9-OCT-81 CHANGED FROM
C	                                      !RECORD PTR TO BYTE PTR
C
D	INTEGER     IFLREC(2,5)
D	EQUIVALENCE (IFLREC,FLREC)
	DATA        MAXLVL/5/
	INTEGER     INLVL                     !CURRENT LEVEL POINTER
	INTEGER     OLDLVL                    !PREVIOUS LEVEL POINTER
	INTEGER     ULBUF (7)
	BYTE        CARCTL
	LOGICAL*1   TERM,OUTOPN,TBOPEN
	BYTE        OUTFIL(26)
C
C	Scratch memory.  Definitions may differ from subroutine to subroutine,
C	or may use equivalence statements.
C
	COMMON      /SCRATC/  SCRATC
	BYTE        SCRATC (576)
C
C	Local declarations.
C
C	code
C
	UNLESS (OUTOPN)
	CALL OPENF(OUTFIL,'O',EVALER)
	IF (EVALER) CALL ERROR (6,OUTFIL,MAXFNM)
	FIN
	WHEN (CARCTL.NE.NULL)
	WHEN (OUTEND.GT.0) WRITE (OUTLUN,20) CARCTL,(OUTLIN(I),I=1,OUTEND)
	ELSE WRITE (OUTLUN,20) CARCTL
20	FORMAT (133A1)
	FIN
	ELSE
	WHEN (OUTEND.GT.0) WRITE (OUTLUN,20) (OUTLIN(I),I=1,OUTEND)
	ELSE WRITE (OUTLUN,20) 
	FIN
	OUTPTR = 0
	OUTEND = 0
	RETURN
	END