Class single_field_class
In: GPUSolverClass_v1.2/single_field_class.F90
GPUSolverClass/single_field_class.F90
comlib lattice_class error_class iso_c_binding field_fermion_class field_gauge_class field_clover_class single_field_class dot/f_131.png

*********************************************************** $Id: single_field_class.F90,v 1.15 2011/10/30 02:41:55 ishikawa Exp $ Single precicion solver version without ghost sites ***********************************************************

Methods

NBX   NBX   NBY   NBY   NBZ   NBZ   NDEPTH   NDEPTH   NGX   NGX   NMR   NMR   NRAS   NRAS   NTHT   NTHT   NTHZ   NTHZ   abs2   abs2   abs2   abs2   abs2   abs2   accum_add   accum_add   accum_add   accum_add   accum_add_mult   accum_add_mult   accum_add_mult   accum_add_mult   accum_add_mult   accum_add_mult   accum_add_mult   accum_add_mult   accum_mult_add   accum_mult_add   accum_mult_add   accum_mult_add   accum_mult_add   accum_mult_add   accum_mult_add   accum_mult_add   accum_sub   accum_sub   accum_sub   accum_sub   assign   assign   assign   assign   assign   assign   clear   clear   clear   clear   clear   clear   clear_all   clear_all   clear_all   clear_all   clear_all   clear_all   conv_clv   conv_clv   conv_clv   conv_clv   conv_u   conv_u   conv_u   conv_u   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   new   new   new   new   new   new   new   new   new   new   new   new   new   new   pack   pack   prod   prod   prod   prod   prod   prod   single_field_world   single_field_world   unpack   unpack  

Included Modules

comlib lattice_class error_class iso_c_binding field_fermion_class field_gauge_class field_clover_class

Public Instance methods

NBX
Constant :
NBX = _NBX :integer, parameter
: block size / grid
NBX
Constant :
NBX = _NBX :integer, parameter
: block size / grid
NBY
Constant :
NBY = _NBY :integer, parameter
: block size / grid
NBY
Constant :
NBY = _NBY :integer, parameter
: block size / grid
NBZ
Constant :
NBZ = _NBZ :integer, parameter
: block size / grid
NBZ
Constant :
NBZ = _NBZ :integer, parameter
: block size / grid
NDEPTH
Constant :
NDEPTH = _NDEPTH :integer, parameter
: RAS overlap depth
NDEPTH
Constant :
NDEPTH = _NDEPTH :integer, parameter
: RAS overlap depth
NGX
Constant :
NGX = _NGX :integer, parameter
: grid size (X direction only) = Num of GPU
NGX
Constant :
NGX = _NGX :integer, parameter
: grid size (X direction only) = Num of GPU
NMR
Constant :
NMR = _NMR :integer, parameter
NMR
Constant :
NMR = _NMR :integer, parameter
NRAS
Constant :
NRAS = _NRAS :integer, parameter
NRAS
Constant :
NRAS = _NRAS :integer, parameter
NTHT
Constant :
NTHT = _NTHT :integer, parameter
: thread size / block
NTHT
Constant :
NTHT = _NTHT :integer, parameter
: thread size / block
NTHZ
Constant :
NTHZ = _NTHZ :integer, parameter
: thread size / block
NTHZ
Constant :
NTHZ = _NTHZ :integer, parameter
: thread size / block
Function :
a :real(SP)
y :type(s_wqf_eo_blk_obj), intent(in)
 a = |y|^2

[Source]

function abs2_swqf_blk(y) result(a)
!
!  a = |y|^2
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(in) :: y
  real(SP) :: a
  integer :: ix,iy,iz,ieoxyz,ic,is
  integer :: ibx,iby,ibz,itht,ithz,ics
  a=0.0_SP
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ithz=1,NTHZ
      ix=ibx+(y%igx-1)*NBX
      iy=iby
      iz=ithz+(ibz-1)*NTHZ
      ieoxyz=mod(ipeo+ix+iy+iz+y%ieo,2)
      do ics=1,COL*2
#ifdef _SF
        do itht=1+ieoxyz,NTHT    !ieoxyz=1 => itht = 2..NTHT, ieoxyz=0 => itht=1..NTHT
#else
        do itht=1,NTHT
#endif
          a = a + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w**2
        enddo
      enddo
    enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(a)
#endif
  return
end function
Function :
a :real(SP)
y :type(s_wqf_eo_blk_obj), intent(in)
 a = |y|^2

[Source]

function abs2_swqf_blk(y) result(a)
!
!  a = |y|^2
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(in) :: y
  real(SP) :: a
  integer :: ix,iy,iz,ieoxyz,ic,is
  integer :: ibx,iby,ibz,itht,ithz,ics
  a=0.0_SP
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ithz=1,NTHZ
      ix=ibx+(y%igx-1)*NBX
      iy=iby
      iz=ithz+(ibz-1)*NTHZ
      ieoxyz=mod(ipeo+ix+iy+iz+y%ieo,2)
      do ics=1,COL*2
#ifdef _SF
        do itht=1+ieoxyz,NTHT    !ieoxyz=1 => itht = 2..NTHT, ieoxyz=0 => itht=1..NTHT
#else
        do itht=1,NTHT
#endif
          a = a + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w**2
        enddo
      enddo
    enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(a)
#endif
  return
end function
Function :
a :real(SP)
y :type(s_wqf_eo_obj), intent(in)
 a = |y|^2

[Source]

function abs2_swqf_eo(y) result(a)
!
!  a = |y|^2
!
  implicit none
  type(s_wqf_eo_obj), intent(in) :: y
  real(SP) :: a
  integer :: igx
  a = 0.0_SP
!$OMP PARALLEL DO REDUCTION(+:a)
  do igx=1,NGX
    a = a + abs2(y%g(igx))
  enddo
  return
end function
Function :
a :real(SP)
y :type(s_wqf_eo_obj), intent(in)
 a = |y|^2

[Source]

function abs2_swqf_eo(y) result(a)
!
!  a = |y|^2
!
  implicit none
  type(s_wqf_eo_obj), intent(in) :: y
  real(SP) :: a
  integer :: igx
  a = 0.0_SP
!$OMP PARALLEL DO REDUCTION(+:a)
  do igx=1,NGX
    a = a + abs2(y%g(igx))
  enddo
  return
end function
Function :
a :real(SP)
y :type(s_wqf_obj), intent(in)
 a = |y|^2

[Source]

function abs2_swqf(y) result(a)
!
!  a = |y|^2
!
  implicit none
  type(s_wqf_obj), intent(in) :: y
  real(SP) :: a
  integer :: ieo
  a = 0.0_SP
  do ieo=0,1
    a = a + abs2(y%eo(ieo))
  enddo
  return
end function
Function :
a :real(SP)
y :type(s_wqf_obj), intent(in)
 a = |y|^2

[Source]

function abs2_swqf(y) result(a)
!
!  a = |y|^2
!
  implicit none
  type(s_wqf_obj), intent(in) :: y
  real(SP) :: a
  integer :: ieo
  a = 0.0_SP
  do ieo=0,1
    a = a + abs2(y%eo(ieo))
  enddo
  return
end function
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
qe :type(s_wqf_eo_blk_obj), intent(in)
 pe = pe + qe

[Source]

subroutine accum_add_swqf_blk(pe,qe)
!
!  pe = pe + qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  integer :: ibx,iby,ibz,ics,ithz,itht
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_add_swqf_blk pe/=qe.")
  endif
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL*2
      do ithz=1,NTHZ
      do itht=1,NTHT
          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w
      enddo
      enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
qe :type(s_wqf_eo_blk_obj), intent(in)
 pe = pe + qe

[Source]

subroutine accum_add_swqf_blk(pe,qe)
!
!  pe = pe + qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  integer :: ibx,iby,ibz,ics,ithz,itht
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_add_swqf_blk pe/=qe.")
  endif
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL*2
      do ithz=1,NTHZ
      do itht=1,NTHT
          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w
      enddo
      enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
qe :type(s_wqf_eo_obj), intent(in)
 pe = pe + qe

[Source]

