!===============================================================================
!
! init_modules.F90 - initialise (some) modules
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2003-2016 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 init_modules()

  call init_module_decomp()
  call init_module_lattice_io()
  call init_module_sc_size()
!!  call init_module_sc_size_r4()
  call init_module_surface()

end

!-------------------------------------------------------------------------------
subroutine init_module_decomp()

  use module_decomp
  use module_lattice
  use module_vol
  implicit none

  integer :: i, j, i_pe(DIM)
  integer :: x, y, z, t, eo
  integer :: x_std(DIM), i_std
  integer :: x_act(DIM), i_act
  integer :: me_act, me_std

  integer, external :: e_o
  integer, external :: ieo


  allocate(decomp%std%i(volh, EVEN:ODD))
  allocate(decomp%act%i(volh, EVEN:ODD))

  call my_coord(i_pe)

  decomp%act%L           = L
  decomp%act%NPE         = NPE
  decomp%act%N           = N
  decomp%act%NH          = NH
  decomp%act%i_pe        = i_pe
  decomp%act%bc_fermions = bc_fermions
  decomp%gamma_index     = gamma_index
  decomp%direction       = decomp_direction

  do j = 1, DIM
     i = gamma_index(j)

     ASSERT(gamma_index(j) == j)

     decomp%std%L(i)           = L(j)
     decomp%std%NPE(i)         = NPE(j)
     decomp%std%N(i)           = N(j)
     decomp%std%i_pe(i)        = i_pe(j)
     decomp%std%bc_fermions(i) = bc_fermions(j)
  enddo

  decomp%std%NH(1) = decomp%std%N(1) / 2
  decomp%std%NH(2) = decomp%std%N(2)
  decomp%std%NH(3) = decomp%std%N(3)
  decomp%std%NH(4) = decomp%std%N(4)


  decomp%std%i = 0
  decomp%act%i = 0

  do t = 0, decomp%act%N(4) - 1
  do z = 0, decomp%act%N(3) - 1
  do y = 0, decomp%act%N(2) - 1
  do x = 0, decomp%act%N(1) - 1

     x_act(1) = x
     x_act(2) = y
     x_act(3) = z
     x_act(4) = t

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

     i_std = ieo(DIM, x_std, decomp%std%N) + 1
     i_act = ieo(DIM, x_act, decomp%act%N) + 1
     eo = e_o(x_act)

     decomp%std%i(i_act, eo) = i_std
     decomp%act%i(i_std, eo) = i_act
  enddo
  enddo
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine init_module_lattice_io()

  use module_decomp
  use module_lattice_io
  implicit none

  L   = decomp%std%L
  N   = decomp%std%N
  NH  = decomp%std%NH
  NPE = decomp%std%NPE

end

