!===============================================================================
!
! conf_bqcd.F90 - read/write configurations in BQCD format
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 1998-2017 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"

!-------------------------------------------------------------------------------
subroutine conf_read_bqcd(restart, para, conf, io_format)

  use typedef_cksum
  use typedef_para
  use module_conf_info
  use module_lattice_io
  use module_p_interface
  use module_switches
  use module_vol
  implicit none

  character(len = *), parameter              :: READ = "read"

  logical                                    :: restart
  type(type_para)                            :: para
  type(hmc_conf), dimension(MAX_TEMPER)      :: conf
  integer                                    :: io_format

  type(type_conf_info)                       :: info
  type(type_cksum), dimension(0:L(4)-1)      :: cksum
  P_GAUGE_FIELD_IO, save                     :: u_io => null()
  P_SPINCOL_FIELD_IO, save                   :: phi_io => null()
  FILENAME, external                         :: u_file, phi_file, info_file
  FILENAME, external                         :: u1_file, axion_file
  FILENAME                                   :: file
  integer                                    :: i, t
  integer                                    :: u_m, u_mx, phi_m, phi_mx
  integer                                    :: n_u_io, n_phi
  

  ALLOCATE_G_FIELD_IO(u_io)
  if (switches%tempering) then
     ALLOCATE_SC_FIELD_IO(phi_io)
  endif

  u_m    = SIZE_COMPLEX * NCOL * (NCOL - 1) * DIM
  u_mx   = NX
  phi_m  = SIZE_COMPLEX * NDIRAC * NCOL
  phi_mx = NXH
  n_u_io = u_m * vol * SIZE_COMPLEX
  n_phi  = size_sc_field
  
  do i = 1, para%n_temper
     
     if (restart) then
        file = info_file(i)
     else
        file = para%info_file(i)
     endif

     open(UINFO, file = trim(file), action = READ, status = "old")
     call read_conf_info_header(UINFO, info)
     call check_conf_info_header(restart, info, para)

     if (restart) then
        conf(i)%former = info%ensemble(2)
     else
        conf(i)%former = i
     endif

     ! read SU(3)

     call read_cksum(restart, UINFO, cksum, L(4), i, u_file)

     TIMING_START(timing_bin_u_read_bqcd)
     call field_io(READ, u_m, u_mx, u_io, cksum, io_format)
     TIMING_STOP(timing_bin_u_read_bqcd)

     call conf_seq_bqcd(READ, conf(i)%u, u_io)
     call xbound_g_field(conf(i)%u)
     call d_g_init(conf(i)%u)

     if (switches%tempering .and. switches%dynamical) then
        ! read PHI
        call read_cksum(restart, UINFO, cksum, L(4), i, phi_file)
        call field_io(READ, phi_m, phi_mx, phi_io, cksum, io_format)
        call phi_seq_bqcd(READ, conf(i)%phi, phi_io)
        !!call xbound_sc_field(conf(i)%phi)  incompatible with libd25
     endif

     if (switches%qed) then  ! uses u_io as scratch array
        ! read U(1)
        call read_cksum(restart, UINFO, cksum, L(4), i, u1_file)
        call field_io(READ, DIM, NX, u_io, cksum, io_format)
        call ildg_u1_seq_r8(READ, conf(i)%a_qed, u_io)
        call xbound_u1gen_field(conf(i)%a_qed)
     endif

     if (switches%axion) then  ! uses u_io as scratch array
        ! read AXION
        call read_cksum(restart, UINFO, cksum, L(4), i, axion_file)
        call field_io(READ, 1, NX, u_io, cksum, io_format)
        call ildg_axion_seq_r8(READ, conf(i)%axion, u_io)
        call xbound_axion_field(conf(i)%axion)
     endif

     close(UINFO)
  enddo

  if (switches%tempering) deallocate(phi_io)
  deallocate(u_io)
end

