C	OPEN OR RE-OPEN INPUT FILE
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
	SUBROUTINE OPENF(NAME,TYPE,OPNERR)
	BYTE        NAME(1)
	BYTE        TYPE,OPNERR
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
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
	REAL*4      RWIND
	DATA        RWIND /0.0/
	BYTE NAME2(26)
	BYTE DEVNAM(6),UICNAM(10)
	LOGICAL*1 SAMFIL,EQUAL
	INTEGER FDBADR
	INTEGER FEOF,ULBOPN,ULBCLS,ULBRWD,FPOSIT,FPOINT
	REAL*4 TFLREC
	INTEGER REWIND(2)
	DATA REWIND /1,0/
	INTEGER EOFERR
	DATA EOFERR /-10/

	OPNERR = .FALSE.
	LNAME = LENGTH(NAME) - 1
	SELECT (TYPE)
	('D') DELETE-FILE
	('E') DO-EXTEND-COMMAND
	('O') OPEN-OUTPUT-FILE
	('I') OPEN-INPUT-FILE
	(OTHERWISE) OPNERR = .TRUE.
	FIN
	RETURN

	TO DELETE-FILE
	SUPPLY-DEFAULT-DEVICE
D	WRITE (5,9930) (NAME(I),I=1,LNAME)
D9930	FORMAT (' DELETING FILE ',40A1)
C
C	BORROW TI: LUN
C
	CLOSE (UNIT=TILUN)
	OPEN (UNIT=TILUN,NAME=NAME,TYPE='OLD',DISP='DELETE')
	CLOSE (UNIT=TILUN)
	OPEN (UNIT=TILUN,NAME='TI:')
	FIN


	TO DO-EXTEND-COMMAND
	SUPPLY-DEFAULT-DEVICE
D	WRITE (5,9920) INLUN,OUTLUN,(NAME(I),I=1,LNAME)
D9920	FORMAT ('  EXTEND',2I5,1X,40A1)
	IF (OUTOPN) CALL CLOSEF('O')
	OPEN (UNIT=OUTLUN,NAME=NAME,TYPE='UNKNOWN')
	OUTOPN = .TRUE.
C	POSITION FILE TO EOF
	IRET = FEOF(OUTLUN)
	OPNERR = IRET.LT.0.AND.IRET.NE.EOFERR
	FIN

	TO OPEN-INPUT-FILE
C	INLVL .EQ. OLDLVL MEANS REWIND OR RE-POINT CURRENT FILE
	WHEN (INLVL.EQ.OLDLVL)
D	WRITE (5,9923) INLVL,(MODNAM(INLVL).EQ.0.0),IFLREC(1,INLVL),
D	1 IFLREC(2,INLVL)
D9923	FORMAT (' RE-POINT FILE AT LEVEL',I5,' MODNAM.EQ.0.0:',L2,
D	1 ' IFLREC:',2I6)
	WHEN (FLREC(INLVL).EQ.RWIND)
	WHEN (MODNAM(INLVL).EQ.0.0) IRET = FPOINT(INLUN,REWIND)
	ELSE IRET = ULBRWD(INLUN)
	FIN
	ELSE IRET = FPOINT(INLUN,FLREC(INLVL))
	UNLESS (IRET.EQ.EOFERR) CHECK-RETURN-CODE
	FIN
	ELSE
	IF (INLVL.GT.OLDLVL)
	STACK-INPUT-FILE-NAME
	UNLESS (OLDLVL.EQ.0)
	IRET = FPOSIT(INLUN,FLREC(OLDLVL))
	UNLESS (IRET.EQ.EOFERR) CHECK-RETURN-CODE
	FIN
	FIN
	TERM = (EQUAL(FILNAM(1,INLVL),'TI:',3))
