!{\src2tex{textfont=tt}}
!!****m* ABINIT/m_io_tools
!! NAME
!!  m_io_tools
!!
!! FUNCTION
!!  This module contains basic tools to deal with Fortran IO
!!
!! COPYRIGHT
!! Copyright (C) 2008-2016 ABINIT group (MG)
!! This file is distributed under the terms of the
!! GNU General Public License, see ~abinit/COPYING
!! or http://www.gnu.org/copyleft/gpl.txt .
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

#if defined HAVE_CONFIG_H
#include "config.h"
#endif

#include "abi_common.h"

MODULE m_io_tools

 use defs_basis

 implicit none

 private

 public :: get_unit           ! Get a free unit if no argument is specified or report the unit associated to a file name
 public :: file_exists        ! Return .TRUE. if file exists.
 public :: delete_file        ! Delete a file if present.
 public :: is_open            ! .TRUE. if file is open
 public :: is_connected       ! .TRUE. if file is connected to a logical unit number
 public :: prompt             ! Simple prompt
 public :: read_line          ! Read line from unit ignoring blank lines and deleting comments beginning with !
 public :: flush_unit         ! Wrapper to the intrinsic flush routine, not implemented by every compiler
 public :: pick_aname         ! Returns the name of a non-existent file to be used for temporary storage.
 public :: isncfile           ! .TRUE. if we have a NETCDF file.
 public :: iomode_from_fname  ! Automatic selection of the IO mode based on the file extension.
 public :: iomode2str         ! Convert iomode to string 
 public :: mvrecord           ! Moves forward or backward in a Fortran binary file by nn records.
 public :: open_file          ! Helper function to open a file in sequential mode with improved error handling.
 public :: close_unit         ! Helper function to close a Fortran unit with improved error handling.
 public :: write_lines        ! split a string in lines and output the text to the specified unit 
 public :: lock_and_write     ! Write a string to a file with locking mechanism. 
 public :: num_opened_units   ! Return the number of opened units.
 public :: show_units         ! Print info on the logical units.

 interface get_unit
   module procedure get_free_unit
   module procedure get_unit_from_fname
 end interface

 interface is_open
   module procedure is_open_unit
   module procedure is_open_fname
 end interface

 interface prompt
   module procedure prompt_int0D
   module procedure prompt_rdp0D
   module procedure prompt_string
   module procedure prompt_int1D
   module procedure prompt_int2D
   module procedure prompt_rdp1D
   module procedure prompt_rdp2D
 end interface

  integer,parameter :: STDIN=std_in
  integer,parameter :: STDOUT=std_out_default
  integer,parameter :: MIN_UNIT_NUMBER=10  ! Fortran does not define the range for logical unit numbers (they not be negative)
#ifdef FC_NAG
  integer,parameter :: MAX_UNIT_NUMBER=64    ! There's a serious problem in Nag6.0. In principle
                                             ! Maximum unit number: 2147483647
#else
  integer,parameter :: MAX_UNIT_NUMBER=1024  ! The following values should be safe
#endif
  integer,parameter :: IO_MAX_LEN=500
  character(len=1),parameter :: BLANK=' '

  ! === For Interactive sessions ===
  integer,parameter :: IO_EOT=-1           ! End of transmission i.e CTRL+D
  character(len=4),parameter :: PS1='>>> '
  character(len=4),parameter :: PS2='??? '

  integer,parameter :: IO_NO_AVAILABLE_UNIT  =-1   ! No units are available for Fortran I/O
  integer,parameter :: IO_FILE_NOT_ASSOCIATED=-2   ! File is not associated with any unit

  !integer,save,public ABI_PROTECTED :: IO_MODE_DEFAULT=-1

CONTAINS  !===========================================================
!!***

!!****f* m_io_tools/get_unit
!! NAME
!!  get_unit
!!
!! FUNCTION
!!  Obtain a logical Fortran unit.
!!  A free unit is reported if no argument is specified.
!!  If the file name is supplied, the function reports the unit number
!!  associated to the file
!!  Note that GET_UNIT assumes that units 0, 5, 6 (stderr, stdin, std_out) 
!!  are special, and will never return those values.
!!
!! TODO
!!   One should define an abinit-specific function with a list of reserved units!
!!
!! OUTPUT
!!  The unit number (free unit or unit associated to the file)
!!  Raises:
!!   IO_NO_AVAILABLE_UNIT if no logical unit is free (!)
!!   IO_FILE_NOT_ASSOCIATED if the file is not linked to a logical unit
!!
!! PARENTS
!!
!! SOURCE

