!**********************************************************************
!
!	I N T E G R A L   S C I E N C E   D A T A   C E N T E R
!
!	P A R A M E T E R   I N T E R F A C E   L I B R A R Y
!
! Copyright:	(c) 1998,2002 ISDC http://isdc.unige.ch
! File:		pil_f90_api.f90
! Description:	Parameter Interface Library - fotran 90 API bindings
! Authors:	Jerzy.Borkowski@obs.unige.ch (JB)
! History:	10-May-98 (JB) : PILGetReal4 function added 
!		13-May-98 (JB) : version 0.7 released. Code cleanup, unnecesary
!			dependencies removed. Uses/links only PIL library. Changes
!			to Makefile.
!		13-Aug-98 (JB) : version 1.0 released. More compatible with Common
!			library some new functions: PILReloadParameters,
!			PILFlushParameters, locking of parameter file during
!			read/write implemented.
!		17-Aug-98 (JB) : reformatted, more comments added
!		01-Feb-99 (JB) : IMPLICIT NONE and ISDC_OK added
!		03-Feb-99 (JB) : *4/8 replaced with (KIND=4/8)
!		06-Mar-00 (JB) : error codes corrected (in line with C)
!		27-Aug-01 (JB) : SPR 00649 fixes
!		08-Mar-02 (JB) : SPR 01050 : add PILGETDOL F90 prototype
!		08-May-02 (JB) : brought in sync with C code
!**********************************************************************

MODULE	PIL_F90_API
!
! the following USE statement is required by NAG F90 compiler. They do not
! predefine IARGC and GETARG, and without module do not mangle names
! properly, so even if F90 library has those routines any attempt to 
! link code with this library is hopeless ... Now, how can I implement
! conditional compilation in F90 ???

USE	F90_UNIX

IMPLICIT NONE

INTEGER, PARAMETER :: ISDC_OK			= 0

INTEGER, PARAMETER :: PIL_LINESIZE		= 2000
INTEGER, PARAMETER :: PIL_CURLYSIZE		= 10000
INTEGER, PARAMETER :: PIL_PATH_MAX		= 1024
INTEGER, PARAMETER :: PIL_COPYCHUNK		= 8192

INTEGER, PARAMETER :: PIL_RDONLY		= 0
INTEGER, PARAMETER :: PIL_RDWRITE		= 1

INTEGER, PARAMETER :: PIL_WHAT_VALUE		= 0
INTEGER, PARAMETER :: PIL_WHAT_MIN		= 1
INTEGER, PARAMETER :: PIL_WHAT_MAX		= 2

INTEGER, PARAMETER :: PIL_MODE_STANDALONE	= 0
INTEGER, PARAMETER :: PIL_MODE_SERVER		= 1


INTEGER, PARAMETER :: PIL_TYPE_UNKNOWN		= 0
INTEGER, PARAMETER :: PIL_TYPE_BOOL		= 1
INTEGER, PARAMETER :: PIL_TYPE_INT4		= 2
INTEGER, PARAMETER :: PIL_TYPE_REAL8		= 3
INTEGER, PARAMETER :: PIL_TYPE_STRING		= 4
INTEGER, PARAMETER :: PIL_TYPE_FNAME		= 5
INTEGER, PARAMETER :: PIL_TYPE_STRUCT		= 6
INTEGER, PARAMETER :: PIL_TYPE_GCUR		= 7
INTEGER, PARAMETER :: PIL_TYPE_IMCUR		= 8
INTEGER, PARAMETER :: PIL_TYPE_D		= 9
INTEGER, PARAMETER :: PIL_TYPE_G		= 10
INTEGER, PARAMETER :: PIL_TYPE_REAL4		= 11
INTEGER, PARAMETER :: PIL_TYPE_DOL		= 12

INTEGER, PARAMETER :: PIL_FILECHECK_EXIST	= 1
INTEGER, PARAMETER :: PIL_FILECHECK_NOEXIST	= 2
INTEGER, PARAMETER :: PIL_FILECHECK_READ	= 4
INTEGER, PARAMETER :: PIL_FILECHECK_WRITE	= 8
INTEGER, PARAMETER :: PIL_ATTRIB_REDIRECTION	= 16
INTEGER, PARAMETER :: PIL_VALUE_INVALID		= 32
INTEGER, PARAMETER :: PIL_VALUE_FROM_CMDLINE	= 64
INTEGER, PARAMETER :: PIL_FILECHECK_CREATE	= 128