D	WRITE (5,9901) INLVL,OLDLVL,TERM
D9901	FORMAT (' OPEN-INPUT-FILE: INLVL =',I4,' OLDLVL =',I4,' TERM =',
D	1 L1/ ' LEVEL  BLOCK   BYTE  MODULE       FILE')
D	DO 9904 IFIL=1,5
D	CALL R50ASC(6,MODNAM(IFIL),NAME2)
D9904	WRITE (5,9905) IFIL, (IFLREC(J,IFIL),J=1,2), (NAME2(J),J=1,6),
D	1 (FILNAM(J,IFIL),J=1,LFNAM(IFIL))
D9905	FORMAT (1X,I4,2O8,2X,6A1,2X,26A1)
	SAMFIL = .FALSE.
	IF (OLDLVL.NE.0) SAMFIL=(EQUAL(FILNAM(1,OLDLVL),FILNAM(1,INLVL)))
	IF (MODNAM(OLDLVL).NE.0.0) CALL ULBCLS(INLUN,ULBUF)
	UNLESS (SAMFIL)
	UNLESS (OLDLVL .EQ. 0)
D	WRITE (5,9906)
D9906	FORMAT (' CLOSING OLD FILE.')
	CALL CLSFDB(INLUN,IRET)
	CHECK-RETURN-CODE
	FIN
D	WRITE (5,9907) (FILNAM(J,INLVL),J=1,LFNAM(INLVL))
D9907	FORMAT (' ASSIGNING FILE ',40A1)
C	OPEN (UNIT=INLUN,NAME=FILNAM(1,INLVL),TYPE='OLD',READONLY)
	ICOLON = INDEX(FILNAM(1,INLVL),':')
	IBRACK = INDEX(FILNAM(ICOLON+1,INLVL),']')
	INAME = MAX0(ICOLON+1,ICOLON+IBRACK+1)
D	WRITE (5,9921) ICOLON, IBRACK, INAME
D9921	FORMAT (' ICOLON',I5,' IBRACK',I5,' INAME',I5)
	CALL MVSTR(DEVNAM,FILNAM(1,INLVL),ICOLON+1)
D	WRITE (5,9911) DEVNAM,DEVNAM
D9911	FORMAT (' DEVNAM: ',6A1,1X,6O4)
	CALL MVSTR(NAME,FILNAM(INAME,INLVL))
D	WRITE (5,9912) (NAME(J),J=1,LENGTH(NAME)-1)
D9912	FORMAT (' NAME: ',40A1)
	WHEN (IBRACK.EQ.0) CALL OPNFDB (INLUN,1,INLUN,DEVNAM,,NAME,IRET)
	ELSE
	CALL MVSTR(UICNAM,FILNAM(ICOLON+1,INLVL),IBRACK+1)
D	WRITE (5,9913) UICNAM,UICNAM
D9913	FORMAT (' UICNAM: ',10A1/1X,10O4)
	CALL OPNFDB (INLUN,1,INLUN,DEVNAM,UICNAM,NAME,IRET)
	FIN
	CHECK-RETURN-CODE
	FIN
C
C	IF NEW FILE IS A MODULE, CALL UNIV. LIBR. OPEN ROUTINE
C
	IF (MODNAM(INLVL).NE.0.0)
	IRET = ULBOPN(INLUN,MODNAM(INLVL),ULBUF)
D	WRITE (5,9908) IRET,ULBUF
D9908	FORMAT (' IRET ,ULBUF FROM ULBOPN =',I8,7O8)
	CHECK-RETURN-CODE
	FIN
	IF (INLVL.LT.OLDLVL)
C
C	IF RE-OPENING PREVIOUS FILE, POINT TO NEXT RECORD
C
	IRET = FPOINT(INLUN,FLREC(INLVL))
D	WRITE (5,9910) IRET,(IFLREC(J,INLVL),J=1,2)
D9910	FORMAT (' IRET, IFLREC FROM FPOINT =',I8,2O8)
	UNLESS (IRET.EQ.EOFERR) CHECK-RETURN-CODE
	FIN
C
C	UPDATE LEVEL
C
	OLDLVL = INLVL
	FIN
	FIN

	TO OPEN-OUTPUT-FILE
	SUPPLY-DEFAULT-DEVICE