integer function get_free_unit()


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_free_unit'
!End of the abilint section

 implicit none

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_free_unit'
!End of the abilint section

!Local variables-------------------------------
 integer :: iunt
 logical :: isopen
! *********************************************************************

 do iunt=MAX_UNIT_NUMBER,MIN_UNIT_NUMBER,-1
   if (any(iunt == [std_err, std_in, std_out])) cycle
   inquire(unit=iunt, opened=isopen)
   if (.not.isopen) then
      get_free_unit = iunt; return
   end if
 end do
 get_free_unit = IO_NO_AVAILABLE_UNIT

end function get_free_unit
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/get_unit_from_fname
!! NAME
!! get_unit_from_fname
!!
!! FUNCTION
!!  Returns the unit number associated to an open file whose name is fname.
!!  If the file is not connected to an unit number, returns IO_FILE_NOT_ASSOCIATED
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! SOURCE

integer function get_unit_from_fname(fname)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_unit_from_fname'
!End of the abilint section

 implicit none

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_unit_from_fname'
!End of the abilint section

!Arguments ------------------------------------
 character(len=*),intent(in) :: fname

!Local variables-------------------------------
 integer :: unit
! *********************************************************************

 inquire(file=fname,number=unit)

 get_unit_from_fname=unit
 if (unit==-1) get_unit_from_fname=IO_FILE_NOT_ASSOCIATED

end function get_unit_from_fname
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/file_exists
!! NAME
!!  file_exists
!!
!! FUNCTION
!!  Return .TRUE. if file existent (function version of inquire).
!!
!! INPUTS
!!  fname=The name of the file.
!!
!! PARENTS
!!
!! SOURCE

logical function file_exists(fname)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'file_exists'
!End of the abilint section

 character(len=*),intent(in) :: fname

! *********************************************************************

 inquire(file=fname,exist=file_exists)

end function file_exists
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/delete_file
!! NAME
!!  delete_file
!!
!! FUNCTION
!!  Delete a file if present.
!!
!! INPUTS
!!  fname=The name of the file.
!!
!! OUTPUT
!!  ierr=Non-zero value indicates that a problem occured.
!!   111 = To signal that the file does not exist.
!!   112 = File exist, is open but no associated unit is found!
!!   Other values are system-dependent as the value is returned by a open or close
!!   instruction.
!!
!! SIDE EFFECTS
!!  The specified file is deleted.
!!
!! PARENTS
!!      abinit,ioprof,m_io_redirect,m_nctk,m_wfk,mlwfovlp
!!
!! CHILDREN
!!
!! SOURCE

