C;+
C - I M P O P N
C****NAME:   SUBROUTINE IMPOPN
C    IDENT:  /850304/
C    FILE:   ISUB.FLX
C
C****PURPOSE:  Process the FLECS .IMPLICIT NONE statement.  See note 1.
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/FORTRAN
C AUTHOR:     M. OOTHOUDT
C DATE:       07-MAR-84
C REVISIONS:
C 850228mao Use FINPOP instead of FORT OPEN; Use PUTNUM instead of ENCODE
C 850304mao New call to FIMPOP to be RSX-11M/VMS compatible.
C
C****CALLING SEQUENCE:  CALL IMPOPN (IMPSET,LINENO,FORTCL,ERRCL,MAJCNT)
C
C		INPUT:  
C
C IMPSET= (L*2) .T. if file already open; .F. otherwise.
C LINENO= (I*2) number of source line input came from.
C FORTCL= (I*2) IO class for fortran file.
C ERRCL = (I*2) IO class for error messages.
C
C	       OUTPUT:  
C
C IMPSET= (L*2) set .T. if .FID file openned.
C MAJCNT= (I*2) incremented if .FID already open (major error counter).
C
C       CMN BLOCK I/O:  NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  FIMPOP,PUT,PUTNUM
C DISK FILES:  n.FID
C DEVICES:     None
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C	1.  FLECS generates variables with names like I32767
C for procedure invocations.  If the FORTRAN "IMPLICIT NONE" statement
C is used, such variables are illegal.  This subroutine processes
C the FLECS directive ".IMPLICT NONE" statement to put
C	"IMPLICT NONE"
C	INCLUDE 'n.FID/-LI'
C in the FORTRAN file.  Then it opens a file named n.FID.  Later calls
C to IMPWRT will put lines like "INTEGER*2 I32767" into the file.
C
C	2.  F4P and F77 do not have an IMPLICT NONE statement.  For
C these compiliers we use "IMPLICIT COMPLEX (A-Z)", which is almost
C as good.
C;-
	.PAGE
	SUBROUTINE IMPOPN (IMPSET,LINENO,FORTCL,ERRCL,MAJCNT)
 
C			Declarations
 
	INTEGER*2 ERRCL          !EXT, R, IO class for PUT call
	BYTE      FILE(14)       !LOC, R/W, file name
	INTEGER*2 FNUM           !LOC, R/W, # to use for .FID file name
	INTEGER*2 FORTCL         !EXT, R, IO class for PUT call
	INTEGER*2 IMPDSC(2,4)    !LOC, R/W, filename descriptor table
	LOGICAL*2 IMPSET         !EXT, R/W, .T. if .FID file is open
	INTEGER*2 LINENO         !EXT, R, line # for PUT call
	INTEGER*2 MAJCNT         !EXT, R/W, counter for major errors
	INTEGER*2 NUM(4)         !LOC, R/W, FNUM in ASCII
	INTEGER*2 SALRDY(18)     !LOC, R, error text
	INTEGER*2 SIMPNO(15)     !LOC, R, FORTRAN implict none statement
	INTEGER*2 SINCL(18)      !LOC, R/W, FORTRAN include statement
 
	DATA FILE /1HS,1HY,1H0,1H:,1H ,1H ,1H ,1H ,1H ,
	1 1H.,1HF,1HI,1HD,0/
	DATA IMPDSC /4,1,0,0,9,5,13,1/			!850304mao
 
	DATA FNUM /32767/
	DATA SALRDY/34,2H**,2H**,2H**,2H.I,2HMP,2HLI,2HCI,2HT ,2HNO,
	1 2HNE,2H A,2HLR,2HEA,2HDY,2H G,2HIV,2HEN/
	.PASSIF VAX
	DATA SIMPNO/19,2H  ,2H  ,2H  ,2HIM,2HPL,2HIC,2HIT,2H N,2HON,2HE ,
	1 4*2H  /
	.PASSEND
	.PASSIF PDP
	DATA SIMPNO/28,2H  ,2H  ,2H  ,2HIM,2HPL,2HIC,2HIT,2H C,2HOM,2HPL,
	1 2HEX,2H (,2HA-,2HZ)/
	.PASSEND
	DATA SINCL/34,2H  ,2H  ,2H  ,2HIN,2HCL,2HUD,2HE ,2H' ,2H  ,2H  ,
	1 2H  ,2H.F,2HID,2H/N,2HOL,2HIS,2HT'/
 
	.PASSUNLESS VAX
	.PASSUNLESS PDP
	ERROR--MUST HAVE /CO:VAX OR :PDP
	.PASSEND
	.PASSEND
 
	WHEN (IMPSET)
 
