!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   Copyright (C) 2008-2019 by Simon Prunet, Christophe Pichon et al     !
!   prunet iap.fr                                                        !
!                                                                        !
!   This program is free software; you can redistribute it and/or modify !
!   it under the terms of the GNU General Public License as published by !
!   the Free Software Foundation; either version 2 of the License, or    !
!   (at your option) any later version.                                  !
!                                                                        !
!   This program is distributed in the hope that it will be useful,      !
!   but WITHOUT ANY WARRANTY; without even the implied warranty of       !
!   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        !
!   GNU General Public License for more details.                         !
!                                                                        !
!   You should have received a copy of the GNU General Public License    !
!   along with this program; if not, write to the                        !
!   Free Software Foundation, Inc.,                                      !
!     59 Temple Place - Suite 330, Boston, MA  02111-1307, USA           !
!   or see https://www.gnu.org/licenses/licenses.html#GPL .              !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

#include "../config.h"

module grafic_io

  use grafic_types
  implicit none
!  integer, parameter :: nblock = 10
  integer, parameter :: RECORD_FLAG=4 !bytes

  type taille
     integer :: nx
     integer :: ny
     integer :: nz
     real(kind=sp) :: dx
     real(kind=sp) :: lx
     real(kind=sp) :: ly
     real(kind=sp) :: lz
  end type taille

  type cosmo
     real(kind=sp) :: astart
     real(kind=sp) :: omegam
     real(kind=sp) :: omegav
     real(kind=sp) :: h0
  end type cosmo

  interface grafic_write
     module procedure grafic_write_single, grafic_write_double
  end interface

  interface grafic_read
     module procedure grafic_read_single, grafic_read_double
  end interface

  ! TODO: When c_off_t becomes available and standard, use this
  ! together with AC_SYS_LARGEFILE in configure.ac to get 64-bit
  ! file offsets; change int64_t to off_t in parallel_io.c too.
  interface
     subroutine f77_parallel_read &
          (filename, fnamelen, size, offset, buffer_address)
       use iso_C_binding
       implicit none
       character(len=128) :: filename
       integer(c_int32_t) :: fnamelen
       integer(c_size_t) :: size ! size_t = unsigned long, cf pread(), pwrite()
       integer(c_int64_t) :: offset
       type(c_ptr), value :: buffer_address
     end subroutine f77_parallel_read
  end interface

  interface
     subroutine f77_parallel_write &
          (filename, fnamelen, size, offset, buffer_address)
       use iso_C_binding
       implicit none
       character(len=128) :: filename
       integer(c_int32_t) :: fnamelen
       integer(c_size_t) :: size
       integer(c_int64_t) :: offset
       type(c_ptr), value :: buffer_address
     end subroutine f77_parallel_write
  end interface

contains


  ! This routine write a fftw_mpi slice of a cube
  ! This slice has interior dimension nx, exterior nz.
  ! Beware that interior dimension is padded: nx <- 2(nx/2+1)
  ! Padded region will not be written.
  subroutine grafic_write_double(buffer,local_nz,local_z_start,ny,nx,filename,padding_in, white_in)
    use iso_C_binding
#ifdef HAVE_USE_MPI_F08
    use mpi_f08
#endif

    ! Arguments
    implicit none
#ifndef HAVE_USE_MPI_F08
    include 'mpif.h'