subroutine accum_add_swqf_eo(pe,qe)
!
!  pe = pe + qe
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: pe
  type(s_wqf_eo_obj), intent(in)    :: qe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_add(pe%g(igx),qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
qe :type(s_wqf_eo_obj), intent(in)
 pe = pe + qe

[Source]

subroutine accum_add_swqf_eo(pe,qe)
!
!  pe = pe + qe
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: pe
  type(s_wqf_eo_obj), intent(in)    :: qe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_add(pe%g(igx),qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
ccoef :complex(SP), intent(in)
qe :type(s_wqf_eo_blk_obj), intent(in)

pe = pe + ccoef * qe

[Source]

subroutine accum_add_cmult_swqf_blk(pe,ccoef,qe)
!
! pe = pe + ccoef * qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  complex(SP),            intent(in)    :: ccoef
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  real(SP) :: cr,ci
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_add_cmult_swqf_blk pe/=qe.")
  endif
  cr =  real(ccoef)
  ci = aimag(ccoef)
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL
    jcs=ics+COL
    do ithz=1,NTHZ
    do itht=1,NTHT
        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * ci

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * ci

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * ci

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * ci

        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * ci

        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * ci

        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * ci

        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * ci
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
ccoef :complex(SP), intent(in)
qe :type(s_wqf_eo_blk_obj), intent(in)

pe = pe + ccoef * qe

[Source]

subroutine accum_add_cmult_swqf_blk(pe,ccoef,qe)
!
! pe = pe + ccoef * qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  complex(SP),            intent(in)    :: ccoef
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  real(SP) :: cr,ci
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_add_cmult_swqf_blk pe/=qe.")
  endif
  cr =  real(ccoef)
  ci = aimag(ccoef)
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL
    jcs=ics+COL
    do ithz=1,NTHZ
    do itht=1,NTHT
        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * ci

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * ci

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * ci

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * ci

        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * ci

        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * ci

        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * ci

        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * ci
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
ccoef :complex(SP), intent(in)
qe :type(s_wqf_eo_obj), intent(in)

pe = pe + ccoef * qe

[Source]

subroutine accum_add_cmult_swqf_eo(pe,ccoef,qe)
!
! pe = pe + ccoef * qe
!
  implicit none
  type(s_wqf_eo_obj), intent(in)    :: qe
  complex(SP),        intent(in)    :: ccoef
  type(s_wqf_eo_obj), intent(inout) :: pe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_add_mult(pe%g(igx),ccoef,qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
ccoef :complex(SP), intent(in)
qe :type(s_wqf_eo_obj), intent(in)

pe = pe + ccoef * qe

[Source]

subroutine accum_add_cmult_swqf_eo(pe,ccoef,qe)
!
! pe = pe + ccoef * qe
!
  implicit none
  type(s_wqf_eo_obj), intent(in)    :: qe
  complex(SP),        intent(in)    :: ccoef
  type(s_wqf_eo_obj), intent(inout) :: pe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_add_mult(pe%g(igx),ccoef,qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
rcoef :real(SP), intent(in)
qe :type(s_wqf_eo_blk_obj), intent(in)

pe = pe + rcoef * qe

[Source]

subroutine accum_add_rmult_swqf_blk(pe,rcoef,qe)
!
! pe = pe + rcoef * qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  real(SP),               intent(in)    :: rcoef
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_add_rmult_swqf_blk pe/=qe.")
  endif
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL*2
    do ithz=1,NTHZ
    do itht=1,NTHT
        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * rcoef

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * rcoef

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * rcoef

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * rcoef
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
rcoef :real(SP), intent(in)
qe :type(s_wqf_eo_blk_obj), intent(in)

pe = pe + rcoef * qe

[Source]

subroutine accum_add_rmult_swqf_blk(pe,rcoef,qe)
!
! pe = pe + rcoef * qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  real(SP),               intent(in)    :: rcoef
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_add_rmult_swqf_blk pe/=qe.")
  endif
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL*2
    do ithz=1,NTHZ
    do itht=1,NTHT
        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * rcoef

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * rcoef

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * rcoef

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * rcoef
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
rcoef :real(SP), intent(in)
qe :type(s_wqf_eo_obj), intent(in)

pe = pe + rcoef * qe

[Source]

subroutine accum_add_rmult_swqf_eo(pe,rcoef,qe)
!
! pe = pe + rcoef * qe
!
  implicit none
  type(s_wqf_eo_obj), intent(in)    :: qe
  real(SP),           intent(in)    :: rcoef
  type(s_wqf_eo_obj), intent(inout) :: pe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_add_mult(pe%g(igx),rcoef,qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
rcoef :real(SP), intent(in)
qe :type(s_wqf_eo_obj), intent(in)

pe = pe + rcoef * qe

[Source]

subroutine accum_add_rmult_swqf_eo(pe,rcoef,qe)
!
! pe = pe + rcoef * qe
!
  implicit none
  type(s_wqf_eo_obj), intent(in)    :: qe
  real(SP),           intent(in)    :: rcoef
  type(s_wqf_eo_obj), intent(inout) :: pe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_add_mult(pe%g(igx),rcoef,qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
ccoef :complex(SP), intent(in)
qe :type(s_wqf_eo_blk_obj), intent(in)

pe = pe * ccoef + qe

[Source]

subroutine accum_cmult_add_swqf_blk(pe,ccoef,qe)
!
! pe = pe * ccoef + qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  complex(SP),            intent(in)    :: ccoef
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  type(myfloat4) :: pp(COL*2)
  real(SP) :: cr,ci
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_cmult_add_swqf_blk pe/=qe.")
  endif
  cr =  real(ccoef)
  ci = aimag(ccoef)
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ithz=1,NTHZ
    do itht=1,NTHT
      do ics=1,COL
        jcs=ics+COL
        pp(ics)%x = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * ci
        pp(ics)%y = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * ci
        pp(ics)%z = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * ci
        pp(ics)%w = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * ci

        pp(jcs)%x = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * ci
        pp(jcs)%y = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * ci
        pp(jcs)%z = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * ci
        pp(jcs)%w = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * ci

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = pp(ics)
        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz) = pp(jcs)
      enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
ccoef :complex(SP), intent(in)
qe :type(s_wqf_eo_blk_obj), intent(in)

pe = pe * ccoef + qe

[Source]

subroutine accum_cmult_add_swqf_blk(pe,ccoef,qe)
!
! pe = pe * ccoef + qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  complex(SP),            intent(in)    :: ccoef
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  type(myfloat4) :: pp(COL*2)
  real(SP) :: cr,ci
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_cmult_add_swqf_blk pe/=qe.")
  endif
  cr =  real(ccoef)
  ci = aimag(ccoef)
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ithz=1,NTHZ
    do itht=1,NTHT
      do ics=1,COL
        jcs=ics+COL
        pp(ics)%x = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * ci
        pp(ics)%y = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * ci
        pp(ics)%z = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * ci
        pp(ics)%w = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * ci

        pp(jcs)%x = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * ci
        pp(jcs)%y = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * ci
        pp(jcs)%z = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * ci
        pp(jcs)%w = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * ci

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = pp(ics)
        pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz) = pp(jcs)
      enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
ccoef :complex(SP), intent(in)
qe :type(s_wqf_eo_obj), intent(in)

pe = pe * ccoef + qe

[Source]

subroutine accum_cmult_add_swqf_eo(pe,ccoef,qe)
!
! pe = pe * ccoef + qe
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: pe
  complex(SP),        intent(in)    :: ccoef
  type(s_wqf_eo_obj), intent(in)    :: qe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_mult_add(pe%g(igx),ccoef,qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
ccoef :complex(SP), intent(in)
qe :type(s_wqf_eo_obj), intent(in)

pe = pe * ccoef + qe

[Source]

subroutine accum_cmult_add_swqf_eo(pe,ccoef,qe)
!
! pe = pe * ccoef + qe
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: pe
  complex(SP),        intent(in)    :: ccoef
  type(s_wqf_eo_obj), intent(in)    :: qe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_mult_add(pe%g(igx),ccoef,qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
rcoef :real(SP), intent(in)
qe :type(s_wqf_eo_blk_obj), intent(in)

pe = pe * rcoef + qe

[Source]

subroutine accum_rmult_add_swqf_blk(pe,rcoef,qe)
!
! pe = pe * rcoef + qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  real(SP),               intent(in)    :: rcoef
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  real(SP) :: cr,ci
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_rmult_add_swqf_blk pe/=qe.")
  endif
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ithz=1,NTHZ
    do itht=1,NTHT
      do ics=1,COL*2
        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w
      enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
rcoef :real(SP), intent(in)
qe :type(s_wqf_eo_blk_obj), intent(in)

pe = pe * rcoef + qe

[Source]

subroutine accum_rmult_add_swqf_blk(pe,rcoef,qe)
!
! pe = pe * rcoef + qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  real(SP),               intent(in)    :: rcoef
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  real(SP) :: cr,ci
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_rmult_add_swqf_blk pe/=qe.")
  endif
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ithz=1,NTHZ
    do itht=1,NTHT
      do ics=1,COL*2
        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z

        pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w
      enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
rcoef :real(SP), intent(in)
qe :type(s_wqf_eo_obj), intent(in)

pe = pe * rcoef + qe

[Source]

subroutine accum_rmult_add_swqf_eo(pe,rcoef,qe)
!
! pe = pe * rcoef + qe
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: pe
  real(SP),           intent(in)    :: rcoef
  type(s_wqf_eo_obj), intent(in)    :: qe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_mult_add(pe%g(igx),rcoef,qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
rcoef :real(SP), intent(in)
qe :type(s_wqf_eo_obj), intent(in)

pe = pe * rcoef + qe

[Source]

subroutine accum_rmult_add_swqf_eo(pe,rcoef,qe)
!
! pe = pe * rcoef + qe
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: pe
  real(SP),           intent(in)    :: rcoef
  type(s_wqf_eo_obj), intent(in)    :: qe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_mult_add(pe%g(igx),rcoef,qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
qe :type(s_wqf_eo_blk_obj), intent(in)
 pe = pe - qe

[Source]

subroutine accum_sub_swqf_blk(pe,qe)
!
!  pe = pe - qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  integer :: ibx,iby,ibz,ics,ithz,itht
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_sub_swqf_blk pe/=qe.")
  endif
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL*2
      do ithz=1,NTHZ
      do itht=1,NTHT
          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w
      enddo
      enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_blk_obj), intent(inout)
qe :type(s_wqf_eo_blk_obj), intent(in)
 pe = pe - qe

[Source]

subroutine accum_sub_swqf_blk(pe,qe)
!
!  pe = pe - qe
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: pe
  type(s_wqf_eo_blk_obj), intent(in)    :: qe
  integer :: ibx,iby,ibz,ics,ithz,itht
  if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then
    call error_stop("index (ieo,igx) error in accum_sub_swqf_blk pe/=qe.")
  endif
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL*2
      do ithz=1,NTHZ
      do itht=1,NTHT
          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z

          pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w
      enddo
      enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
qe :type(s_wqf_eo_obj), intent(in)
 pe = pe - qe

[Source]

subroutine accum_sub_swqf_eo(pe,qe)
!
!  pe = pe - qe
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: pe
  type(s_wqf_eo_obj), intent(in)    :: qe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_sub(pe%g(igx),qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
pe :type(s_wqf_eo_obj), intent(inout)
qe :type(s_wqf_eo_obj), intent(in)
 pe = pe - qe

[Source]

subroutine accum_sub_swqf_eo(pe,qe)
!
!  pe = pe - qe
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: pe
  type(s_wqf_eo_obj), intent(in)    :: qe
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call accum_sub(pe%g(igx),qe%g(igx))
  enddo
  return
end subroutine
Subroutine :
y2 :type(s_wqf_eo_blk_obj), intent(inout)
y1 :type(s_wqf_eo_blk_obj), intent(in)
  y2 <= y1

assign including extended sites.

[Source]

subroutine assign_swqf_blk(y2,y1)
!
!   y2 <= y1
!
! assign including extended sites.
!
  type(s_wqf_eo_blk_obj), intent(inout):: y2
  type(s_wqf_eo_blk_obj), intent(in)   :: y1
  if (y1%ieo /= y2%ieo .and. y1%igx /= y2%igx) then
    call error_stop("index (ieo,igx) error in assign_wqf_blk")
  endif
  y2 = y1
  return
end subroutine
Subroutine :
y2 :type(s_wqf_eo_blk_obj), intent(inout)
y1 :type(s_wqf_eo_blk_obj), intent(in)
  y2 <= y1

assign including extended sites.

[Source]

subroutine assign_swqf_blk(y2,y1)
!
!   y2 <= y1
!
! assign including extended sites.
!
  type(s_wqf_eo_blk_obj), intent(inout):: y2
  type(s_wqf_eo_blk_obj), intent(in)   :: y1
  if (y1%ieo /= y2%ieo .and. y1%igx /= y2%igx) then
    call error_stop("index (ieo,igx) error in assign_wqf_blk")
  endif
  y2 = y1
  return
end subroutine
Subroutine :
y2 :type(s_wqf_eo_obj), intent(inout)
y1 :type(s_wqf_eo_obj), intent(in)
  y2 <= y1

[Source]

subroutine assign_swqf_eo(y2,y1)
!
!   y2 <= y1
!
  type(s_wqf_eo_obj), intent(inout):: y2
  type(s_wqf_eo_obj), intent(in)   :: y1
  integer :: igx
  if (y1%ieo /= y2%ieo) then
    call error_stop("index (ieo) error in assign_wqf_eo")
  endif
!$OMP PARALLEL DO
  do igx=1,NGX
    call assign(y2%g(igx),y1%g(igx))
  enddo
  return
end subroutine
Subroutine :
y2 :type(s_wqf_eo_obj), intent(inout)
y1 :type(s_wqf_eo_obj), intent(in)
  y2 <= y1

[Source]

subroutine assign_swqf_eo(y2,y1)
!
!   y2 <= y1
!
  type(s_wqf_eo_obj), intent(inout):: y2
  type(s_wqf_eo_obj), intent(in)   :: y1
  integer :: igx
  if (y1%ieo /= y2%ieo) then
    call error_stop("index (ieo) error in assign_wqf_eo")
  endif
!$OMP PARALLEL DO
  do igx=1,NGX
    call assign(y2%g(igx),y1%g(igx))
  enddo
  return
end subroutine
Subroutine :
y2 :type(s_wqf_obj), intent(inout)
y1 :type(s_wqf_obj), intent(in)
  y2 <= y1

[Source]

subroutine assign_swqf(y2,y1)
!
!   y2 <= y1
!
  type(s_wqf_obj), intent(inout):: y2
  type(s_wqf_obj), intent(in)   :: y1
  integer :: ieo
  do ieo=0,1
    call assign(y2%eo(ieo),y1%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
y2 :type(s_wqf_obj), intent(inout)
y1 :type(s_wqf_obj), intent(in)
  y2 <= y1

[Source]

subroutine assign_swqf(y2,y1)
!
!   y2 <= y1
!
  type(s_wqf_obj), intent(inout):: y2
  type(s_wqf_obj), intent(in)   :: y1
  integer :: ieo
  do ieo=0,1
    call assign(y2%eo(ieo),y1%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_eo_blk_obj), intent(inout)

y = 0

[Source]

subroutine clear_swqf_blk(y)
!
! y = 0
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: y
  integer :: ibx,iby,ibz,itht,ithz,ics
  type(myfloat4) :: Z0
  Z0%x=0.0_SP
  Z0%y=0.0_SP
  Z0%z=0.0_SP
  Z0%w=0.0_SP
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL*2
    do ithz=1,NTHZ
    do itht=1,NTHT
      y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0
      y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_eo_blk_obj), intent(inout)

y = 0

[Source]

subroutine clear_swqf_blk(y)
!
! y = 0
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: y
  integer :: ibx,iby,ibz,itht,ithz,ics
  type(myfloat4) :: Z0
  Z0%x=0.0_SP
  Z0%y=0.0_SP
  Z0%z=0.0_SP
  Z0%w=0.0_SP
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ics=1,COL*2
    do ithz=1,NTHZ
    do itht=1,NTHT
      y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0
      y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_eo_obj), intent(inout)

y = 0

[Source]

subroutine clear_swqf_eo(y)
!
! y = 0
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: y
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call clear(y%g(igx))
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_eo_obj), intent(inout)

y = 0

[Source]

subroutine clear_swqf_eo(y)
!
! y = 0
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: y
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call clear(y%g(igx))
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_obj), intent(inout)

y = 0

[Source]

subroutine clear_swqf(y)
!
! y = 0
!
  implicit none
  type(s_wqf_obj), intent(inout) :: y
  integer :: ieo
  do ieo=0,1
    call clear(y%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_obj), intent(inout)

y = 0

[Source]

subroutine clear_swqf(y)
!
! y = 0
!
  implicit none
  type(s_wqf_obj), intent(inout) :: y
  integer :: ieo
  do ieo=0,1
    call clear(y%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_eo_blk_obj), intent(inout)
  y = 0

[Source]

subroutine clear_swqf_blk_wg(y)
!
!   y = 0
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: y
  integer :: ibx,iby,ibz,itht,ithz,ics
  type(myfloat4) :: Z0
  Z0%x=0.0_SP
  Z0%y=0.0_SP
  Z0%z=0.0_SP
  Z0%w=0.0_SP
  do ibx=1-NDEPTH,NBX+NDEPTH
  do iby=1-NDEPTH,NBY+NDEPTH
  do ibz=1,NBZ
    do ics=1,COL*2
    do ithz=1,NTHZ
    do itht=1,NTHT
      y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0
      y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_eo_blk_obj), intent(inout)
  y = 0

[Source]

subroutine clear_swqf_blk_wg(y)
!
!   y = 0
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(inout) :: y
  integer :: ibx,iby,ibz,itht,ithz,ics
  type(myfloat4) :: Z0
  Z0%x=0.0_SP
  Z0%y=0.0_SP
  Z0%z=0.0_SP
  Z0%w=0.0_SP
  do ibx=1-NDEPTH,NBX+NDEPTH
  do iby=1-NDEPTH,NBY+NDEPTH
  do ibz=1,NBZ
    do ics=1,COL*2
    do ithz=1,NTHZ
    do itht=1,NTHT
      y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0
      y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_eo_obj), intent(inout)
  y = 0

[Source]

subroutine clear_swqf_eo_wg(y)
!
!   y = 0
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: y
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call clear_all(y%g(igx))
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_eo_obj), intent(inout)
  y = 0

[Source]

subroutine clear_swqf_eo_wg(y)
!
!   y = 0
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: y
  integer :: igx
!$OMP PARALLEL DO
  do igx=1,NGX
    call clear_all(y%g(igx))
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_obj), intent(inout)
  y = 0

[Source]

subroutine clear_swqf_wg(y)
!
!   y = 0
!
  implicit none
  type(s_wqf_obj), intent(inout) :: y
  integer :: ieo
  do ieo=0,1
    call clear_all(y%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
y :type(s_wqf_obj), intent(inout)
  y = 0

[Source]

subroutine clear_swqf_wg(y)
!
!   y = 0
!
  implicit none
  type(s_wqf_obj), intent(inout) :: y
  integer :: ieo
  do ieo=0,1
    call clear_all(y%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
sclv :type(s_clvf_eo_obj), intent(out)
dclv :type(field_clover_term_eo), intent(in)

[Source]

subroutine conv_clv_eo(sclv,dclv)
  use field_clover_class
  implicit none
  type(s_clvf_eo_obj),        intent(out) :: sclv
  type(field_clover_term_eo), intent(in)  :: dclv

  complex(DP) :: ztmp
  type(clvmat) :: cc
  integer :: itht,ithz,ibz,iby,ibx,igx,ics,itht0
  integer :: ix,iy,iz,ieoxyz,ieo

  ieo = dclv%ieo
  sclv%ieo = ieo
  sclv%ipeo = ipeo

!$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht0,ix,iy,iz,ieoxyz,ics,cc)
  do igx=1,NGX
    sclv%g(igx)%ipeo=ipeo
    sclv%g(igx)%ieo=ieo
    sclv%g(igx)%igx=igx
    do ibx=1,NBX
    ix = ibx + (igx-1)*NBX
    do iby=1,NBY
    do ibz=1,NBZ
      iy = iby
      do ithz=1,NTHZ
        iz = ithz + (ibz-1)*NTHZ
        ieoxyz=mod(ipeo+ieo+ix+iy+iz,2)
        do itht0=1,NTHT
          do ics=1,CLSPH
            cc%c1r(ics) =  REAL(dclv%l(ics,1,itht0,iz,iy,ix))
            cc%c1i(ics) = AIMAG(dclv%l(ics,1,itht0,iz,iy,ix))
            cc%c2r(ics) =  REAL(dclv%l(ics,2,itht0,iz,iy,ix))
            cc%c2i(ics) = AIMAG(dclv%l(ics,2,itht0,iz,iy,ix))
          enddo
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%x = cc%c1r( 1)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%y = cc%c1r( 2)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%z = cc%c1r( 3)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%w = cc%c1r( 4)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%x = cc%c1r( 5)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%y = cc%c1r( 6)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%z = cc%c1r( 7)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%w = cc%c1r( 8)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%x = cc%c1r( 9)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%y = cc%c1r(10)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%z = cc%c1r(11)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%w = cc%c1r(12)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%x = cc%c1r(13)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%y = cc%c1r(14)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%z = cc%c1r(15)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%w = cc%c1r(16)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%x = cc%c1r(17)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%y = cc%c1r(18)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%z = cc%c1r(19)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%w = cc%c1r(20)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%x = cc%c1r(21)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%y = cc%c1i( 1)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%z = cc%c1i( 2)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%w = cc%c1i( 3)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%x = cc%c1i( 4)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%y = cc%c1i( 5)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%z = cc%c1i( 6)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%w = cc%c1i( 7)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%x = cc%c1i( 8)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%y = cc%c1i( 9)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%z = cc%c1i(10)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%w = cc%c1i(11)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%x = cc%c1i(12)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%y = cc%c1i(13)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%z = cc%c1i(14)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%w = cc%c1i(15)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%x = cc%c1i(16)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%y = cc%c1i(17)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%z = cc%c1i(18)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%w = cc%c1i(19)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%x = cc%c1i(20)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%y = cc%c1i(21)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%z = cc%c2r( 1)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%w = cc%c2r( 2)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%x = cc%c2r( 3)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%y = cc%c2r( 4)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%z = cc%c2r( 5)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%w = cc%c2r( 6)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%x = cc%c2r( 7)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%y = cc%c2r( 8)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%z = cc%c2r( 9)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%w = cc%c2r(10)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%x = cc%c2r(11)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%y = cc%c2r(12)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%z = cc%c2r(13)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%w = cc%c2r(14)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%x = cc%c2r(15)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%y = cc%c2r(16)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%z = cc%c2r(17)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%w = cc%c2r(18)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%x = cc%c2r(19)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%y = cc%c2r(20)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%z = cc%c2r(21)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%w = cc%c2i( 1)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%x = cc%c2i( 2)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%y = cc%c2i( 3)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%z = cc%c2i( 4)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%w = cc%c2i( 5)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%x = cc%c2i( 6)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%y = cc%c2i( 7)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%z = cc%c2i( 8)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%w = cc%c2i( 9)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%x = cc%c2i(10)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%y = cc%c2i(11)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%z = cc%c2i(12)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%w = cc%c2i(13)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%x = cc%c2i(14)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%y = cc%c2i(15)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%z = cc%c2i(16)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%w = cc%c2i(17)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%x = cc%c2i(18)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%y = cc%c2i(19)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%z = cc%c2i(20)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%w = cc%c2i(21)
        enddo
      enddo
    enddo
    enddo
    enddo
  enddo
!$OMP END PARALLEL DO

  call copy_boundary(sclv)
  
  return
end subroutine
Subroutine :
sclv :type(s_clvf_eo_obj), intent(out)
dclv :type(field_clover_term_eo), intent(in)

[Source]

subroutine conv_clv_eo(sclv,dclv)
  use field_clover_class
  implicit none
  type(s_clvf_eo_obj),        intent(out) :: sclv
  type(field_clover_term_eo), intent(in)  :: dclv

  complex(DP) :: ztmp
  type(clvmat) :: cc
  integer :: itht,ithz,ibz,iby,ibx,igx,ics,itht0
  integer :: ix,iy,iz,ieoxyz,ieo

  ieo = dclv%ieo
  sclv%ieo = ieo
  sclv%ipeo = ipeo

!$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht0,ix,iy,iz,ieoxyz,ics,cc)
  do igx=1,NGX
    sclv%g(igx)%ipeo=ipeo
    sclv%g(igx)%ieo=ieo
    sclv%g(igx)%igx=igx
    do ibx=1,NBX
    ix = ibx + (igx-1)*NBX
    do iby=1,NBY
    do ibz=1,NBZ
      iy = iby
      do ithz=1,NTHZ
        iz = ithz + (ibz-1)*NTHZ
        ieoxyz=mod(ipeo+ieo+ix+iy+iz,2)
        do itht0=1,NTHT
          do ics=1,CLSPH
            cc%c1r(ics) =  REAL(dclv%l(ics,1,itht0,iz,iy,ix))
            cc%c1i(ics) = AIMAG(dclv%l(ics,1,itht0,iz,iy,ix))
            cc%c2r(ics) =  REAL(dclv%l(ics,2,itht0,iz,iy,ix))
            cc%c2i(ics) = AIMAG(dclv%l(ics,2,itht0,iz,iy,ix))
          enddo
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%x = cc%c1r( 1)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%y = cc%c1r( 2)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%z = cc%c1r( 3)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%w = cc%c1r( 4)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%x = cc%c1r( 5)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%y = cc%c1r( 6)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%z = cc%c1r( 7)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%w = cc%c1r( 8)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%x = cc%c1r( 9)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%y = cc%c1r(10)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%z = cc%c1r(11)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%w = cc%c1r(12)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%x = cc%c1r(13)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%y = cc%c1r(14)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%z = cc%c1r(15)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%w = cc%c1r(16)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%x = cc%c1r(17)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%y = cc%c1r(18)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%z = cc%c1r(19)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%w = cc%c1r(20)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%x = cc%c1r(21)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%y = cc%c1i( 1)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%z = cc%c1i( 2)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%w = cc%c1i( 3)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%x = cc%c1i( 4)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%y = cc%c1i( 5)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%z = cc%c1i( 6)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%w = cc%c1i( 7)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%x = cc%c1i( 8)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%y = cc%c1i( 9)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%z = cc%c1i(10)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%w = cc%c1i(11)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%x = cc%c1i(12)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%y = cc%c1i(13)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%z = cc%c1i(14)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%w = cc%c1i(15)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%x = cc%c1i(16)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%y = cc%c1i(17)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%z = cc%c1i(18)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%w = cc%c1i(19)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%x = cc%c1i(20)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%y = cc%c1i(21)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%z = cc%c2r( 1)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%w = cc%c2r( 2)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%x = cc%c2r( 3)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%y = cc%c2r( 4)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%z = cc%c2r( 5)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%w = cc%c2r( 6)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%x = cc%c2r( 7)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%y = cc%c2r( 8)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%z = cc%c2r( 9)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%w = cc%c2r(10)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%x = cc%c2r(11)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%y = cc%c2r(12)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%z = cc%c2r(13)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%w = cc%c2r(14)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%x = cc%c2r(15)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%y = cc%c2r(16)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%z = cc%c2r(17)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%w = cc%c2r(18)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%x = cc%c2r(19)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%y = cc%c2r(20)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%z = cc%c2r(21)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%w = cc%c2i( 1)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%x = cc%c2i( 2)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%y = cc%c2i( 3)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%z = cc%c2i( 4)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%w = cc%c2i( 5)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%x = cc%c2i( 6)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%y = cc%c2i( 7)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%z = cc%c2i( 8)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%w = cc%c2i( 9)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%x = cc%c2i(10)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%y = cc%c2i(11)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%z = cc%c2i(12)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%w = cc%c2i(13)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%x = cc%c2i(14)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%y = cc%c2i(15)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%z = cc%c2i(16)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%w = cc%c2i(17)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%x = cc%c2i(18)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%y = cc%c2i(19)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%z = cc%c2i(20)
          sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%w = cc%c2i(21)
        enddo
      enddo
    enddo
    enddo
    enddo
  enddo
!$OMP END PARALLEL DO

  call copy_boundary(sclv)
  
  return
end subroutine
Subroutine :
sclv :type(s_clvf_obj), intent(out)
dclv :type(field_clover_term), intent(in)

[Source]

subroutine conv_clv(sclv,dclv)
  use field_clover_class
  implicit none
  type(s_clvf_obj),        intent(out) :: sclv
  type(field_clover_term), intent(in)  :: dclv
  integer :: ieo
  do ieo=0,1
    call conv_clv_eo(sclv%eo(ieo),dclv%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
sclv :type(s_clvf_obj), intent(out)
dclv :type(field_clover_term), intent(in)

[Source]

subroutine conv_clv(sclv,dclv)
  use field_clover_class
  implicit none
  type(s_clvf_obj),        intent(out) :: sclv
  type(field_clover_term), intent(in)  :: dclv
  integer :: ieo
  do ieo=0,1
    call conv_clv_eo(sclv%eo(ieo),dclv%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
su :type(s_gvf_eo_obj), intent(out)
du :type(vfield_gluon_eo_wg), intent(in)

[Source]

subroutine conv_u_d2s_eo(su,du)
  use field_gauge_class
  implicit none
  type(s_gvf_eo_obj),       intent(out) :: su
  type(vfield_gluon_eo_wg), intent(in)  :: du

  type(su3mat) :: uu
  complex(DP) :: ztmp
  integer :: itht,ithz,ibz,iby,ibx,igx,ic,jc,mu,itht0
  integer :: ix,iy,iz,ieoxyz,ieo
  integer :: itx,ity,ipu
  character(len=256) :: str(0:NPU-1)

  ieo = du%ieo
  su%ieo = ieo
  su%ipeo = ipeo

!$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,jc,mu,ztmp,uu)
  do igx=1,NGX
    su%g(igx)%ipeo=ipeo
    su%g(igx)%ieo=ieo
    su%g(igx)%igx=igx
    do ibx=1,NBX
    ix = ibx + (igx-1)*NBX
    do iby=1,NBY
    do ibz=1,NBZ
      iy = iby
      do mu=1,NDIM
      do ithz=1,NTHZ
        iz = ithz + (ibz-1)*NTHZ
        ieoxyz=mod(ipeo+ieo+ix+iy+iz,2)
        do itht=1-ieoxyz,NTHT-ieoxyz
          itht0=itht+ieoxyz
          do jc=1,COL-1
          do ic=1,COL
            ztmp = du%mu(mu)%s(itht,iz,iy,ix)%u(ic,jc)
            uu%ur(ic,jc) =  REAL(ztmp)
            uu%ui(ic,jc) = AIMAG(ztmp)
          enddo
          enddo
          su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%x = uu%ur(1,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%y = uu%ur(2,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%z = uu%ur(3,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%w = uu%ur(1,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%x = uu%ur(2,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%y = uu%ur(3,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%z = uu%ui(1,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%w = uu%ui(2,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%x = uu%ui(3,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%y = uu%ui(1,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%z = uu%ui(2,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%w = uu%ui(3,2)
        enddo
      enddo
      enddo
    enddo
    enddo
    enddo
  enddo
!$OMP END PARALLEL DO

  call copy_boundary(su)

  return
end subroutine
Subroutine :
su :type(s_gvf_eo_obj), intent(out)
du :type(vfield_gluon_eo_wg), intent(in)

[Source]

subroutine conv_u_d2s_eo(su,du)
  use field_gauge_class
  implicit none
  type(s_gvf_eo_obj),       intent(out) :: su
  type(vfield_gluon_eo_wg), intent(in)  :: du

  type(su3mat) :: uu
  complex(DP) :: ztmp
  integer :: itht,ithz,ibz,iby,ibx,igx,ic,jc,mu,itht0
  integer :: ix,iy,iz,ieoxyz,ieo
  integer :: itx,ity,ipu
  character(len=256) :: str(0:NPU-1)

  ieo = du%ieo
  su%ieo = ieo
  su%ipeo = ipeo

!$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,jc,mu,ztmp,uu)
  do igx=1,NGX
    su%g(igx)%ipeo=ipeo
    su%g(igx)%ieo=ieo
    su%g(igx)%igx=igx
    do ibx=1,NBX
    ix = ibx + (igx-1)*NBX
    do iby=1,NBY
    do ibz=1,NBZ
      iy = iby
      do mu=1,NDIM
      do ithz=1,NTHZ
        iz = ithz + (ibz-1)*NTHZ
        ieoxyz=mod(ipeo+ieo+ix+iy+iz,2)
        do itht=1-ieoxyz,NTHT-ieoxyz
          itht0=itht+ieoxyz
          do jc=1,COL-1
          do ic=1,COL
            ztmp = du%mu(mu)%s(itht,iz,iy,ix)%u(ic,jc)
            uu%ur(ic,jc) =  REAL(ztmp)
            uu%ui(ic,jc) = AIMAG(ztmp)
          enddo
          enddo
          su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%x = uu%ur(1,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%y = uu%ur(2,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%z = uu%ur(3,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%w = uu%ur(1,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%x = uu%ur(2,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%y = uu%ur(3,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%z = uu%ui(1,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%w = uu%ui(2,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%x = uu%ui(3,1)
          su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%y = uu%ui(1,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%z = uu%ui(2,2)
          su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%w = uu%ui(3,2)
        enddo
      enddo
      enddo
    enddo
    enddo
    enddo
  enddo
!$OMP END PARALLEL DO

  call copy_boundary(su)

  return
end subroutine
Subroutine :
su :type(s_gvf_obj), intent(out)
du :type(vfield_gluon_wg), intent(in)

[Source]

subroutine conv_u_d2s(su,du)
  use field_gauge_class
  implicit none
  type(s_gvf_obj),       intent(out) :: su
  type(vfield_gluon_wg), intent(in)  :: du
  integer :: ieo
  do ieo=0,1
    call conv_u_d2s_eo(su%eo(ieo),du%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
su :type(s_gvf_obj), intent(out)
du :type(vfield_gluon_wg), intent(in)

[Source]

subroutine conv_u_d2s(su,du)
  use field_gauge_class
  implicit none
  type(s_gvf_obj),       intent(out) :: su
  type(vfield_gluon_wg), intent(in)  :: du
  integer :: ieo
  do ieo=0,1
    call conv_u_d2s_eo(su%eo(ieo),du%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
sclv :type(s_clvf_eo_obj), intent(inout)

[Source]

subroutine copy_boundary_sclv_eo(sclv)
  implicit none
  type(s_clvf_eo_obj), intent(inout) :: sclv
  integer :: ibz,iby,igx,ibx
  integer :: igx_dn,igx_up
  integer :: itht,ithz,ic,ibuff
  type(single_field_world) :: sp_lattice

  if (.not. m_is_initialized) call new(sp_lattice)

#ifndef _singlePU
  call comlib_barrier
#endif

  do igx=1,NGX
    igx_up=mod(igx-1+1+NGX,NGX)+1
    igx_dn=mod(igx-1-1+NGX,NGX)+1
    do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz)
    do iby=1,NBY
    do ibz=1,NBZ
      sclv%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = sclv%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx)
      sclv%g(igx)%blk(ibz,iby,   NBX+1+ibx) = sclv%g(igx_up)%blk(ibz,iby,           1+ibx)
    enddo
    enddo
    enddo
  enddo
  do igx=1,NGX
    do iby=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(ibx,ibz)
    do ibx=1-NDEPTH,NBX+NDEPTH
    do ibz=1,NBZ
      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = sclv%g(igx   )%blk(ibz,NBY-NDEPTH+1+iby,ibx)
      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx) = sclv%g(igx   )%blk(ibz,           1+iby,ibx)
    enddo
    enddo
    enddo
  enddo

#if _NDIMX != 1
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do ic=1,CLSPH
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (iby-1)*2*NTHT*NTHZ*CLSPH*NBZ + (ibx)*2*NTHT*NTHZ*CLSPH*NBZ*NBY

      clvf_buff(1)%buff_up(ibuff+1,1) = cmplx(sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%y)
      clvf_buff(1)%buff_up(ibuff+2,1) = cmplx(sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%w)

      clvf_buff(1)%buff_dn(ibuff+1,1) = cmplx(sclv%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%y)
      clvf_buff(1)%buff_dn(ibuff+2,1) = cmplx(sclv%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(clvf_buff(1)%id_sendup)
  call comlib_sendrecv(clvf_buff(1)%id_senddn)
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do ic=1,CLSPH
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (iby-1)*2*NTHT*NTHZ*CLSPH*NBZ + (ibx)*2*NTHT*NTHZ*CLSPH*NBZ*NBY

      sclv%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%x =  real(clvf_buff(1)%buff_dn(ibuff+1,2))
      sclv%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(1)%buff_dn(ibuff+1,2))
      sclv%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%z =  real(clvf_buff(1)%buff_dn(ibuff+2,2))
      sclv%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(1)%buff_dn(ibuff+2,2))

      sclv%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%x =  real(clvf_buff(1)%buff_up(ibuff+1,2))
      sclv%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(1)%buff_up(ibuff+1,2))
      sclv%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%z =  real(clvf_buff(1)%buff_up(ibuff+2,2))
      sclv%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(1)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#endif

#if _NDIMY != 1
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do ic=1,CLSPH
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (ibx-1+NDEPTH)*2*NTHT*NTHZ*CLSPH*NBZ + (igx-1)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH)*NGX

      clvf_buff(2)%buff_up(ibuff+1,1) = cmplx(sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%y)
      clvf_buff(2)%buff_up(ibuff+2,1) = cmplx(sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%w)

      clvf_buff(2)%buff_dn(ibuff+1,1) = cmplx(sclv%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%y)
      clvf_buff(2)%buff_dn(ibuff+2,1) = cmplx(sclv%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(clvf_buff(2)%id_sendup)
  call comlib_sendrecv(clvf_buff(2)%id_senddn)
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do ic=1,CLSPH
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (ibx-1+NDEPTH)*2*NTHT*NTHZ*CLSPH*NBZ + (igx-1)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH)*NGX

      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%x =  real(clvf_buff(2)%buff_dn(ibuff+1,2))
      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(2)%buff_dn(ibuff+1,2))
      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%z =  real(clvf_buff(2)%buff_dn(ibuff+2,2))
      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(2)%buff_dn(ibuff+2,2))

      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%x =  real(clvf_buff(2)%buff_up(ibuff+1,2))
      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(2)%buff_up(ibuff+1,2))
      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%z =  real(clvf_buff(2)%buff_up(ibuff+2,2))
      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(2)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
Subroutine :
sclv :type(s_clvf_eo_obj), intent(inout)

[Source]

subroutine copy_boundary_sclv_eo(sclv)
  implicit none
  type(s_clvf_eo_obj), intent(inout) :: sclv
  integer :: ibz,iby,igx,ibx
  integer :: igx_dn,igx_up
  integer :: itht,ithz,ic,ibuff
  type(single_field_world) :: sp_lattice

  if (.not. m_is_initialized) call new(sp_lattice)

#ifndef _singlePU
  call comlib_barrier
#endif

  do igx=1,NGX
    igx_up=mod(igx-1+1+NGX,NGX)+1
    igx_dn=mod(igx-1-1+NGX,NGX)+1
    do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz)
    do iby=1,NBY
    do ibz=1,NBZ
      sclv%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = sclv%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx)
      sclv%g(igx)%blk(ibz,iby,   NBX+1+ibx) = sclv%g(igx_up)%blk(ibz,iby,           1+ibx)
    enddo
    enddo
    enddo
  enddo
  do igx=1,NGX
    do iby=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(ibx,ibz)
    do ibx=1-NDEPTH,NBX+NDEPTH
    do ibz=1,NBZ
      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = sclv%g(igx   )%blk(ibz,NBY-NDEPTH+1+iby,ibx)
      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx) = sclv%g(igx   )%blk(ibz,           1+iby,ibx)
    enddo
    enddo
    enddo
  enddo

#if _NDIMX != 1
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do ic=1,CLSPH
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (iby-1)*2*NTHT*NTHZ*CLSPH*NBZ + (ibx)*2*NTHT*NTHZ*CLSPH*NBZ*NBY

      clvf_buff(1)%buff_up(ibuff+1,1) = cmplx(sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%y)
      clvf_buff(1)%buff_up(ibuff+2,1) = cmplx(sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%w)

      clvf_buff(1)%buff_dn(ibuff+1,1) = cmplx(sclv%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%y)
      clvf_buff(1)%buff_dn(ibuff+2,1) = cmplx(sclv%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(clvf_buff(1)%id_sendup)
  call comlib_sendrecv(clvf_buff(1)%id_senddn)
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do ic=1,CLSPH
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (iby-1)*2*NTHT*NTHZ*CLSPH*NBZ + (ibx)*2*NTHT*NTHZ*CLSPH*NBZ*NBY

      sclv%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%x =  real(clvf_buff(1)%buff_dn(ibuff+1,2))
      sclv%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(1)%buff_dn(ibuff+1,2))
      sclv%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%z =  real(clvf_buff(1)%buff_dn(ibuff+2,2))
      sclv%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(1)%buff_dn(ibuff+2,2))

      sclv%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%x =  real(clvf_buff(1)%buff_up(ibuff+1,2))
      sclv%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(1)%buff_up(ibuff+1,2))
      sclv%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%z =  real(clvf_buff(1)%buff_up(ibuff+2,2))
      sclv%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(1)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#endif

#if _NDIMY != 1
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do ic=1,CLSPH
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (ibx-1+NDEPTH)*2*NTHT*NTHZ*CLSPH*NBZ + (igx-1)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH)*NGX

      clvf_buff(2)%buff_up(ibuff+1,1) = cmplx(sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%y)
      clvf_buff(2)%buff_up(ibuff+2,1) = cmplx(sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%w)

      clvf_buff(2)%buff_dn(ibuff+1,1) = cmplx(sclv%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%y)
      clvf_buff(2)%buff_dn(ibuff+2,1) = cmplx(sclv%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(clvf_buff(2)%id_sendup)
  call comlib_sendrecv(clvf_buff(2)%id_senddn)
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do ic=1,CLSPH
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (ibx-1+NDEPTH)*2*NTHT*NTHZ*CLSPH*NBZ + (igx-1)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH)*NGX

      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%x =  real(clvf_buff(2)%buff_dn(ibuff+1,2))
      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(2)%buff_dn(ibuff+1,2))
      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%z =  real(clvf_buff(2)%buff_dn(ibuff+2,2))
      sclv%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(2)%buff_dn(ibuff+2,2))

      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%x =  real(clvf_buff(2)%buff_up(ibuff+1,2))
      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(2)%buff_up(ibuff+1,2))
      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%z =  real(clvf_buff(2)%buff_up(ibuff+2,2))
      sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(2)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
Subroutine :
sclv :type(s_clvf_obj), intent(inout)

[Source]

subroutine copy_boundary_sclv(sclv)
  implicit none
  type(s_clvf_obj), intent(inout) :: sclv
  integer :: ieo
  do ieo=0,1
    call copy_boundary(sclv%eo(ieo))
  enddo
end subroutine
Subroutine :
sclv :type(s_clvf_obj), intent(inout)

[Source]

subroutine copy_boundary_sclv(sclv)
  implicit none
  type(s_clvf_obj), intent(inout) :: sclv
  integer :: ieo
  do ieo=0,1
    call copy_boundary(sclv%eo(ieo))
  enddo
end subroutine
Subroutine :
sq :type(s_wqf_eo_obj), intent(inout)

[Source]

subroutine copy_boundary_sq_eo(sq)
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: sq
  integer :: ibx,ibz,iby,igx,idx
  integer :: igx_up
  integer :: igx_dn
  integer :: itht,ithz,ic,ibuff
  type(su3ferm) :: yy,ww
  type(single_field_world) :: sp_lattice

  if (.not. m_is_initialized) call new(sp_lattice)

#ifndef _singlePU
  call comlib_barrier
#endif

  do igx=1,NGX
    igx_up=mod(igx-1+1+NGX,NGX)+1
    igx_dn=mod(igx-1-1+NGX,NGX)+1
    do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz)
    do iby=1,NBY
    do ibz=1,NBZ
      sq%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = sq%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx)
      sq%g(igx)%blk(ibz,iby,   NBX+1+ibx) = sq%g(igx_up)%blk(ibz,iby,           1+ibx)
    enddo
    enddo
    enddo
  enddo
  do igx=1,NGX
    do iby=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(ibx,ibz)
    do ibx=1-NDEPTH,NBX+NDEPTH
    do ibz=1,NBZ
      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = sq%g(igx   )%blk(ibz,NBY-NDEPTH+1+iby,ibx)
      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx) = sq%g(igx   )%blk(ibz,           1+iby,ibx)
    enddo
    enddo
    enddo
  enddo

#if _NDIMX != 1
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do ic=1,CLSP/2
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (iby-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ +   (ibx)*2*NTHT*NTHZ*(CLSP/2)*NBZ*NBY

      wqf_buff(1)%buff_up(ibuff+1,1) = cmplx(sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%x, sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%y)
      wqf_buff(1)%buff_up(ibuff+2,1) = cmplx(sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%z, sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%w)

      wqf_buff(1)%buff_dn(ibuff+1,1) = cmplx(sq%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%x, sq%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%y)
      wqf_buff(1)%buff_dn(ibuff+2,1) = cmplx(sq%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%z, sq%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(wqf_buff(1)%id_sendup)
  call comlib_sendrecv(wqf_buff(1)%id_senddn)
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do ic=1,CLSP/2
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (iby-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ +   (ibx)*2*NTHT*NTHZ*(CLSP/2)*NBZ*NBY

      sq%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%x =  real(wqf_buff(1)%buff_dn(ibuff+1,2))
      sq%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(1)%buff_dn(ibuff+1,2))
      sq%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%z =  real(wqf_buff(1)%buff_dn(ibuff+2,2))
      sq%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(1)%buff_dn(ibuff+2,2))

      sq%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%x =  real(wqf_buff(1)%buff_up(ibuff+1,2))
      sq%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(1)%buff_up(ibuff+1,2))
      sq%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%z =  real(wqf_buff(1)%buff_up(ibuff+2,2))
      sq%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(1)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#endif

#if _NDIMY != 1
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do ic=1,CLSP/2
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (ibx-1+NDEPTH)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (igx-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH)*NGX

      wqf_buff(2)%buff_up(ibuff+1,1) = cmplx(sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%y)
      wqf_buff(2)%buff_up(ibuff+2,1) = cmplx(sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%w)

      wqf_buff(2)%buff_dn(ibuff+1,1) = cmplx(sq%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sq%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%y)
      wqf_buff(2)%buff_dn(ibuff+2,1) = cmplx(sq%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sq%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(wqf_buff(2)%id_sendup)
  call comlib_sendrecv(wqf_buff(2)%id_senddn)
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do ic=1,CLSP/2
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (ibx-1+NDEPTH)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (igx-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH)*NGX

      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%x =  real(wqf_buff(2)%buff_dn(ibuff+1,2))
      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(2)%buff_dn(ibuff+1,2))
      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%z =  real(wqf_buff(2)%buff_dn(ibuff+2,2))
      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(2)%buff_dn(ibuff+2,2))

      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%x =  real(wqf_buff(2)%buff_up(ibuff+1,2))
      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(2)%buff_up(ibuff+1,2))
      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%z =  real(wqf_buff(2)%buff_up(ibuff+2,2))
      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(2)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