INTEGER, PARAMETER :: PIL_FORMAT_OK		= 0
INTEGER, PARAMETER :: PIL_FORMAT_BLANK		= 1
INTEGER, PARAMETER :: PIL_FORMAT_COMMENT	= 2
INTEGER, PARAMETER :: PIL_FORMAT_ERR		= 4

INTEGER, PARAMETER :: PIL_MODE_AUTO		= 1
INTEGER, PARAMETER :: PIL_MODE_HIDDEN		= 2
INTEGER, PARAMETER :: PIL_MODE_LEARN		= 4
INTEGER, PARAMETER :: PIL_MODE_QUERY		= 8

INTEGER, PARAMETER :: PIL_DEFAULT_MODE		= PIL_MODE_QUERY
INTEGER, PARAMETER :: PIL_DEFAULT_AUTO_MODE	= PIL_MODE_HIDDEN

INTEGER, PARAMETER :: PIL_MODIFIED_NAME		= 1
INTEGER, PARAMETER :: PIL_MODIFIED_TYPE		= 2
INTEGER, PARAMETER :: PIL_MODIFIED_MODE		= 4
INTEGER, PARAMETER :: PIL_MODIFIED_VALUE	= 8
INTEGER, PARAMETER :: PIL_MODIFIED_MIN		= 16
INTEGER, PARAMETER :: PIL_MODIFIED_MAX		= 32
INTEGER, PARAMETER :: PIL_MODIFIED_PROMPT	= 64
INTEGER, PARAMETER :: PIL_MODIFIED_ANY		= 127

INTEGER, PARAMETER :: PIL_MODIFIED_PFILE	= 256
INTEGER, PARAMETER :: PIL_SUBST_ENV		= 512
INTEGER, PARAMETER :: PIL_SUBST_INDIR		= 1024
INTEGER, PARAMETER :: PIL_PSET_MODE		= 2048
INTEGER, PARAMETER :: PIL_NO_POSITIONAL		= 4096
INTEGER, PARAMETER :: PIL_BYPASS_NAMING		= 8192
INTEGER, PARAMETER :: PIL_SUBST_EMPTYSTR	= 16384
INTEGER, PARAMETER :: PIL_OPEN_RDONLY		= 32768
INTEGER, PARAMETER :: PIL_SUBST_CURLY		= 65536
INTEGER, PARAMETER :: PIL_FLUSH_PERFORMED	= 131072
INTEGER, PARAMETER :: PIL_LINT_MODE		= 262144

INTEGER, PARAMETER :: PIL_MODIFIED_YES		= 1
INTEGER, PARAMETER :: PIL_CHECK_RANGE_YES	= 2

INTEGER, PARAMETER :: PIL_MAX_INDIR		= 10

INTEGER, PARAMETER :: PIL_QUERY_OVERRIDE	= 0
INTEGER, PARAMETER :: PIL_QUERY_DEFAULT		= 1

INTEGER, PARAMETER :: PIL_ROOTNAME_FILE		= 0
INTEGER, PARAMETER :: PIL_ROOTNAME_NOTFILE	= 1
INTEGER, PARAMETER :: PIL_ROOTNAME_STDIN	= 2
INTEGER, PARAMETER :: PIL_ROOTNAME_STDOUT	= 3
INTEGER, PARAMETER :: PIL_ROOTNAME_STDINOUT	= 4

INTEGER, PARAMETER :: PIL_RL_PROMPT_PIL		= 0
INTEGER, PARAMETER :: PIL_RL_PROMPT_IEB		= 1

!
! PIL error codes defined in pil_error.h
!

INTEGER, PARAMETER :: PIL_OK			= 0

INTEGER, PARAMETER :: PIL_ERR_BASE		= -3000
INTEGER, PARAMETER :: PIL_ERR_MAX_IDX		= PIL_ERR_BASE