#endif
    real(dp), dimension(:), intent(in) :: buffer
    integer, intent(in) :: local_nz, local_z_start, ny, nx
    character(len=128), intent(in) :: filename
    !integer, intent(in) :: filenamelen
    logical, optional :: padding_in
    logical, optional :: white_in

    ! Local variables
    !real(sp), allocatable, dimension(:) :: tampon
    !integer :: record_size
    !integer(RECORD_FLAG) :: taille_tampon ! kind values are implementation dependent!

    real(c_float), allocatable, dimension(:), target :: tampon
    integer(c_int32_t), target :: taille_tampon

    integer :: n2x
    integer(i8b) :: index, index2, offset
    integer(c_size_t) length !, toto
    !integer :: idummy=0
    integer :: i,j,k !,myid,ierr
    logical :: padding, white

    padding=.false.
    white=.false.
    if (present(padding_in)) padding = padding_in
    !if (present(padding_in)) write(*,*) 'padding is on'
    if (present(white_in)) white = white_in
    ! 2*4 for leading and trailing record sizes
    n2x = 2*(nx/2+1)
    if (padding) then
       !write(*,*) 'padding is true in grafic_write'
       allocate(tampon(ny*n2x))
       taille_tampon = ny*n2x*sp_bytes ! in bytes
    else
       allocate(tampon(ny*nx))
       taille_tampon = ny*nx*sp_bytes ! in bytes
    endif

    if (white) then
       offset = 4*4 + 2*RECORD_FLAG
    else
       offset = 3*4+8*sp_bytes + 2*RECORD_FLAG ! First record
    endif

    if (padding) then
       offset = offset + local_z_start*int(ny*n2x*sp_bytes + 2*RECORD_FLAG, i8b)
    else
       offset = offset + local_z_start*int(ny*nx*sp_bytes + 2*RECORD_FLAG, i8b)
    endif

    do k=1,local_nz

       index2=1
       ! This loop to (eventually) get rid of fftw padding zone
       if (padding) then
       do j=1,ny
          do i=1,n2x
             index = ((k-1)*ny+j-1)*n2x+i
             tampon(index2) = real(buffer(index),kind=sp)
             index2 = index2 + 1
          enddo
       enddo
       else
          do j=1,ny
             do i=1,nx
                index = ((k-1)*ny+j-1)*n2x+i
                tampon(index2) = real(buffer(index),kind=sp)
                index2 = index2 + 1
             enddo
          enddo
       endif
       ! First write f... Fortran record length
       length=RECORD_FLAG
       call f77_parallel_write(trim(filename),len_trim(filename, i4b), length &
            & ,offset,c_loc(taille_tampon))
       offset = offset+RECORD_FLAG
       if (padding) then
          length = ny*n2x*sp_bytes
       else
          length = ny*nx*sp_bytes
       endif
       call f77_parallel_write(trim(filename),len_trim(filename, i4b), length, &
            & offset, c_loc(tampon))
       offset = offset+length
       ! Again ..
       length=RECORD_FLAG
       call f77_parallel_write(trim(filename),len_trim(filename, i4b), length &
            & ,offset,c_loc(taille_tampon))
       offset = offset+RECORD_FLAG

    enddo
    deallocate(tampon)

  end subroutine grafic_write_double

  subroutine grafic_write_single(buffer,local_nz,local_z_start,ny,nx,filename,padding_in, white_in)
    use iso_C_binding
#ifdef HAVE_USE_MPI_F08
    use mpi_f08
#endif

    ! Arguments
    implicit none
#ifndef HAVE_USE_MPI_F08
    include 'mpif.h'