subroutine delete_file(fname,ierr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'delete_file'
!End of the abilint section

 integer,intent(out) :: ierr
 character(len=*),intent(in) :: fname

!Local variables-------------------------------
 integer :: tmp_unt
 logical :: exists
! *********************************************************************

 ierr=0

 inquire(file=fname,exist=exists)

 if (.not.exists) then
   ierr=111
   write(std_out,*)" Asked to delete not existent file: ",TRIM(fname)
   RETURN
 end if

 if (is_open_fname(fname)) then
   tmp_unt = get_unit_from_fname(fname)
   if ( tmp_unt == IO_FILE_NOT_ASSOCIATED ) then
    write(std_out,*) "File is opened but no associated unit found!"
    ierr=112
    RETURN
   end if
   close(tmp_unt)
 else
   tmp_unt = get_unit()
 end if

 ! Now close the file.
 open(unit=tmp_unt,file=trim(fname),status="OLD",iostat=ierr)
 if (ierr==0) close(unit=tmp_unt,status="DELETE",iostat=ierr)

end subroutine delete_file
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/is_connected
!! NAME
!!  is_connected
!!
!! FUNCTION
!!  Returns .TRUE. if unit is connected to fname.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! SOURCE

logical function is_connected(unit,fname)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'is_connected'
!End of the abilint section

 integer,intent(in) :: unit
 character(len=*),intent(in) :: fname

!Local variables-------------------------------
 integer :: unt_found
 logical :: isopen
! *********************************************************************

 inquire(file=fname,number=unt_found,opened=isopen)
 is_connected=(isopen.and.(unt_found==unit))

end function is_connected
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/is_open
!! NAME
!!  is_open
!!
!! FUNCTION
!!  Returns .TRUE. if unit is associated to an open file.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! SOURCE

logical function is_open_unit(unit)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'is_open_unit'
!End of the abilint section

 integer,intent(in) :: unit
! *********************************************************************

 inquire(unit=unit,opened=is_open_unit)

end function is_open_unit
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/is_open_fname
!! NAME
!!  is_open_fname
!!
!! FUNCTION
!!  Returns .TRUE. if the file name fname is open.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! SOURCE

logical function is_open_fname(fname)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'is_open_fname'
!End of the abilint section

 character(len=*),intent(in) :: fname
! *********************************************************************

 inquire(file=fname,opened=is_open_fname)

end function is_open_fname
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/prompt_int0D
!! NAME
!!  prompt_int0D
!!
!! FUNCTION
!!  A primitive prompt. Writes msg on STDOUT and reads the value entered by the user.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine prompt_int0D(msg,ivalue)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'prompt_int0D'
!End of the abilint section

 character(len=*),intent(in) :: msg
 integer,intent(out) :: ivalue

!Local variables-------------------------------
 integer :: ios
 character(len=4) :: PS
! *********************************************************************

 ios=-1 ; PS=PS1
 do while (ios/=0)
  write(STDOUT,'(a)',ADVANCE='NO')PS//TRIM(msg)//BLANK
  call flush_unit(STDOUT)
  read(STDIN,*,IOSTAT=ios)ivalue
  if (ios==IO_EOT) then
    call prompt_exit()
  endif
  PS=PS2
 end do
 write(STDOUT,*)

end subroutine prompt_int0D
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/prompt_rdp0d
!! NAME
!!  prompt_rdp0d
!!
!! FUNCTION
!!  A primitive prompt. Writes msg on STDOUT and reads the value entered by the user.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine prompt_rdp0D(msg,rvalue)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'prompt_rdp0D'
!End of the abilint section

 character(len=*),intent(in) :: msg
 real(dp),intent(out) :: rvalue

!Local variables-------------------------------
 integer :: ios
 character(len=4) :: PS
! *********************************************************************

 ios=-1 ; PS=PS1
 do while (ios/=0)
  write(STDOUT,'(a)',ADVANCE='NO')PS//TRIM(msg)//BLANK
  call flush_unit(STDOUT)
  read(STDIN,*,IOSTAT=ios)rvalue
  if (ios==IO_EOT) then
    call prompt_exit()
  endif

  PS=PS2
 end do
 write(STDOUT,*)

end subroutine prompt_rdp0D
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/prompt_string
!! NAME
!!  prompt_string
!!
!! FUNCTION
!!  A primitive prompt. Writes msg on STDOUT and reads the value entered by the user.
!!  If strip_comment is True (default), all the characters after "#" or "!" are ignored.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine prompt_string(msg,string,strip_comment)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'prompt_string'
!End of the abilint section

 character(len=*),intent(in) :: msg
 logical,optional,intent(in) :: strip_comment
 character(len=*),intent(out) :: string

!Local variables-------------------------------
 integer :: ios,ic
 logical :: do_strip
 character(len=4) :: PS
 !character(len=len(string)) :: tmps
! *********************************************************************

 do_strip = .True.; if (present(strip_comment)) do_strip = strip_comment

 ios=-1 ; PS=PS1
 do while (ios/=0)
   write(STDOUT,'(a)',ADVANCE='NO')PS//TRIM(msg)//BLANK
   call flush_unit(STDOUT)
   read(STDIN,'(a)',IOSTAT=ios)string
   if (ios==IO_EOT) call prompt_exit()

   PS=PS2
 end do
 write(STDOUT,*)

 if (do_strip) then
   ic = INDEX(string, "#"); if (ic /= 0) string(:) = string(:ic-1)
   ic = INDEX(string, "!"); if (ic /= 0) string(:) = string(:ic-1)
 end if

end subroutine prompt_string
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/prompt_int1D
!! NAME
!!  prompt_int1D
!!
!! FUNCTION
!!  A primitive prompt. Writes msg on STDOUT and reads the value entered by the user.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine prompt_int1D(msg,ivect)

!Arguments ------------------------------------

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'prompt_int1D'
!End of the abilint section

 character(len=*),intent(in) :: msg
 integer,intent(out) :: ivect(:)

!Local variables-------------------------------
 integer :: ios
 character(len=4) :: PS
! *********************************************************************

 ios=-1 ; PS=PS1
 do while (ios/=0)
   write(STDOUT,'(a)',ADVANCE='NO')PS//TRIM(msg)//BLANK
   call flush_unit(STDOUT)
   read(STDIN,*,IOSTAT=ios)ivect(:)
   if (ios==IO_EOT) then
     call prompt_exit()
   endif

   PS=PS2
 end do
 write(STDOUT,*)

end subroutine prompt_int1D
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/prompt_int2D
!! NAME
!!  prompt_int2d
!!
!! FUNCTION
!!  A primitive prompt. Writes msg on STDOUT and reads the value entered by the user.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine prompt_int2D(msg,iarr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'prompt_int2D'
!End of the abilint section

 character(len=*),intent(in) :: msg
 integer,intent(out) :: iarr(:,:)

!Local variables-------------------------------
 integer :: ios
 character(len=4) :: PS
! *********************************************************************

 ios=-1 ; PS=PS1
 do while (ios/=0)
   write(STDOUT,'(a)',ADVANCE='NO')PS//TRIM(msg)//BLANK
   call flush_unit(STDOUT)
   read(STDIN,*,IOSTAT=ios)iarr(:,:)
   if (ios==IO_EOT) then
     call prompt_exit()
   endif

   PS=PS2
 end do
 write(STDOUT,*)

end subroutine prompt_int2D
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/prompt_rdp1D
!! NAME
!!  prompt_rdp1D
!!
!! FUNCTION
!!  A primitive prompt. Writes msg on STDOUT and reads the value entered by the user.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine prompt_rdp1D(msg,rvect)

!Arguments ------------------------------------

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'prompt_rdp1D'
!End of the abilint section

 character(len=*),intent(in) :: msg
 real(dp),intent(out) :: rvect(:)
 character(len=4) :: PS
!Local variables-------------------------------
 integer :: ios
! *********************************************************************

 ios=-1 ; PS=PS1
 do while (ios/=0)
   write(STDOUT,'(a)',ADVANCE='NO')PS//TRIM(msg)//BLANK
   call flush_unit(STDOUT)
   read(STDIN,*,IOSTAT=ios)rvect(:)
   if (ios==IO_EOT) then
     call prompt_exit()
   endif

   PS=PS2
 end do
 write(STDOUT,*)

end subroutine prompt_rdp1D
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/prompt_rdp2D
!! NAME
!!  prompt_rdp2D
!!
!! FUNCTION
!!  A primitive prompt. Writes msg on STDOUT and reads the value entered by the user.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine prompt_rdp2D(msg,rarr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'prompt_rdp2D'
!End of the abilint section

 character(len=*),intent(in) :: msg
 real(dp),intent(out) :: rarr(:,:)

!Local variables-------------------------------
 integer :: ios
 character(len=4) :: PS
! *********************************************************************

 ios=-1 ; PS=PS1
 do while (ios/=0)
   write(STDOUT,'(a)',ADVANCE='NO')PS//TRIM(msg)//BLANK
   call flush_unit(STDOUT)
   read(STDIN,*,IOSTAT=ios)rarr(:,:)
   if (ios==IO_EOT) then
     call prompt_exit()
   endif
   PS=PS2
 end do
 write(STDOUT,*)

end subroutine prompt_rdp2D
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/prompt_exit
!! NAME
!!  prompt_exit
!!
!! FUNCTION
!!  A primitive prompt. Writes msg on STDOUT and reads the value entered by the user.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!      m_io_tools
!!
!! CHILDREN
!!
!! SOURCE

subroutine prompt_exit()


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'prompt_exit'
!End of the abilint section

 integer,parameter :: NASK=5
 integer :: ios,iask
 character(len=IO_MAX_LEN) :: ans
! *********************************************************************

 write(STDOUT,*)
 ios=-1 ; iask=0
 do while (ios/=0.or.(ans/='y'.or.ans/='n'))
   iask=iask+1
   write(STDOUT,'(a)')' Do you really want to exit (y/n)? '
   call flush_unit(STDOUT)
   read(STDIN,*,IOSTAT=ios)ans
   if (ans=='y'.or.iask>NASK) STOP
   if (ans=='n') RETURN
 end do

end subroutine prompt_exit
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/read_line
!! NAME
!!  read_line
!!
!! FUNCTION
!!  Reads line from unit=std_in_ or unit if specified, ignoring blank lines
!!  and deleting comments beginning with !
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine read_line(line,ios,unit,comment)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'read_line'
!End of the abilint section

 character(len=*),intent(out):: line
 character(len=1),optional,intent(in) :: comment
 integer,optional,intent(in) :: unit
 integer,intent(out) :: ios

!Local variables-------------------------------
 integer :: ipos,unt
! *********************************************************************

 unt=STDIN ; if (PRESENT(unit)) unt=unit

 do
   read(unt,'(a)',iostat=ios) line  ! read input line
   if (ios/=0) RETURN
   line=ADJUSTL(line)
   if (PRESENT(comment)) then
     ipos=INDEX(line,comment)
     if (ipos==1) CYCLE
     if (ipos/=0) line=line(:ipos-1)
   end if
   if (LEN_TRIM(line)/=0) EXIT
 end do

end subroutine read_line
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/flush_unit
!! NAME
!! flush_unit
!!
!! FUNCTION
!! Wrapper for the standard flush_unit routine
!!
!! INPUTS
!!  unit=Fortran logical Unit number
!!
!! OUTPUT
!!
!! NOTES
!!  Available only if the compiler implements this intrinsic procedure.
!!
!! PARENTS
!!      abinit,anaddb,bsepostproc,cchi0,cchi0q0,cut3d,fftprof,impurity_solve
!!      m_errors,m_hdr,m_io_redirect,m_io_tools,m_matlu,m_shirley,m_xc_vdw
!!      mrgddb,mrggkk,mrgscr,optic,pawmkaewf,prep_calc_ucrpa,qmc_prep_ctqmc
!!      scprqt,vdw_kernelgen,vtorho,wrtout
!!
!! CHILDREN
!!
!! SOURCE

subroutine flush_unit(unit)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'flush_unit'
!End of the abilint section

 integer,intent(in) :: unit

!Local variables-------------------------------
 logical :: isopen

!************************************************************************

 if (unit == dev_null) return

 inquire(unit=unit,opened=isopen)

!FLUSH on unconnected unit is illegal: F95 std., 9.3.5.
#if defined HAVE_FC_FLUSH
 if (isopen) then
   call flush(unit)
 endif
#elif defined HAVE_FC_FLUSH_
 if (isopen) then
   call flush_(unit)
  end if
#endif

end subroutine flush_unit
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/pick_aname
!! NAME
!!  pick_aname
!!
!! FUNCTION
!!  Returns the name of a non-existent file to be used for temporary storage.
!!
!! PARENTS
!!
!! SOURCE

function pick_aname() result(aname)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'pick_aname'
!End of the abilint section

 character(len=fnlen) :: aname

!Local variables-------------------------------
 integer :: ii,spt,ept
 real(dp) :: xrand(fnlen)
!************************************************************************

 aname="__TMP_FILE__"

 spt=LEN(aname); ept=spt

 do while (file_exists(aname))
   call RANDOM_NUMBER(xrand(spt:ept))
   xrand(spt:ept) = 64+xrand(spt:ept)*26
   do ii=spt,ept
     aname(ii:ii) = ACHAR(NINT(xrand(ii)))
   end do
   ept = MIN(ept+1,fnlen)
 end do

end function pick_aname
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/isncfile
!! NAME
!! isncfile
!!
!! FUNCTION
!!  Return .TRUE. if fname is a NETCDF file.
!!
!! INPUTS
!!  fname(len=*)=The name of the file to be tested.
!!
!! NOTES
!!  The idea is extremely simple: a NETCDF file terminates with ".nc".
!!  Obviously this approach is not bulletproof but it will work
!!  provided that we continue to append the ".nc" string to any NETCDF
!!  file produced by abinit.
!!
!! PARENTS
!!
!! SOURCE

pure logical function isncfile(fname)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'isncfile'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=*),intent(in) :: fname

!Local variables-------------------------------
!scalars
 integer :: ic,nch_trim

! *************************************************************************

 nch_trim=LEN_TRIM(fname)
 ic = INDEX (TRIM(fname), ".", back=.TRUE.)

 isncfile=.FALSE.
 if (ic >= 1 .and. ic <= nch_trim-1) then ! there is stuff after the .
   isncfile = (fname(ic+1:nch_trim)=="nc")
 end if

end function isncfile
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/iomode_from_fname
!! NAME
!! iomode_from_fname
!!
!! FUNCTION
!!  Automatic selection of the IO mode based on the file extension.
!!
!! INPUTS
!!  fname = Name of the file.
!!
!! NOTES
!!  if fname has extension '.nc', IO_MODE_ETSF is used
!!  else:
!!    IO_MODE_MPI if available
!!    IO_MODE_FORTRAN if HAVE_MPI_IO is not defined.
!!
!! PARENTS
!!
!! SOURCE

pure function iomode_from_fname(fname) result(iomode)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'iomode_from_fname'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=*),intent(in) :: fname
 integer :: iomode

! *************************************************************************

 if (isncfile(fname)) then
   iomode = IO_MODE_ETSF
 else
#ifdef HAVE_MPI_IO
   iomode = IO_MODE_MPI  
#else
   iomode = IO_MODE_FORTRAN
#endif
   !if (IO_MODE_DEFAULT /= -1) iomode = IO_MODE_DEFAULT
 end if

end function iomode_from_fname
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/iomode2str
!! NAME
!! iomode2str
!!
!! FUNCTION
!!  Convert iomode to string 
!!
!! PARENTS
!!
!! SOURCE

pure function iomode2str(iomode) 


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'iomode2str'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=48) :: iomode2str
 integer,intent(in) :: iomode

