!===============================================================================
!
! init_schr_bc.F90 -- init schr boundary condition
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2007 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"

!-------------------------------------------------------------------------------
module module_schr_bc

  INTEGER, dimension(:, :), pointer, save :: bc_list_1
  INTEGER, dimension(:, :), pointer, save :: bc_list_b
  INTEGER, dimension(:, :), pointer, save :: bc_list_t
  INTEGER, dimension(:, :), pointer, save :: bc_list_bb
  INTEGER, dimension(:, :), pointer, save :: bc_list_tp
  INTEGER, dimension(:, :), pointer, save :: bc_list_b_all
  INTEGER, dimension(:, :), pointer, save :: bc_list_t_all

  INTEGER, dimension(EVEN:ODD), save      :: bc_len_1
  INTEGER, dimension(EVEN:ODD), save      :: bc_len_b
  INTEGER, dimension(EVEN:ODD), save      :: bc_len_t
  INTEGER, dimension(EVEN:ODD), save      :: bc_len_bb
  INTEGER, dimension(EVEN:ODD), save      :: bc_len_tp
  INTEGER, dimension(EVEN:ODD), save      :: bc_len_b_all
  INTEGER, dimension(EVEN:ODD), save      :: bc_len_t_all

  REAL, save :: cps, cpt, crt

end

!-------------------------------------------------------------------------------
subroutine init_schr_bc()
  use module_schr_bc
  use module_function_decl
  use module_lattice
  use module_vol
  implicit none

  integer, dimension(DIM) :: i_pe, j
  integer :: mu, x, y, z, t, i, eo, dmin(3), dmax(3)
  integer, external :: xyzt2i, e_o

  if (NPE(4) == 1 ) call die("so far schr bc does not work in NPE(4)=1 ")
  call my_coord(i_pe)

  allocate(bc_list_1( (nx+2)*(ny+2)*(nz+2), EVEN:ODD))
  allocate(bc_list_b( (nx+2)*(ny+2)*(nz+2), EVEN:ODD))
  allocate(bc_list_t( (nx+2)*(ny+2)*(nz+2), EVEN:ODD))
  allocate(bc_list_bb((nx+2)*(ny+2)*(nz+2), EVEN:ODD))
  allocate(bc_list_tp((nx+2)*(ny+2)*(nz+2), EVEN:ODD))
  allocate(bc_list_b_all( (nx+2)*(ny+2)*(nz+2), EVEN:ODD))
  allocate(bc_list_t_all( (nx+2)*(ny+2)*(nz+2), EVEN:ODD))
  bc_len_1 = 0
  bc_len_b = 0
  bc_len_t = 0
  bc_len_bb = 0
  bc_len_tp = 0
  bc_len_b_all = 0
  bc_len_t_all = 0

  do mu = 1, 3
     dmin(mu) = 0
     dmax(mu) = n(mu) - 1
     if (NPE(mu) > 1) dmin(mu) = -1
     if (NPE(mu) > 1) dmax(mu) = n(mu)
  enddo

  if ( i_pe(4) == (NPE(4) - 1) ) then   !! t=T-1
     do x = 0, n(1) - 1
     do y = 0, n(2) - 1
     do z = 0, n(3) - 1
        j = (/x, y, z, nt-1/)
        i = xyzt2i(j)
        eo = e_o(j)
        bc_len_t(eo) = bc_len_t(eo) + 1
        bc_list_t(bc_len_t(eo), eo) = i
     enddo
     enddo
     enddo
     do x = dmin(1), dmax(1)
     do y = dmin(2), dmax(2)
     do z = dmin(3), dmax(3)
        j = (/x, y, z, nt-1/)
        i = xyzt2i(j)
        eo = e_o(j)
        bc_len_t_all(eo) = bc_len_t_all(eo) + 1
        bc_list_t_all(bc_len_t_all(eo), eo) = i
     enddo
     enddo
     enddo

     do x = dmin(1), dmax(1)
     do y = dmin(2), dmax(2)
     do z = dmin(3), dmax(3)
        j = (/x, y, z, nt/)
        i = xyzt2i(j)
        eo = e_o(j)
        bc_len_tp(eo) = bc_len_tp(eo) + 1
        bc_list_tp(bc_len_tp(eo), eo) = i
     enddo
     enddo
     enddo
  endif
  if ( i_pe(4) == 0 ) then   !! t=0
     do x = 0, n(1) - 1
     do y = 0, n(2) - 1
     do z = 0, n(3) - 1
        j = (/x, y, z, 0/)
        i = xyzt2i(j)
        eo = e_o(j)
        bc_len_b(eo) = bc_len_b(eo) + 1
        bc_list_b(bc_len_b(eo), eo) = i
     enddo
     enddo
     enddo
     do x = dmin(1), dmax(1)
     do y = dmin(2), dmax(2)
     do z = dmin(3), dmax(3)
        j = (/x, y, z, 0/)
        i = xyzt2i(j)
        eo = e_o(j)
        bc_len_b_all(eo) = bc_len_b_all(eo) + 1
        bc_list_b_all(bc_len_b_all(eo), eo) = i
     enddo
     enddo
     enddo
     do x = dmin(1), dmax(1)
     do y = dmin(2), dmax(2)
     do z = dmin(3), dmax(3)
        j = (/x, y, z, -1/)
        i = xyzt2i(j)
        eo = e_o(j)
        bc_len_bb(eo) = bc_len_bb(eo) + 1
        bc_list_bb(bc_len_bb(eo), eo) = i
     enddo
     enddo
     enddo
  endif

  if (nt > 1 .and. i_pe(4) == 0) then
     do x = 0, n(1) - 1
     do y = 0, n(2) - 1
     do z = 0, n(3) - 1
        j = (/x, y, z, 1/)
        i = xyzt2i(j)
        eo = e_o(j)
        bc_len_1(eo) = bc_len_1(eo) + 1
        bc_list_1(bc_len_1(eo), eo) = i
     enddo
     enddo
     enddo
  endif
  if(nt==1 .and. i_pe(4) == 1) then
     do x = 0, n(1) - 1
     do y = 0, n(2) - 1
     do z = 0, n(3) - 1
        j = (/x, y, z, 0/)
        i = xyzt2i(j)
        eo = e_o(j)
        bc_len_1(eo) = bc_len_1(eo) + 1
        bc_list_1(bc_len_1(eo), eo) = i
     enddo
     enddo
     enddo
  endif

!write(*,*)",bc_len_t e",my_pe(),bc_len_t(0)
!write(*,*)",bc_len_b o",my_pe(),bc_len_b(1)
!write(*,*)",bc_len_t o",my_pe(),bc_len_t(1)
!call flush(6)
!call comm_finalize()
!stop

end

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