#endif
    real(sp), dimension(:), intent(in) :: buffer
    integer, intent(in) :: local_nz, local_z_start, ny, nx
    character(len=128), intent(in) :: filename
    !integer, intent(in) :: filenamelen
    logical, optional :: padding_in
    logical, optional :: white_in


    ! Local variables
    !real(sp), allocatable, dimension(:) :: tampon
    !integer :: record_size
    !integer(RECORD_FLAG) :: taille_tampon

    real(c_float), allocatable, dimension(:), target :: tampon
    integer(c_int32_t), target :: taille_tampon

    integer :: n2x
    integer(i8b) :: index, index2, offset
    integer(c_size_t) :: length !, toto
    !integer :: idummy=0
    integer :: i,j,k !,myid,ierr
    logical :: padding, white


    padding=.false.
    white=.false.
    if (present(padding_in)) padding = padding_in
    !if (present(padding_in)) write(*,*) 'padding is on'
    if (present(white_in)) white = white_in
    ! 2*4 for leading and trailing record sizes
    n2x = 2*(nx/2+1)
    if (padding) then
       !write(*,*) 'padding is true in grafic_write'
       allocate(tampon(ny*n2x))
       taille_tampon = ny*n2x*sp_bytes ! in bytes
    else
       allocate(tampon(ny*nx))
       taille_tampon = ny*nx*sp_bytes ! in bytes
    endif

    if (white) then
       offset = 4*4 + 2*RECORD_FLAG
    else
       offset = 3*4+8*sp_bytes + 2*RECORD_FLAG ! First record
    endif

    if (padding) then
       offset = offset + local_z_start*int(ny*n2x*sp_bytes + 2*RECORD_FLAG, i8b)
    else
       offset = offset + local_z_start*int(ny*nx*sp_bytes + 2*RECORD_FLAG, i8b)
    endif

    do k=1,local_nz

       index2=1
       ! This loop to (eventually) get rid of fftw padding zone
       if (padding) then
       do j=1,ny
          do i=1,n2x
             index = ((k-1)*ny+j-1)*n2x+i
             tampon(index2) = real(buffer(index),kind=sp)
             index2 = index2 + 1
          enddo
       enddo
       else
          do j=1,ny
             do i=1,nx
                index = ((k-1)*ny+j-1)*n2x+i
                tampon(index2) = real(buffer(index),kind=sp)
                index2 = index2 + 1
             enddo
          enddo
       endif
       ! First write f... Fortran record length
       length=RECORD_FLAG
       call f77_parallel_write(trim(filename),len_trim(filename, i4b), length &
            & ,offset,c_loc(taille_tampon))
       offset = offset+RECORD_FLAG
       if (padding) then
          length = ny*n2x*sp_bytes
       else
          length = ny*nx*sp_bytes
       endif
       call f77_parallel_write(trim(filename),len_trim(filename, i4b), length, &
            & offset, c_loc(tampon))
       offset = offset+length
       ! Again ..
       length=RECORD_FLAG
       call f77_parallel_write(trim(filename),len_trim(filename, i4b), length &
            & ,offset,c_loc(taille_tampon))
       offset = offset+RECORD_FLAG

    enddo
    deallocate(tampon)

  end subroutine grafic_write_single

  subroutine grafic_read_double(buffer,local_nz,local_z_start,ny,nx,filename, padding_in, white_in)

    use iso_C_binding
#ifdef HAVE_USE_MPI_F08
    use mpi_f08
#endif

    ! Arguments
    implicit none
#ifndef HAVE_USE_MPI_F08
    include 'mpif.h'