Subroutine :
sq :type(s_wqf_eo_obj), intent(inout)

[Source]

subroutine copy_boundary_sq_eo(sq)
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: sq
  integer :: ibx,ibz,iby,igx,idx
  integer :: igx_up
  integer :: igx_dn
  integer :: itht,ithz,ic,ibuff
  type(su3ferm) :: yy,ww
  type(single_field_world) :: sp_lattice

  if (.not. m_is_initialized) call new(sp_lattice)

#ifndef _singlePU
  call comlib_barrier
#endif

  do igx=1,NGX
    igx_up=mod(igx-1+1+NGX,NGX)+1
    igx_dn=mod(igx-1-1+NGX,NGX)+1
    do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz)
    do iby=1,NBY
    do ibz=1,NBZ
      sq%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = sq%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx)
      sq%g(igx)%blk(ibz,iby,   NBX+1+ibx) = sq%g(igx_up)%blk(ibz,iby,           1+ibx)
    enddo
    enddo
    enddo
  enddo
  do igx=1,NGX
    do iby=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(ibx,ibz)
    do ibx=1-NDEPTH,NBX+NDEPTH
    do ibz=1,NBZ
      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = sq%g(igx   )%blk(ibz,NBY-NDEPTH+1+iby,ibx)
      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx) = sq%g(igx   )%blk(ibz,           1+iby,ibx)
    enddo
    enddo
    enddo
  enddo