!-------------------------------------------------------------------------------
subroutine init_module_surface()

  use module_surface
  use module_function_decl
  use module_lattice
  use module_nn
  use module_vol
  implicit none
  integer :: eo, mu, fb, bf, i, ii, maxsites, x, y, z, t
  integer :: i1, i2, count, nsites
  integer :: start(DIM), end(DIM), j(DIM)
  integer :: contiguous_start, block_start, i_block
  integer, external :: e_o, xyzt2i  

  ! local lattice:
  !
  !      h h h h h h
  !    +-------------+        s: surface
  !  h | s s s s s s | h      h: surface_halo
  !  h | s x x x x s | h
  !  h | s x x x x s | h
  !  h | s x x x x s | h
  !  h | s x x x x s | h
  !  h | s s s s s s | h
  !    +-------------+ 
  !      h h h h h h

  surface(:, :, :)%nsites = 0
  surface_halo(:, :, :)%nsites = 0

  do mu = 1, DIM
     if (npe(mu) == 1) cycle

     do fb = FWD, BWD
        bf = FWD + BWD - fb

        maxsites = (1 + vol / n(mu)) / 2
        allocate(surface(EVEN, mu, fb)%site(maxsites))
        allocate(surface(ODD, mu, fb)%site(maxsites))
        
        start(:) = 0
        end(:) = n(:) - 1
     
        if (fb == FWD) end(mu) = 0
        if (fb == BWD) start(mu) = n(mu) - 1 

        do t = start(4), end(4)
        do z = start(3), end(3)
        do y = start(2), end(2)
        do x = start(1), end(1)
               
           j = (/x,y,z,t/)
           eo = e_o(j)

           i = surface(eo, mu, fb)%nsites + 1
           ASSERT(i <= maxsites)
           surface(eo, mu, fb)%nsites = i
           surface(eo, mu, fb)%site(i) = xyzt2i(j)
        enddo
        enddo
        enddo
        enddo
        !!if (my_pe() == 0) write(6,"(3(4i4,4x))") &
        !!   fb, mu, surface(:, mu, fb)%nsites, start, end


        allocate(surface_halo(EVEN, mu, fb)%site(maxsites))
        allocate(surface_halo(ODD, mu, fb)%site(maxsites))

        start(:) = 0
        end(:) = n(:) - 1
     
        if (fb == FWD) then
            start(mu) = n(mu)
            end(mu) = n(mu)
        endif

        if (fb == BWD) then
            start(mu) = -1
            end(mu) = -1
        endif


        do t = start(4), end(4)
        do z = start(3), end(3)
        do y = start(2), end(2)
        do x = start(1), end(1)
               
           j = (/x,y,z,t/)
           eo = e_o(j)

           i = surface_halo(eo, mu, fb)%nsites + 1
           ASSERT(i <= maxsites)
           surface_halo(eo, mu, fb)%nsites = i
           surface_halo(eo, mu, fb)%site(i) = xyzt2i(j)

        enddo
        enddo
        enddo
        enddo

        ASSERT(surface(EVEN, mu, fb)%nsites == surface_halo(EVEN, mu, fb)%nsites)
        ASSERT(surface(ODD,  mu, fb)%nsites == surface_halo(ODD,  mu, fb)%nsites)

if (mu == 1) then
  ASSERT(surface_halo(EVEN, mu, fb)%site(1) /= surface_halo(ODD, mu, fb)%site(1))