INTEGER, PARAMETER :: PIL_NUL_PTR		= PIL_ERR_BASE - 0
INTEGER, PARAMETER :: PIL_BAD_ARG		= PIL_ERR_BASE - 1
INTEGER, PARAMETER :: PIL_NO_MEM		= PIL_ERR_BASE - 2
INTEGER, PARAMETER :: PIL_NO_FILE		= PIL_ERR_BASE - 3
INTEGER, PARAMETER :: PIL_ERR_FREAD		= PIL_ERR_BASE - 4
INTEGER, PARAMETER :: PIL_ERR_FWRITE		= PIL_ERR_BASE - 5
INTEGER, PARAMETER :: PIL_EOS			= PIL_ERR_BASE - 6
INTEGER, PARAMETER :: PIL_BAD_NAME		= PIL_ERR_BASE - 7
INTEGER, PARAMETER :: PIL_BAD_TYPE		= PIL_ERR_BASE - 8
INTEGER, PARAMETER :: PIL_BAD_MODE		= PIL_ERR_BASE - 9
INTEGER, PARAMETER :: PIL_BAD_LINE		= PIL_ERR_BASE - 10
INTEGER, PARAMETER :: PIL_NOT_IMPLEMENTED	= PIL_ERR_BASE - 11
INTEGER, PARAMETER :: PIL_FILE_NOT_EXIST	= PIL_ERR_BASE - 12
INTEGER, PARAMETER :: PIL_FILE_EXIST		= PIL_ERR_BASE - 13
INTEGER, PARAMETER :: PIL_FILE_NO_RD		= PIL_ERR_BASE - 14
INTEGER, PARAMETER :: PIL_FILE_NO_WR		= PIL_ERR_BASE - 15
INTEGER, PARAMETER :: PIL_LINE_BLANK		= PIL_ERR_BASE - 16
INTEGER, PARAMETER :: PIL_LINE_COMMENT		= PIL_ERR_BASE - 17
INTEGER, PARAMETER :: PIL_LINE_ERROR		= PIL_ERR_BASE - 18
INTEGER, PARAMETER :: PIL_NOT_FOUND		= PIL_ERR_BASE - 19
INTEGER, PARAMETER :: PIL_PFILES_TOO_LONG	= PIL_ERR_BASE - 20
INTEGER, PARAMETER :: PIL_PFILES_FORMAT		= PIL_ERR_BASE - 21
INTEGER, PARAMETER :: PIL_LOCK_FAILED		= PIL_ERR_BASE - 22
INTEGER, PARAMETER :: PIL_BOGUS_CMDLINE		= PIL_ERR_BASE - 23
INTEGER, PARAMETER :: PIL_NO_LOGGER		= PIL_ERR_BASE - 24
INTEGER, PARAMETER :: PIL_LINE_TOO_MANY		= PIL_ERR_BASE - 25
INTEGER, PARAMETER :: PIL_LINE_TOO_FEW		= PIL_ERR_BASE - 26
INTEGER, PARAMETER :: PIL_LINE_UNMATCHED_QUOTE	= PIL_ERR_BASE - 27
INTEGER, PARAMETER :: PIL_LINE_NO_LF		= PIL_ERR_BASE - 28
INTEGER, PARAMETER :: PIL_LINE_EXTRA_SPACES	= PIL_ERR_BASE - 29

INTEGER, PARAMETER :: PIL_ERR_MIN_IDX		= PIL_ERR_MAX_IDX - 29


INTERFACE PILGETBOOL
  FUNCTION PILGETBOOL(NAME, RESULT)
    CHARACTER*(*)	:: NAME
    INTEGER (KIND=4)	:: RESULT
    INTEGER	:: PILGETBOOL
  END FUNCTION PILGETBOOL
END INTERFACE

INTERFACE PILGETINT
  FUNCTION PILGETINT(NAME, RESULT)
    CHARACTER*(*)	:: NAME
    INTEGER (KIND=4)	:: RESULT
    INTEGER	:: PILGETINT
  END FUNCTION PILGETINT
END INTERFACE

INTERFACE PILGETREAL
  FUNCTION PILGETREAL(NAME, RESULT)
    CHARACTER*(*)	:: NAME
    REAL (KIND=8)	:: RESULT
    INTEGER	:: PILGETREAL
  END FUNCTION PILGETREAL
END INTERFACE

INTERFACE PILGETREAL4
  FUNCTION PILGETREAL4(NAME, RESULT)
    CHARACTER*(*)	:: NAME
    REAL (KIND=4)	:: RESULT
    INTEGER	:: PILGETREAL4
  END FUNCTION PILGETREAL4
END INTERFACE

INTERFACE PILGETSTRING
  FUNCTION PILGETSTRING(NAME, RESULT)
    CHARACTER*(*)	:: NAME
    CHARACTER*(*)	:: RESULT
    INTEGER	:: PILGETSTRING
  END FUNCTION PILGETSTRING