#if _NDIMX != 1
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do ic=1,CLSP/2
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (iby-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ +   (ibx)*2*NTHT*NTHZ*(CLSP/2)*NBZ*NBY

      wqf_buff(1)%buff_up(ibuff+1,1) = cmplx(sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%x, sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%y)
      wqf_buff(1)%buff_up(ibuff+2,1) = cmplx(sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%z, sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%w)

      wqf_buff(1)%buff_dn(ibuff+1,1) = cmplx(sq%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%x, sq%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%y)
      wqf_buff(1)%buff_dn(ibuff+2,1) = cmplx(sq%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%z, sq%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(wqf_buff(1)%id_sendup)
  call comlib_sendrecv(wqf_buff(1)%id_senddn)
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do ic=1,CLSP/2
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (iby-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ +   (ibx)*2*NTHT*NTHZ*(CLSP/2)*NBZ*NBY

      sq%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%x =  real(wqf_buff(1)%buff_dn(ibuff+1,2))
      sq%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(1)%buff_dn(ibuff+1,2))
      sq%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%z =  real(wqf_buff(1)%buff_dn(ibuff+2,2))
      sq%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(1)%buff_dn(ibuff+2,2))

      sq%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%x =  real(wqf_buff(1)%buff_up(ibuff+1,2))
      sq%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(1)%buff_up(ibuff+1,2))
      sq%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%z =  real(wqf_buff(1)%buff_up(ibuff+2,2))
      sq%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(1)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#endif

