C**********************************************************************
C
	SUBROUTINE SYOPEN( IUNIT, NAME, NDEF, NEW)
C
C   OPEN A FILE.
C	IUNIT = unit number to open on
C	NAME  = file name
C	NDEF  = the default portions of the filename
C	IFLAG = the sum of the following:
C	   = 1 if this is a new file.
C	   = 50 if NAME should only take name and extension from NDEF
C
C	THIS VERSION IS INTENDED FOR VAX OR PDP-11 FORTRAN-77
C	READONLY & CARRIAGECONTROL are not standard keywords.
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE NAME, NDEF
C
C======================================================================
C
C  Insert the default fields into the filename.
	CALL SYDFLT(NAME,NDEF)
C  Take out the pieces we don't want.
	CALL SYSKIP(NAME,NEW)
C
C======================================================================
C
C	OPEN THE FILE
C
1000	IF(MOD(NEW,2).EQ.1) GOTO 1010
C
C   Open an old file for read.
	OPEN(UNIT=IUNIT, FILE=NAME, STATUS='OLD', READONLY)
C	OPEN(UNIT=IUNIT, NAME=NAME, TYPE='OLD', SHARED)
	OPEN(UNIT=IUNIT, NAME=NAME, TYPE='OLD', READONLY)
	GOTO 9999