endif
     enddo

     if (mu > 1) then
        ASSERT(surface(EVEN, mu, FWD)%nsites == surface(EVEN, mu, BWD)%nsites) 
        ASSERT(surface(EVEN, mu, BWD)%nsites == surface(EVEN, mu, FWD)%nsites) 
        ASSERT(surface(ODD,  mu, FWD)%nsites == surface(ODD,  mu, BWD)%nsites) 
        ASSERT(surface(ODD,  mu, BWD)%nsites == surface(ODD,  mu, FWD)%nsites) 
     endif

  enddo

  surface2(:)%count = 0
  surface2(:)%nsites = 0

  surface2(2)%i_start(FWD) = xyzt2i((/0, 0, 0, 0/))
  surface2(2)%i_start(BWD) = xyzt2i((/0, ny - 1, 0, 0/))

  surface2(3)%i_start(FWD) = xyzt2i((/0, 0, 0, 0/))
  surface2(3)%i_start(BWD) = xyzt2i((/0, 0, nz - 1, 0/))

  surface2(4)%i_start(FWD) = xyzt2i((/0, 0, 0, 0/))
  surface2(4)%i_start(BWD) = xyzt2i((/0, 0, 0, nt - 1/))

  if (npe(1) > 1) surface2(1)%count = ny * nz * nt
  if (npe(2) > 1) surface2(2)%count = nz * nt
  if (npe(3) > 1) surface2(3)%count = nt
  if (npe(4) > 1) surface2(4)%count = 1

  surface2(1)%blocklength = 1
  surface2(2)%blocklength = nxh
  surface2(3)%blocklength = nxh * ny
  surface2(4)%blocklength = nxh * ny * nz

  surface2(1)%stride = surface2(1)%blocklength * nxh
  surface2(2)%stride = surface2(2)%blocklength * ny
  surface2(3)%stride = surface2(3)%blocklength * nz
  surface2(4)%stride = surface2(4)%blocklength * nt

  surface2(1)%nsites = surface2(1)%count * surface2(1)%blocklength
  surface2(2)%nsites = surface2(2)%count * surface2(2)%blocklength
  surface2(3)%nsites = surface2(3)%count * surface2(3)%blocklength
  surface2(4)%nsites = surface2(4)%count * surface2(4)%blocklength


  surface_halo2(:)%count = 0
  surface_halo2(:)%nsites = 0

  surface_halo2(2)%i_start(FWD) = xyzt2i((/0, ny, 0, 0/))
  surface_halo2(2)%i_start(BWD) = xyzt2i((/0, -1, 0, 0/))

  surface_halo2(3)%i_start(FWD) = xyzt2i((/0, 0, nz, 0/))
  surface_halo2(3)%i_start(BWD) = xyzt2i((/0, 0, -1, 0/))

  surface_halo2(4)%i_start(FWD) = xyzt2i((/0, 0, 0, nt/))
  surface_halo2(4)%i_start(BWD) = xyzt2i((/0, 0, 0, -1/))

  if (npe(2) > 1) surface_halo2(2)%count = 1
  if (npe(3) > 1) surface_halo2(3)%count = 1
  if (npe(4) > 1) surface_halo2(4)%count = 1

  surface_halo2(2)%blocklength = nxh * nz * nt
  surface_halo2(3)%blocklength = nxh * ny * nt
  surface_halo2(4)%blocklength = nxh * ny * nz

  surface_halo2(2)%stride = surface_halo2(2)%blocklength
  surface_halo2(3)%stride = surface_halo2(3)%blocklength
  surface_halo2(4)%stride = surface_halo2(4)%blocklength

  surface_halo2(2)%nsites = surface_halo2(2)%count * surface_halo2(2)%blocklength
  surface_halo2(3)%nsites = surface_halo2(3)%count * surface_halo2(3)%blocklength
  surface_halo2(4)%nsites = surface_halo2(4)%count * surface_halo2(4)%blocklength

  ! check correctness of typical loop constructs (loops over surfaces)

  do mu = 2, DIM
     if (npe(mu) == 1) then
        ASSERT(surface2(mu)%count == 0)
        cycle
     endif
     do fb = FWD, BWD
        do eo = EVEN, ODD

           ! loop construct 1 (has recursions)

           nsites = 0

           i1 = surface2(mu)%i_start(fb)
           do count = 1, surface2(mu)%count
              i2 = i1 + surface2(mu)%blocklength - 1
              do i = i1, i2
                 nsites = nsites + 1
                                
                 ASSERT(nsites <= surface(eo, mu, fb)%nsites)
                 ASSERT(i == surface(eo, mu, fb)%site(nsites))
              enddo
              i1 = i1 + surface2(mu)%stride
           enddo
  
           ASSERT(nsites == surface(eo, mu, fb)%nsites)
           ASSERT(nsites == surface2(mu)%nsites)
           ASSERT(nsites == surface_halo2(mu)%nsites)

           ! loop construct 2 (no recursions)

           nsites = 0

           do count = 0, surface2(mu)%count - 1

              contiguous_start = count * surface2(mu)%blocklength
              block_start = surface2(mu)%i_start(fb) + count * surface2(mu)%stride - 1

              do i_block = 1, surface2(mu)%blocklength  
                 nsites = nsites + 1

                 i = block_start + i_block
                 ii = contiguous_start + i_block

                 ASSERT(nsites <= surface(eo, mu, fb)%nsites)
                 ASSERT(i == surface(eo, mu, fb)%site(nsites))
                 ASSERT(ii == nsites)
              enddo
           enddo

           ASSERT(nsites == surface(eo, mu, fb)%nsites)
           ASSERT(nsites == surface2(mu)%nsites)

        enddo
     enddo
  enddo

end

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