#endif
    integer, intent(in) :: local_nz, local_z_start, ny, nx
    real(dp), dimension(local_nz*ny*2*(nx/2+1)), intent(out) :: buffer
    character(len=128), intent(in) :: filename
    logical, optional :: padding_in ! Read padded zone or not
    logical, optional :: white_in ! Different header for white noise file
    ! Local variables
    !real(sp), allocatable, dimension(:) :: tampon
    !integer :: record_size
    !integer(RECORD_FLAG) :: taille_tampon ! kind values are implementation dependent!

    real(c_float), allocatable, dimension(:), target :: tampon
    integer(c_int32_t), target :: taille_tampon

    integer :: n2x
    integer(i8b) :: index, index2, offset
    integer(c_size_t) :: length
    !integer :: idummy=0
    integer :: i,j,k
    !integer :: myid,ierr
    logical :: padding
    logical :: white


    padding = .false.
    white = .false.
    if (present(padding_in)) padding = padding_in
    if (present(white_in)) white = white_in
    ! 2*4 for leading and trailing record sizes
    n2x = 2*(nx/2+1)
    if (padding) then
       allocate(tampon(ny*n2x))
    else
       allocate(tampon(ny*nx))
    endif
    taille_tampon = 0

    if (white) then
       offset = 4*4 + 2*RECORD_FLAG
    else
       offset = 3*4+8*sp_bytes + 2*RECORD_FLAG ! First record
    endif
    if (padding) then
       offset = offset + local_z_start*int(ny*n2x*sp_bytes + 2*RECORD_FLAG, i8b)
    else
       offset = offset + local_z_start*int(ny*nx*sp_bytes+2*RECORD_FLAG, i8b)
    endif

    do k=1,local_nz

       length = RECORD_FLAG
       ! First read f... Fortran record length
       call f77_parallel_read(trim(filename),len_trim(filename, i4b), length &
            & ,offset,c_loc(taille_tampon))
       if (padding) then
           if (taille_tampon /= ny*n2x*sp_bytes) then
             print*,'Record size ',taille_tampon,' is different from expected', &
                  & ny*n2x*sp_bytes
             stop
          endif
       else
           if (taille_tampon /= ny*nx*sp_bytes) then
             print*,'Record size ',taille_tampon,' is different from expected', &
                  & ny*nx*sp_bytes
             stop
          endif
       endif
       offset = offset+RECORD_FLAG

       if (padding) then
          length = ny*n2x*sp_bytes
       else
          length = ny*nx*sp_bytes
       endif
       call f77_parallel_read(trim(filename),len_trim(filename, i4b), length, &
            & offset, c_loc(tampon))
       offset = offset+length
       ! Again ..
       length=RECORD_FLAG
       call f77_parallel_read(trim(filename),len_trim(filename, i4b), length &
            & ,offset,c_loc(taille_tampon))
       offset = offset+RECORD_FLAG

       ! This loop to (eventually) get rid of fftw padding zone
       index2=1
       if (padding) then
          do j=1,ny
             do i=1,n2x ! Read padding (Nyquist) : reading in k space ...
                index=((k-1)*ny+j-1)*n2x+i
                buffer(index) = real(tampon(index2),kind=dp)
                index2 = index2 + 1
             enddo
          enddo
       else
          do j=1,ny
             do i=1,nx ! Do not read padding : reading in real space ...
                index = ((k-1)*ny+j-1)*n2x+i
                buffer(index) = real(tampon(index2),kind=dp)
                index2 = index2 + 1
             enddo
          enddo
       endif

    enddo
    deallocate(tampon)

  end subroutine grafic_read_double

  subroutine grafic_read_single(buffer,local_nz,local_z_start,ny,nx,filename, padding_in, white_in)
    use iso_C_binding
#ifdef HAVE_USE_MPI_F08
    use mpi_f08
#endif

    ! Arguments
    implicit none
#ifndef HAVE_USE_MPI_F08
    include 'mpif.h'