END INTERFACE

INTERFACE PILGETFNAME
  FUNCTION PILGETFNAME(NAME, RESULT)
    CHARACTER*(*)	:: NAME
    CHARACTER*(*)	:: RESULT
    INTEGER	:: PILGETFNAME
  END FUNCTION PILGETFNAME
END INTERFACE

INTERFACE PILGETDOL
  FUNCTION PILGETDOL(NAME, RESULT)
    CHARACTER*(*)	:: NAME
    CHARACTER*(*)	:: RESULT
    INTEGER	:: PILGETDOL
  END FUNCTION PILGETDOL
END INTERFACE

INTERFACE PILPUTBOOL
  FUNCTION PILPUTBOOL(NAME, VALUE)
    CHARACTER*(*)	:: NAME
    INTEGER (KIND=4)	:: VALUE
    INTEGER	:: PILPUTBOOL
  END FUNCTION PILPUTBOOL
END INTERFACE

INTERFACE PILPUTINT
  FUNCTION PILPUTINT(NAME, VALUE)
    CHARACTER*(*)	:: NAME
    INTEGER (KIND=4)	:: VALUE
    INTEGER	:: PILPUTINT
  END FUNCTION PILPUTINT
END INTERFACE

INTERFACE PILPUTREAL
  FUNCTION PILPUTREAL(NAME, VALUE)
    CHARACTER*(*)	:: NAME
    REAL (KIND=8)	:: VALUE
    INTEGER	:: PILPUTREAL
  END FUNCTION PILPUTREAL
END INTERFACE

INTERFACE PILPUTSTRING
  FUNCTION PILPUTSTRING(NAME, VALUE)
    CHARACTER*(*)	:: NAME
    CHARACTER*(*)	:: VALUE
    INTEGER	:: PILPUTSTRING
  END FUNCTION PILPUTSTRING
END INTERFACE

INTERFACE PILPUTFNAME
  FUNCTION PILPUTFNAME(NAME, VALUE)
    CHARACTER*(*)	:: NAME
    CHARACTER*(*)	:: VALUE
    INTEGER	:: PILPUTFNAME
  END FUNCTION PILPUTFNAME
END INTERFACE

INTERFACE PILSETMODULENAME
  FUNCTION PILSETMODULENAME(ARG)
    CHARACTER*(*) :: ARG
    INTEGER	:: PILSETMODULENAME
  END FUNCTION PILSETMODULENAME
END INTERFACE

INTERFACE PILSETMODULEVERSION
  FUNCTION PILSETMODULEVERSION(ARG)
    CHARACTER*(*) :: ARG
    INTEGER	:: PILSETMODULEVERSION
  END FUNCTION PILSETMODULEVERSION
END INTERFACE

INTERFACE PILF90ADDARG
  FUNCTION PILF90ADDARG(ARG)
    CHARACTER*(*) :: ARG
    INTEGER	:: PILF90ADDARG
  END FUNCTION PILF90ADDARG
END INTERFACE

INTERFACE PILF90INIT
  FUNCTION PILF90INIT()
    INTEGER	:: PILF90INIT
  END FUNCTION PILF90INIT
END INTERFACE

INTERFACE PILCLOSE
  FUNCTION PILCLOSE(STATUS)
    INTEGER	:: STATUS
    INTEGER	:: PILCLOSE
  END FUNCTION PILCLOSE
END INTERFACE

INTERFACE PILGETPARFILENAME
  FUNCTION PILGETPARFILENAME(FNAME)
    CHARACTER*(*)	:: FNAME
    INTEGER	:: PILGETPARFILENAME
  END FUNCTION PILGETPARFILENAME
END INTERFACE

INTERFACE PILLOCKPFILE
  FUNCTION PILLOCKPFILE()
    INTEGER	:: PILLOCKPFILE
  END FUNCTION PILLOCKPFILE
END INTERFACE

INTERFACE PILUNLOCKPFILE
  FUNCTION PILUNLOCKPFILE()
    INTEGER	:: PILUNLOCKPFILE
  END FUNCTION PILUNLOCKPFILE
END INTERFACE

INTERFACE PILFLUSHPARAMETERS
  FUNCTION PILFLUSHPARAMETERS()
    INTEGER	:: PILFLUSHPARAMETERS
  END FUNCTION PILFLUSHPARAMETERS
END INTERFACE

