!===============================================================================
!
! ildg_landau.F90 - read/write ILDG-configs in QED Landau gauge fixing program
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2013 Hinnerk Stueben
!
! This file is part of BQCD -- Berlin Quantum ChromoDynamics program
!
! BQCD 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 3 of the License, or
! (at your option) any later version.
!
! BQCD 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 BQCD.  If not, see <http://www.gnu.org/licenses/>.
!
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
module module_ildg_landau

  use iso_c_binding
  implicit none
  real(ILDG_KIND), allocatable, save :: u1_ildg(:,:,:,:,:)
  INT8, save :: chunk, words_per_chunk
  INT8, save :: cksum_r, bytes_r
  INT8, save :: cksum_w, bytes_w

  interface
     subroutine ildg_landau_close_r(cksum) bind(c)
       use iso_c_binding
       integer(c_long_long), intent(in) :: cksum
     end subroutine ildg_landau_close_r

     subroutine ildg_landau_close_w(cksum, s, plaquette, plaquette_qed) bind(c)
       use iso_c_binding
       integer(c_long_long), intent(in) :: cksum
       character(c_char), intent(in) :: s(*)
       real(c_double), intent(out) :: plaquette
       real(c_double), intent(out) :: plaquette_qed
     end subroutine ildg_landau_close_w

  end interface
end

!-------------------------------------------------------------------------------
subroutine init_ildg_landau(infile, outfile, size_s, size_t)

  use module_ildg_conf
  use module_ildg_landau
  implicit none
  character(*), intent(inout) :: infile, outfile
  integer, intent(out) :: size_s, size_t
  INT8 :: count

  infile = trim(infile) // ascii_null
  outfile = trim(outfile) // ascii_null

  call ildg_open_r(infile, lx, ly, lz, lt, precision, bytes)

  CHECK (lx == ly)
  CHECK (lx == lz)
  CHECK(precision == 32 .or. precision == 64)

  size_s = lx
  size_t = lt

  if (.not. allocated(u1_ildg)) allocate(u1_ildg(DIM, lx, ly, lz, lt))

  call ildg_landau_set_sizes()

  do count = 1, bytes, chunk        ! read SU(3) data for check-sum verification
     call ildg_read(u1_ildg, chunk) ! u1_ildg is scratch array
  enddo
end

!-------------------------------------------------------------------------------
subroutine ildg_landau_read(a, infile)

  use module_ildg_conf
  use module_ildg_landau
  implicit none
  REAL, intent(out)        :: a(lx, ly, lz, lt, DIM)
  character(*), intent(in) :: infile
  integer :: len_lfn
  INT8    :: bytes_read

  call ildg_find_u1_binary_data()
  call ildg_landau_io(READ, u1_ildg)

  len_lfn = len(lfn) - 1
  call ildg_close_r(cksum, bytes_read, lfn, len_lfn)

  if (precision == 32) call ildg_landau_seq_r4(READ, a, u1_ildg)
  if (precision == 64) call ildg_landau_seq_r8(READ, a, u1_ildg)
end

!-------------------------------------------------------------------------------
subroutine ildg_landau_write(a, infile, outfile, plaq, plaq_qed)

  use module_ildg_conf
  use module_ildg_landau
  implicit none
  REAL, intent(in)         :: a(lx, ly, lz, lt, DIM)
  character(*), intent(in) :: infile, outfile
  REAL, intent(out)        :: plaq, plaq_qed
  integer :: len_lfn
  INT8    :: cksum0, bytes_read, bytes_written, count
  
  call ildg_open_r( infile, lx, ly, lz, lt, precision, bytes)
  call ildg_open_w(outfile, lx, ly, lz, lt, precision, bytes)

  call ildg_landau_set_sizes()

  cksum_r = 0
  bytes_r = 0

  do count = 1, bytes, chunk
     call ildg_landau_r(u1_ildg, chunk)   ! u1_ildg is scratch array
     call ildg_landau_w(u1_ildg, chunk)
     call cksum2(u1_ildg, chunk, cksum_r, bytes_r)
  enddo
  cksum_w = cksum_r
  bytes_w = bytes_r

  ! check-sum of input
  call qcdsf_u1_r(lx, ly, lz, lt, precision, u1_bytes) 
  call ildg_landau_io(READ, u1_ildg)
  call cksum2_end(cksum_r, bytes_r)

  if (precision == 32) call ildg_landau_seq_r4(WRITE, a, u1_ildg)
  if (precision == 64) call ildg_landau_seq_r8(WRITE, a, u1_ildg)

  call qcdsf_u1_w(lx, ly, lz, lt, precision, u1_bytes)
  call ildg_landau_io(WRITE, u1_ildg)
  call cksum2_end(cksum_w, bytes_w)

  cksum = cksum_r
  bytes = bytes_r
  call ildg_rec(READ, infile)

  lfn = outfile
  cksum = cksum_w
  bytes = bytes_w
  call ildg_rec(WRITE, outfile)

  call ildg_landau_close_w(cksum_w, lfn, plaq, plaq_qed)
  call ildg_landau_close_r(cksum_r)

  ! ildg_close_r() not called:  would detect a cksum mismatch, which is wrong