#if _NDIMY != 1
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do ic=1,CLSP/2
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (ibx-1+NDEPTH)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (igx-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH)*NGX

      wqf_buff(2)%buff_up(ibuff+1,1) = cmplx(sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%y)
      wqf_buff(2)%buff_up(ibuff+2,1) = cmplx(sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%w)

      wqf_buff(2)%buff_dn(ibuff+1,1) = cmplx(sq%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sq%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%y)
      wqf_buff(2)%buff_dn(ibuff+2,1) = cmplx(sq%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sq%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(wqf_buff(2)%id_sendup)
  call comlib_sendrecv(wqf_buff(2)%id_senddn)
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do ic=1,CLSP/2
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (ibx-1+NDEPTH)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (igx-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH)*NGX

      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%x =  real(wqf_buff(2)%buff_dn(ibuff+1,2))
      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(2)%buff_dn(ibuff+1,2))
      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%z =  real(wqf_buff(2)%buff_dn(ibuff+2,2))
      sq%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(2)%buff_dn(ibuff+2,2))

      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%x =  real(wqf_buff(2)%buff_up(ibuff+1,2))
      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(2)%buff_up(ibuff+1,2))
      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%z =  real(wqf_buff(2)%buff_up(ibuff+2,2))
      sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(2)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
Subroutine :
sq :type(s_wqf_obj), intent(inout)

[Source]

subroutine copy_boundary_sq(sq)
  implicit none
  type(s_wqf_obj), intent(inout) :: sq
  integer :: ieo
  do ieo=0,1
    call copy_boundary(sq%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
sq :type(s_wqf_obj), intent(inout)

[Source]

subroutine copy_boundary_sq(sq)
  implicit none
  type(s_wqf_obj), intent(inout) :: sq
  integer :: ieo
  do ieo=0,1
    call copy_boundary(sq%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
su :type(s_gvf_eo_obj), intent(inout)

[Source]

subroutine copy_boundary_su_eo(su)
  implicit none
  type(s_gvf_eo_obj), intent(inout) :: su
  integer :: ibz,iby,igx,ibx
  integer :: igx_dn,igx_up
  integer :: itht,ithz,ic,mu,ibuff
  type(single_field_world) :: sp_lattice

  if (.not. m_is_initialized) call new(sp_lattice)

#ifndef _singlePU
  call comlib_barrier
#endif

  do igx=1,NGX
    igx_up=mod(igx-1+1+NGX,NGX)+1
    igx_dn=mod(igx-1-1+NGX,NGX)+1
    do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz)
    do iby=1,NBY
    do ibz=1,NBZ
      su%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = su%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx)
      su%g(igx)%blk(ibz,iby,   NBX+1+ibx) = su%g(igx_up)%blk(ibz,iby,           1+ibx)
    enddo
    enddo
    enddo
  enddo
  do igx=1,NGX
    do iby=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(ibx,ibz)
    do ibx=1-NDEPTH,NBX+NDEPTH
    do ibz=1,NBZ
      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = su%g(igx   )%blk(ibz,NBY-NDEPTH+1+iby,ibx)
      su%g(igx)%blk(ibz,   NBY+1+iby,ibx) = su%g(igx   )%blk(ibz,           1+iby,ibx)
    enddo
    enddo
    enddo
  enddo

#if _NDIMX != 1
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,mu,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do mu=1,NDIM
    do ic=1,COL
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (iby-1)*2*NTHT*NTHZ*COL*NDIM*NBZ +   (ibx)*2*NTHT*NTHZ*COL*NDIM*NBZ*NBY

      gvf_buff(1)%buff_up(ibuff+1,1) = cmplx(su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%y)
      gvf_buff(1)%buff_up(ibuff+2,1) = cmplx(su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%w)

      gvf_buff(1)%buff_dn(ibuff+1,1) = cmplx(su%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic,mu)%f(itht,ithz)%y)
      gvf_buff(1)%buff_dn(ibuff+2,1) = cmplx(su%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic,mu)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(gvf_buff(1)%id_sendup)
  call comlib_sendrecv(gvf_buff(1)%id_senddn)
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,mu,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do mu=1,NDIM
    do ic=1,COL
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (iby-1)*2*NTHT*NTHZ*COL*NDIM*NBZ +   (ibx)*2*NTHT*NTHZ*COL*NDIM*NBZ*NBY

      su%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%x =  real(gvf_buff(1)%buff_dn(ibuff+1,2))
      su%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(1)%buff_dn(ibuff+1,2))
      su%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%z =  real(gvf_buff(1)%buff_dn(ibuff+2,2))
      su%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(1)%buff_dn(ibuff+2,2))

      su%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%x =  real(gvf_buff(1)%buff_up(ibuff+1,2))
      su%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(1)%buff_up(ibuff+1,2))
      su%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%z =  real(gvf_buff(1)%buff_up(ibuff+2,2))
      su%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(1)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#endif