! *************************************************************************

 select case (iomode)
 case (IO_MODE_FORTRAN_MASTER)
   iomode2str = "IO_MODE_FORTRAN_MASTER"
 case (IO_MODE_FORTRAN)
   iomode2str = "IO_MODE_FORTRAN"
 case (IO_MODE_MPI)
   iomode2str = "IO_MODE_MPI"
 case (IO_MODE_NETCDF)
   iomode2str = "IO_MODE_NETCDF"
 case (IO_MODE_ETSF)
   iomode2str = "IO_MODE_ETSF"
 case default
   iomode2str = "Unknown!"
 end select

end function iomode2str
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/mvrecord
!! NAME
!! mvrecord
!!
!! FUNCTION
!! This subroutine moves forward or backward in a Fortran binary file by nn records.
!!
!! INPUTS
!! funt= Fortran file unit number
!! nrec=number of records
!!
!! OUTPUT
!! ierr=error code
!!
!! TODO
!! One should treat the possible errors of backspace
!!
!! PARENTS
!!      m_wffile,m_wfk
!!
!! CHILDREN
!!
!! SOURCE

subroutine mvrecord(funt,nrec,ierr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'mvrecord'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: funt,nrec
 integer,intent(out) :: ierr

!Local variables-------------------------------
!scalars
 integer :: irec

! *************************************************************************

 ierr = 0
 if (nrec > 0) then ! Move forward nrec records
   do irec=1,nrec
     read(funt,iostat=ierr)
     if (ierr /= 0) EXIT
   end do
 else if (nrec < 0) then ! Move backward nrec records
   do irec=1,-nrec
     backspace (unit=funt,iostat=ierr)
     if (ierr /= 0) EXIT
   end do
 end if

end subroutine mvrecord
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/open_file
!! NAME
!! open_file
!!
!! FUNCTION
!!  Open a file in sequential mode and associate it to the unit number number.
!!  The main differences wrt the intrinsic open:
!!
!!    * Function statement that returns the value of iostat
!!    * Emulate iomsg (F2003)
!!    * Accepts either unit (user-specified unit number, input) or
!!      newunit (free unit not associated to any file, output). 
!!      The two options are mutually exclusive.
!!
!!  See Fortran intrinsic for a more detailed description of the variables
!!
!! OUTPUT
!!  iostat=Exit status
!!  iomsg=Error message
!!
!! PARENTS
!!
!! SOURCE

function open_file(file,iomsg,unit,newunit,form,status,action) result(iostat)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'open_file'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=*),intent(in) :: file
 character(len=*),optional,intent(in) :: form,status,action
 character(len=*),intent(out) :: iomsg
 integer,optional,intent(in) :: unit
 integer,optional,intent(out) :: newunit
 integer :: iostat

