module gsys_interfaces_private
  interface
    subroutine set_ctrlc
      use gsys_variables
      !---------------------------------------------------------------------
      ! @ private
      ! Set CONTROLC flag to .TRUE.
      ! Re-initiate the ^C trapping by calling TRAP_CTRLC
      !---------------------------------------------------------------------
    end subroutine set_ctrlc
  end interface
  !
  interface
    function gag_julda(nyr)
      !---------------------------------------------------------------------
      ! @ private
      !  Returns Julian date of 1 day of Year
      !---------------------------------------------------------------------
      integer(kind=4) :: gag_julda  ! Date returned
      integer(kind=4), intent(in) :: nyr  !
    end function gag_julda
  end interface
  !
  interface
    subroutine gag_gregorian2mjd(iy,im,id,djm,ier)
      !---------------------------------------------------------------------
      ! @ private
      ! Gregorian Calendar to Modified Julian Date
      ! MJD is not computed when ier.ne.0
      !
      ! The year must be -4699 (i.e. 4700BC) or later.
      !
      ! The algorithm is derived from that of Hatcher 1984
      ! (QJRAS 25, 53-55).
      !
      ! Derived from P.T.Wallace   Starlink   11 March 1998
      ! Copyright (C) 1998 Rutherford Appleton Laboratory
      !---------------------------------------------------------------------
      integer(kind=4), intent(in)  :: iy  ! year in Gregorian calendar
      integer(kind=4), intent(in)  :: im  ! month in Gregorian calendar
      integer(kind=4), intent(in)  :: id  ! day in Gregorian calendar
      real(kind=8),    intent(out) :: djm ! Modified Julian Date (JD-2400000.5) for 0 hrs
      integer(kind=4), intent(out) :: ier ! Status  (0 = OK, 1 = bad year, 2 = bad month, 3 = bad day)
    end subroutine gag_gregorian2mjd
  end interface
  !
  interface
    subroutine gag_mjd2gregorian(mjd,iy,im,id,error)
      use phys_const
      !---------------------------------------------------------------------
      ! @ private
      ! Modified Julian Date to Gregorian Calendar
      !---------------------------------------------------------------------
      real(kind=8),    intent(in)    :: mjd    ! Modified Julian Date (JD-2400000.5) for 0 hrs
      integer(kind=4), intent(out)   :: iy     ! Year in Gregorian calendar
      integer(kind=4), intent(out)   :: im     ! Month in Gregorian calendar
      integer(kind=4), intent(out)   :: id     ! Day in Gregorian calendar
      logical(kind=4), intent(inout) :: error  ! Logical error flag
    end subroutine gag_mjd2gregorian
  end interface
  !
  interface
    subroutine gmessage_open(mesname,error)
      use gildas_def
      !---------------------------------------------------------------------
      ! @ private
      ! Opens message file in GAG_LOG: directory. Must be called only once.
      !---------------------------------------------------------------------
      character(len=*), intent(in)    :: mesname  ! Message base filename
      logical,          intent(inout) :: error    ! Error flag
    end subroutine gmessage_open
  end interface
  !
  interface
    subroutine gmessage_flush(error)
      use gbl_message
      !---------------------------------------------------------------------
      ! @private
      ! Closes message file and reset its logical unit for a clean handling
      ! of very last messages.
      !---------------------------------------------------------------------
      logical, intent(inout) :: error    ! Error flag
    end subroutine gmessage_flush
  end interface
  !
  interface
    function gmessage_isoff(id,mkind)
      !---------------------------------------------------------------------
      ! @ private
      ! Checks if the message sent to gmessage_write is intended to be
      ! printed to at least one of the outputs (screen or message file).
      ! Should be used if you want to skip string formatting (for example)
      ! in order to save CPU time.
      !---------------------------------------------------------------------
      logical :: gmessage_isoff
      integer(kind=4), intent(in) :: id     ! Package id
      integer(kind=4), intent(in) :: mkind  ! Message kind
    end function gmessage_isoff
  end interface
  !
  interface
    subroutine gmessage_gbl_filters_on(rule)
      !---------------------------------------------------------------------
      ! @ private
      ! Set Global filters and activate its use.
      !---------------------------------------------------------------------
      character(len=*), intent(in) :: rule  ! Optional rule to alter filters
    end subroutine gmessage_gbl_filters_on
  end interface
  !
  interface
    subroutine gmessage_gbl_filters_off
      !---------------------------------------------------------------------
      ! @ private
      ! Deactivate use of Global filters
      !---------------------------------------------------------------------
      !
    end subroutine gmessage_gbl_filters_off
  end interface
  !
  interface
    subroutine gpack_get_name(id,packname,error)
      use gpack_def
      use gbl_message
      !---------------------------------------------------------------------
      ! @ private
      ! Get package name from the given package id
      !---------------------------------------------------------------------
      integer(kind=4),  intent(in)    :: id
      character(len=*), intent(out)   :: packname
      logical,          intent(inout) :: error
    end subroutine gpack_get_name
  end interface
  !
  interface
    function gpack_register(pack,error)
      use gpack_def
      use gbl_message
      !----------------------------------------------------------------------
      ! @ private
      ! Private function to register a package and return a new package id
      !----------------------------------------------------------------------
      integer(kind=4) :: gpack_register
      type(gpack_prop_t), intent(in)    :: pack
      logical,            intent(inout) :: error
    end function gpack_register
  end interface
  !
  interface
    recursive subroutine gpack_recurse(pack_fct,pack_id,error)
      !---------------------------------------------------------------------
      ! @ private
      ! Call pack_fct on all package from the dependency hierarchy, starting
      ! from low level packages and ending with the root package given by
      ! pack_id
      !---------------------------------------------------------------------
      external                       :: pack_fct
      integer(kind=4), intent(in)    :: pack_id
      logical,         intent(inout) :: error
    end subroutine gpack_recurse
  end interface
  !
  interface
    subroutine gpack_recurse_high_first(pack_fct,pack_id,error)
      !---------------------------------------------------------------------
      ! @ private
      ! Call pack_fct on all package from the dependency hierarchy, starting
      ! from the root package given by pack_id and ending with low level
      ! packages
      !---------------------------------------------------------------------
      external                       :: pack_fct
      integer(kind=4), intent(in)    :: pack_id
      logical,         intent(inout) :: error
    end subroutine gpack_recurse_high_first
  end interface
  !
  interface
    recursive subroutine gpack_recurse_depend(pack_fct,pack,parent_pack,low_first,  &
      recurse_level,pack_reach_flags,error)
      use gpack_def
      !---------------------------------------------------------------------
      ! @ private
      ! Generic routine to recurse through all dependent packages of package
      ! pack
      !---------------------------------------------------------------------
      external                          :: pack_fct       ! Function to call on each package
      type(gpack_prop_t), intent(in)    :: pack           ! Package to start from
      type(gpack_prop_t), intent(in)    :: parent_pack    ! Initial recursion package
      logical,            intent(in)    :: low_first      ! Call pack_fct from low level package to high level
      integer(kind=4),    intent(in)    :: recurse_level  !
      logical,            intent(inout) :: pack_reach_flags(gpack_max_count)
      logical,            intent(inout) :: error          ! Error flag
    end subroutine gpack_recurse_depend
  end interface
  !
  interface
    recursive subroutine gpack_set_dependencies(pack,error)
      use gpack_def
      !---------------------------------------------------------------------
      ! @ private
      ! Intermediate routine to call gpack_set recursively and build package
      ! depend_id member
      !---------------------------------------------------------------------
      type(gpack_prop_t), intent(inout) :: pack
      logical,            intent(inout) :: error
    end subroutine gpack_set_dependencies
  end interface
  !
  interface
    subroutine gpack_init(pack,parent_pack,error)
      use gpack_def
      !---------------------------------------------------------------------
      ! @ private-mandatory (because symbol is used elsewhere)
      ! Call package init method from gpack_recurse
      !---------------------------------------------------------------------
      type(gpack_prop_t), intent(inout) :: pack
      type(gpack_prop_t), intent(in)    :: parent_pack
      logical,            intent(inout) :: error
    end subroutine gpack_init
  end interface
  !
  interface
    subroutine gpack_exec_on_child(pack,parent_pack,error)
      use gpack_def
      !---------------------------------------------------------------------
      ! @ private-mandatory (because symbol is used elsewhere)
      ! Call package exec_on_child method from gpack_recurse_again
      !---------------------------------------------------------------------
      type(gpack_prop_t), intent(in)    :: pack
      type(gpack_prop_t), intent(in)    :: parent_pack
      logical,            intent(inout) :: error
    end subroutine gpack_exec_on_child
  end interface
  !
  interface
    subroutine gpack_clean(pack,parent_pack,error)
      use gpack_def
      !---------------------------------------------------------------------
      ! @ private
      ! Call package start method from gpack_recurse_high_first
      !---------------------------------------------------------------------
      type(gpack_prop_t), intent(in)    :: pack
      type(gpack_prop_t), intent(in)    :: parent_pack
      logical,            intent(inout) :: error
    end subroutine gpack_clean
  end interface
  !
  interface
    subroutine gsys_message(mkind,procname,message)
      use gbl_message
      !---------------------------------------------------------------------
      ! @ private
      ! Messaging facility for the current library. Calls the low-level
      ! messaging routine with its own identifier.
      !---------------------------------------------------------------------
      integer(kind=4),  intent(in) :: mkind     ! Message kind
      character(len=*), intent(in) :: procname  ! Name of calling procedure
      character(len=*), intent(in) :: message   ! Message string
    end subroutine gsys_message
  end interface
  !
  interface
    subroutine sic_handlelog(name,trans,codeop,coderr)
      use gildas_def
      use gbl_message
      !---------------------------------------------------------------------
      ! @ private
      !
      !     Get or Set a log name according to Code Op
      !
      ! Simulates recursive translation of a VMS logical name by looking into
      ! a dictionary in the user's path. The calling list should probably be
      ! modified to include the string length.
      ! Three dictionaries are used: a global dictionary contains site independent
      ! definitions, a local one is defined at installation level and a user
      ! specific one can be used by any individual user to customize his
      ! definitions. Local definitions override more global definitions, so the
      ! user has the final say.
      !---------------------------------------------------------------------
      character(len=*), intent(inout) :: name     !
      character(len=*), intent(in)    :: trans    !
      integer(kind=4),  intent(in)    :: codeop   !
      integer(kind=4),  intent(out)   :: coderr   !
    end subroutine sic_handlelog
  end interface
  !
  interface
    function sic_get_npath(paths,sep)
      !---------------------------------------------------------------------
      ! @ private
      ! Return number of paths in a list of paths PATHS separated by SEP.
      ! Return 0 if input string is empty. Take care that PATHS may or may not
      ! end with a SEP.
      !---------------------------------------------------------------------
      integer(kind=4) :: sic_get_npath  !
      character(len=*), intent(in) :: paths  ! Paths list
      character(len=*), intent(in) :: sep    ! Separator (assume len=1)
    end function sic_get_npath
  end interface
  !
  interface
    subroutine sic_get_path(paths,sep,n,istart,iend)
      !---------------------------------------------------------------------
      ! @ private
      ! Return Nth path indices in a list of paths PATHS separated by SEP.
      ! Return indexes for an empty string if such a path does not exist.
      !---------------------------------------------------------------------
      character(len=*), intent(in)  :: paths   ! Paths list
      character(len=*), intent(in)  :: sep     ! Separator (assume len=1)
      integer(kind=4),  intent(in)  :: n       ! Position
      integer(kind=4),  intent(out) :: istart  ! Beginning of string
      integer(kind=4),  intent(out) :: iend    ! End of string
    end subroutine sic_get_path
  end interface
  !
  interface
    subroutine load_dict(maxlog,pflog,pnlog,diclog,translog,error)
      use gildas_def
      use gbl_message
      !---------------------------------------------------------------------
      ! @ private
      !  Fills the internal dictionary, reading from the three possible
      ! configuration files.
      !---------------------------------------------------------------------
      integer(kind=4),    intent(in)    :: maxlog            !
      integer(kind=4),    intent(out)   :: pflog(0:27)       ! Alphabetic pointers PF(27)=number of
      integer(kind=4),    intent(out)   :: pnlog(maxlog)     ! Chained pointers
      character(len=512), intent(inout) :: diclog(maxlog)    ! Identifiers
      character(len=512), intent(inout) :: translog(maxlog)  ! Translation for identifiers
      logical,            intent(inout) :: error             !
    end subroutine load_dict
  end interface
  !
  interface
    subroutine gtlblanc(c,n)
      !---------------------------------------------------------------------
      ! @ private
      !  Reduce the character string C to the standard SIC internal syntax.
      !  Suppress all unecessary separators.
      !  Ignores and destroys comments.
      !---------------------------------------------------------------------
      character(len=*), intent(inout) :: c  ! Character string to be formatted
      integer(kind=4),  intent(inout) :: n  ! Length of C
    end subroutine gtlblanc
  end interface
  !
  interface
    function sic_expenv(name)
      !---------------------------------------------------------------------
      ! @ private
      !
      ! This Unix specific routine expands environment variables in file names.
      ! Environment variables begin with a $ sign. They are terminated by a /
      ! sign.
      !---------------------------------------------------------------------
      integer(kind=4) :: sic_expenv  !
      character(len=*), intent(inout) :: name  !
    end function sic_expenv
  end interface
  !
  interface
    subroutine sic_ctrans (name,nn,trans,np)
      use gildas_def
      !---------------------------------------------------------------------
      ! @ private
      !     Returns the translation (TRANS(1:NP)) of a Logical name (NAME(1:NN))
      !     NAME and TRANS are assumed to be C Strings, i.e. Byte arrays.
      !---------------------------------------------------------------------
      integer(kind=1), intent(in)    :: name(*)   !
      integer(kind=4), intent(in)    :: nn        !
      integer(kind=1), intent(out)   :: trans(*)  !
      integer(kind=4), intent(inout) :: np        !
    end subroutine sic_ctrans
  end interface
  !
  interface
    subroutine gag_setcleanlog (input,output,ispath)
      !---------------------------------------------------------------------
      ! @ private
      ! Perform a good cleaning on the Logical name definitions to 
      ! use the appropriate system dependent separators.
      !
      ! A better job can be done using the code marked !!BETTER
      ! but that does not seem to be required.
      !---------------------------------------------------------------------
      character(len=*), intent(in)  :: input
      character(len=*), intent(out) :: output
      logical,          intent(in)  :: ispath
    end subroutine gag_setcleanlog
  end interface
  !
  interface
    function sic_close_one(unit)
      !---------------------------------------------------------------------
      ! @ private
      ! This function closes a formatted file, and returns an error code.
      ! Following the Fortran norm, default closing STATUS:
      ! - is DELETE if unit has been opened with STATUS=SCRATCH,
      ! - is KEEP if unit has been opened with any other STATUS.
      !---------------------------------------------------------------------
      integer(kind=4)             :: sic_close_one  ! Close status (0=success)
      integer(kind=4), intent(in) :: unit           ! Logical unit to close
    end function sic_close_one
  end interface
  !
  interface
    subroutine gag_stalun_print(unit)
      use gildas_def
      use gbl_message
      !---------------------------------------------------------------------
      ! @ private
      ! Print out status of a single lun
      ! NB: the lun can be one not reserved by SIC_GETLUN
      !---------------------------------------------------------------------
      integer(kind=4), intent(in) :: unit  ! Unit to stat
    end subroutine gag_stalun_print
  end interface
  !
  interface
    subroutine putmsg (name,ier)
      !---------------------------------------------------------------------
      ! @ private
      ! UTIL  Internal routine
      !       Print system message corresponding to code IER on SYS$OUTPUT.
      !---------------------------------------------------------------------
      character(len=*), intent(in) :: name  ! Facility name
      integer(kind=4),  intent(in) :: ier   ! 32-bit system message code
    end subroutine putmsg
  end interface
  !
  interface
    subroutine win32_iostat (msg,ier)
      !---------------------------------------------------------------------
      ! @ private
      ! Get system message corresponding to IO error code IER
      !     Version for WIN32 Dec/Compaq compiler
      !---------------------------------------------------------------------
      character(len=*), intent(out) :: msg  ! Returned message
      integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
    end subroutine win32_iostat
  end interface
  !
  interface
    subroutine g95_iostat (msg,ier)
      !---------------------------------------------------------------------
      ! @ private
      ! Get system message corresponding to IO error code IER
      !     Version for G95 Gnu compiler.
      !---------------------------------------------------------------------
      character(len=*), intent(out) :: msg  ! Returned message
      integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
    end subroutine g95_iostat
  end interface
  !
  interface
    subroutine gfc_iostat (msg,ier)
      !---------------------------------------------------------------------
      ! @ private
      ! Get system message corresponding to IO error code IER
      !     Version for GFortran Gnu compiler.
      !---------------------------------------------------------------------
      character(len=*), intent(out) :: msg  ! Returned message
      integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
    end subroutine gfc_iostat
  end interface
  !
  interface
    subroutine ifort_iostat(msg,ier)
      !---------------------------------------------------------------------
      ! @ private
      ! Get system message corresponding to IO error code IER
      !     Version for Intel Fortran compiler.
      !---------------------------------------------------------------------
      character(len=*), intent(out) :: msg  ! Returned message
      integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
    end subroutine ifort_iostat
  end interface
  !
  interface
    subroutine gag_cflab (chrstr,x,w,d)
      !---------------------------------------------------------------------
      ! @ private
      !  Convert floating point value to a display of the form of the
      ! "Babylonian" ddd mm ss.s, where each field represents a sexagesimal
      ! increment over its successor. The value X must be in the units of
      ! the rightmost field.  For instance, X must be in seconds of time for
      ! hours, minutes, seconds display.
      !---------------------------------------------------------------------
      character(len=*), intent(out)   :: chrstr  ! Formatted string
      real(kind=8),     intent(in)    :: x       ! Input number
      integer(kind=4),  intent(inout) :: w       ! Length of string
      integer(kind=4),  intent(in)    :: d       ! Number of decimals
    end subroutine gag_cflab
  end interface
  !
  interface
    subroutine blank_fill(oct,long)
      !---------------------------------------------------------------------
      ! @ private
      ! Blank the input string along its 'long' first chars. Work with
      ! integer*1 values instead of characters.
      !---------------------------------------------------------------------
      integer(kind=4), intent(in)  :: long       ! Length of string
      integer(kind=1), intent(out) :: oct(long)  ! String retrieved as a I*1 array
    end subroutine blank_fill
  end interface
  !
  interface
    subroutine mtskip(chan,nskip,ncoun,end_tape,err)
      use gbl_message
      !---------------------------------------------------------------------
      ! @ private
      ! FITS  Internal routine
      !       Skip tape-marks and return count and status
      !       This entry should only be called when END_OF_FILE is
      !       already .TRUE.
      ! Arguments :
      !       CHAN     I      I/O Channel
      !       NSKIP    I      Number of files to skip         Input
      !       NCOUN    I      Number of tape mark skipped     Output
      !       END_TAPE L      End-of-Tape reached             Output
      !       ERR      L      Logical error flag              Output
      !---------------------------------------------------------------------
      integer(kind=4) :: chan           !
      integer(kind=2) :: nskip          !
      integer(kind=4) :: ncoun          !
      logical         :: end_tape       !
      logical         :: err            !
    end subroutine mtskip
  end interface
  !
  interface
    subroutine mtmoun (tape,dens,chan,err)
      use gbl_message
      !---------------------------------------------------------------------
      ! @ private
      ! UTIL  Internal routine
      !       Tries to mount a tape on device "TAPE", which
      !       must be assigned to a generic name of tape devices.
      ! Arguments :
      !       TAPE    C*(*)   Tape device logical name        Input
      !       CHAN    I       I/O channel assigned            Output
      !       ERR     L       Logical error flag              Input
      !---------------------------------------------------------------------
      character(len=*) :: tape          !
      integer(kind=4)  :: dens          !
      integer(kind=4)  :: chan          !
      logical          :: err           !
    end subroutine mtmoun
  end interface
  !
end module gsys_interfaces_private
