C;+
C - F I L E
C****NAME:   File handling subroutines for FLECS/ALECS
C    FILE:   FILE.FLX
C
C****PURPOSE:  Perform file handling for FLECS/ALECS.
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/F77
C AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
C DATE:       25-OCT-74
C REVISIONS:
C 1980 (GTA) CONVERT MACRO IN FLERSX TO FORTRAN.
C;-
	.PASSUNLESS VAX
	.PASSUNLESS PDP
	ERROR--MUST GIVE EITHER /CO:VAX OR /CO:PDP
	.PASSEND
	.PASSEND
 
	.PASSUNLESS FLECS
	.PASSUNLESS ALECS
	ERROR--MUST GIVE EITHER /CO:FLECS OR /CO:ALECS
	.PASSEND
	.PASSEND
 
	.NAME CLOSEF
C;+
C - C L O S E F
C****NAME:   SUBROUTINE CLOSEF
C    FILE:   FILE.FLX
C
C****PURPOSE:  CLOSE OPEN FILES FOR FLECS/ALECS
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/F77
C AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
C DATE:       25-OCT-74
C REVISIONS:
C 1980GTA Convert macro to fortran.
C 850227mao Rewritten to use FCLOSE, /ERRS/; do not put cmd line at end
C		of listing (since its at top of every page).
C
C****CALLING SEQUENCE:  	CALL CLOSEF(MINCNT,MAJCNT)
C
C		INPUT: 
C
C MINCNT=(I*2) COUNT OF MINOR ERRORS (WARNINGS) ENCOUNTERED
C MAJCNT=(I*2) COUNT OF MAJOR ERRORS ENCOUNTERED.  IF MAJCNT=-1, A
C		SYMBOL TABLE OVERFLOW HAS OCCURRED.
C 
C	       OUTPUT:  NONE
C
C	CMN BLOCK I/O: NONE
C
C	    RESOURCES:
C LIBRARIES:   QLIB:MSGOUT
C OTHER SUBR:  FCLOSE, EXFLE, PUT, PUTNUM
C DISK FILES:  FLX, FTN AND FLL FILES
C DEVICES:     DISK
C SGAS:        NONE
C EVENT FLAGS: None
C SYSTEM DIR:  None
C
C****NOTES:  
C 1.  THIS ROUTINE NOW DOES THE FOLLOWING:
C
C	1. IF THERE ARE ANY ERRORS, OUTPUTS ERROR COUNT TO BOTH THE
C	   LISTING AND THE TERMINAL.
C	2. IF 'ERROR' IS NEGATIVE (INDICATING AN ABORT) OUTPUTS AN ABORT
C	   MESSAGE TO THE TERMINAL.
C	3. CLOSES FILES.
C	4. IF 'ERROR' IS NEGATIVE, EXITS; OTHERWISE, RETURNS.
C;-
	.PAGE
      SUBROUTINE CLOSEF(IWARN,IERR)
 
	.PASSIF VAX
	.INCLUDE [MP1Q.FLEALECOM]FILDAT.INC
	.PASSEND
	.PASSIF PDP
	.INCLUDE [201,13]FILDAT.INC
	.PASSEND
 
	INTEGER*2 SEVFLG,ERRFLG,WRNFLG
	COMMON/ERRS/SEVFLG,ERRFLG,WRNFLG
 
C	Local declarations
 
	INTEGER*2 BLANK(2)      !LOC, R/W, blank line
	INTEGER*2 ERRMS(23)     !LOC, R/W, error message string
	INTEGER*2 IERR          !EXT, R, # of errors generated
	INTEGER*2 IWARN         !EXT, R, # of warnings
 
	DATA BLANK /2,'  '/
 
	DATA ERRMS /42,3*'  ',3*'  ','ER','RO','RS',5*'  ',3*'  ',
	1 'WA','RN','IN','GS',0/
	.PAGE
 
	CONDITIONAL
	(IERR.LT.0)
	CALL MSGOUT('F-Aborted due to table overflow.')
	SEVFLG=SEVFLG+1
	FIN
	((IWARN.NE.0).OR.(IERR.NE.0))
	IF (IWARN.NE.0) WRNFLG=WRNFLG+1
	IF (IERR.NE.0) ERRFLG=ERRFLG+1
 
	CALL PUTNUM (ERRMS(4),IERR)	!insert # of errors
	CALL PUTNUM (ERRMS(15),IWARN)	!insert # of warnings
 
	CALL MSGOUT (ERRMS(5))		!output to TI:
	IF (LIST)
	CALL PUT (0,BLANK,2)	!output blank line
	CALL PUT (0,ERRMS,2)	!output to listing file
	FIN!if
	FIN
	FIN!conditional
 
	CALL FCLOSE
 
	IF (IERR.LT.0) CALL EXFLE		!things are hopeless

	RETURN
	END
	.NAME EXFLE