!Local variables-------------------------------
!scalars
 character(len=500) :: my_form,my_status,my_action,msg

! *************************************************************************

 my_form = "formatted"; if (present(form)) my_form = form
 my_status = "unknown"; if (present(status)) my_status = status
 my_action = "readwrite"; if (present(action)) my_action = action ! default is system dependent. Enforce RW mode

 iomsg = ""  ! iomsg is not changed if open succeeds

 if (present(unit)) then
   open(file=trim(file),unit=unit,form=my_form,status=my_status,access="sequential",iostat=iostat, iomsg=iomsg)
   if (present(newunit)) iostat = -666 ! wrong call

 else if (present(newunit)) then
   ! Get free unit (emulate newunit of F2008)
   newunit = get_unit()
   open(file=trim(file),unit=newunit,form=my_form,status=my_status,access="sequential",iostat=iostat, iomsg=iomsg)
   if (present(unit)) iostat = -666  ! wrong call

 else 
   iomsg = "Either unit or newunit must be specified"
   iostat = -1
 end if

 if (iostat /= 0) then
   write(msg, "(a,i0,2a)")"Fortran open returned iostat ",iostat," while opening: "//trim(file)
   iomsg = trim(msg)//ch10//"IOMSG: "//trim(iomsg)
 end if

end function open_file
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/close_unit
!! NAME
!! close_unit
!!
!! FUNCTION
!!  close a Fortran unit 
!!  The main differences wrt the intrinsic close:
!!
!!    * Function statement that returns the value of iostat
!!    * Emulate iomsg (F2003)
!!
!!  See Fortran intrinsic for a more detailed description of the variables
!!
!! OUTPUT
!!  iostat=Exit status
!!  iomsg=Error message
!!
!! PARENTS
!!
!! SOURCE