#endif
    integer, intent(in) :: local_nz, local_z_start, ny, nx
    real(sp), dimension(local_nz*ny*2*(nx/2+1)), intent(out) :: buffer
    character(len=128), intent(in) :: filename
    logical, optional :: padding_in ! Read padded zone or not
    logical, optional :: white_in ! Different header for white noise file
    ! Local variables
    !real(sp), allocatable, dimension(:) :: tampon
    !integer :: record_size
    !integer(RECORD_FLAG) :: taille_tampon

    real(c_float), allocatable, dimension(:), target :: tampon
    integer(c_int32_t), target :: taille_tampon

    integer :: n2x
    integer(i8b) :: index, index2, offset
    integer(c_size_t) :: length
    !integer :: idummy=0
    integer :: i,j,k
    !integer :: myid,ierr
    logical :: padding
    logical :: white


    padding = .false.
    white = .false.
    if (present(padding_in)) padding = padding_in
    if (present(white_in)) white = white_in
    ! 2*4 for leading and trailing record sizes
    n2x = 2*(nx/2+1)
    if (padding) then
       allocate(tampon(ny*n2x))
    else
       allocate(tampon(ny*nx))
    endif
    taille_tampon = 0

    if (white) then
       offset = 4*4 + 2*RECORD_FLAG
    else
       offset = 3*4+8*sp_bytes + 2*RECORD_FLAG ! First record
    endif
    if (padding) then
       offset = offset + local_z_start*int(ny*n2x*sp_bytes + 2*RECORD_FLAG, i8b)
    else
       offset = offset + local_z_start*int(ny*nx*sp_bytes+2*RECORD_FLAG, i8b)
    endif

    do k=1,local_nz

       length = RECORD_FLAG
       ! First read f... Fortran record length
       call f77_parallel_read(trim(filename),len_trim(filename, i4b), length &
            & ,offset,c_loc(taille_tampon))
       if (padding) then
           if (taille_tampon /= ny*n2x*sp_bytes) then
             print*,'Record size ',taille_tampon,' is different from expected', &
                  & ny*n2x*sp_bytes
             stop
          endif
       else
           if (taille_tampon /= ny*nx*sp_bytes) then
             print*,'Record size ',taille_tampon,' is different from expected', &
                  & ny*nx*sp_bytes
             stop
          endif
       endif
       offset = offset+RECORD_FLAG

       if (padding) then
          length = ny*n2x*sp_bytes
       else
          length = ny*nx*sp_bytes
       endif
       call f77_parallel_read(trim(filename),len_trim(filename, i4b), length, &
            & offset, c_loc(tampon))
       offset = offset+length
       ! Again ..
       length=RECORD_FLAG
       call f77_parallel_read(trim(filename),len_trim(filename, i4b), length &
            & ,offset,c_loc(taille_tampon))
       offset = offset+RECORD_FLAG

       ! This loop to (eventually) get rid of fftw padding zone
       index2=1
       if (padding) then
          do j=1,ny
             do i=1,n2x ! Read padding (Nyquist) : reading in k space ...
                index=((k-1)*ny+j-1)*n2x+i
                buffer(index) = real(tampon(index2),kind=sp)
                index2 = index2 + 1
             enddo
          enddo
       else
          do j=1,ny
             do i=1,nx ! Do not read padding : reading in real space ...
                index = ((k-1)*ny+j-1)*n2x+i
                buffer(index) = real(tampon(index2),kind=sp)
                index2 = index2 + 1
             enddo
          enddo
       endif

    enddo
    deallocate(tampon)

  end subroutine grafic_read_single




  subroutine grafic_read_header(filename,head_taille,head_cosmo)

    type(taille), intent(out) :: head_taille
    type(cosmo), intent(out) :: head_cosmo
    character(len=128), intent(in) :: filename
    logical :: ok

    inquire(file=filename,exist=ok)
    if (.not. ok) then
       print*,'File ',trim(filename),' does not exist, aborting.'
       stop
    endif

    open(2,file=filename,form='unformatted',status='old')
    read(2) head_taille%nx, head_taille%ny, head_taille%nz, head_taille%dx, &
         head_taille%lx, head_taille%ly, head_taille%lz, head_cosmo%astart, &
         head_cosmo%omegam, head_cosmo%omegav, head_cosmo%h0
    close(2)

  end subroutine grafic_read_header

  subroutine grafic_read_header_white(filename,nx,ny,nz,iseed)

    use iso_C_binding
    integer, intent(out) :: nx,ny,nz
#ifdef HAVE_LIBGSL
    integer(c_int64_t), intent(out) :: iseed
#else
    integer, intent(out) :: iseed
#endif

    character(len=128), intent(in) :: filename
    logical :: ok

    inquire(file=filename,exist=ok)
    if (.not. ok) then
       print*,'File ',trim(filename),' does not exist, aborting.'
       stop
    endif

    open(2,file=filename,form='unformatted',status='old')
    read(2) nx, ny, nz, iseed
    close(2)

  end subroutine grafic_read_header_white

  subroutine grafic_write_header(filename,head_taille,head_cosmo)

    type(taille), intent(in) :: head_taille
    type(cosmo), intent(in) :: head_cosmo
    character(len=128), intent(in) :: filename

    open(2,file=filename,form='unformatted',status='unknown')
    write(2) head_taille%nx, head_taille%ny, head_taille%nz, head_taille%dx, &
         head_taille%lx, head_taille%ly, head_taille%lz, head_cosmo%astart, &
         head_cosmo%omegam, head_cosmo%omegav, head_cosmo%h0
    close(2)

  end subroutine grafic_write_header

  subroutine grafic_write_header_white(filename,nx,ny,nz,iseed)

    use iso_C_binding
    integer, intent(in) :: nx,ny,nz
#ifdef HAVE_LIBGSL
    integer(c_int64_t), intent(in) :: iseed
#else
    integer, intent(in) :: iseed
#endif
    character(len=128), intent(in) :: filename

    open(2,file=filename,form='unformatted',status='unknown')
    write(2) nx, ny, nz, iseed
    close(2)

  end subroutine grafic_write_header_white


end module grafic_io