#if _NDIMY != 1
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,mu,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do mu=1,NDIM
    do ic=1,COL
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (ibx-1+NDEPTH)*2*NTHT*NTHZ*COL*NDIM*NBZ + (igx-1)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH) +   (iby)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH)*NGX

      gvf_buff(2)%buff_up(ibuff+1,1) = cmplx(su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y)
      gvf_buff(2)%buff_up(ibuff+2,1) = cmplx(su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w)

      gvf_buff(2)%buff_dn(ibuff+1,1) = cmplx(su%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y)
      gvf_buff(2)%buff_dn(ibuff+2,1) = cmplx(su%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(gvf_buff(2)%id_sendup)
  call comlib_sendrecv(gvf_buff(2)%id_senddn)
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,mu,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do mu=1,NDIM
    do ic=1,COL
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (ibx-1+NDEPTH)*2*NTHT*NTHZ*COL*NDIM*NBZ + (igx-1)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH) +   (iby)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH)*NGX

      su%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x =  real(gvf_buff(2)%buff_dn(ibuff+1,2))
      su%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(2)%buff_dn(ibuff+1,2))
      su%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z =  real(gvf_buff(2)%buff_dn(ibuff+2,2))
      su%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(2)%buff_dn(ibuff+2,2))

      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x =  real(gvf_buff(2)%buff_up(ibuff+1,2))
      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(2)%buff_up(ibuff+1,2))
      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z =  real(gvf_buff(2)%buff_up(ibuff+2,2))
      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(2)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
Subroutine :
su :type(s_gvf_eo_obj), intent(inout)

[Source]

subroutine copy_boundary_su_eo(su)
  implicit none
  type(s_gvf_eo_obj), intent(inout) :: su
  integer :: ibz,iby,igx,ibx
  integer :: igx_dn,igx_up
  integer :: itht,ithz,ic,mu,ibuff
  type(single_field_world) :: sp_lattice

  if (.not. m_is_initialized) call new(sp_lattice)

#ifndef _singlePU
  call comlib_barrier
#endif

  do igx=1,NGX
    igx_up=mod(igx-1+1+NGX,NGX)+1
    igx_dn=mod(igx-1-1+NGX,NGX)+1
    do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz)
    do iby=1,NBY
    do ibz=1,NBZ
      su%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = su%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx)
      su%g(igx)%blk(ibz,iby,   NBX+1+ibx) = su%g(igx_up)%blk(ibz,iby,           1+ibx)
    enddo
    enddo
    enddo
  enddo
  do igx=1,NGX
    do iby=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(ibx,ibz)
    do ibx=1-NDEPTH,NBX+NDEPTH
    do ibz=1,NBZ
      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = su%g(igx   )%blk(ibz,NBY-NDEPTH+1+iby,ibx)
      su%g(igx)%blk(ibz,   NBY+1+iby,ibx) = su%g(igx   )%blk(ibz,           1+iby,ibx)
    enddo
    enddo
    enddo
  enddo

#if _NDIMX != 1
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,mu,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do mu=1,NDIM
    do ic=1,COL
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (iby-1)*2*NTHT*NTHZ*COL*NDIM*NBZ +   (ibx)*2*NTHT*NTHZ*COL*NDIM*NBZ*NBY

      gvf_buff(1)%buff_up(ibuff+1,1) = cmplx(su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%y)
      gvf_buff(1)%buff_up(ibuff+2,1) = cmplx(su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%w)

      gvf_buff(1)%buff_dn(ibuff+1,1) = cmplx(su%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic,mu)%f(itht,ithz)%y)
      gvf_buff(1)%buff_dn(ibuff+2,1) = cmplx(su%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(  1)%blk(ibz,iby,           1+ibx)%thd(ic,mu)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(gvf_buff(1)%id_sendup)
  call comlib_sendrecv(gvf_buff(1)%id_senddn)
  ibuff=0
  do ibx=0,NDEPTH-1
!$OMP PARALLEL DO PRIVATE(iby,ibz,mu,ic,ithz,itht,ibuff)
  do iby=1,NBY
  do ibz=1,NBZ
    do mu=1,NDIM
    do ic=1,COL
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (iby-1)*2*NTHT*NTHZ*COL*NDIM*NBZ +   (ibx)*2*NTHT*NTHZ*COL*NDIM*NBZ*NBY

      su%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%x =  real(gvf_buff(1)%buff_dn(ibuff+1,2))
      su%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(1)%buff_dn(ibuff+1,2))
      su%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%z =  real(gvf_buff(1)%buff_dn(ibuff+2,2))
      su%g(NGX)%blk(ibz,iby,   NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(1)%buff_dn(ibuff+2,2))

      su%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%x =  real(gvf_buff(1)%buff_up(ibuff+1,2))
      su%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(1)%buff_up(ibuff+1,2))
      su%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%z =  real(gvf_buff(1)%buff_up(ibuff+2,2))
      su%g(  1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(1)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#endif

#if _NDIMY != 1
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,mu,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do mu=1,NDIM
    do ic=1,COL
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (ibx-1+NDEPTH)*2*NTHT*NTHZ*COL*NDIM*NBZ + (igx-1)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH) +   (iby)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH)*NGX

      gvf_buff(2)%buff_up(ibuff+1,1) = cmplx(su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y)
      gvf_buff(2)%buff_up(ibuff+2,1) = cmplx(su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w)

      gvf_buff(2)%buff_dn(ibuff+1,1) = cmplx(su%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y)
      gvf_buff(2)%buff_dn(ibuff+2,1) = cmplx(su%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(igx)%blk(ibz,           1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w)
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(gvf_buff(2)%id_sendup)
  call comlib_sendrecv(gvf_buff(2)%id_senddn)
  ibuff=0
  do iby=0,NDEPTH-1
  do igx=1,NGX
!$OMP PARALLEL DO PRIVATE(ibx,ibz,mu,ic,ithz,itht,ibuff)
  do ibx=1-NDEPTH,NBX+NDEPTH
  do ibz=1,NBZ
    do mu=1,NDIM
    do ic=1,COL
    do ithz=1,NTHZ
    do itht=1,NTHT
      ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (ibx-1+NDEPTH)*2*NTHT*NTHZ*COL*NDIM*NBZ + (igx-1)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH) +   (iby)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH)*NGX

      su%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x =  real(gvf_buff(2)%buff_dn(ibuff+1,2))
      su%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(2)%buff_dn(ibuff+1,2))
      su%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z =  real(gvf_buff(2)%buff_dn(ibuff+2,2))
      su%g(igx)%blk(ibz,   NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(2)%buff_dn(ibuff+2,2))

      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x =  real(gvf_buff(2)%buff_up(ibuff+1,2))
      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(2)%buff_up(ibuff+1,2))
      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z =  real(gvf_buff(2)%buff_up(ibuff+2,2))
      su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(2)%buff_up(ibuff+2,2))
!      ibuff=ibuff+2
    enddo
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
Subroutine :
su :type(s_gvf_obj), intent(inout)

[Source]