D	WRITE (5,9922) INLUN,OUTLUN,(NAME(I),I=1,LNAME)
D9922	FORMAT ('  OUTPUT',2I5,1X,40A1)
	IF (OUTOPN) CALL CLOSEF(TYPE)
	OPEN (UNIT=OUTLUN,NAME=NAME,TYPE='NEW')
	OUTOPN = .TRUE.
	FIN

	TO STACK-INPUT-FILE-NAME
C	GET NEW MODULE NAME
	DO (I=1,6) NAME2(I) = ' '
	ICOLON = INDEX(NAME,'!')
	IF (ICOLON.GT.0)
	LNAME = MIN0(LNAME,ICOLON+6)
	DO (I=ICOLON+1,LNAME) NAME2(I-ICOLON) = NAME(I)
	LNAME = ICOLON-1
	NAME(ICOLON)  = 0
	FIN

C	CONVERT MODULE NAME TO RAD50 ON FILE STACK
	CALL IRAD50 (6,NAME2,MODNAM(INLVL))

	SUPPLY-DEFAULT-DEVICE
	CALL MVSTR (FILNAM(1,INLVL), NAME)

C	DEFAULT EXTENSION FOR NON-LIBRARY RPT INPUT FILE IS '.RPI';
C	FOR LIBRARY FILE IS '.RLB'.
	TERM = INDEX(NAME,'TI:').GT.0
	IF (.NOT.TERM .AND. INDEX(FILNAM(1,INLVL),'.').EQ.0)
	WHEN (MODNAM(INLVL).EQ.0.0)
	CALL MVSTR(FILNAM(LNAME+1,INLVL),'.RPI')
	FIN
	ELSE CALL MVSTR(FILNAM(LNAME+1,INLVL),'.RLB')
	LNAME = LNAME+4
	FIN
	IF (LNAME.GT.MAXFNM-1) ABORT-ON-INPUT-FILE-ERROR
	LFNAM(INLVL) = LNAME
	FIN

	TO SUPPLY-DEFAULT-DEVICE
C	IF DEVICE NOT GIVEN, DEFAULT DEVICE TO 'SY0:"
	IF (INDEX (NAME,':').EQ.0)
	CALL MVSTR (NAME2,'SY0:')
	CALL MVSTR (NAME2(5),NAME)
	CALL MVSTR (NAME,NAME2)
	LNAME = LNAME+4
	FIN
	FIN

	TO CHECK-RETURN-CODE
	IF (IRET.LT.0)
	WRITE (TILUN,29) IRET
29	FORMAT (' Return code =',I8)
	ABORT-ON-INPUT-FILE-ERROR
	FIN
	FIN

	TO ABORT-ON-INPUT-FILE-ERROR
	OPNERR = .TRUE.
	RETURN
	FIN

	END
C	FILE CLOSE
	SUBROUTINE CLOSEF(TYPE)
	BYTE TYPE
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
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 INPUT,OUTPUT,TABLE
	DATA INPUT,OUTPUT,TABLE /'I','O','T'/
C
	SELECT (TYPE)
	(INPUT)
	IF (MODNAM(INLVL).NE.0.0) CALL ULBCLS(INLUN,ULBUF)
	CALL CLSFDB(INLUN)
	FIN
	(OUTPUT)
	IF (OUTOPN)
	IF (OUTPTR.NE.0) CALL WRITLN
	CLOSE (UNIT=OUTLUN)
	OUTOPN = .FALSE.
	FIN
	FIN
	(TABLE)
	IF (TBOPEN)
	IF (IALT) WRITE (TABLUN'TABREC) (DATA(I),I=1,LENREC)
	IF (TABREC.GT.NREC)
	WRITE (TAILUN) TABREC
	BACKSPACE TAILUN
	FIN
	CLOSE (UNIT=TABLUN)
	CLOSE (UNIT=TAILUN)
	FIN
	FIN
	FIN
	RETURN
	END