C;+
C - E X F L E
C****NAME:   SUBROUTINE EXFLE
C    FILE:   FILE.FLX
C
C****PURPOSE:  EXIT ROUTINE FOR FLECS TO RETURN EXIT STATUS TO CALLER
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/F77
C AUTHOR:     M. OOTHOUDT
C DATE:       02-MAY-80
C REVISIONS:
C 850211mao Complete rewrite to convert macro to fortran.
C
C****CALLING SEQUENCE:  CALL EXFLE
C
C		INPUT: NONE
C
C	       OUTPUT: NONE
C
C	CMN BLOCK I/O: /ERRS/
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  NONE
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  EXIT
C
C****NOTES:  
C	1.  THIS ROUTINE USES THE VALUE OF VARIABLES SEVFLG, ERRFLG,
C AND WRNFLG TO DETERMINE IF IT SHOULD EXIT WITH A SEVERE ERROR, AN
C ERROR, A WARNING OR SUCCESS.  THE PURPOSE OF EXIT-WITH-STATUS IS TO
C ALLOW A TASK THAT RUNS FLECS (EG. INDIRECT MCR OR SPAWN) TO DETERMINE
C IF FLECS WAS SUCCESSFUL.  EG. THE CALLER MIGHT SPAWN FORTRAN IF AND
C ONLY IF FLECS IS SUCCESSFUL.
C
C	2.  THE STATUS VALUES RETURNED ARE
C SEVERE - FLECS ABORTED EXTERNALLY (EXEC FUNCTION),
C	   FLECS SELF-ABORTED DUE TO TABLE OVERFLOW, OR
C	   INPUT ERROR IN COMMAND LINE.
C ERROR  - TRANSLATION ERROR IN PROCESSING SOURCE FILE.
C WARNING- TRANSLATION WARNING IN SOURCE FILE.
C SUCCESS- NONE OF THE ABOVE.
C
C	3.  BECAUSE "FLE @FILE" IS LEGAL, IT IS NECESSARY FOR FLECS TO
C KEEP A SUM OF ALL ERRORS AND WARNINGS SO THAT WHEN IT FINALLY
C EXITS, IT WILL KNOW IF SUCH PROBLEMS OCCURRED ON ANY TRANSLATION,
C NOT JUST THE LAST ONE DONE.
C
C	4.  AN INPUT ERROR IS TREATED AS A SEVERE ERROR MAINLY TO
C DISTINGUISH IT FROM A TRANSLATION PROBLEM.  ALSO THIS USAGE IS FAIRLY
C COMMON AND MAKES REASONABLE SENSE IN INDIRECT MCR OR SPAWN MODES.
C;-
	.PAGE
	SUBROUTINE EXFLE
 
	INTEGER*2 SEVFLG,ERRFLG,WRNFLG
	INTEGER*2 STATUS,EXSUC,EXSEV,EXERR,EXWAR
 
	COMMON/ERRS/SEVFLG,ERRFLG,WRNFLG
 
	PARAMETER (EXSUC=1)	!success
	PARAMETER (EXWAR=3)	!warning
	PARAMETER (EXERR=2)	!error
	PARAMETER (EXSEV=4)	!severe error
 
	CONDITIONAL
	(SEVFLG.NE.0) STATUS=EXSEV
	(ERRFLG.NE.0) STATUS=EXERR
	(WRNFLG.NE.0) STATUS=EXWAR
	(OTHERWISE) STATUS=EXSUC
	FIN!conditional
 
	CALL EXIT (STATUS)
	END
	.NAME GET
