!===============================================================================
!
! ildg_seq_r8.F90 - order gauge field in ILDG sequence 
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2007-2017 Hinnerk Stueben
!                    2013 Yoshifumi Nakamura
!
! 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 ildg_seq_r8(action, u, u_ildg)  ! 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_ILDG :: u_ildg

  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
                    do c1 = 1, NCOL
                       if (action == "read") then
                          u(c1, c2, i, eo, mu) = u_ildg(c2, c1, mu, x, y, z, t)
                       else
                          u_ildg(c2, c1, mu, x, y, z, t) = u(c1, c2, i, eo, mu)
                       endif
                    enddo
                 enddo
              enddo
           enddo
        enddo
     enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine ildg_u1_seq_r8(action, u1, u1_ildg)  ! arranges u1-field for i/o

  use module_lattice_io
  use module_decomp
  use module_vol
  implicit none

  character(*)     :: action
  U1_GENERATOR_FIELD      :: u1
  U1_GENERATOR_FIELD_ILDG :: u1_ildg

  integer, dimension(DIM) :: j
  integer :: x, y, z, t, i, eo, mu
  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
                 if (action == "read") then
                    u1(i, eo, mu) = u1_ildg(mu, x, y, z, t)
                 else
                    u1_ildg(mu, x, y, z, t) = u1(i, eo, mu)
                 endif
              enddo
           enddo
        enddo
     enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine ildg_axion_seq_r8(action, a, a_ildg)  ! arranges axion-field for i/o

  use module_lattice_io
  use module_decomp
  use module_vol
  implicit none

  character(*)     :: action
  AXION_FIELD      :: a
  AXION_FIELD_ILDG :: a_ildg

  integer, dimension(DIM) :: j
  integer :: x, y, z, t, i, eo
  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)

              if (action == "read") then
                 a(i, eo) = a_ildg(x, y, z, t)
              else
                 a_ildg(x, y, z, t) = a(i, eo)
              endif
           enddo
        enddo
     enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine ildg_landau_seq_r8(action, a, u1_ildg)  ! ordering for QED Landau gauge fixing program

  use module_ildg_conf
  implicit none
  character(*), intent(in) :: action
  REAL :: a(lx, ly, lz, lt, DIM)
  real(ILDG_KIND) :: u1_ildg(DIM, lx, ly, lz, lt)
  integer :: x, y, z, t, mu

  do t = 1, lt
  do z = 1, lz
  do y = 1, ly
  do x = 1, lx
  do mu = 1, DIM
     if (action == "read") then
        a(x, y, z, t, mu) = u1_ildg(mu, x, y, z, t)
     else
        u1_ildg(mu, x, y, z, t) = a(x, y, z, t, mu)
     endif
  enddo
  enddo
  enddo
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine ildg_landau_mult_r8(charge, a, y, z, t, u)  ! U = U exp(i charge A)

  use module_ildg_conf
  use module_ildg_landau
  implicit none
  REAL, intent(in) :: charge
  REAL, intent(in) :: a(lx, ly, lz, lt, DIM)
  integer, intent(in) :: y, z, t
  complex(ILDG_KIND), intent(inout) :: u(NCOL, NCOL, DIM, lx)
  REAL :: charge_a
  COMPLEX :: factor
  integer :: x, mu, c1, c2

  call swap_endian8(words_per_chunk, u)

  do x = 1, lx
     do mu = 1, DIM
        charge_a = charge * a(x, y, z, t, mu)
        factor = cmplx(cos(charge_a), sin(charge_a), kind = RKIND)
        do c2 = 1, NCOL
           do c1 = 1, NCOL
              u(c1, c2, mu, x) = u(c1, c2, mu, x) * factor
           enddo
        enddo
     enddo
  enddo

  call swap_endian8(words_per_chunk, u)

end

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