subroutine copy_boundary_su(su)
  implicit none
  type(s_gvf_obj), intent(inout) :: su
  integer :: ieo
  do ieo=0,1
    call copy_boundary(su%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
su :type(s_gvf_obj), intent(inout)

[Source]

subroutine copy_boundary_su(su)
  implicit none
  type(s_gvf_obj), intent(inout) :: su
  integer :: ieo
  do ieo=0,1
    call copy_boundary(su%eo(ieo))
  enddo
  return
end subroutine
Subroutine :
sclv :type(s_clvf_obj), intent(inout)

[Source]

subroutine new_sclv(sclv)
  implicit none
  type(s_clvf_obj), intent(inout) :: sclv
  integer :: ieo
  sclv%ipeo=ipeo
  do ieo=0,1
    call new(sclv%eo(ieo),ieo)
  enddo
  return
end subroutine
Subroutine :
sclv :type(s_clvf_obj), intent(inout)

[Source]

subroutine new_sclv(sclv)
  implicit none
  type(s_clvf_obj), intent(inout) :: sclv
  integer :: ieo
  sclv%ipeo=ipeo
  do ieo=0,1
    call new(sclv%eo(ieo),ieo)
  enddo
  return
end subroutine
Subroutine :
sclv :type(s_clvf_eo_obj), intent(inout)
ieo :integer, intent(in)

[Source]

subroutine new_sclv_eo(sclv,ieo)
  implicit none
  type(s_clvf_eo_obj), intent(inout) :: sclv
  integer, intent(in) :: ieo
  integer :: igx
  sclv%ieo=ieo
  sclv%ipeo=ipeo
  do igx=1,NGX
    sclv%g(igx)%ieo=ieo
    sclv%g(igx)%igx=igx
    sclv%g(igx)%ipeo=ipeo
  enddo
  return
end subroutine
Subroutine :
sclv :type(s_clvf_eo_obj), intent(inout)
ieo :integer, intent(in)

[Source]

subroutine new_sclv_eo(sclv,ieo)
  implicit none
  type(s_clvf_eo_obj), intent(inout) :: sclv
  integer, intent(in) :: ieo
  integer :: igx
  sclv%ieo=ieo
  sclv%ipeo=ipeo
  do igx=1,NGX
    sclv%g(igx)%ieo=ieo
    sclv%g(igx)%igx=igx
    sclv%g(igx)%ipeo=ipeo
  enddo
  return
end subroutine
Subroutine :
sq :type(s_wqf_obj), intent(inout)

[Source]

subroutine new_sq(sq)
  implicit none
  type(s_wqf_obj), intent(inout) :: sq
  integer :: ieo
  sq%ipeo = ipeo
  do ieo = 0,1
    call new(sq%eo(ieo),ieo)
  enddo
  return
end subroutine
Subroutine :
sq :type(s_wqf_obj), intent(inout)

[Source]

subroutine new_sq(sq)
  implicit none
  type(s_wqf_obj), intent(inout) :: sq
  integer :: ieo
  sq%ipeo = ipeo
  do ieo = 0,1
    call new(sq%eo(ieo),ieo)
  enddo
  return
end subroutine
Subroutine :
sq :type(s_wqf_eo_obj), intent(inout)
ieo :integer, intent(in)

[Source]

subroutine new_sq_eo(sq,ieo)
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: sq
  integer, intent(in) :: ieo
  integer :: igx
  sq%ieo=ieo
  sq%ipeo = ipeo
  do igx=1,NGX
    sq%g(igx)%ieo=ieo
    sq%g(igx)%igx=igx
    sq%g(igx)%ipeo=ipeo
  enddo
  return
end subroutine
Subroutine :
sq :type(s_wqf_eo_obj), intent(inout)
ieo :integer, intent(in)

[Source]

subroutine new_sq_eo(sq,ieo)
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: sq
  integer, intent(in) :: ieo
  integer :: igx
  sq%ieo=ieo
  sq%ipeo = ipeo
  do igx=1,NGX
    sq%g(igx)%ieo=ieo
    sq%g(igx)%igx=igx
    sq%g(igx)%ipeo=ipeo
  enddo
  return
end subroutine
Subroutine :
su :type(s_gvf_obj), intent(inout)

[Source]

subroutine new_su(su)
  implicit none
  type(s_gvf_obj), intent(inout) :: su
  integer :: ieo
  su%ipeo=ipeo
  do ieo=0,1
    call new(su%eo(ieo),ieo)
  enddo
  return
end subroutine
Subroutine :
su :type(s_gvf_obj), intent(inout)

[Source]

subroutine new_su(su)
  implicit none
  type(s_gvf_obj), intent(inout) :: su
  integer :: ieo
  su%ipeo=ipeo
  do ieo=0,1
    call new(su%eo(ieo),ieo)
  enddo
  return
end subroutine
Subroutine :
su :type(s_gvf_eo_obj), intent(inout)
ieo :integer, intent(in)

[Source]

subroutine new_su_eo(su,ieo)
  implicit none
  type(s_gvf_eo_obj), intent(inout) :: su
  integer, intent(in) :: ieo
  integer :: igx
  su%ieo=ieo
  su%ipeo=ipeo
  do igx=1,NGX
    su%g(igx)%ieo=ieo
    su%g(igx)%igx=igx
    su%g(igx)%ipeo=ipeo
  enddo
  return
end subroutine
Subroutine :
su :type(s_gvf_eo_obj), intent(inout)
ieo :integer, intent(in)

[Source]

subroutine new_su_eo(su,ieo)
  implicit none
  type(s_gvf_eo_obj), intent(inout) :: su
  integer, intent(in) :: ieo
  integer :: igx
  su%ieo=ieo
  su%ipeo=ipeo
  do igx=1,NGX
    su%g(igx)%ieo=ieo
    su%g(igx)%igx=igx
    su%g(igx)%ipeo=ipeo
  enddo
  return
end subroutine
Subroutine :
this :type(single_field_world), intent(inout)

[Source]

subroutine new_single_fields(this)
  use error_class
  implicit none
  type(single_field_world), intent(inout) :: this
  integer :: imu((NDIM-1)*2)
  integer :: mu
  type(lattice_world) :: lattice

  if (.not.is_initialized(lattice)) then
    call error_stop("Lattice is not initialized. stop.")
  endif

  if (m_is_initialized) return

  this%dummy = 1
  m_is_initialized = .false.

#ifndef _singlePU

  wqhf_buff(1)%size=    (CLSP/2)*NTHT*NTHZ*NBZ*NBY      ! half spin/single edge
  wqhf_buff(2)%size=    (CLSP/2)*NTHT*NTHZ*NBZ*NBX*NGX  ! half spin/single edge

   wqf_buff(1)%size=     CLSP   *NTHT*NTHZ*NBZ*NBY*NDEPTH
   wqf_buff(2)%size=     CLSP   *NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH
   gvf_buff(1)%size= COL*(COL-1)*NTHT*NTHZ*NBZ*NBY*NDEPTH*NDIM
   gvf_buff(2)%size= COL*(COL-1)*NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH*NDIM
#ifdef _CLOVER
  clvf_buff(1)%size= CLSPH*2    *NTHT*NTHZ*NBZ*NBY*NDEPTH
  clvf_buff(2)%size= CLSPH*2    *NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH
#endif

  do mu=1,NDIM-2
    allocate(wqhf_buff(mu)%buff_up(wqhf_buff(mu)%size,2))
    allocate(wqhf_buff(mu)%buff_dn(wqhf_buff(mu)%size,2))
    allocate( wqf_buff(mu)%buff_up( wqf_buff(mu)%size,2))
    allocate( wqf_buff(mu)%buff_dn( wqf_buff(mu)%size,2))
    allocate( gvf_buff(mu)%buff_up( gvf_buff(mu)%size,2))
    allocate( gvf_buff(mu)%buff_dn( gvf_buff(mu)%size,2))
#ifdef _CLOVER
    allocate(clvf_buff(mu)%buff_up(clvf_buff(mu)%size,2))
    allocate(clvf_buff(mu)%buff_dn(clvf_buff(mu)%size,2))
#endif
  enddo

  imu(1)=1
  imu(2)=2
  imu(3)=3
  imu(4)=1
  imu(5)=1
  imu(6)=2
  do mu=1,NDIM-2
    wqhf_buff(mu)%buff_up(:,:) = Z0
    wqhf_buff(mu)%buff_dn(:,:) = Z0
    call comlib_make2(wqhf_buff(mu)%id_sendup,nodeidup(imu(mu)), wqhf_buff(mu)%buff_up(:,1), wqhf_buff(mu)%buff_up(:,2),wqhf_buff(mu)%size)
    call comlib_make2(wqhf_buff(mu)%id_senddn,nodeiddn(imu(mu)), wqhf_buff(mu)%buff_dn(:,1), wqhf_buff(mu)%buff_dn(:,2),wqhf_buff(mu)%size)

    wqf_buff(mu)%buff_up(:,:) = Z0
    wqf_buff(mu)%buff_dn(:,:) = Z0
    call comlib_make2(wqf_buff(mu)%id_sendup,nodeidup(imu(mu)), wqf_buff(mu)%buff_up(:,1), wqf_buff(mu)%buff_up(:,2),wqf_buff(mu)%size)
    call comlib_make2(wqf_buff(mu)%id_senddn,nodeiddn(imu(mu)), wqf_buff(mu)%buff_dn(:,1), wqf_buff(mu)%buff_dn(:,2),wqf_buff(mu)%size)

    gvf_buff(mu)%buff_up(:,:) = Z0
    gvf_buff(mu)%buff_dn(:,:) = Z0
    call comlib_make2(gvf_buff(mu)%id_sendup,nodeidup(imu(mu)), gvf_buff(mu)%buff_up(:,1), gvf_buff(mu)%buff_up(:,2),gvf_buff(mu)%size)
    call comlib_make2(gvf_buff(mu)%id_senddn,nodeiddn(imu(mu)), gvf_buff(mu)%buff_dn(:,1), gvf_buff(mu)%buff_dn(:,2),gvf_buff(mu)%size)

#ifdef _CLOVER
    clvf_buff(mu)%buff_up(:,:) = Z0
    clvf_buff(mu)%buff_dn(:,:) = Z0
    call comlib_make2(clvf_buff(mu)%id_sendup,nodeidup(imu(mu)), clvf_buff(mu)%buff_up(:,1), clvf_buff(mu)%buff_up(:,2),clvf_buff(mu)%size)
    call comlib_make2(clvf_buff(mu)%id_senddn,nodeiddn(imu(mu)), clvf_buff(mu)%buff_dn(:,1), clvf_buff(mu)%buff_dn(:,2),clvf_buff(mu)%size)
#endif
  enddo
#endif

  m_is_initialized = .true.

  return
end subroutine
Subroutine :
this :type(single_field_world), intent(inout)

[Source]

subroutine new_single_fields(this)
  use error_class
  implicit none
  type(single_field_world), intent(inout) :: this
  integer :: imu((NDIM-1)*2)
  integer :: mu
  type(lattice_world) :: lattice

  if (.not.is_initialized(lattice)) then
    call error_stop("Lattice is not initialized. stop.")
  endif

  if (m_is_initialized) return

  this%dummy = 1
  m_is_initialized = .false.

#ifndef _singlePU

  wqhf_buff(1)%size=    (CLSP/2)*NTHT*NTHZ*NBZ*NBY      ! half spin/single edge
  wqhf_buff(2)%size=    (CLSP/2)*NTHT*NTHZ*NBZ*NBX*NGX  ! half spin/single edge

   wqf_buff(1)%size=     CLSP   *NTHT*NTHZ*NBZ*NBY*NDEPTH
   wqf_buff(2)%size=     CLSP   *NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH
   gvf_buff(1)%size= COL*(COL-1)*NTHT*NTHZ*NBZ*NBY*NDEPTH*NDIM
   gvf_buff(2)%size= COL*(COL-1)*NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH*NDIM
#ifdef _CLOVER
  clvf_buff(1)%size= CLSPH*2    *NTHT*NTHZ*NBZ*NBY*NDEPTH
  clvf_buff(2)%size= CLSPH*2    *NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH
#endif

  do mu=1,NDIM-2
    allocate(wqhf_buff(mu)%buff_up(wqhf_buff(mu)%size,2))
    allocate(wqhf_buff(mu)%buff_dn(wqhf_buff(mu)%size,2))
    allocate( wqf_buff(mu)%buff_up( wqf_buff(mu)%size,2))
    allocate( wqf_buff(mu)%buff_dn( wqf_buff(mu)%size,2))
    allocate( gvf_buff(mu)%buff_up( gvf_buff(mu)%size,2))
    allocate( gvf_buff(mu)%buff_dn( gvf_buff(mu)%size,2))
#ifdef _CLOVER
    allocate(clvf_buff(mu)%buff_up(clvf_buff(mu)%size,2))
    allocate(clvf_buff(mu)%buff_dn(clvf_buff(mu)%size,2))
#endif
  enddo

  imu(1)=1
  imu(2)=2
  imu(3)=3
  imu(4)=1
  imu(5)=1
  imu(6)=2
  do mu=1,NDIM-2
    wqhf_buff(mu)%buff_up(:,:) = Z0
    wqhf_buff(mu)%buff_dn(:,:) = Z0
    call comlib_make2(wqhf_buff(mu)%id_sendup,nodeidup(imu(mu)), wqhf_buff(mu)%buff_up(:,1), wqhf_buff(mu)%buff_up(:,2),wqhf_buff(mu)%size)
    call comlib_make2(wqhf_buff(mu)%id_senddn,nodeiddn(imu(mu)), wqhf_buff(mu)%buff_dn(:,1), wqhf_buff(mu)%buff_dn(:,2),wqhf_buff(mu)%size)

    wqf_buff(mu)%buff_up(:,:) = Z0
    wqf_buff(mu)%buff_dn(:,:) = Z0
    call comlib_make2(wqf_buff(mu)%id_sendup,nodeidup(imu(mu)), wqf_buff(mu)%buff_up(:,1), wqf_buff(mu)%buff_up(:,2),wqf_buff(mu)%size)
    call comlib_make2(wqf_buff(mu)%id_senddn,nodeiddn(imu(mu)), wqf_buff(mu)%buff_dn(:,1), wqf_buff(mu)%buff_dn(:,2),wqf_buff(mu)%size)

    gvf_buff(mu)%buff_up(:,:) = Z0
    gvf_buff(mu)%buff_dn(:,:) = Z0
    call comlib_make2(gvf_buff(mu)%id_sendup,nodeidup(imu(mu)), gvf_buff(mu)%buff_up(:,1), gvf_buff(mu)%buff_up(:,2),gvf_buff(mu)%size)
    call comlib_make2(gvf_buff(mu)%id_senddn,nodeiddn(imu(mu)), gvf_buff(mu)%buff_dn(:,1), gvf_buff(mu)%buff_dn(:,2),gvf_buff(mu)%size)

#ifdef _CLOVER
    clvf_buff(mu)%buff_up(:,:) = Z0
    clvf_buff(mu)%buff_dn(:,:) = Z0
    call comlib_make2(clvf_buff(mu)%id_sendup,nodeidup(imu(mu)), clvf_buff(mu)%buff_up(:,1), clvf_buff(mu)%buff_up(:,2),clvf_buff(mu)%size)
    call comlib_make2(clvf_buff(mu)%id_senddn,nodeiddn(imu(mu)), clvf_buff(mu)%buff_dn(:,1), clvf_buff(mu)%buff_dn(:,2),clvf_buff(mu)%size)
#endif
  enddo
#endif

  m_is_initialized = .true.

  return
end subroutine
Subroutine :
sq :type(s_wqf_eo_obj), intent(inout)
vec(:) :complex(DP), intent(inout)
norm :real(DP), intent(in)

vec <= sq * norm

[Source]

subroutine pack_s2d_eo(sq,vec,norm)
!
! vec <= sq * norm
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: sq
  complex(DP),        intent(inout) :: vec(:)
  real(DP),           intent(in)    :: norm
  type(su3ferm) :: yy
  integer :: igx,ibx,iby,ibz,ithz,itht,itht0
  integer :: ix,iy,iz,ieoxyz,ith,is,ic,isite,ieo

  ieo = sq%ieo

!$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,is,isite,yy)
  do igx=1,NGX
    do ibx=1,NBX
    ix = ibx + (igx-1)*NBX
    do iby=1,NBY
    do ibz=1,NBZ
      iy = iby
      do ithz=1,NTHZ
        iz = ithz + (ibz-1)*NTHZ
        ieoxyz=mod(ipeo+ieo+ix+iy+iz,2)
        do itht=1-ieoxyz,NTHT-ieoxyz
          itht0=itht+ieoxyz

          yy%yr(1,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%x
          yy%yr(2,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%y
          yy%yr(3,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%z
          yy%yr(1,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%w
          yy%yr(2,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%x
          yy%yr(3,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%y
          yy%yr(1,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%z
          yy%yr(2,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%w
          yy%yr(3,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%x
          yy%yr(1,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%y
          yy%yr(2,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%z
          yy%yr(3,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%w
          yy%yi(1,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%x
          yy%yi(2,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%y
          yy%yi(3,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%z
          yy%yi(1,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%w
          yy%yi(2,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%x
          yy%yi(3,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%y
          yy%yi(1,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%z
          yy%yi(2,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%w
          yy%yi(3,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%x
          yy%yi(1,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%y
          yy%yi(2,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%z
          yy%yi(3,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%w

          do is=1,SPIN
          do ic=1,COL
            isite = ic +    (is-1)*COL + (itht0-1)*CLSP +    (iz-1)*CLSP*NTH +    (iy-1)*CLSP*NTH*NZ +    (ix-1)*CLSP*NTH*NZ*NY

            vec(isite) = CMPLX(yy%yr(ic,is),yy%yi(ic,is),kind=KIND(DP))*norm
          enddo
          enddo

        enddo
      enddo
    enddo
    enddo
    enddo
  enddo

  return
end subroutine
Subroutine :
sq :type(s_wqf_eo_obj), intent(inout)
vec(:) :complex(DP), intent(inout)
norm :real(DP), intent(in)

vec <= sq * norm

[Source]

subroutine pack_s2d_eo(sq,vec,norm)
!
! vec <= sq * norm
!
  implicit none
  type(s_wqf_eo_obj), intent(inout) :: sq
  complex(DP),        intent(inout) :: vec(:)
  real(DP),           intent(in)    :: norm
  type(su3ferm) :: yy
  integer :: igx,ibx,iby,ibz,ithz,itht,itht0
  integer :: ix,iy,iz,ieoxyz,ith,is,ic,isite,ieo

  ieo = sq%ieo

!$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,is,isite,yy)
  do igx=1,NGX
    do ibx=1,NBX
    ix = ibx + (igx-1)*NBX
    do iby=1,NBY
    do ibz=1,NBZ
      iy = iby
      do ithz=1,NTHZ
        iz = ithz + (ibz-1)*NTHZ
        ieoxyz=mod(ipeo+ieo+ix+iy+iz,2)
        do itht=1-ieoxyz,NTHT-ieoxyz
          itht0=itht+ieoxyz

          yy%yr(1,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%x
          yy%yr(2,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%y
          yy%yr(3,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%z
          yy%yr(1,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%w
          yy%yr(2,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%x
          yy%yr(3,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%y
          yy%yr(1,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%z
          yy%yr(2,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%w
          yy%yr(3,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%x
          yy%yr(1,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%y
          yy%yr(2,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%z
          yy%yr(3,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%w
          yy%yi(1,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%x
          yy%yi(2,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%y
          yy%yi(3,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%z
          yy%yi(1,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%w
          yy%yi(2,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%x
          yy%yi(3,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%y
          yy%yi(1,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%z
          yy%yi(2,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%w
          yy%yi(3,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%x
          yy%yi(1,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%y
          yy%yi(2,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%z
          yy%yi(3,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%w

          do is=1,SPIN
          do ic=1,COL
            isite = ic +    (is-1)*COL + (itht0-1)*CLSP +    (iz-1)*CLSP*NTH +    (iy-1)*CLSP*NTH*NZ +    (ix-1)*CLSP*NTH*NZ*NY

            vec(isite) = CMPLX(yy%yr(ic,is),yy%yi(ic,is),kind=KIND(DP))*norm
          enddo
          enddo

        enddo
      enddo
    enddo
    enddo
    enddo
  enddo

  return
end subroutine
Function :
p :complex(SP)
y1 :type(s_wqf_eo_blk_obj), intent(in)
y2 :type(s_wqf_eo_blk_obj), intent(in)

p = <y1|y2>

[Source]

function prod_swqf_blk(y1,y2) result(p)
!
! p = <y1|y2>
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(in) :: y1,y2
  complex(SP) :: p
  real(SP) :: pr,pi
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (y1%ieo /= y2%ieo .or. y1%igx /= y2%igx) then
    call error_stop("index (ieo,igx) error in prod_swqf_blk.")
  endif
  pr=0.0_SP
   pi=0.0_SP
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ithz=1,NTHZ
      ix=ibx+(y1%igx-1)*NBX
      iy=iby
      iz=ithz+(ibz-1)*NTHZ
      ieoxyz=mod(ipeo+ix+iy+iz+y1%ieo,2)
      do ics=1,COL
      jcs=ics+COL
#ifdef _SF
      do itht=1+ieoxyz,NTHT
#else
      do itht=1,NTHT
#endif
          pr = pr + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w

          pi = pi + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w
      enddo
      enddo
    enddo
  enddo
  enddo
  enddo
  p = cmplx(pr,pi)
#ifndef _singlePU
  call comlib_sumcast(p)
#endif
  return
end function
Function :
p :complex(SP)
y1 :type(s_wqf_eo_blk_obj), intent(in)
y2 :type(s_wqf_eo_blk_obj), intent(in)

p = <y1|y2>

[Source]

function prod_swqf_blk(y1,y2) result(p)
!
! p = <y1|y2>
!
  implicit none
  type(s_wqf_eo_blk_obj), intent(in) :: y1,y2
  complex(SP) :: p
  real(SP) :: pr,pi
  integer :: ix,iy,iz,ieoxyz,ics,jcs
  integer :: ibx,iby,ibz,itht,ithz
  if (y1%ieo /= y2%ieo .or. y1%igx /= y2%igx) then
    call error_stop("index (ieo,igx) error in prod_swqf_blk.")
  endif
  pr=0.0_SP
   pi=0.0_SP
  do ibx=1,NBX
  do iby=1,NBY
  do ibz=1,NBZ
    do ithz=1,NTHZ
      ix=ibx+(y1%igx-1)*NBX
      iy=iby
      iz=ithz+(ibz-1)*NTHZ
      ieoxyz=mod(ipeo+ix+iy+iz+y1%ieo,2)
      do ics=1,COL
      jcs=ics+COL
#ifdef _SF
      do itht=1+ieoxyz,NTHT
#else
      do itht=1,NTHT
#endif
          pr = pr + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w

          pi = pi + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w
      enddo
      enddo
    enddo
  enddo
  enddo
  enddo
  p = cmplx(pr,pi)
#ifndef _singlePU
  call comlib_sumcast(p)
#endif
  return
end function
Function :
p :complex(SP)
y1 :type(s_wqf_eo_obj), intent(in)
y2 :type(s_wqf_eo_obj), intent(in)

p = <y1|y2>

[Source]

function prod_swqf_eo(y1,y2) result(p)
!
! p = <y1|y2>
!
  implicit none
  type(s_wqf_eo_obj), intent(in) :: y1,y2
  complex(SP) :: p
  integer :: igx
  p = (0.0_SP,0.0_SP)
!$OMP PARALLEL DO REDUCTION(+:p)
  do igx=1,NGX
    p = p + prod(y1%g(igx),y2%g(igx))
  enddo
  return
end function
Function :
p :complex(SP)
y1 :type(s_wqf_eo_obj), intent(in)
y2 :type(s_wqf_eo_obj), intent(in)

p = <y1|y2>

[Source]

function prod_swqf_eo(y1,y2) result(p)
!
! p = <y1|y2>
!
  implicit none
  type(s_wqf_eo_obj), intent(in) :: y1,y2
  complex(SP) :: p
  integer :: igx
  p = (0.0_SP,0.0_SP)
!$OMP PARALLEL DO REDUCTION(+:p)
  do igx=1,NGX
    p = p + prod(y1%g(igx),y2%g(igx))
  enddo
  return
end function
Function :
p :complex(SP)
y1 :type(s_wqf_obj), intent(in)
y2 :type(s_wqf_obj), intent(in)

p = <y1|y2>

[Source]

function prod_swqf(y1,y2) result(p)
!
! p = <y1|y2>
!
  implicit none
  type(s_wqf_obj), intent(in) :: y1,y2
  complex(SP) :: p
  integer :: ieo
  p = (0.0_SP,0.0_SP)
  do ieo=0,1
    p = p + prod(y1%eo(ieo),y2%eo(ieo))
  enddo
  return
end function
Function :
p :complex(SP)
y1 :type(s_wqf_obj), intent(in)
y2 :type(s_wqf_obj), intent(in)

p = <y1|y2>

[Source]

function prod_swqf(y1,y2) result(p)
!
! p = <y1|y2>
!
  implicit none
  type(s_wqf_obj), intent(in) :: y1,y2
  complex(SP) :: p
  integer :: ieo
  p = (0.0_SP,0.0_SP)
  do ieo=0,1
    p = p + prod(y1%eo(ieo),y2%eo(ieo))
  enddo
  return
end function
single_field_world
Derived Type :
dummy :integer
single_field_world
Derived Type :
dummy :integer
Subroutine :
vec(:) :complex(DP), intent(inout)
sq :type(s_wqf_eo_obj), intent(inout)
norm :real(DP), intent(out)

norm = |vec| sq <= vec/norm

[Source]

subroutine unpack_d2s_eo(vec,sq,norm)
!
! norm = |vec|
! sq <= vec/norm
!
  implicit none
  complex(DP),        intent(inout) :: vec(:)
  type(s_wqf_eo_obj), intent(inout) :: sq
  real(DP),           intent(out)   :: norm
  type(su3ferm) :: yy
  real(DP) :: rtmp
  complex(DP) :: ztmp
  integer :: igx,ibx,iby,ibz,ithz,itht,itht0
  integer :: ix,iy,iz,ieoxyz,ith,is,ic,isite,ieo

  ieo = sq%ieo

  norm = 0.0_DP
!$OMP PARALLEL DO PRIVATE(isite) REDUCTION(+:norm)
  do isite=1,SIZE(vec)
    norm = norm + REAL(vec(isite))**2 + AIMAG(vec(isite))**2
  enddo
#ifndef _singlePU
  call comlib_sumcast(norm)
#endif
  norm = SQRT(norm)
  rtmp = 1.0_DP/norm 

!$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,is,isite,yy,ztmp)
  do igx=1,NGX
    do ibx=1,NBX
    ix = ibx + (igx-1)*NBX
    do iby=1,NBY
    do ibz=1,NBZ
      iy = iby
      do ithz=1,NTHZ
        iz = ithz + (ibz-1)*NTHZ
        ieoxyz=mod(ipeo+ieo+ix+iy+iz,2)
        do itht=1-ieoxyz,NTHT-ieoxyz
          itht0=itht+ieoxyz

          do is=1,SPIN
          do ic=1,COL
            isite = ic +    (is-1)*COL + (itht0-1)*CLSP +    (iz-1)*CLSP*NTH +    (iy-1)*CLSP*NTH*NZ +    (ix-1)*CLSP*NTH*NZ*NY

            ztmp = vec(isite)*rtmp
            yy%yr(ic,is) =  REAL(ztmp)
            yy%yi(ic,is) = AIMAG(ztmp)
          enddo
          enddo

          sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%x = yy%yr(1,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%y = yy%yr(2,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%z = yy%yr(3,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%w = yy%yr(1,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%x = yy%yr(2,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%y = yy%yr(3,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%z = yy%yr(1,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%w = yy%yr(2,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%x = yy%yr(3,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%y = yy%yr(1,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%z = yy%yr(2,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%w = yy%yr(3,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%x = yy%yi(1,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%y = yy%yi(2,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%z = yy%yi(3,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%w = yy%yi(1,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%x = yy%yi(2,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%y = yy%yi(3,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%z = yy%yi(1,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%w = yy%yi(2,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%x = yy%yi(3,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%y = yy%yi(1,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%z = yy%yi(2,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%w = yy%yi(3,4)

        enddo
      enddo
    enddo
    enddo
    enddo
  enddo

  call copy_boundary(sq)

  return
end subroutine
Subroutine :
vec(:) :complex(DP), intent(inout)
sq :type(s_wqf_eo_obj), intent(inout)
norm :real(DP), intent(out)

norm = |vec| sq <= vec/norm

[Source]

subroutine unpack_d2s_eo(vec,sq,norm)
!
! norm = |vec|
! sq <= vec/norm
!
  implicit none
  complex(DP),        intent(inout) :: vec(:)
  type(s_wqf_eo_obj), intent(inout) :: sq
  real(DP),           intent(out)   :: norm
  type(su3ferm) :: yy
  real(DP) :: rtmp
  complex(DP) :: ztmp
  integer :: igx,ibx,iby,ibz,ithz,itht,itht0
  integer :: ix,iy,iz,ieoxyz,ith,is,ic,isite,ieo

  ieo = sq%ieo

  norm = 0.0_DP
!$OMP PARALLEL DO PRIVATE(isite) REDUCTION(+:norm)
  do isite=1,SIZE(vec)
    norm = norm + REAL(vec(isite))**2 + AIMAG(vec(isite))**2
  enddo
#ifndef _singlePU
  call comlib_sumcast(norm)
#endif
  norm = SQRT(norm)
  rtmp = 1.0_DP/norm 

!$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,is,isite,yy,ztmp)
  do igx=1,NGX
    do ibx=1,NBX
    ix = ibx + (igx-1)*NBX
    do iby=1,NBY
    do ibz=1,NBZ
      iy = iby
      do ithz=1,NTHZ
        iz = ithz + (ibz-1)*NTHZ
        ieoxyz=mod(ipeo+ieo+ix+iy+iz,2)
        do itht=1-ieoxyz,NTHT-ieoxyz
          itht0=itht+ieoxyz

          do is=1,SPIN
          do ic=1,COL
            isite = ic +    (is-1)*COL + (itht0-1)*CLSP +    (iz-1)*CLSP*NTH +    (iy-1)*CLSP*NTH*NZ +    (ix-1)*CLSP*NTH*NZ*NY

            ztmp = vec(isite)*rtmp
            yy%yr(ic,is) =  REAL(ztmp)
            yy%yi(ic,is) = AIMAG(ztmp)
          enddo
          enddo

          sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%x = yy%yr(1,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%y = yy%yr(2,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%z = yy%yr(3,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%w = yy%yr(1,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%x = yy%yr(2,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%y = yy%yr(3,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%z = yy%yr(1,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%w = yy%yr(2,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%x = yy%yr(3,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%y = yy%yr(1,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%z = yy%yr(2,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%w = yy%yr(3,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%x = yy%yi(1,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%y = yy%yi(2,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%z = yy%yi(3,1)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%w = yy%yi(1,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%x = yy%yi(2,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%y = yy%yi(3,2)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%z = yy%yi(1,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%w = yy%yi(2,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%x = yy%yi(3,3)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%y = yy%yi(1,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%z = yy%yi(2,4)
          sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%w = yy%yi(3,4)

        enddo
      enddo
    enddo
    enddo
    enddo
  enddo

  call copy_boundary(sq)

  return
end subroutine