function close_unit(unit,iomsg,status) result(iostat)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'close_unit'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(inout) :: unit
 character(len=*),optional,intent(in) :: status
 character(len=*),intent(out) :: iomsg
 integer :: iostat

!Local variables-------------------------------
 character(len=500) :: msg

! *************************************************************************

 iomsg = "" ! iomsg is not changed if close succeeds

 if (.not.present(status)) then ! Use Fortran default e.g delete for scratch files.
#ifdef HAVE_FC_IOMSG
   close(unit=unit,iostat=iostat,iomsg=iomsg)
#else
   close(unit=unit,iostat=iostat)
#endif
 else
#ifdef HAVE_FC_IOMSG
   close(unit=unit,iostat=iostat,status=status,iomsg=iomsg)
#else
   close(unit=unit,iostat=iostat,status=status)
#endif
 end if

 ! TODO: Add more info for example the filename.
 if (iostat /= 0) then
   write(msg,'(2(a,i0),a)')"Fortran close returned iostat ",iostat," while closing unit: ",unit,ch10
   iomsg = trim(msg)//ch10//"IOMSG: "//trim(msg)
 end if

end function close_unit
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/write_lines
!! NAME
!!  write_lines
!!
!! FUNCTION
!!  This routine receives a string, split the message in lines according to the 
!!  ch10 character and output the text to the specified unit 
!!
!! INPUTS
!!  unit=unit number for writing
!!  message=(character(len=*)) message to be written
!!
!! OUTPUT
!!  Only writing.
!!
!! PARENTS
!!      m_io_tools,wrtout
!!
!! CHILDREN
!!
!! SOURCE