C;+
C - G E T
C****NAME:   SUBROUTINE GET
C    FILE:   FILE.FLX
C
C****PURPOSE:  READ A LINE FROM THE FLX/ALX FILE
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/F77
C AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
C DATE:       25-OCT-74
C REVISIONS:
C 1980GTA Convert macro to fortran.
C 850211mao Update to agree with latest version of FLERSX.MAC.
C
C****CALLING SEQUENCE:  CALL GET(LINENO,STRING,ENDFIL,ERR1,ERR2)
C
C		INPUT: 
C
C LINENO=(I*2) NUMBER OF LAST LINE READ FROM FLX FILE
C 
C	       OUTPUT:  
C
C LINENO=(I*2) INCREMENTED BY ONE FOR EACH LINE READ FROM FLX FILE
C STRING=STRING OF UP TO 72 CHARACTERS READ FROM FLX FILE
C		(to guard against some "line-too-long" errors, this
C		array should be at least 83 bytes long!)
C ENDFIL=(L*2) SET TO .TRUE. IF READ EOF, .FALSE. OTHERWISE
C ERR1	=(I*2) .NE.0==>NON-EOF READ ERROR (F.ERR)
C ERR2	=(I*2) DEFINDED ONLY IF ERR1.NE.0
C		=0==>I/O ERROR, <0==>DSW ERROR (F.ERR+1),
C		>0==>EXPANDING TABS GAVE TOO LONG A LINE.
C
C	CMN BLOCK I/O: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  FGET, ROPN
C DISK FILES:  FLX READ
C DEVICES:     DISK
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C	1. REWRITTEN JUNE 28, 1977 BY RICHARD KITTELL, LASL MP-1 TO
C HANDLE TAB CHARACTERS PROPERLY: (1) A TAB IN THE STATEMENT
C NUMBER FIELD FOLLOWED BY A BLANK OR A DIGIT 0-9 MOVES THE DIGIT
C TO THE CONTINUATION FIELDC (2) A TAB IN THE STATEMENT NUMBER
C FIELD FOLLOWED BY ANY OTHER CHARACTER MOVES THAT CHARACTER TO THE
C STATEMENT FIELDC (3) A TAB ANYWHERE ELSE IS REPLACED BY ENOUGH
C BLANKS TO BRING THE COLUMN NUMBER TO A MULTIPLE OF 8C (4) ALL
C TABS IN COMMENT LINES ARE HANDLED AS IN -3-, ABOVE.
C
C	2. THE ABOVE FIX FOR TABS DOES NOT WORK COMPLETELY.
C THERE IS NO GENERAL FIX SINCE THE INDENTATION
C IN THE FLL FILE IS NOT THE SAME NUMBER OF COLUMNS AS A TAB.  AS
C AN EXAMPLE CONSIDER THE FOLLOWING INPUT AND THE RESULTING FLL
C LISTING.  (LOCATION OF TAB COLUMNS SHOWN BY V AND TABS BY *.)
C
C	V	V	V	V
C	WHEN (I.GT.J)			!INPUT AS TYPED BY PROGRAMMER
C	IJKL=1* !A
C	M=2*    !B
C
C	WHEN (I.GT.J)			!FLL LISTING FILE
C	.  IJKL=1*      !A
C	.  M=2* !B
C
C NOTE THERE IS NO (SIMPLE) WAY TO GET THIS EXAMPLE TO WORK OUT RIGHT
C (AND EVEN IF YOU COULD, THINGS WOULDN'T WORK FOR MULTIPLE INDENTATIONS).
C
C	3.  IF ERR1 IS NONZERO, INPUT MAY STILL BE RETURNED TO CALLER.
C EG. FOR A "LINE-TOO-LONG" ERROR, THE TRUNCATED INPUT IS RETURNED.
C NOTE THAT ERR2 MAY HAVE ANY RANDOM VALUE IF ERR1=0.
C;-
	.PAGE
      SUBROUTINE GET(LINENO,STRING,ENDFIL,ERR1,ERR2)	!850211mao
 
	.PASSIF VAX
	.INCLUDE [MP1Q.FLEALECOM]FILDAT.INC		!850213mao
	.INCLUDE [MP1Q.FLEALECOM]INCDAT.INC		!850213mao
	.PASSEND
	.PASSIF PDP
	.INCLUDE [201,13]FILDAT.INC		!850213mao
	.INCLUDE [201,13]INCDAT.INC		!850213mao
	.PASSEND
 
	LOGICAL*2 ALECS,LSTFUL
	INTEGER*2 TYPIN,TYPLST,TYPOUT,CHCMNT
      COMMON/MACVAL/ALECS,TYPIN,TYPLST,TYPOUT,CHCMNT,LSTFUL!850211mao
 
C	Local variables
 
      INTEGER*2 LINENO,STNO,INPNO,NB,ERR1,ERR2,LEN	!850211mao
	INTEGER*2 NCHAR,I,N
      BYTE INPUT(80),STRING(82),TEST,TAB
      LOGICAL*2 ENDFIL,GOTLIN,EOF			!850213mao
	BYTE LENB(2)					!850213mao
 
	EQUIVALENCE (LEN,LENB(1))			!850213mao
   
      DATA TAB/"11/
	.PAGE
 
      LINENO = LINENO + 1
	ENDFIL=.FALSE.					!850213mao
	LEN=0						!850213mao
	ERR1=0						!850213mao
 
	GET-INPUT-LINE					!850213mao
	IF (.NOT.ENDFIL)				!850213mao
 
	IF (NCHAR.GT.0)					!850213mao
 
C IF INPUT IS A COMMENT, PROCESS 80 CHARS; IF NOT, PROCESS 72.
C (Note FORTRAN throws away characters beyond 73 without warning but
C prints them on listing!  For noncomment lines, FLECS throws them away
C and does NOT print them to warn the user that something is lost.)
 
      IF ((NCHAR.GT.72).AND.(INPUT(1).NE.CHCMNT)) NCHAR = 72
      STNO = 3
      INPNO = 1
      REPEAT UNTIL ((STNO.GT.74).OR.(INPNO.GT.NCHAR))	!850213mao
 
C	Test on STNO>74 is right!  STNO is pointer into STRING array &
C	1st 2 bytes of STRING are a character count.  Thus max # allowed
C	characters is 72--see comment a few lines above.
 
      WHEN (INPUT(INPNO).EQ.TAB) PROCESS-TAB
      ELSE
      STRING(STNO) = INPUT(INPNO)
      STNO = STNO + 1
      FIN
      INPNO = INPNO + 1
      FIN
C  SAVE # OF CHARACTERS
	IF (STNO.GT.75)					!850213mao
	STNO = 75	!truncate to allowed #		!850213mao
	ERR1 = "177730	!IE.RBG as in FLERSX.MAC	!850213mao
	ERR2 = 1					!850213mao
	FIN!if
 
	LEN=STNO-3					!850213mao
C
C	CHECK FOR BLANK LINE; STRIP OFF TRAILING BLANKS
C
	I = LEN+2					!850213mao
	WHILE (STRING(I).EQ.(1H )) I = I-1
	LEN = I-2					!850213mao
 
	FIN!if						!850213mao
	FIN!if						!850213mao
 
	STRING(1) = LENB(1)				!850213mao
	STRING(2) = LENB(2)				!850213mao
 
      RETURN
	.PAGE
	TO GET-INPUT-LINE				!850213mao
 
	REPEAT UNTIL (GOTLIN .OR. ENDFIL)		!850213mao
 
	GOTLIN = .TRUE.
	CALL FGET (NCHAR,INPUT,EOF,ERR1,ERR2)		!850213mao
 
	IF (EOF)		!eof on input processing
 
	WHEN (INCLVL.EQ.0) ENDFIL=.TRUE.
	ELSE
	CALL ROPN (.TRUE.)	!go to previous level, close cur file
	GOTLIN=.FALSE.		!try again
	FIN!else
	FIN!if
 
	FIN!repeat until
	FIN!to get-input-line
	.PAGE
      TO PROCESS-NORMAL-TAB
 
C	Note this routine might generate characters beyond col 72
C	(by one tab's worth).
 
C  N IS NEXT COLUMN THAT IS MULTIPLE OF 8+1
 
      N = ((STNO-2+8-1)/8)*8+1
      NB = N - (STNO-2)
      IF (NB.LT.1) NB = 1
 
C  PUT NB BLANKS IN STRING.
 
      DO (I = 1,NB)
      STRING(STNO) = (1H )
      STNO = STNO + 1
      FIN!do
      FIN!to process-normal-tab
	.PAGE
      TO PROCESS-TAB
 
C	Note this routine might generate characters beyond col 72
C	(by one tab's worth).
 
      CONDITIONAL
 
C      TAB IS LAST CHARACTER IN INPUT
      (INPNO.EQ.NCHAR) CONTINUE
 
C     LINE BEING PROCESSED IS A COMMENT
      (INPUT(1).EQ.CHCMNT) PROCESS-NORMAL-TAB
 
C     Are we past label & continuation field?
      ((STNO-3).GE.6) PROCESS-NORMAL-TAB		!850213mao
 
      (OTHERWISE)
C        TAB IS IN FIRST 5 COLUMNS OF LINE
C        NB = # OF BLANKS TO INSERT
      TEST = INPUT(INPNO + 1)
      CONDITIONAL
      (TEST.EQ.(1H )) NB = 5
      ((TEST.GE.1H0).AND.(TEST.LE.1H9)) NB = 5
      (OTHERWISE) NB = 6
      FIN
      NB = NB - (STNO-3)
C  PUT NB BLANKS IN STRING
      DO (I = 1,NB)
      STRING(STNO) = (1H )
      STNO = STNO + 1
      FIN!do
      FIN
      FIN
      FIN!to process-tab
      END
	.NAME NEWNAM
C;+
C - N E W N A M
C****NAME:   SUBROUTINE NEWNAM
C    FILE:   FILE.FLX
C
C****PURPOSE:  CHANGE THE NAME IN HEADER LINE 2 DUE TO .NAME DIRECTIVE
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/FORTRAN
C AUTHOR:     M. OOTHOUDT
C DATE:       30-JUN-81
C REVISIONS:
C 850214mao Convert macro to fortran
C 850305mao Force a new page for this directive.
C
C****CALLING SEQUENCE:  CALL NEWNAM(LEN,NAME)
C
C		INPUT: 
C
C LEN	=(I*2) NUMBER OF CHARACTERS IN NAME; IF =0, THE CURRENT
C		NAME IN THE PAGE HEADER IS BLANKED OUT.
C NAME	=(ASCII ARRAY) THE NAME TO PUT IN THE HEADER
C
C	       OUTPUT:  NONE
C
C	CMN BLOCK I/O: /FILES/
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  NONE
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C	1. This directive forces a new page.  Thus the new value for
C "name" will appear immediately on a new page without the need for a
C .PAGE directive.  The ".NAME name" line will appear on the new page.
C;-
	.PAGE
 
	SUBROUTINE NEWNAM (LEN,NAME)
 
	.PASSIF VAX
	.INCLUDE [MP1Q.FLEALECOM]FILDAT.INC
	.PASSEND
	.PASSIF PDP
	.INCLUDE [201,13]FILDAT.INC
	.PASSEND
 
C	Local Variables
 
	INTEGER*2 I		!scratch
	INTEGER*2 LEN		!EXT, R, # characters in name
	INTEGER*2 LENU		!# characters used from NAME
	BYTE      NAME(6)	!EXT, R, characters input with .NAME
 
	LENU = MIN (6,LEN)
 
	IF (LENU.GT.0)
	DO (I=1,LENU) NAMEHD(I) = NAME(I)
	FIN!if
 
	IF (LENU.LT.6)
	DO (I=LENU+1,6) NAMEHD(I) = (1H )
	FIN!if
 
	CALL NEWPG		!force new page		!850305mao
	RETURN
	END
	.NAME NEWPG
C;+
C - N E W P G
C****NAME:   SUBROUTINE NEWPG
C    FILE:   FILE.FLX
C
C****PURPOSE:  PUT OUT A NEW PAGE
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/FORTRAN
C AUTHOR:     M. OOTHOUDT
C DATE:       22-JUN-81
C REVISIONS:
C 850214mao Convert from macro to fortran.
C
C****CALLING SEQUENCE:  CALL NEWPG
C
C		INPUT: NONE
C
C	       OUTPUT:  NONE
C
C	CMN BLOCK I/O: /FILES/
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  NONE
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C;-
	.PAGE
 
	SUBROUTINE NEWPG
 
	.PASSIF VAX
	.INCLUDE [MP1Q.FLEALECOM]FILDAT.INC
	.PASSEND
	.PASSIF PDP
	.INCLUDE [201,13]FILDAT.INC
	.PASSEND
 
	LINCNT = 0	!# lines left on current page
 
	RETURN
	END
	.NAME OPENF
C;+
C - O P E N F
C****NAME:   SUBROUTINE OPENF
C    FILE:   FILE.FLX
C
C****PURPOSE:  GET COMMAND LINE FOR FLECS, OPEN INPUT AND OUTPUT FILES
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/F77
C AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
C DATE:       25-OCT-74
C REVISIONS:
C 1980 (GTA) CONVERT MACRO TO FORTRAN.
C 850227mao Rewrite to use FOPN, add /CO, etc.
C 850327mao Put CSI variables into /CSIVR1/.
C
C****CALLING SEQUENCE:  CALL OPENF(CALLNO,DONE,SVER)
C
C		INPUT: 
C
C CALLNO=(I*2)NUMBER OF TIMES OPENF HAS BEEN CALLED BEFORE THIS
C SVER	=STRING TO HEAD FLL PAGES
C 
C	       OUTPUT:  
C
C DONE	=(L*2) .TRUE. IF NO MORE INPUT PRESENT, .FALSE. OTHERWISE
C
C	CMN BLOCK I/O: /CSIVR1/
C
C	    RESOURCES:
C LIBRARIES:   SYSLIB:DATE:TIME
C		QLIB:CSI:CSIGO:CSISW:CSIVAL:GETCML:MSGOUT
C OTHER SUBR:  EXFLE, FOPN
C DISK FILES:  FLX, FTN AND FLL FILES
C DEVICES:     DISK FILES
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C;-
	.PAGE
      SUBROUTINE OPENF (CALLNO,DONE,SVER)
 
	.PASSIF VAX
	.INCLUDE [MP1Q.FLEALECOM]FILDAT.INC
	.INCLUDE [MP1Q.FLEALECOM]INCDAT.INC
	.PASSEND
	.PASSIF PDP
	.INCLUDE [201,13]FILDAT.INC
	.INCLUDE [201,13]INCDAT.INC
	.PASSEND
 
	INTEGER*2 SEVFLG,ERRFLG,WRNFLG
	COMMON/ERRS/SEVFLG,ERRFLG,WRNFLG
 
	LOGICAL*2 ALECS,LSTFUL
	INTEGER*2 TYPIN,TYPLST,TYPOUT,CHCMNT
	COMMON/MACVAL/ALECS,TYPIN,TYPLST,TYPOUT,CHCMNT,LSTFUL
    
	INTEGER*2 CNTALL,NUMLIN
	COMMON/FLINE/CNTALL,NUMLIN
 
	BYTE CNDVLB(8,10)
	LOGICAL*2 PASFLG
	INTEGER*2 CNDLVL,OFFLVL,COND,CNDVAL(4,10)
	COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL
	EQUIVALENCE (CNDVLB(1,1),CNDVAL(1,1))
 
C	Local Variables
 
	INTEGER*2 CALLNO
	LOGICAL*2 COON
	INTEGER*2 DEVIND(2)
	LOGICAL*2 DONE
	LOGICAL*2 EOF
	LOGICAL*2 EQUAL
	INTEGER*2 ERR
	INTEGER*2 ERRNUM
	LOGICAL*2 ERROR
	INTEGER*2 FILIND(2)
	BYTE      FLLDEF(4)
	BYTE      FLXDEF(4)
	INTEGER*2 FLXDSC(2,4)
	BYTE      FTNDEF(4)
	INTEGER*2 FTNDSC(2,4)
	INTEGER*2 FUON
	INTEGER*2 I
	INTEGER*2 J
	INTEGER*2 K
	INTEGER*2 LENG
	BYTE      LENGB(2)
	INTEGER*2 LENGTH
	INTEGER*2 LSTDSC(2,4)
	LOGICAL*2 MORE
	BYTE      SVER(23)
	INTEGER*2 UICIND(2)
	LOGICAL*2 WILD
    
	COMMON/CSIVR1/DEVIND,UICIND,FILIND,MORE,WILD,EQUAL, !850327mao
	1 FUON,COON					    !850327mao
 
	EQUIVALENCE (LENG,LENGB(1))
 
	.PASSIF FLECS
	DATA FLLDEF /'.','F','L','L'/
	DATA FLXDEF /'.','F','L','X'/
	DATA FTNDEF /'.','F','T','N'/
	.PASSEND
	.PASSIF ALECS
	DATA FLLDEF /'.','A','L','L'/
	DATA FLXDEF /'.','A','L','X'/
	DATA FTNDEF /'.','M','A','C'/
	.PASSEND
 
	.PAGE
	INITIALIZE-VARIABLES
  
	REPEAT WHILE(ERROR)
 
      ERROR = .FALSE.
 
	GET-CMD-LINE-AND-SETUP-FOR-CSIGO-CALLS
 
      PARSE-FORT-FILENAME
 
      WHEN ((MORE).AND.(.NOT.ERROR))
	PARSE-LISTING-FILENAME
	FIN!when
      ELSE LIST = .FALSE.
 
      IF (.NOT.ERROR) PARSE-INPUT-FILENAME
 
	IF (.NOT.ERROR) OPEN-FILES
 
      FIN!repeat while
 
      DONE = .FALSE.
	FLLON = LIST
 
      RETURN
	.PAGE
	TO GET-CMD-LINE-AND-SETUP-FOR-CSIGO-CALLS
 
	.PASSIF ALECS
	CALL GETCML(LINE,'ALE',LENGTH,106,EOF,1)
	.PASSEND
	.PASSIF FLECS
	CALL GETCML(LINE,'FLE',LENGTH,106,EOF,1)
	.PASSEND
	IF (EOF) CALL EXFLE	!task exit with status
 
	LINE(LENGTH+1) = "15		!append <CR><LF>
	LINE(LENGTH+2) = "12
	P2(1) = LENGTH+12		!fill in string length
 
      CALL CSI(DEVIND,UICIND,FILIND,MORE,WILD,EQUAL)
      CALL CSISW('FU',FUON,2)
      CALL CSISW('SP',SPON,2)
	CALL CSISW('CO',COON,2)
	CALL CSIVAL('CO',CNDVAL(2,1),6)
	CALL CSIVAL('CO',CNDVAL(2,2),6)
	CALL CSIVAL('CO',CNDVAL(2,3),6)
	CALL CSIVAL('CO',CNDVAL(2,4),6)
	CALL CSIVAL('CO',CNDVAL(2,5),6)
	CALL CSIVAL('CO',CNDVAL(2,6),6)
	CALL CSIVAL('CO',CNDVAL(2,7),6)
	CALL CSIVAL('CO',CNDVAL(2,8),6)
	CALL CSIVAL('CO',CNDVAL(2,9),6)
	CALL CSIVAL('CO',CNDVAL(2,10),6)
 
	FIN!to get-cmd-line-and-setup-for-csigo-calls
	.PAGE
	TO INITIALIZE-VARIABLES
      IF (CALLNO.EQ.1)
 
	P1(1) = 64		!initialize page header, line 1
	DO (I=2,33) P1(I) = '  '
	P1(27) = 'PA'
	P1(28) = 'GE'

	LENGB(1) = SVER(1)	!get string length for FLECS version
	LENGB(2) = SVER(2)
	IF (LENG.GT.21) LENG=21
      DO (I = 1,LENG) FVER(I) = SVER(I+2)
 
	P2(1) = 116		!initialize page header, line 2
	DO (I=2,59) P2(I) = '  '
      FIN!if
 
      CALL DATE(DAT(1))		!put date & time into page hdr, line 1
      CALL TIME(TIM(1))
 
      PAGENO = 0
      LINCNT = 0
	INCLVL=0
	INCSTR=.FALSE.
	COND=0
	FORT=.FALSE.
	LIST=.FALSE.

	FIN!to initialize-variables
	.PAGE
	TO OPEN-FILES
 
	CALL FOPN (LINE,FLXDEF,FLXDSC,FORT,FTNDEF,FTNDSC,
	1 LIST,FLLDEF,LSTDSC,ERRNUM)
	ERROR = ERRNUM.NE.0
	IF (ERROR)
	SEVFLG=SEVFLG+1
	SELECT (ERRNUM)
	(1)
	CALL MSGOUT ('F-Open error on input file')
	FIN
	(2)
	CALL MSGOUT ('F-Open error on output FORT/MAC file')
	FIN
	(3) CALL MSGOUT('F-Open error on output FLL/ALL file')
	FIN!select
	FIN!if
	FIN!to open-files
	.PAGE
      TO PARSE-FORT-FILENAME
 
      CALL CSIGO(LINE,LENGTH,'O',ERR)
 
	IF (WILD) 
	ERROR = .TRUE.
	CALL MSGOUT
	1 ('F-Wild cards are not allowed in FLE/ALE command line')
	FIN
	IF (.NOT.EQUAL)		
	ERROR = .TRUE.
	CALL MSGOUT (
	1 'F-Must have an input file & at least one output file')
	FIN!if
	IF (ERR)
	ERROR = .TRUE.
	CALL MSGOUT (
	1 'F-Syntax error or illegal switch in FORT/MAC file spec')
	FIN!if
	WHEN (SPON.NE.2 .OR. COON.NE.2)
	ERROR=.TRUE.
	CALL MSGOUT ('F-/SP & /CO illegal on FORT/MAC file')
	FIN!when
	ELSE LSTFUL = FUON.NE.2 .AND. FUON
 
 
	FORT = .NOT.ERROR .AND.
	1 (DEVIND(1).NE.0 .OR. FILIND(1).NE.0)
 
	IF (FORT)
 
	DO (I=1,4)
	DO (J=1,2) FTNDSC(J,I) = 0	!assume no filename
	FIN!do
 
	I=0		!pointer to end of spec
 
	IF (DEVIND(1).NE.0)
	FTNDSC(1,1) = DEVIND(2)-DEVIND(1)+2	!length, including :
	FTNDSC(2,1) = DEVIND(1)			!index
	FTNDSC(2,4) = DEVIND(1)
	I=DEVIND(2)+1
	FIN!if
 
	IF (UICIND(1).NE.0)
	FTNDSC(1,2) = UICIND(2)-UICIND(1)+1	!length, including []
	FTNDSC(2,2) = UICIND(1)			!index
	IF (FTNDSC(2,4).EQ.0) FTNDSC(2,4) = UICIND(1)
	I=UICIND(2)
	FIN!if
 
	IF (FILIND(1).NE.0)
	FTNDSC(1,3) = FILIND(2)-FILIND(1)+1	!length
	FTNDSC(2,3) = FILIND(1)			!index
	IF (FTNDSC(2,4).EQ.0) FTNDSC(2,4) = FILIND(1)
	I=FILIND(2)
	FIN!if
 
	IF (FTNDSC(2,4).NE.0) FTNDSC(1,4) = I-FTNDSC(2,4)+1
	FIN!if
      FIN!to parse-fort-filename
	.PAGE
      TO PARSE-INPUT-FILENAME
 
      CALL CSIGO(LINE,LENGTH,'I',ERR)
 
      TEST-FOR-ERRORS-IN-INPUT-FILE-SPEC-AND-PARSE-CO-SW
 
      IF (.NOT.ERROR)
 
	DO (I=1,4)
	DO (J=1,2) FLXDSC(J,I) = 0	!assume no filename
	FIN!do
 
	I=0			!pointer to end of spec
 
	IF (DEVIND(1).NE.0)
	FLXDSC(1,1) = DEVIND(2)-DEVIND(1)+2	!length, including :
	FLXDSC(2,1) = DEVIND(1)			!index
	FLXDSC(2,4) = DEVIND(1)
	I=DEVIND(2)+1
	FIN!if
 
	IF (UICIND(1).NE.0)
	FLXDSC(1,2) = UICIND(2)-UICIND(1)+1	!length, including []
	FLXDSC(2,2) = UICIND(1)			!index
	IF (FLXDSC(2,4).EQ.0) FLXDSC(2,4) = UICIND(1)
	I=UICIND(2)
	FIN!if
 
	IF (FILIND(1).NE.0)
	FLXDSC(1,3) = FILIND(2)-FILIND(1)+1	!length
	FLXDSC(2,3) = FILIND(1)			!index
	IF (FLXDSC(2,4).EQ.0) FLXDSC(2,4) = FILIND(1)
	I=FILIND(2)
	FIN!if
 
	IF (FLXDSC(2,4).NE.0) FLXDSC(1,4) = I-FLXDSC(2,4)+1
 
	FIN!if
      FIN!to parse-input-filename
	.PAGE
      TO PARSE-LISTING-FILENAME
 
      CALL CSIGO(LINE,LENGTH,'O',ERR)
      IF (ERR)
	ERROR = .TRUE.
	CALL MSGOUT ('F-Syntax error or illegal sw in listing file')
	FIN!if
      IF (WILD)
      ERROR = .TRUE.
	CALL MSGOUT (
	1 'F-Wild cards are not allowed in FLE/ALE command line')
	FIN!if
	IF (MORE)
	ERROR=.TRUE.
	CALL MSGOUT ('F-Only 2 output specs allowed')
	FIN!if
	IF (FUON.NE.2 .OR. COON.NE.2)
	CALL MSGOUT ('F-/FU & /CO illegal on listing file')
	ERROR = .TRUE.
	FIN!if
 
C	/SP ignored, but allowed for compatility
 
	LIST = .NOT.ERROR .AND. 
	1 (DEVIND(1).NE.0 .OR. FILIND(1).NE.0)
	IF (LIST)
 
	DO (I=1,4)
	DO (J=1,2) LSTDSC(J,I) = 0	!assume no filename
	FIN!do
 
	I=0		!pointer to end of spec
 
	IF (DEVIND(1).NE.0)
	LSTDSC(1,1) = DEVIND(2)-DEVIND(1)+2	!length, including :
	LSTDSC(2,1) = DEVIND(1)			!index
	LSTDSC(2,4) = DEVIND(1)
	I=DEVIND(2)+1
	FIN!if
 
	IF (UICIND(1).NE.0)
	LSTDSC(1,2) = UICIND(2)-UICIND(1)+1	!length, including []
	LSTDSC(2,2) = UICIND(1)			!index
	IF (LSTDSC(2,4).EQ.0) LSTDSC(2,4) = UICIND(1)
	I=UICIND(2)
	FIN!if
 
	IF (FILIND(1).NE.0)
	LSTDSC(1,3) = FILIND(2)-FILIND(1)+1	!length
	LSTDSC(2,3) = FILIND(1)			!index
	IF (LSTDSC(2,4).EQ.0) LSTDSC(2,4) = FILIND(1)
	I=FILIND(2)
	FIN!if
 
	IF (LSTDSC(2,4).NE.0) LSTDSC(1,4) = I-LSTDSC(2,4)+1
	FIN!if
 
      FIN!to parse-listing-filename-and-open
	.PAGE
      TO TEST-FOR-ERRORS-IN-INPUT-FILE-SPEC-AND-PARSE-CO-SW

      IF (ERR)
	ERROR = .TRUE.
	CALL MSGOUT ('F-Switch or syntax error in input file spec')
	FIN!if
      IF (WILD)
      ERROR = .TRUE.
	CALL MSGOUT (
	1 ' Wild cards are not allowed in FLE/ALE command line')
      FIN
      IF (FILIND(1).EQ.0)
	ERROR = .TRUE.
	CALL MSGOUT ('F-Must give file name for input FLE/ALE file')
	FIN!if

	WHEN (SPON.NE.2 .OR. FUON.NE.2)
	ERROR=.TRUE.
	CALL MSGOUT (' /SP & /FU illegal on input file spec')
	FIN!when
	ELSE
 
	WHEN (COON.EQ.2) COND=0
	ELSE
 
C	Ignore /-CO ie. treat it as if /CO
C	Find # of last value given
 
	COND=10
	WHILE (COND.GT.0 .AND. CNDVAL(2,COND).EQ.0)
	COND=COND-1
	FIN!while
 
	IF (COND.GT.0)	!any values given?
 
C	Yes, find last nonnull character in each string.
C	(Ignore possibility of embedded null.)  Note /CO:A::B
C	is possible and allowed.
 
	DO (I=1,COND)
	J=6
	WHILE (J.GT.0 .AND. CNDVLB(J+2,I).EQ.0) J=J-1
	CNDVAL(1,I) = J
	FIN!do
	FIN!if
	FIN!else
	FIN!else
      FIN!to test-for-errors-in-input-file-spec-and-parse-co-sw
      END
	.NAME OPNINC
C;+
C - O P N I N C
C****NAME:   SUBROUTINE OPNINC
C    FILE:   FILE.FLX
C
C****PURPOSE:  OPEN AN .INCLUDE FILE
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/F77
C AUTHOR:     M. OOTHOUDT
C DATE:       29-JUN-81
C REVISIONS:
C 850213MAO CONVERT MACRO TO FLECS
C 850304mao New calling sequence to FOPNIN for RSX/VMS compatibility
C 850327mao Put CSI variables into /CSIVR2/.
C
C****CALLING SEQUENCE:  CALL OPNINC (NCHAR,NAME,IERR)
C
C		INPUT: 
C
C NCHAR =(I*2) NUMBER OF CHARACTERS IN FILE NAME
C NAME  =(ARRAY) ASCII ARRAY CONTAINING THE FILE NAME
C 
C	       OUTPUT:  
C
C IERR	=(I*2) ERROR RETURN CODE
C	=0, ALL OK
C	=1, ALREADY AT MAXIMUM INCLUDE FILE NESTING DEPTH
C	=2, ERROR IN PARSING GIVEN FILE NAME
C	=3, OPEN ERROR ON INCLUDE FILE
C
C	CMN BLOCK I/O: /INCDAT/
C
C	    RESOURCES:
C LIBRARIES:   QLIB:CSI:CSIGO:CSISW
C OTHER SUBR:  FOPNIN, ROPN
C DISK FILES:  INCLUDE FILE
C DEVICES:     DISK FILES
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C;-
	.PAGE
	SUBROUTINE OPNINC (NCHAR,NAME,IERR)
 
	.PASSIF VAX
	.INCLUDE [MP1Q.FLEALECOM]FILDAT.INC
	.INCLUDE [MP1Q.FLEALECOM]INCDAT.INC
	.PASSEND
	.PASSIF PDP
	.INCLUDE [201,13]FILDAT.INC
	.INCLUDE [201,13]INCDAT.INC
	.PASSEND
 
C	Local variables
 
	INTEGER*2 DEVIND(2)  !pointer to device		!850304mao
	LOGICAL*2 ERR        !.T. if CSI error
	INTEGER*2 FILDSC(2,4)!file descriptor array	!850304mao
	INTEGER*2 FILIND(2)  !pointer to filename	!850304mao
	INTEGER*2 I          !scratch
	INTEGER*2 IERR       !EXT, R/W, error return
	INTEGER*2 IPNT       !last good char in NAME
	INTEGER*2 J          !scratch
	LOGICAL*2 LISET      !.T. if /LI; .F. if /-LI
	BYTE      NAME(80)   !EXT, R, file name of include file
	INTEGER*2 NCHAR      !EXT, R, # characters in file name
	INTEGER*2 UICIND(2)  !pointer to directory	!850304mao
 
	COMMON /CSIVR2/ DEVIND,UICIND,FILIND,LISET	!850327mao
 
	WHEN (INCLVL.EQ.NUMINC) IERR=1	!at max depth
	ELSE
 
	CALL CSI(DEVIND,UICIND,FILIND)	!parse file name!850304mao
	CALL CSISW ('LI',LISET,.TRUE.)
	CALL CSIGO(NAME,NCHAR,'O',ERR)
 
	WHEN (ERR) IERR=2		!bad filename
	ELSE
 
	FLLONS(INCLVL) = FLLON	!save FLL listing status
	INCLVL = INCLVL + 1	!next level
 
	PARSE-FILENAME					!850304mao
	CALL FOPNIN (INCLVL,NAME,FILDSC,IERR)		!850304mao
 
	WHEN (IERR.NE.0)		!OPEN error recovery
 
100	IERR=3
	CALL ROPN(.FALSE.)		!go back to previous level
	FIN!when
	ELSE
 
	INCSTR = INCLVL.EQ.1		!set "no star" flag
 
C	Problem: If output is currently on, but /-LI is in current
C	line, the .INCLUDE line will not be listed.  Therefore use
C	LICHNG flag to tell PUT to ignore FLLON flag for this line.
 
	LICHNG = FLLON .AND. .NOT.LISET
 
	FLLON = LISET
 
	FIN!else
	FIN!else
	FIN!else
 
	RETURN
	.PAGE
	TO PARSE-FILENAME
 
	DO (I=1,4)
	DO (J=1,2) FILDSC(J,I) = 0	!assume no filename
	FIN!do
 
	I=0		!pointer to end of spec
 
	IF (DEVIND(1).NE.0)
	FILDSC(1,1) = DEVIND(2)-DEVIND(1)+2	!length, including :
	FILDSC(2,1) = DEVIND(1)			!index
	FILDSC(2,4) = DEVIND(1)
	I=DEVIND(2)+1
	FIN!if
 
	IF (UICIND(1).NE.0)
	FILDSC(1,2) = UICIND(2)-UICIND(1)+1	!length, including []
	FILDSC(2,2) = UICIND(1)			!index
	IF (FILDSC(2,4).EQ.0) FILDSC(2,4) = UICIND(1)
	I=UICIND(2)
	FIN!if
 
	IF (FILIND(1).NE.0)
	FILDSC(1,3) = FILIND(2)-FILIND(1)+1	!length
	FILDSC(2,3) = FILIND(1)			!index
	IF (FILDSC(2,4).EQ.0) FILDSC(2,4) = FILIND(1)
	I=FILIND(2)
	FIN!if
 
	IF (FILDSC(2,4).NE.0) FILDSC(1,4) = I-FILDSC(2,4)+1
	FIN!to parse-filename
	END
	.NAME PUT
C;+
C - P U T
C****NAME:   SUBROUTINE PUT
C    FILE:   FILE.FLX
C
C****PURPOSE:  OUTPUT TO FORTRAN, LISTING OR ERROR STREAMS
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/FORTRAN
C AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
C DATE:       25-OCT-74
C REVISIONS:
C 1980gta Convert from macro to fortran
C 850227mao Rewrite to use FPUT.
C
C****CALLING SEQUENCE:  CALL PUT(LINENO,STRING,IOCLAS)
C
C		INPUT: 
C
C LINENO=(I*2) CONTROL
C	=0, COL 1-5 SHOULD BE LEFT BLANK
C	>0, PUT LINENO IN COL 1-5
C	<0, PUT ABS(LINENO) IN COL 1-5, BUT PREFIX WITH "E"
C STRING= STRING TO BE PUT OUT
C IOCLAS=(I*2) WHICH OUTPUT CLASS IS TO BE USED:
C	=1, FTN (NOTE LINENO CAN ONLY BE POSITIVE)
C	=2, LIST
C	=3, ERROR
C 
C	       OUTPUT:  NONE
C
C	CMN BLOCK I/O: /FILE/, /INCDAT/, /FILE/, /COND/
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  FPUT, PUTNUM
C DISK FILES:  FTN, FLL FILES
C DEVICES:     DISK
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  None
C
C****NOTES:  
C;-
	.PAGE
      SUBROUTINE PUT(LINENO,STRING,IOCLAS)
 
	.PASSIF VAX
	.INCLUDE [MP1Q.FLEALECOM]FILDAT.INC
	.INCLUDE [MP1Q.FLEALECOM]INCDAT.INC
	.PASSEND
	.PASSIF PDP
	.INCLUDE [201,13]FILDAT.INC
	.INCLUDE [201,13]INCDAT.INC
	.PASSEND
 
	INTEGER*2 CNTALL,NUMLIN
	COMMON/FLINE/CNTALL,NUMLIN
 
	LOGICAL*2 PASFLG
	INTEGER*2 CNDLVL,OFFLVL,COND,CNDVAL(4,10)
	COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL
 
C	Local variables
 
      BYTE STRING(82),OUTPUT(132),OUTF(80),LENB(2),NPB(2)
      INTEGER*2 LINENO, IOCLAS, LEN, I, K, NP
   
	EQUIVALENCE (LEN,LENB(1))
	EQUIVALENCE (OUTPUT(1),OUTF(1))	!optimize fort IO
	EQUIVALENCE (NP,NPB(1))
 
	DATA NPB /"14,"40/		!forces new page
	.PAGE
 
	LENB(1) = STRING(1)
	LENB(2) = STRING(2)
 
      WHEN (IOCLAS.EQ.1)
      IF (FORT.AND.PASFLG) OUTPUT-FORT
      FIN
      ELSE
      IF (LIST)
	CONDITIONAL
	(FLLON) OUTPUT-LIST
	(LICHNG)
	LICHNG=.FALSE.
	OUTPUT-LIST
	FIN
	FIN!conditional
	FIN!if
      FIN
      RETURN
	.PAGE
      TO OUTPUT-FORT
 
	NUMLIN=NUMLIN+1			!one more FORT line output
 
      DO (I = 3,LEN+2) OUTF(I-2) = STRING(I) !Get the string
      IF (LEN.LT.72)			!blank fill if necessary
      DO (I = LEN+1,72) OUTF(I) = ' '
      FIN
 
	.PASSIF ALECS
      OUTF(72) = ';'		!make a commant
	.PASSEND
 
C	For compatibility with the old version of FLECS,
C	we put out 80 bytes even though only 78 are used (last
C	two bytes are nulls).
 
	CALL PUTNUM (OUTF(73-2),LINENO)	!append input line #
 
      OUTF(78) = ' '
	OUTF(79)=0
	OUTF(80)=0
 
	CALL FPUT (IOCLAS,OUTF,80)	!write to file
      FIN
	.PAGE
      TO OUTPUT-LIST
 
	IF (STRING(3).EQ."14)		!FF?
	LINCNT=0	!yes, new page
	STRING(3) = (1H )	!overwrite it
	FIN!if
 
      IF (LINCNT.EQ.0)
      PAGENO = PAGENO + 1
      WHEN (PAGENO.EQ.1) P1(2) = '  '
      ELSE P1(2) = NP
 
	CALL PUTNUM (P1(29),PAGENO)
	CALL FPUT (IOCLAS,P1(2),P1(1))
	CALL FPUT (IOCLAS,P2(2),P2(1))
      LINCNT = -55
      FIN
   
      DO (I = 1,18) OUTPUT(I) = ' '
 
	IF (INCLVL.GT.0)
	WHEN (INCSTR) INCSTR=.FALSE.
	ELSE OUTPUT(2) = '*'
	FIN!if
 
	IF(LINENO.NE.0)
      IF(LINENO.LT.0) OUTPUT(2) = 'E'
	CALL PUTNUM (OUTPUT(1),IABS(LINENO))
	CALL PUTNUM (OUTPUT(9),NUMLIN)
      FIN!if
 
      DO (I = 3,LEN+2) OUTPUT(I+16) = STRING(I)
	CALL FPUT (IOCLAS,OUTPUT,LEN+18)
      LINCNT = LINCNT + 1
      FIN
      END
	.NAME ROPN
C;+
C - R O P N
C****NAME:   SUBROUTINE ROPN
C    FILE:   FILE.FLX
C
C****PURPOSE:  Open previous level .INCLUDE file
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/F77
C AUTHOR:     M. OOTHOUDT
C DATE:       29-JUN-81
C REVISIONS:
C 850213MAO CONVERT MACRO TO FLECS
C
C****CALLING SEQUENCE:  CALL ROPN (CLS)
C
C		INPUT:  
C
C CLS	= (L*2) .T. if should close current include level.
C
C	       OUTPUT:  None
C
C	CMN BLOCK I/O: /INCDAT/, /FILDAT/
C
C	    RESOURCES:
C LIBRARIES:   None
C OTHER SUBR:  FROPN
C DISK FILES:  INCLUDE FILE
C DEVICES:     DISK FILES
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C;-
	.PAGE
	SUBROUTINE ROPN (CLS)
 
	.PASSIF VAX
	.INCLUDE [MP1Q.FLEALECOM]FILDAT.INC
	.INCLUDE [MP1Q.FLEALECOM]INCDAT.INC
	.PASSEND
	.PASSIF PDP
	.INCLUDE [201,13]FILDAT.INC
	.INCLUDE [201,13]INCDAT.INC
	.PASSEND
 
C	Local variables
 
	LOGICAL*2 CLS
 
	INCLVL = INCLVL - 1		!back to previous level
 
	FLLON = FLLONS(INCLVL)		!/LI setting for that level
 
	CALL FROPN (INCLVL,CLS)		!tell macro code what level
					!to read from
	RETURN
	END