end

!-------------------------------------------------------------------------------
subroutine ildg_landau_write_charge(a, infile, outfile, plaq, plaq_qed, charge)

  use module_ildg_conf
  use module_ildg_landau
  implicit none
  REAL, intent(in)         :: a(lx, ly, lz, lt, DIM)
  character(*)             :: infile, outfile
  REAL, intent(out)        :: plaq, plaq_qed
  REAL, intent(in)         :: charge
  integer :: len_lfn
  integer :: y, z, t
  INT8    :: cksum0, bytes_read, bytes_written, count

  write(UREC,*)
  write(UREC,*) 'write-charge ', trim(outfile)
  
  call ildg_open_r( infile, lx, ly, lz, lt, precision, bytes)
  call ildg_open_w(outfile, lx, ly, lz, lt, precision, bytes)

  call ildg_landau_set_sizes()

  cksum_r = 0
  bytes_r = 0
  cksum_w = 0
  bytes_w = 0

  ASSERT(ly * lz * lt == bytes / chunk)

  do t = 1, lt
  do z = 1, lz
  do y = 1, ly
     call ildg_landau_r(u1_ildg, chunk)   ! u1_ildg is scratch array
     call cksum2(u1_ildg, chunk, cksum_r, bytes_r)

     if (precision == 32) call ildg_landau_mult_r4(charge, a, y, z, t, u1_ildg)
     if (precision == 64) call ildg_landau_mult_r8(charge, a, y, z, t, u1_ildg)

     call cksum2(u1_ildg, chunk, cksum_w, bytes_w)
     call ildg_landau_w(u1_ildg, chunk)
  enddo
  enddo
  enddo

  ! check-sum of input
  call qcdsf_u1_r(lx, ly, lz, lt, precision, u1_bytes) 
  call ildg_landau_io(READ, u1_ildg)
  call cksum2_end(cksum_r, bytes_r)
  call cksum2_end(cksum_w, bytes_w)

  lfn = infile
  cksum = cksum_r
  bytes = bytes_r
  call ildg_rec(READ, infile)

  lfn = outfile
  cksum = cksum_w
  bytes = bytes_w
  call ildg_rec(WRITE, outfile)

  call ildg_landau_close_w(cksum_w, lfn, plaq, plaq_qed)
  call ildg_landau_close_r(cksum_r)

end

!-------------------------------------------------------------------------------
subroutine ildg_landau_set_sizes()

  use module_ildg_conf
  use module_ildg_landau
  implicit none
  integer :: volume, bytes_per_word

  select case (precision)
     case(32)
        bytes_per_word = 4
     case(64)
        bytes_per_word = 8
     case default
        call die("ildg_set_sizes(): unknown precision")
  end select

  volume = lx * ly * lz * lt

  words = SIZE_COMPLEX * NCOL * NCOL * DIM 

  words_per_chunk = words * lx             ! 64 bit integer arithmetic
  chunk = words_per_chunk * bytes_per_word

  words = words * volume                   ! 64 bit integer arithmetic
  bytes = words * bytes_per_word

  u1_words = DIM
  u1_words = u1_words * volume
  u1_bytes = u1_words * bytes_per_word

  CHECK(chunk <= u1_bytes)  ! check that scratch array u1_ildg is large enough
end  

!-------------------------------------------------------------------------------
subroutine ildg_landau_io(action, u)

  use module_ildg_conf
  use module_ildg_landau
  implicit none
  character(*), intent(in)        :: action
  real(ILDG_KIND), intent(inout)  :: u(*)

  if (action == "read") then
     call ildg_read(u, u1_bytes)
     call cksum2(u, u1_bytes, cksum_r, bytes_r)
  endif

  if (action == "write") then
     call swap_endian()
     call ildg_write(u, u1_bytes)
     call cksum2(u, u1_bytes, cksum_w, bytes_w)
  endif

  call swap_endian()

contains

  subroutine swap_endian()
    if (precision == 32) call swap_endian4(u1_words, u)
    if (precision == 64) call swap_endian8(u1_words, u)
  end subroutine swap_endian
end

!===============================================================================