C
C   Create a new file.
C1010	OPEN(UNIT=IUNIT, FILE=NAME, STATUS='NEW', 
 1010	OPEN(UNIT=IUNIT, NAME=NAME, TYPE='NEW', 
     &      CARRIAGECONTROL='LIST')
C
 9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYSKIP( NAME, IFLAG)
C
C	CLEAR FIELDS OF A FILENAME THAT WE DON'T WANT.
C
C   This version is intended for RSX or VMS or RT-11.
C   The syntax for a filename is 
C   node"username password"::disk:[directory]name.extension;version
C   \_______32_one piece_________/\___16____/\8_/\___4____/\__2___/
C                 \__64__/
C
C	IFLAG is a sum of code code numbers for the pieces of the filename
C	that are to be cleared.  The code numbers are under their 
C	respective fields above.  Code 1 is not used.  Code 64 is for
C	changing the password to ?????? before printing the filename.
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE NAME(1), NDEF(1), NUL
	DATA NUL/0/
C
C  Find the pieces.
	CALL SYPARS(NAME,IDISK,IDIR,IEXT,IVER,IEND)
C
C  2 version
	JFLAG = IFLAG/2
	IF(MOD(JFLAG,2).EQ.0 .OR. IVER.EQ.IEND) GOTO 400
	DO 250,I=IVER,IEND
  250	NAME(I)=NUL
	IEND=IVER
C
C  4 extension
  400	JFLAG = JFLAG/2
	IF(MOD(JFLAG,2).EQ.0 .OR. IEXT.EQ.IVER) GOTO 800
	DO 450,I=IEXT,IVER-1
  450	NAME(I)=NUL
C
C  8 filename
  800	JFLAG = JFLAG/2
	IF(MOD(JFLAG,2).EQ.0 .OR. IDIR+1.EQ.IEXT) GOTO 1600
	DO 850,I=IDIR+1,IEXT-1
  850	NAME(I)=NUL
C
C 16 Directory
 1600	JFLAG = JFLAG/2
	IF(MOD(JFLAG,2).EQ.0 .OR. IDISK.EQ.IDIR) GOTO 3200
	DO 1650,I=IDISK+1,IDIR
 1650	NAME(I)=NUL
C
C 32 Node and disk name:
 3200	JFLAG = JFLAG/2
	IF(0.EQ.IDISK) GOTO 12800
	IF(MOD(JFLAG,2).EQ.0) GOTO 6400
	DO 3250,I=1,IDISK
 3250	NAME(I)=NUL
	GOTO 12800
C
C 64 " password":: to " ?????"::
 6400	IF(MOD(JFLAG/2,2).EQ.0) GOTO 12800
	I = 0
 6410	IF(I.EQ.IDISK) GOTO 12800
	I=I+1
	IF(NAME(I).NE.' ') GOTO 6410
C   Found password.  Clear to '"::'
 6420	I=I+1
	IF(I.GT.132 .OR. NAME(I).EQ.NUL) GOTO 12800
	IF(NAME(I).EQ.'"' .AND. NAME(I+1).EQ.':') GOTO 12800
	NAME(I)='?'
	GOTO 6420
C
C   Nothing after password--yet.
12800	JFLAG = JFLAG/4 ! note 4 this time
C
C   Now strip out the nulls.
 300	J=1
	DO 310,I=1,IEND
	IF(NAME(I).EQ.NUL) GOTO 310
	NAME(J)=NAME(I)
	J=J+1
 310	CONTINUE
	DO 320,J=J,IEND
 320	NAME(J)=NUL
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYDFLT(NAME,NDEF)
C
C	FILL IN DEFAULT FIELDS OF A FILENAME.
C
C   This version is intended for RSX or VMS or RT-11.
C   The syntax for a filename is 
C   node"username password"::disk:[directory]name.extension;version
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE NAME(1), NDEF(1)
C
C  Find the various pieces of the filename and default.
	CALL SYPARS(NAME,IDISK,IDIR,IEXT,IVER,IEND)
	CALL SYPARS(NDEF,JDISK,JDIR,JEXT,JVER,JEND)
C
C  Insert defaults into the missing fields of NAME
C
C  First the Version number
	IF(IVER.EQ.IEND)
     &    CALL INSERT(NAME,IVER,IEND,NDEF,JVER,JEND-1)
C  Extension
	IF(IEXT.EQ.IVER)
     &    CALL INSERT(NAME,IEXT,IEND,NDEF,JEXT,JVER-1)
C  Name field
	IF(IDIR+1.EQ.IEXT)
     &    CALL INSERT(NAME,IDIR+1,IEND,NDEF,JDIR+1,JEXT-1)
C  Directory
	IF(IDISK.EQ.IDIR)
     &    CALL INSERT(NAME,IDISK+1,IEND,NDEF,JDISK+1,JDIR)
C  Finally the disk
	IF(0.EQ.IDISK)
     &    CALL INSERT(NAME,1,IEND,NDEF,1,JDISK)
C  Make sure the filename ends with a null character.
	NAME(IEND) = 0
C  All done
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYPARS(NAME,IDISK,IDIR,IEXT,IVER,IEND)
C
C	FIND THE VARIOUS ELEMENTS OF THE FILENAME
C
C   This version is intended for RSX or VMS or RT-11.
C   The syntax for a filename is 
C   node"username password"::disk:[directory]name.extension;version
C  |    one big piece            |          |    |         |       |
C  0                            IDISK      IDIR IEXT      IVER    IEND
	IMPLICIT INTEGER*2 (I-N)
	BYTE NAME(40)
C
C  Assume nothing exists until it is found.
	IDISK = 0
	IDIR = 0
	IEXT = 0
	IVER = 0
	IQUOTE=0
C  Scan the name looking for punctuation marks.
	DO 100, I=1,40
	  IF(NAME(I).EQ.':') IDISK = I
	  IF(NAME(I).EQ.']') IDIR = I
	  IF(NAME(I).EQ.'.') IEXT = I
	  IF(NAME(I).EQ.';') IVER = I
	  IF(NAME(I).EQ.'"') IQUOTE = 1-IQUOTE
	  IEND = I
	  IF(NAME(I).LE.' '.AND.IQUOTE.EQ.0.AND.I.LT.132) GOTO 200
 100	CONTINUE
C
C  The returned variables should be in order; a blank field is indicated
C  by equal locations for marks.
 200	IF(IVER.EQ.0) IVER = IEND
	IF(IEXT.EQ.0) IEXT = IVER
	IF(IDIR.EQ.0) IDIR = IDISK
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE INSERT(IBIG,IAT,ILEN,LITTLE,JBEG,JEND)
C
C	Insert a little substring from LITTLE from JBEG to JEND
C	into a big string IBIG before IAT and update ILEN, the length of IBIG.
C	For example, CALL INSERT('ABCDE',2,5,'12345',3,4) will result 
C	in A34BCDE.  It was written that way because that's what I need today.
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE IBIG(1),LITTLE(1)
C
C  If the little string is length 0 then don't bother.
	IF(JBEG.GT.JEND) GOTO 9999
C
C  Make a space in IBIG
	INC = JEND - JBEG + 1
	DO 80, I=ILEN,IAT,-1
 80	IBIG(I+INC) = IBIG(I)
C
C  Move the little string into place and update the length of IBIG
	ILEN = ILEN + INC
	INC = INC - 1
	DO 90, I=0,INC
 90	IBIG(I+IAT) = LITTLE(I+JBEG)
C
C  All done.
 9999	RETURN
	END