INTERFACE PILRELOADPARAMETERS
  FUNCTION PILRELOADPARAMETERS()
    INTEGER	:: PILRELOADPARAMETERS
  END FUNCTION PILRELOADPARAMETERS
END INTERFACE

INTERFACE PILOVERRIDEQUERYMODE
  FUNCTION PILOVERRIDEQUERYMODE(NEWMODE)
    INTEGER (KIND=4)	:: NEWMODE
    INTEGER	:: PILOVERRIDEQUERYMODE
  END FUNCTION PILOVERRIDEQUERYMODE
END INTERFACE

INTERFACE PILGETINTVECTOR
  FUNCTION PILGETINTVECTOR(NAME, NELEM, RESULT)
    CHARACTER*(*)	:: NAME
    INTEGER		:: NELEM
    INTEGER		:: RESULT
    INTEGER		:: PILGETINTVECTOR
  END FUNCTION PILGETINTVECTOR
END INTERFACE

INTERFACE PILGETINTVARVECTOR
  FUNCTION PILGETINTVARVECTOR(NAME, NELEM, RESULT)
    CHARACTER*(*)	:: NAME
    INTEGER		:: NELEM
    INTEGER		:: RESULT
    INTEGER		:: PILGETINTVARVECTOR
  END FUNCTION PILGETINTVARVECTOR
END INTERFACE

INTERFACE PILGETREALVECTOR
  FUNCTION PILGETREALVECTOR(NAME, NELEM, RESULT)
    CHARACTER*(*)	:: NAME
    INTEGER		:: NELEM
    REAL (KIND=8)	:: RESULT
    INTEGER		:: PILGETREALVECTOR
  END FUNCTION PILGETREALVECTOR
END INTERFACE

INTERFACE PILGETREALVARVECTOR
  FUNCTION PILGETREALVARVECTOR(NAME, NELEM, RESULT)
    CHARACTER*(*)	:: NAME
    INTEGER		:: NELEM
    REAL (KIND=8)	:: RESULT
    INTEGER		:: PILGETREALVARVECTOR
  END FUNCTION PILGETREALVARVECTOR
END INTERFACE

INTERFACE PILGETREAL4VECTOR
  FUNCTION PILGETREAL4VECTOR(NAME, NELEM, RESULT)
    CHARACTER*(*)	:: NAME
    INTEGER		:: NELEM
    REAL (KIND=4)	:: RESULT
    INTEGER		:: PILGETREAL4VECTOR
  END FUNCTION PILGETREAL4VECTOR
END INTERFACE

INTERFACE PILGETREAL4VARVECTOR
  FUNCTION PILGETREAL4VARVECTOR(NAME, NELEM, RESULT)
    CHARACTER*(*)	:: NAME
    INTEGER		:: NELEM
    REAL (KIND=4)	:: RESULT
    INTEGER		:: PILGETREAL4VARVECTOR
  END FUNCTION PILGETREAL4VARVECTOR
END INTERFACE

INTERFACE PILSETREADLINEPROMPTMODE
  FUNCTION PILSETREADLINEPROMPTMODE(MODE)
    INTEGER	:: MODE
    INTEGER	:: PILSETREADLINEPROMPTMODE
  END FUNCTION PILSETREADLINEPROMPTMODE
END INTERFACE

INTERFACE PILSETCMNDARGMODE
  FUNCTION PILSETCMNDARGMODE(MODE)
    INTEGER	:: MODE
    INTEGER	:: PILSETCMNDARGMODE
  END FUNCTION PILSETCMNDARGMODE
END INTERFACE

! initialize PIL stuff (F90 version)
! prototype given by module. 
! MODE parameter can be PIL_MODE_STANDALONE/SERVER

CONTAINS
  FUNCTION PILINIT()
    INTEGER	  :: PILINIT

! hopefully nobody will create args longer than PIL_LINESIZE 
CHARACTER*(PIL_LINESIZE) :: ARGV
INTEGER  :: I, N, R

! get number of command line parameters
N = IARGC()

! pass them to C object
DO  I=0,N
  call GETARG(I, ARGV)
  R = PILF90ADDARG(ARGV)
  IF (.NOT. (PIL_OK == R)) THEN 
    PILINIT = R
    RETURN
  END IF
END DO

! call C initializer, return value taken from C initializer
PILINIT = PILF90INIT()

END FUNCTION PILINIT


END MODULE PIL_F90_API