subroutine write_lines(unit,message)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'write_lines'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: unit
 character(len=*),intent(in) :: message

!Local variables-------------------------------
!scalars
 integer :: msg_size,ii,jj,rtnpos

!******************************************************************

 msg_size = len_trim(message)

 if (msg_size == 0) then
   write(unit,*)
   return 
 end if

 ! Here, split the message, according to the char(10) characters (carriage return). 
 ! This technique is portable accross different OS.
 rtnpos = index(message,ch10)

 if (rtnpos == 0) then
   write(unit,"(a)")message(1:msg_size)
   return
 end if 

 ii = 1; jj = rtnpos
 do 
   if (ii == jj) then
     write(unit,*)
   else
     write(unit, '(a)' ) message(ii:jj-1)
   end if
   ii = jj + 1
   if (ii > msg_size) exit
   jj = index(message(ii:msg_size),ch10) 
   if (jj == 0) then 
     ! Will write the last line at the next iteration and exit .
     jj = msg_size + 1
   else
     jj = jj + ii - 1
   end if
   !write(*,*)"ii, jj, msg_size",ii, jj, msg_size
 end do

 ! This is needed to preserve the od behaviour: a ch10 at the 
 ! end of the string was causing an extra newline!
 if (message(msg_size:msg_size) == ch10) write(unit,*)

