!===============================================================================
!
! field_io_bgl.F90 - I/O routine for gauge and pseudo fermion fields for BG/L
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2006 Thomas Streuer
!
! 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"

#ifndef INCLUDE_MPIF_H
#define INCLUDE_MPIF_H include 'mpif.h'
#endif

!-------------------------------------------------------------------------------
subroutine field_io(action, m, mx, field, cksum)  ! read or write g- or sc-field

  use typedef_cksum
  use module_decomp
  use module_function_decl
  use module_lattice_io
  use module_vol
  implicit none

  character(len = *) :: action
  integer            :: m, mx
  type(type_cksum)   :: cksum(0:LT - 1)

  REAL :: field(SIZE_COMPLEX * m, 0:mx - 1, 0:NY - 1, 0:NZ - 1, 0:NT - 1)

  REAL :: buffer(0:(SIZE_COMPLEX * m * mx * NPE(1))-1, 0:(NY * NPE(2))-1)


  FILENAME           :: file
  integer            :: i_pe(DIM)
  integer, external  :: i_global, ilex
  integer            :: x, y, z, t, t_global, me, pe, size, rec, recl
  INT8               :: size_field
  integer            :: pe_x, pe_y, pe_z, pe_t
  CHECK_SUM          :: check_sum(2), n_bytes, cs_local(2), cs_global(2)
  integer            :: tt, pe_tt, pe_io
  integer            :: count, block_length, stride, buf_type
  logical            :: io_pe
  integer	     :: mu_s, mu_r, thr, b_blocks, b_len, b_stride

  ASSERT(m==24)        ! only gaugefield implemented


  count        = NY
  block_length = SIZE_COMPLEX * m * mx
  stride       = block_length * NPE(1)

  size         = block_length * NY               ! words in send/recv
  size_field   = block_length * NY * NZ * NT     ! words in "field"
  n_bytes      = size * NPE(1) * NPE(2) * RKIND  ! bytes in "buffer"
  recl         = n_bytes                         ! cast to standard integer

  ASSERT(mod(recl, RECL_UNIT) == 0)
  recl         = recl / RECL_UNIT

  i_pe         = decomp%std%i_pe


  b_len=block_length/12
  b_blocks=count
  b_stride=(stride-block_length)*8

  
  if (action == "write") call swap_endian8(size_field, field)



  if (i_pe(1) == 0 .and. i_pe(2) == 0 .and. i_pe(3) == 0) then
     io_pe = .true.
  else
     io_pe = .false.
  endif

  pe_t = i_pe(4)
  do t = 0, NT - 1
     t_global = i_global(t, NT, i_pe(4))
     
     file = cksum(t_global)%file
     
     if (io_pe) then
        open(UCONF, file = file, action = action, form = "unformatted", &
             access = "direct", recl = recl)
     endif
     
     rec = 0
     call cksum_init()


      
     do pe_z = 0, NPE(3) - 1
        do z = 0, NZ - 1
           rec = rec + 1
          
           if (io_pe .and. action == "read") then
              read(UCONF, rec = rec) buffer
              call cksum_add(buffer, n_bytes)
           endif
           
           do pe_y = 0, NPE(2) - 1
           do pe_x = 0, NPE(1) - 1


              y = count * pe_y
              x = block_length * pe_x

              call field_io_pes(pe, pe_io, (/pe_x, pe_y, pe_z, pe_t/), &
				thr, mu_s, mu_r)


              if (io_pe) then
                 if (my_pe() /= pe_io) call die("my_pe() /= pe_io")
              endif      

              if (my_pe() == pe .and. my_pe() == pe_io) then
                 call field_io_seq(action, count, block_length, stride, &
                                   field(1,0,0,z,t), buffer(x,y))
              else
                 if (action == "read") then
                    if (my_pe() == pe_io) then
			call bgl_send_u(2*mu_r, buffer(x, y), b_blocks, b_len, b_stride)
             	    else
                      if (my_pe() == pe) then
			call bgl_recv_u(2*mu_s+1, field(1,0,0,z,t), 1, b_blocks*b_len, 0)
    		      else
                        if ( thr == 1 ) then
			     call bgl_thr_u(2*mu_r, 2*mu_s+1, b_blocks*b_len)
                        endif
                      endif
                    endif
                 else
                    if (my_pe() == pe_io) then
		       call bgl_recv_u(2*mu_r, buffer(x, y), b_blocks, b_len, b_stride)
                    else
                      if (my_pe() == pe ) then
	  		call bgl_send_u(2*mu_s+1, field(1,0,0,z,t), 1, b_blocks*b_len, 0)
    		      else
                        if ( thr == 1  ) then
			     call bgl_thr_u(2*mu_s+1, 2*mu_r, b_blocks*b_len)
                        endif
                      endif
                    endif
                 endif
              endif
              
           enddo
           enddo

           if (io_pe .and. action == "write") then
              write(UCONF, rec = rec) buffer
              call cksum_add(buffer, n_bytes)
           endif
        enddo
     enddo

    if (io_pe) then
       close(UCONF)
       call cksum_get(check_sum(1), check_sum(2))

       if (action == "read") then

             if (check_sum(1) /= cksum(t_global)%sum) then
                call die("field_io(): check sum error in file " // file)
             endif

       else
          if (my_pe() == 0) then
             cksum(t_global)%sum = check_sum(1)
             cksum(t_global)%bytes = check_sum(2)
          endif
       endif
    endif


    do pe_tt = 0, NPE(4)-1
      tt = i_global(t, NT, pe_tt)
      if (io_pe .and. t_global==tt) then
         cs_local(1)=check_sum(1)
         cs_local(2)=check_sum(2)
      else
         cs_local(1)=0
         cs_local(2)=0
      endif
      call global_sum_var(cs_local, cs_global, 2, 3)
      if (my_pe()==0) then          
        cksum(tt)%sum = cs_global(1)
        cksum(tt)%bytes = cs_global(2)
      endif
    enddo

  enddo


  call swap_endian8(size_field, field)

end

!-------------------------------------------------------------------------------
subroutine field_io_seq(action, count, block_length, stride, field, buffer)

  use module_lattice_io
  use module_vol
  implicit none

  character(len = *) :: action
  integer            :: count, block_length, stride
  REAL               :: field(*)
  REAL               :: buffer(*)
  integer            :: i, j, x, y

  i = 0
  j = 0
  do y = 1, count
     do x = 1, block_length
        i = i + 1
        if (action == "read") then
           field(i) = buffer(j + x)
        else
           buffer(j + x) = field(i)
        endif
     enddo
     j = j + stride
  enddo

end


subroutine field_io_pes(pe, pe_io, x_std, thr, mu_s, mu_r)

  use module_lattice  ! in contrast to the calling routine !!
  use module_function_decl
  implicit none
  integer, intent(out) :: pe, pe_io
  integer, intent(in)  :: x_std(DIM)
  integer              :: x_act(DIM), x_std_io(DIM), x_act_io(DIM)
  integer	       :: thr
  integer, external    :: ilex
  integer              :: pe_t
  integer              :: mu_s, mu_r
  integer              :: next_r
  integer              :: d_x, d_y, d_z

  x_std_io(1) = 0
  x_std_io(2) = 0
  x_std_io(3) = 0
  x_std_io(4) = x_std(4)

  x_act(1) = x_std(gamma_index(1))
  x_act(2) = x_std(gamma_index(2))
  x_act(3) = x_std(gamma_index(3))
  x_act(4) = x_std(gamma_index(4))

  x_act_io(1) = x_std_io(gamma_index(1))
  x_act_io(2) = x_std_io(gamma_index(2))
  x_act_io(3) = x_std_io(gamma_index(3))
  x_act_io(4) = x_std_io(gamma_index(4))

  pe    = ilex(DIM, x_act,    NPE)
  pe_io = ilex(DIM, x_act_io, NPE)
  thr=0
  next_r=0

  pe_t    = ilex(DIM, x_act_io,    NPE)
  if (my_pe() == pe_t) then
    thr=1
    next_r=1
  endif


  do d_z=1, x_std(3)
    if (next_r==1) then
      mu_r=gamma_index(3)-1
      next_r=0
    endif
    x_std_io(3)=d_z
    x_act_io(1) = x_std_io(gamma_index(1))
    x_act_io(2) = x_std_io(gamma_index(2))
    x_act_io(3) = x_std_io(gamma_index(3))
    x_act_io(4) = x_std_io(gamma_index(4))
    pe_t    = ilex(DIM, x_act_io,    NPE)
    if (my_pe() == pe_t) then
      thr=1
      mu_s=gamma_index(3)-1
      next_r=1
    endif
  enddo	
  do d_y=1, x_std(2)
    if (next_r==1) then
      mu_r=gamma_index(2)-1
      next_r=0
    endif
    x_std_io(2)=d_y
    x_act_io(1) = x_std_io(gamma_index(1))
    x_act_io(2) = x_std_io(gamma_index(2))
    x_act_io(3) = x_std_io(gamma_index(3))
    x_act_io(4) = x_std_io(gamma_index(4))
    pe_t    = ilex(DIM, x_act_io,    NPE)
    if (my_pe() == pe_t) then
      thr=1
      mu_s=gamma_index(2)-1
      next_r=1
    endif
  enddo
  do d_x=1, x_std(1)
    if (next_r==1) then
      mu_r=gamma_index(1)-1
      next_r=0
    endif
    x_std_io(1)=d_x
    x_act_io(1) = x_std_io(gamma_index(1))
    x_act_io(2) = x_std_io(gamma_index(2))
    x_act_io(3) = x_std_io(gamma_index(3))
    x_act_io(4) = x_std_io(gamma_index(4))
    pe_t    = ilex(DIM, x_act_io,    NPE)
    if (my_pe() == pe_t) then
      thr=1
      mu_s=gamma_index(1)-1
      next_r=1
    endif
  enddo
  if (my_pe() == pe .or. my_pe() == pe_io) then
    thr=0
  endif
end


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