!-------------------------------------------------------------------------------
subroutine conf_write_bqcd(restart, para, conf, io_format)

  use typedef_cksum
  use typedef_para
  use module_function_decl
  use module_lattice_io
  use module_p_interface
  use module_switches
  use module_vol
  implicit none

  character(len = *), parameter              :: WRITE = "write"

  logical                                    :: restart
  type(type_para)                            :: para
  type(hmc_conf), dimension(MAX_TEMPER)      :: conf
  integer                                    :: io_format

  type(type_cksum), dimension(0:L(4)-1)      :: cksum
  P_GAUGE_FIELD_IO, save                     :: u_io => null()
  P_SPINCOL_FIELD_IO, save                   :: phi_io => null()
  FILENAME, external                         :: u_file, phi_file, info_file
  FILENAME, external                         :: conf_file, conf_info_file
  FILENAME, external                         :: u1_file, conf_u1_file
  FILENAME, external                         :: axion_file, conf_axion_file
  FILENAME                                   :: f_info
  integer                                    :: i, j, t
  integer                                    :: u_m, u_mx, phi_m, phi_mx
  integer                                    :: n_u_io, n_phi
  REAL                                       :: plaq
  REAL, external                             :: sg  


  ALLOCATE_G_FIELD_IO(u_io)
  if (switches%tempering) then
     ALLOCATE_SC_FIELD_IO(phi_io)
  endif

  u_m    = SIZE_COMPLEX * NCOL * (NCOL - 1) * DIM
  u_mx   = NX
  phi_m  = SIZE_COMPLEX * NDIRAC * NCOL
  phi_mx = NXH
  n_u_io = u_m * vol * SIZE_COMPLEX
  n_phi  = size_sc_field
  
  call check_former(para%n_temper, conf)

  do i = 1, para%n_temper
     
     j = conf(i)%former

     if (restart) then
        f_info = info_file(i)
     else
        f_info = conf_info_file(i, j)
     endif

     if (my_pe() == 0) open(UINFO, file = trim(f_info), action = WRITE)
     plaq = sg(conf(i)%u) / (SIX * volume)
     call write_conf_info_header(para, i, j, plaq)

     ! write SU(3)

     do t = 0, L(4) - 1
        if (restart) then
           cksum(t)%file = u_file(i, t)
        else
           cksum(t)%file = conf_file(i, j, t)
        endif
     enddo

     call conf_seq_bqcd(WRITE, conf(i)%u, u_io)

     TIMING_START(timing_bin_u_write_bqcd)
     call field_io(WRITE, u_m, u_mx, u_io, cksum, io_format)
     TIMING_STOP(timing_bin_u_write_bqcd)

     call write_cksum(UINFO, cksum, L(4))

     if (switches%tempering .and. switches%dynamical .and. restart) then
        ! write PHI
        do t = 0, L(4) - 1
           cksum(t)%file = phi_file(i, t)
        enddo
        call phi_seq_bqcd(WRITE, conf(i)%phi, phi_io)
        call field_io(WRITE, phi_m, phi_mx, phi_io, cksum, io_format)
        call write_cksum(UINFO, cksum, L(4))
     endif

     if (switches%qed) then  ! uses u_io as scratch array
        ! write U(1)
        do t = 0, L(4) - 1
           if (restart) then
              cksum(t)%file = u1_file(i, t)
           else
              cksum(t)%file = conf_u1_file(i, j, t)
           endif
        enddo
        call ildg_u1_seq_r8(WRITE, conf(i)%a_qed, u_io)
        call field_io(WRITE, DIM, NX, u_io, cksum, io_format)
        call write_cksum(UINFO, cksum, L(4))
     endif

     if (switches%axion) then  ! uses u_io as scratch array
        ! write AXION
        do t = 0, L(4) - 1
           if (restart) then
              cksum(t)%file = axion_file(i, t)
           else
              cksum(t)%file = conf_axion_file(i, j, t)
           endif
        enddo
        call ildg_axion_seq_r8(WRITE, conf(i)%axion, u_io)
        call field_io(WRITE, 1, NX, u_io, cksum, io_format)
        call write_cksum(UINFO, cksum, L(4))
     endif

     if (my_pe() == 0) close(UINFO)
  enddo

  if (switches%tempering) deallocate(phi_io)
  deallocate(u_io)
end
    
!-------------------------------------------------------------------------------
subroutine conf_seq_bqcd(action, u, u_io)  ! arranges u-field for i/o

  use module_lattice_io
  use module_decomp
  use module_vol
  implicit none

  character(*) :: action
  GAUGE_FIELD :: u
  GAUGE_FIELD_IO :: u_io

  integer, dimension(DIM) :: j
  integer :: x, y, z, t, i, eo, mu, c1, c2
  integer, external :: std_xyzt2i, e_o

  do t = 0, NT - 1
     do z = 0, NZ - 1
        do y = 0, NY - 1
           do x = 0, NX - 1

              j = (/x, y, z, t/)

              i = std_xyzt2i(j)
              eo = e_o(j)

              do mu = 1, DIM
                 do c2 = 1, NCOL - 1
                    do c1 = 1, NCOL
                       if (action == "read") then
                          u(c1, c2, i, eo, mu) = u_io(c1, c2, mu, x, y, z, t)
                       else
                          u_io(c1, c2, mu, x, y, z, t) = u(c1, c2, i, eo, mu)
                       endif
                    enddo
                 enddo
                 if (action == "read") call u_complete(u(1, 1, i, eo ,mu))
              enddo
           enddo
        enddo
     enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine phi_seq_bqcd(action, phi, phi_io)  ! arranges phi-field for i/o

  use module_lattice_io
  use module_decomp
  use module_vol
  implicit none

  character(*) :: action
  SPINCOL_FIELD :: phi
  SPINCOL_FIELD_IO :: phi_io

  integer, dimension(DIM) :: j
  integer :: x, y, z, t, d, c, i
  integer, external :: std_xyzt2i, e_o

  do t = 0, NT - 1
     do z = 0, NZ - 1
        do y = 0, NY - 1
           do x = 0, NX - 1

              j = (/x, y, z, t/)

              if (e_o(j) == EVEN) then
                 i = std_xyzt2i(j)
                 do c = 1, NCOL
                    do d = 1, NDIRAC
                       if (action == "read") then
                          phi(d, c, i) = phi_io(d, c, x, y, z, t)
                       else
                          phi_io(d, c, x, y, z, t) = phi(d, c, i)
                       endif
                    enddo
                 enddo
              endif

           enddo
        enddo
     enddo
  enddo
end

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