end subroutine write_lines
!!***

!!****f* m_io_tools/lock_and_write
!! NAME
!!  lock_and_write
!!
!! FUNCTION
!!  Writes a string to filename with locking mechanism.
!!
!! INPUTS
!!  filename: Name of the file.
!!  string: Input string.
!!  ierr: Exit status, 0 is string has been written to filename.
!!
!! PARENTS
!!      m_errors
!!
!! CHILDREN
!!
!! SOURCE

subroutine lock_and_write(filename, string, ierr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'lock_and_write'
!End of the abilint section

 integer,intent(out) :: ierr
 character(len=*),intent(in) :: filename,string

!Local variables-------------------------------
 integer :: lock_unit,file_unit
 character(len=len(filename) + 5) :: lock
 !character(len=500) :: msg

! *********************************************************************

 ierr = 0

 ! Try to acquire the lock.
 lock = trim(filename)//".lock"
 lock_unit = get_unit()
 open(unit=lock_unit, file=trim(lock), status='new', err=99)

 file_unit = get_unit()
 open(unit=file_unit, file=trim(filename), form="formatted")
 call write_lines(file_unit, string)
 close(lock_unit, status="delete")
 close(file_unit)
 return 

99 ierr = 1

end subroutine lock_and_write
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/num_opened_units
!! NAME
!!  num_opened_units
!!
!! FUNCTION
!!  Return the number of opened units. 
!!  Unit numbers listed in the optional argument `ignore` are not considered.
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

integer function num_opened_units(ignore) result(nn)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'num_opened_units'
!End of the abilint section

 implicit none

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'show_units'
!End of the abilint section

!Arguments ------------------------------------
!scalars
 integer,optional,intent(in) :: ignore(:)

!Local variables-------------------------------
 integer :: ii,iostat
 logical  :: opened

! *********************************************************************

 nn = 0
 do ii=0, max_unit_number
   if (present(ignore)) then
     if (any(ii == ignore)) cycle
   end if
   inquire(ii, opened=opened, iostat=iostat)
   if (iostat == 0 .and. opened) nn = nn + 1
 end do

end function num_opened_units
!!***

!----------------------------------------------------------------------

!!****f* m_io_tools/show_units
!! NAME
!!  show_units
!!
!! FUNCTION
!!  Print info on the logical units
!!
!! PARENTS
!!      m_errors
!!
!! CHILDREN
!!
!! SOURCE

subroutine show_units(ount)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'show_units'
!End of the abilint section

 implicit none

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'show_units'
!End of the abilint section

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: ount

!Local variables-------------------------------
 integer :: ii,iostat
 logical  :: named, opened
 character(len=fnlen) :: filename,form

! *********************************************************************

 write(ount,'(a)') '******** Fortran Logical Units ********'

 do ii=0,max_unit_number
   inquire(ii, opened=opened, named=named, name=filename, form=form, iostat=iostat)
   if (iostat == 0) then
      if (opened) then
         if (named) then
            write(ount,*)"unit: ", ii, "form: ", trim(form), ", filename: ", trim(filename)
         else
            write(ount,*)"unit: ", ii, "form: ",form, ', No name available'
         endif
      else 
        !write(ount,*)"unit: ", ii, " is not opened"
      endif
   else
      write(ount,*)" unit: ", ii, ' Iostat error'
   endif
 end do

end subroutine show_units
!!***

!----------------------------------------------------------------------

END MODULE m_io_tools
!!***