C	This program module has already done a .IMPLICIT NONE
 
	CALL PUT (0,SALRDY,ERRCL)
	MAJCNT=MAJCNT+1
	FIN!when
	ELSE
 
	FNUM=FNUM-1
 
C	Following funny use of FILE due to PUTNUM expecting a
C	FLECS string--we fake it this way.  (Cannot use FLECS string
C	or OPEN will have trouble.)
 
	CALL PUTNUM (FILE(3),FNUM)			!850228mao
	FILE(10) = 1H.		!PUTNUM wipes out period!850228mao
 
	CALL FIMPOP (FILE,IMPDSC)			!850304mao
  
C	Put out the FORTRAN IMPLICIT line.
 
	CALL PUT (LINENO,SIMPNO,FORTCL)
 
C	Put out the FORTRAN INCLUDE line.
 
	CALL PUTNUM (SINCL(9),FNUM)			!850228mao
	CALL PUT (LINENO,SINCL,FORTCL)
 
	IMPSET=.TRUE.
	FIN!when
	RETURN
	END
	.PAGE
C;+
C - I M P W R T
C****NAME:   SUBROUTINE IMPWRT
C    IDENT:  /850228/
C    FILE:   ISUB.FLX
C
C****PURPOSE:  Write a line to the .FID file.
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/FORTRAN
C AUTHOR:     M. OOTHOUDT
C DATE:       07-MAR-84
C REVISIONS:
C 850228mao Use PUTNUM & FIMPWR instead of FORT WRITE.
C
C****CALLING SEQUENCE:  CALL IMPWRT (NUM,LINENO,IOCLAS)
C
C		INPUT:  
C
C NUM	=(I*2) Number for variable to go into .FID file.
C LINENO=(I*2) Number of source line input came from.
C IOCLAS=(I*2) I/O class for output stream.
C
C	       OUTPUT:  NONE
C
C       CMN BLOCK I/O:  NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  PUTNUM, FIMPWR
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C;-
	.PAGE
	SUBROUTINE IMPWRT (NUM,LINENO,IOCLAS)
 
C	DECLARATIONS
 
	INTEGER*2 IOCLAS         !EXT, R, I/O class for output
	BYTE      LINE(22)       !LOC, R/W, line to output
	INTEGER*2 LINENO         !EXT, R, # of line in source file
	INTEGER*2 NUM            !EXT, R, variable number
 
	DATA LINE /6*' ','I','N','T','E','G','E','R',' ',' ',
	1 'I',6*' '/
	CALL PUTNUM (LINE(15),NUM)			!850228mao
	CALL FIMPWR (LINE,21)				!850228mao
 
	RETURN
	END
	.PAGE
C;+
C - I M P C L S
C****NAME:   SUBROUTINE IMPCLS
C    IDENT:  /850228/
C    FILE:   ISUB.FLX
C
C****PURPOSE:  Close .FID file.
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V4.1, VMS V4.0
C LANGUAGE:   FLECS/FORTRAN
C AUTHOR:     M. OOTHOUDT
C DATE:       07-MAR-84
C REVISIONS:
C 850228mao Use FIMPCL instead of FORT close.
C
C****CALLING SEQUENCE:  CALL IMPCLS
C
C		INPUT:  NONE
C
C	       OUTPUT:  NONE
C
C       CMN BLOCK I/O:  NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  FIMPCL
C DISK FILES:  .FID FILE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C
C****NOTES:  
C;-
	SUBROUTINE IMPCLS
C
	CALL FIMPCL
 
	RETURN
	END