module gildas_luns
  use gildas_def
  !---------------------------------------------------------------------
  ! Logical units reserved for Gildas, from stalun+1 to stalun+1+maxlun
  !---------------------------------------------------------------------
  integer(kind=4), parameter :: stalun=50      ! First lun used is stalun+1
  integer(kind=4), parameter :: maxlun=49      ! Maximum number of luns
  logical                        :: isused(maxlun)   = .false.  ! Use status of luns
  character(len=filename_length) :: lunfiles(maxlun) = ''       ! Last opened file names
  !
end module gildas_luns
!
function sic_open(unit,file,status,readonly)
  use gbl_message
  use gsys_interfaces, except_this=>sic_open
  use gildas_luns
  !---------------------------------------------------------------------
  ! @ public
  ! This machine dependent function opens a formatted file, and returns an
  ! error code. This Unix version simulates version numbers by renaming
  ! any existing file to a ~appended name.
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_open  ! Return value
  integer(kind=4),  intent(in) :: unit      ! Fortran logical unit
  character(len=*), intent(in) :: file      ! File name
  character(len=*), intent(in) :: status    ! File status ('NEW', or 'OLD', or...)
  logical,          intent(in) :: readonly  ! Open as write protected?
  ! Local
  logical :: exist
  integer(kind=4) :: ilun,ier
  !
  call gsys_message(seve%d,'SIC_OPEN',  &
    'Opening file "'//trim(file)//'" with status '//trim(status))
  !
  if (status.eq.'NEW') then 
    inquire(file=file,exist=exist)
    if (exist) then
      ier = gag_filrename(file,trim(file)//'~')
    endif
  endif
  !
  if (status.eq.'APPEND') then
    open(unit=unit,file=file,status='OLD',form='FORMATTED',position='APPEND',  &
         action='READWRITE',iostat=sic_open)
  else
    if (readonly) then
      open(unit=unit,file=file,status=status,form='FORMATTED',action='READ',  &
           iostat=sic_open)
    else
      open(unit=unit,file=file,status=status,form='FORMATTED',  &
           action='READWRITE',iostat=sic_open)
    endif
  endif
  !
  ! Keep track of opened file for debugging purpose (SIC DEBUG LUN)
  ilun = unit-stalun
  if (ilun.ge.1 .and. ilun.le.maxlun) then
    ! This unit is in the range [STALUN+1:STALUN+MAXLUN] usable by Gildas
    ! program
    if (isused(ilun)) then
      ! This LUN was indeed reserved by SIC_GETLUN
      lunfiles(ilun) = file
    endif
  endif
  !
end function sic_open
!
function sic_flush(unit)
  !---------------------------------------------------------------------
  ! @ public
  ! This function flushes file buffer onto disk, and returns an error
  ! code.
  !---------------------------------------------------------------------
  integer(kind=4)             :: sic_flush  ! Flush status (0=success)
  integer(kind=4), intent(in) :: unit       ! Logical unit
#if defined(FORTRAN2003)
  flush(unit=unit,iostat=sic_flush)
#else
  sic_flush=0
#endif
  !
end function sic_flush
!
function sic_close(unit)
  use gildas_luns
  use gsys_interfaces, except_this=>sic_close
  !---------------------------------------------------------------------
  ! @ public
  ! 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.
  ! Use unit=0 to close all units.
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_close  ! Close status (0=success)
  integer(kind=4), intent(in) :: unit  ! Logical unit to close
  ! Local
  integer(kind=4) :: i,iunit,ier
  !
  if (unit.eq.0) then
    sic_close = 0
    do i=1,maxlun
      if (isused(i)) then
        iunit = i+stalun
        ier = sic_close_one(iunit)
        if (ier.ne.0)  sic_close = ier
      endif
    enddo
  else
    sic_close = sic_close_one(unit)
  endif
  !
end function sic_close
!
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
  !
  close(unit=unit,iostat=sic_close_one)
  !
end function sic_close_one
!
subroutine sic_frelun(unit)
  use gsys_interfaces, except_this=>sic_frelun
  !---------------------------------------------------------------------
  ! @ public
  ! This machine dependent function frees a Fortran logical unit obtained
  ! through a call to SIC_GETLUN. Error on close can not be retrieved,
  ! use GAG_FRELUN to do so.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: unit  ! Fortran logical unit to close
  ! Local
  integer(kind=4) :: ier
  !
  ier = gag_frelun(unit)
  !
end subroutine sic_frelun
!
function sic_getlun(unit)
  use gbl_message
  use gsys_interfaces, except_this=>sic_getlun
  use gildas_luns
  !---------------------------------------------------------------------
  ! @ public
  ! This machine dependent function returns a free Fortran logical unit in
  ! UNIT. The function value is an error code. For safe operation, all
  ! logical units used by the program should be obtained through calls to
  ! SIC_GETLUN. This portable version reserves all units between STALUN+1
  ! and STALUN+MAXLUN, which may interfere with the calling program. Safer
  ! equivalents can usually be obtained through system calls.
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_getlun  ! Function value on return
  integer(kind=4), intent(out) :: unit  ! Unit obtained on return
  ! Local
  character(len=*), parameter :: rname='GETLUN'
  integer(kind=4) :: i
  !
  do i=1,maxlun
    if (.not.isused(i)) then
      unit = i+stalun
      isused(i) = .true.
      sic_getlun = 1
      return
    endif
  enddo
  ! Error return
  call gsys_message(seve%e,rname,'No more logical unit available')
  unit = 0
  sic_getlun = 0
  !
  ! Also display the list of reserved LUN (useful for e.g. programs which
  ! do not provide a prompt to call SIC DEBUG LUN)
  call gsys_message(seve%e,rname,'Reserved logical units are:')
  i = gag_stalun(0)
end function sic_getlun
!
function gag_frelun(unit)
  use gildas_def
  use gbl_message
  use gildas_luns
  !---------------------------------------------------------------------
  ! @ public
  ! This machine dependent function frees a Fortran logical unit obtained
  ! through a call to SIC_GETLUN. The function value is an error code.
  !---------------------------------------------------------------------
  integer(kind=4) :: gag_frelun  ! Function value on return
  integer(kind=4), intent(in) :: unit  ! Logical unit to close
  ! Local
  character(len=*), parameter :: rname='FRELUN'
  integer(kind=4) :: i
  logical :: status
  character(len=filename_length) :: file
  character(len=message_length) :: mess
  !
  i = unit-stalun
  if (i.ge.1 .and. i.le.maxlun) then
    gag_frelun = 1
    if (isused(i)) then
      isused(i) = .false.
      ! Was this lun Fortran closed?
      inquire(unit=unit,opened=status,name=file)
      if (status) then
        write(mess,'(A,I0,A,A)')  &
          'lun #',unit,' is still opened on file ',trim(file)
        call gsys_message(seve%w,rname,mess)
      endif
    endif
  else
    gag_frelun = 0
  endif
end function gag_frelun
!
function gag_stalun(unit)
  use gildas_luns
  use gsys_interfaces, except_this=>gag_stalun
  !---------------------------------------------------------------------
  ! @ public
  ! Stat input lun (or all if lun=0) and print out status of lun(s)
  !---------------------------------------------------------------------
  integer(kind=4) :: gag_stalun  ! Function value on return
  integer(kind=4), intent(in) :: unit  ! Unit to stat
  ! Local
  integer(kind=4) :: i,iunit
  !
  if (unit.eq.0) then
    do i=1,maxlun
      if (isused(i)) then
        iunit = i+stalun
        call gag_stalun_print(iunit)
      endif
    enddo
    gag_stalun = 0
  else
    call gag_stalun_print(unit)
    gag_stalun = 1
  endif
end function gag_stalun
!
subroutine gag_stalun_print(unit)
  use gildas_def
  use gbl_message
  use gsys_interfaces, except_this=>gag_stalun_print
  use gildas_luns
  !---------------------------------------------------------------------
  ! @ 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
  ! Local
  character(len=*), parameter :: rname='STALUN'
  character(len=filename_length) :: file
  logical :: isopened
  character(len=message_length) :: mess
  integer(kind=4) :: ilun
  !
  inquire(unit=unit,opened=isopened,name=file)
  !
  ilun = unit-stalun
  if (ilun.ge.1 .and. ilun.le.maxlun) then
    ! This is a SIC_GETLUN lun
    if (isopened) then
      write(mess,'(A,I2,2A)') 'Lun ',unit,' sic_opened on ',trim(lunfiles(ilun))
    elseif (lunfiles(ilun).ne.'') then
      write(mess,'(A,I2,3A)') 'Lun ',unit,' sic_closed (last sic_opened on ',trim(lunfiles(ilun)),')'
    else
      write(mess,'(A,I2,2A)') 'Lun ',unit,' sic_closed'
    endif
    !
  else
    ! This is not a SIC_GETLUN lun
    if (isopened) then
      write(mess,'(A,I2,2A)') 'Lun ',unit,' opened on ',trim(file)
    else
      write(mess,'(A,I2,A)')  'Lun ',unit,' closed'
    endif
  endif
  !
  call gsys_message(seve%r,rname,mess)
  !
end subroutine gag_stalun_print
!
function sic_purge(file,keep)
  !---------------------------------------------------------------------
  ! @ public
  ! This machine dependent function deletes all versions of a file except
  ! for the KEEP last ones, KEEP=0 being a supported case. The function
  ! value is an error code. This dummy version does nothing and should be
  ! replaced by an EMACS-like behaviour (using numbered backup files).
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_purge  ! Return value
  character(len=*), intent(in) :: file       ! File name
  integer(kind=4),  intent(in) :: keep       ! Number of versions that should be kept
  !
  sic_purge = 1                ! SS$_NORMAL
end function sic_purge
