!{\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-2014 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 :: 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.

 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)
  integer,parameter :: MAX_UNIT_NUMBER=1024  ! The following values should be safe
  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

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
!!
!! 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
!!
!! CHILDREN
!!
!! SOURCE

integer function get_free_unit()

!Local variables-------------------------------

!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

 integer :: iunt
 logical :: isopen
! *********************************************************************

 do iunt=MAX_UNIT_NUMBER,MIN_UNIT_NUMBER,-1
   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
!!
!! CHILDREN
!!
!! SOURCE
integer function get_unit_from_fname(fname)

!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 'get_unit_from_fname'
!End of the abilint section

 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
!!
!! CHILDREN
!!
!! SOURCE
function file_exists(fname)

!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 'file_exists'
!End of the abilint section

 logical :: file_exists
 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
!!
!! CHILDREN
!!
!! SOURCE

subroutine delete_file(fname,ierr)

!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 '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=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
!!
!! CHILDREN
!!
!! SOURCE
logical function is_connected(unit,fname)

!!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 '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
!!
!! CHILDREN
!!
!! SOURCE

logical function is_open_unit(unit)

!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 '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
!!
!! CHILDREN
!!
!! SOURCE

logical function is_open_fname(fname)

!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 '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)

!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_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)

!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_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.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE
subroutine prompt_string(msg,string)

!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_string'
!End of the abilint section

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

!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,'(a)',IOSTAT=ios)string
  if (ios==IO_EOT) then
    call prompt_exit()
  endif

  PS=PS2
 end do
 write(STDOUT,*)

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)

!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_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)

!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_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()

!Local variables-------------------------------

!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)

!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 '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,cut3d,defs_scalapack,dfpt_write_cg,exc_diago
!!      exc_iterative_diago,fftprof,impurity_solve,m_bands_sym,m_bse_io,m_chi0
!!      m_errors,m_green,m_header,m_hu,m_io_redirect,m_io_tools,m_matlu
!!      m_pawrhoij,m_shirley,m_wfs,m_xc_vdw,mrgddb,mrggkk,mrgscr,optic
!!      pawmkaewf,prep_calc_ucrpa,qmc_prep_ctqmc,testkgrid,vdw_kernelgen,vtorho
!!      wrtout
!!
!! CHILDREN
!!
!! SOURCE

subroutine flush_unit(unit)

!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 '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
!!
!! CHILDREN
!!
!! SOURCE

function pick_aname() result(aname)

!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 '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
!!
!! CHILDREN
!!
!! SOURCE

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
 logical :: isncfile

!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 .
  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 extesion '.nc', IO_MODE_ETSF is used
!!  else:
!!    IO_MODE_MPI if available
!!    IO_MODE_FORTRAN if HAVE_MPI_IO is not defined.
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

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
 end if

end function iomode_from_fname
!!***

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

!!****f* m_io_tools/mvrecord
!! NAME
!! mvrecord
!!
!! FUNCTION
!! This subroutine moves forward or backward in a Fortran binary file by nn records.
!!
!! INPUTS
!! funt= Fortrna 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-specied unit number, input) or
!!      newunit (free unit not associated to any file, output). 
!!
!!  See Fortran intrinsic for a more detailed description of the variables
!!
!! OUTPUT
!!  iostat=Exit status
!!  iomsg=Error message
!!
!! PARENTS
!!
!! CHILDREN
!!
!! 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
#ifdef HAVE_FC_IOMSG
   open(file=trim(file),unit=unit,form=my_form,status=my_status,access="sequential",iostat=iostat, iomsg=iomsg)
#else
   open(file=trim(file),unit=unit,form=my_form,status=my_status,access="sequential",iostat=iostat)
   iomsg = "IOMSG not supported by the compiler"
#endif
   if (present(newunit)) iostat = -666 ! wrong call

 else if (present(newunit)) then
   ! Get free unit (emulate newunit of F2008)
   newunit = get_unit()
#ifdef HAVE_FC_IOMSG
   open(file=trim(file),unit=newunit,form=my_form,status=my_status,access="sequential",iostat=iostat, iomsg=iomsg)
#else
   open(file=trim(file),unit=newunit,form=my_form,status=my_status,access="sequential",iostat=iostat)
   iomsg = "IOMSG not supported by the compiler"
#endif
   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 open:
!!
!!    * 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
!!
!! CHILDREN
!!
!! 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 (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
!!***

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

END MODULE m_io_tools
!!***
