Class field_5dfermion_class
In: OBSOLETES/PREPROC/field_5dfermion_class.F90
QuarkDwOvlpClass/field_5dfermion_class.F90
QuarkDwOvlpClass_v0.1/field_5dfermion_class.F90
comlib lattice_class counter_class flop_table_module error_class field_fermion_class field_gauge_class timer_class perfmon_class field_5dfermion_class dot/f_19.png

Defines 5D fermion fields

This will be used for 5D representation of overlap fermions

Version

$Id: field_5dfermion_class.F90,v 1.7 2011/06/13 12:04:00 ishikawa Exp $

Methods

NHSITE   NHSITE   NHSITE   NSITE   NSITE   NSITE   abs2   abs2   abs2   abs2   abs2   abs2   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   assign   assign   assign   assign   assign   assign   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_sub   assign_sub   assign_sub   clear   clear   clear   conv_f_dwg_wg   conv_f_dwg_wg   conv_f_dwg_wg   conv_wqf_to_dwqf   conv_wqf_to_dwqf   conv_wqf_to_dwqf   copy_boundary   copy_boundary   copy_boundary   copy_fq_time   copy_fq_time   copy_fq_time   copy_fq_time   copy_fq_time   delete   delete   delete   field_dw_quark_wg   field_dw_quark_wg   field_dw_quark_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wog   field_quark_eo_wog   field_quark_eo_wog   field_quark_eo_wog   field_quark_eo_wog   field_quark_wg   field_quark_wg   field_quark_wg   field_quark_wg   field_quark_wg   field_quark_wog   field_quark_wog   field_quark_wog   field_quark_wog   field_quark_wog   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   is_allocated   is_allocated   is_allocated   is_same_size   is_same_size   is_same_size   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_iter   mult_iter   mult_iter   mult_iter   mult_iter   new   new   new   pack   pack   pack   pack   pack   pack   prod   prod   prod   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   su3fv_spinor   su3fv_spinor   su3fv_spinor   su3fv_spinor   su3fv_spinor   unpack   unpack   unpack   unpack   unpack   unpack   vfield_dw_gluon_wg   vfield_dw_gluon_wg   vfield_dw_gluon_wg  

Included Modules

comlib lattice_class counter_class flop_table_module error_class field_fermion_class field_gauge_class timer_class perfmon_class

Public Instance methods

NHSITE
Constant :
NHSITE =COL*SPIN*NTH*NZ*NY*NX :integer, parameter
NHSITE
Constant :
NHSITE =COL*SPIN*NTH*NZ*NY*NX :integer, parameter
NHSITE
Constant :
NHSITE =COL*SPIN*NTH*NZ*NY*NX :integer, parameter
NSITE
Constant :
NSITE =COL*SPIN*NT*NZ*NY*NX :integer, parameter
NSITE
Constant :
NSITE =COL*SPIN*NT*NZ*NY*NX :integer, parameter
NSITE
Constant :
NSITE =COL*SPIN*NT*NZ*NY*NX :integer, parameter
Function :
my_abs2 :real(DP)
q :type(field_dw_quark_wg), intent(in)

abs2 = |q|^2

[Source]

function abs2_f_dwf_wg(q) result(my_abs2)
!
! \abs2 = |q|^2
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q
  real(DP) :: my_abs2
  integer :: iw,ix,iy,iz,it,ic,is,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-dim size of q is wrong in abs2_f_dwf_wg.")
  endif
  NS = q%NS
  my_abs2 = 0.0_DP
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,is,ic) REDUCTION(+:my_abs2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      my_abs2 = my_abs2 + real(q%s(iw,it,iz,iy,ix)%y(ic,is))**2 +aimag(q%s(iw,it,iz,iy,ix)%y(ic,is))**2
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(my_abs2)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*R_ADD_ABS2)
  return
end function
Function :
my_abs2 :real(DP)
q :type(field_dw_quark_wg), intent(in)

abs2 = |q|^2

[Source]

function abs2_f_dwf_wg(q) result(my_abs2)
!
! \abs2 = |q|^2
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q
  real(DP) :: my_abs2
  integer :: iw,ix,iy,iz,it,ic,is,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-dim size of q is wrong in abs2_f_dwf_wg.")
  endif
  NS = q%NS
  my_abs2 = 0.0_DP
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,is,ic) REDUCTION(+:my_abs2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      my_abs2 = my_abs2 + real(q%s(iw,it,iz,iy,ix)%y(ic,is))**2 +aimag(q%s(iw,it,iz,iy,ix)%y(ic,is))**2
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(my_abs2)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*R_ADD_ABS2)
  return
end function
Function :
my_abs2 :real(DP)
q :type(field_dw_quark_wg), intent(in)

abs2 = |q|^2

[Source]

function abs2_f_dwf_wg(q) result(my_abs2)
!
! \abs2 = |q|^2
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q
  real(DP) :: my_abs2
  integer :: iw,ix,iy,iz,it,ic,is,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-dim size of q is wrong in abs2_f_dwf_wg.")
  endif
  NS = q%NS
  my_abs2 = 0.0_DP
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,is,ic) REDUCTION(+:my_abs2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      my_abs2 = my_abs2 + real(q%s(iw,it,iz,iy,ix)%y(ic,is))**2 +aimag(q%s(iw,it,iz,iy,ix)%y(ic,is))**2
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(my_abs2)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*R_ADD_ABS2)
  return
end function
Function :
fabs2 :real(DP)
q :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

vector norm abs2

 q1^2

 on even/odd sites only.

[Source]

function abs2_eo(q,ieo) result(fabs2)
!
! vector norm abs2
!
!  q1^2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw,ic,is
  real(DP) :: fabs2

  NS = q%NS
  fabs2 = 0.0_DP
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is) REDUCTION(+:fabs2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      do is=1,SPIN
      do ic=1,COL
        fabs2 = fabs2 + REAL(q%s(iw,it,iz,iy,ix)%y(ic,is),kind=KIND(1.0_DP))**2 +AIMAG(q%s(iw,it,iz,iy,ix)%y(ic,is))**2
      enddo
      enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(fabs2)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*R_ADD_ABS2)
  return
end function
Function :
fabs2 :real(DP)
q :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

vector norm abs2

 q1^2

 on even/odd sites only.

[Source]

function abs2_eo(q,ieo) result(fabs2)
!
! vector norm abs2
!
!  q1^2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw,ic,is
  real(DP) :: fabs2

  NS = q%NS
  fabs2 = 0.0_DP
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is) REDUCTION(+:fabs2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      do is=1,SPIN
      do ic=1,COL
        fabs2 = fabs2 + REAL(q%s(iw,it,iz,iy,ix)%y(ic,is),kind=KIND(1.0_DP))**2 +AIMAG(q%s(iw,it,iz,iy,ix)%y(ic,is))**2
      enddo
      enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(fabs2)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*R_ADD_ABS2)
  return
end function
Function :
fabs2 :real(DP)
q :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

vector norm abs2

 q1^2

 on even/odd sites only.

[Source]

function abs2_eo(q,ieo) result(fabs2)
!
! vector norm abs2
!
!  q1^2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw,ic,is
  real(DP) :: fabs2

  NS = q%NS
  fabs2 = 0.0_DP
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is) REDUCTION(+:fabs2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      do is=1,SPIN
      do ic=1,COL
        fabs2 = fabs2 + REAL(q%s(iw,it,iz,iy,ix)%y(ic,is),kind=KIND(1.0_DP))**2 +AIMAG(q%s(iw,it,iz,iy,ix)%y(ic,is))**2
      enddo
      enddo
    enddo
    enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(fabs2)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*R_ADD_ABS2)
  return
end function
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)

q1 <= q1 + q2

[Source]

subroutine accum_add_f_dwf_wg(q1,q2)
!
! q1 <= q1 + q2
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q1)) .or. (.not.is_allocated(q2)) .or. (.not.is_same_size(q1,q2)) ) then
    call error_stop("5-Dim size of q1,q2 is wrong in accum_add_f_dwf_wg.")
  endif
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) +q2%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)

q1 <= q1 + q2

[Source]

subroutine accum_add_f_dwf_wg(q1,q2)
!
! q1 <= q1 + q2
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q1)) .or. (.not.is_allocated(q2)) .or. (.not.is_same_size(q1,q2)) ) then
    call error_stop("5-Dim size of q1,q2 is wrong in accum_add_f_dwf_wg.")
  endif
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) +q2%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)

q1 <= q1 + q2

[Source]

subroutine accum_add_f_dwf_wg(q1,q2)
!
! q1 <= q1 + q2
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q1)) .or. (.not.is_allocated(q2)) .or. (.not.is_same_size(q1,q2)) ) then
    call error_stop("5-Dim size of q1,q2 is wrong in accum_add_f_dwf_wg.")
  endif
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) +q2%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Accumulate addition

 q1 = q1 + q2

 on even/odd sites only.

[Source]

subroutine accum_add_eo(q1,q2,ieo)
!
! Accumulate addition
!
!  q1 = q1 + q2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) +q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Accumulate addition

 q1 = q1 + q2

 on even/odd sites only.

[Source]

subroutine accum_add_eo(q1,q2,ieo)
!
! Accumulate addition
!
!  q1 = q1 + q2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) +q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Accumulate addition

 q1 = q1 + q2

 on even/odd sites only.

[Source]

subroutine accum_add_eo(q1,q2,ieo)
!
! Accumulate addition
!
!  q1 = q1 + q2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) +q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
ccoef :complex(DP), intent(in)

q <= q * ccoef

[Source]

subroutine accum_cmult_f_dwf_wg(q,ccoef)
!
! q <= q * ccoef
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  complex(DP), intent(in) :: ccoef
  integer :: iw,ix,iy,iz,it,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-Dim size of q is wrong in accum_cmult_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = q%s(iw,it,iz,iy,ix)%y(:,:)*ccoef
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_TIMES_C)
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
ccoef :complex(DP), intent(in)

q <= q * ccoef

[Source]

subroutine accum_cmult_f_dwf_wg(q,ccoef)
!
! q <= q * ccoef
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  complex(DP), intent(in) :: ccoef
  integer :: iw,ix,iy,iz,it,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-Dim size of q is wrong in accum_cmult_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = q%s(iw,it,iz,iy,ix)%y(:,:)*ccoef
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_TIMES_C)
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
ccoef :complex(DP), intent(in)

q <= q * ccoef

[Source]

subroutine accum_cmult_f_dwf_wg(q,ccoef)
!
! q <= q * ccoef
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  complex(DP), intent(in) :: ccoef
  integer :: iw,ix,iy,iz,it,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-Dim size of q is wrong in accum_cmult_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = q%s(iw,it,iz,iy,ix)%y(:,:)*ccoef
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_TIMES_C)
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
rcoef :real(DP), intent(in)

q <= q * rcoef

[Source]

subroutine accum_rmult_f_dwf_wg(q,rcoef)
!
! q <= q * rcoef
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  real(DP), intent(in) :: rcoef
  integer :: iw,ix,iy,iz,it,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-Dim size of q is wrong in accum_rmult_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = q%s(iw,it,iz,iy,ix)%y(:,:)*rcoef
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,(NX*NY*NZ*NT*NS*COL*SPIN*R_TIMES_C))
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
rcoef :real(DP), intent(in)

q <= q * rcoef

[Source]

subroutine accum_rmult_f_dwf_wg(q,rcoef)
!
! q <= q * rcoef
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  real(DP), intent(in) :: rcoef
  integer :: iw,ix,iy,iz,it,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-Dim size of q is wrong in accum_rmult_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = q%s(iw,it,iz,iy,ix)%y(:,:)*rcoef
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,(NX*NY*NZ*NT*NS*COL*SPIN*R_TIMES_C))
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
rcoef :real(DP), intent(in)

q <= q * rcoef

[Source]

subroutine accum_rmult_f_dwf_wg(q,rcoef)
!
! q <= q * rcoef
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  real(DP), intent(in) :: rcoef
  integer :: iw,ix,iy,iz,it,NS
  if (.not.is_allocated(q)) then
    call error_stop("5-Dim size of q is wrong in accum_rmult_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = q%s(iw,it,iz,iy,ix)%y(:,:)*rcoef
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,(NX*NY*NZ*NT*NS*COL*SPIN*R_TIMES_C))
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
rtmp :real(DP), intent(in)
ieo :integer, intent(in)

accumulate multiplication

 q1 = q1 * rtmp

 on even/odd sites only.

[Source]

subroutine accum_mult_eo(q1,rtmp,ieo)
!
! accumulate multiplication
!
!  q1 = q1 * rtmp
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  real(DP), intent(in) :: rtmp
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:)*rtmp
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*R_TIMES_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
rtmp :real(DP), intent(in)
ieo :integer, intent(in)

accumulate multiplication

 q1 = q1 * rtmp

 on even/odd sites only.

[Source]

subroutine accum_mult_eo(q1,rtmp,ieo)
!
! accumulate multiplication
!
!  q1 = q1 * rtmp
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  real(DP), intent(in) :: rtmp
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:)*rtmp
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*R_TIMES_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
rtmp :real(DP), intent(in)
ieo :integer, intent(in)

accumulate multiplication

 q1 = q1 * rtmp

 on even/odd sites only.

[Source]

subroutine accum_mult_eo(q1,rtmp,ieo)
!
! accumulate multiplication
!
!  q1 = q1 * rtmp
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  real(DP), intent(in) :: rtmp
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:)*rtmp
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*R_TIMES_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)

q1 <= q1 - q2

[Source]

subroutine accum_sub_f_dwf_wg(q1,q2)
!
! q1 <= q1 - q2
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q1)) .or. (.not.is_allocated(q2)) .or. (.not.is_same_size(q1,q2)) ) then
    call error_stop("5-Dim size of q1,q2 is wrong in accum_sub_f_dwf_wg.")
  endif
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) -q2%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)

q1 <= q1 - q2

[Source]

subroutine accum_sub_f_dwf_wg(q1,q2)
!
! q1 <= q1 - q2
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q1)) .or. (.not.is_allocated(q2)) .or. (.not.is_same_size(q1,q2)) ) then
    call error_stop("5-Dim size of q1,q2 is wrong in accum_sub_f_dwf_wg.")
  endif
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) -q2%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)

q1 <= q1 - q2

[Source]

subroutine accum_sub_f_dwf_wg(q1,q2)
!
! q1 <= q1 - q2
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q1)) .or. (.not.is_allocated(q2)) .or. (.not.is_same_size(q1,q2)) ) then
    call error_stop("5-Dim size of q1,q2 is wrong in accum_sub_f_dwf_wg.")
  endif
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) -q2%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Accumulate subtraction

 q1 = q1 - q2

 on even/odd sites only.

[Source]

subroutine accum_sub_eo(q1,q2,ieo)
!
! Accumulate subtraction
!
!  q1 = q1 - q2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) -q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Accumulate subtraction

 q1 = q1 - q2

 on even/odd sites only.

[Source]

subroutine accum_sub_eo(q1,q2,ieo)
!
! Accumulate subtraction
!
!  q1 = q1 - q2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) -q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Accumulate subtraction

 q1 = q1 - q2

 on even/odd sites only.

[Source]

subroutine accum_sub_eo(q1,q2,ieo)
!
! Accumulate subtraction
!
!  q1 = q1 - q2
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q1%s(iw,it,iz,iy,ix)%y(:,:) -q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
p :type(field_dw_quark_wg), intent(in)

q <= p

[Source]

subroutine assign_f_dwf_wg(q,p)
!
! q <= p
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  type(field_dw_quark_wg), intent(in)    :: p
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q)) .or. (.not.is_allocated(p)) .or. (.not.is_same_size(q,p)) ) then
    call error_stop("5-dim size of q is wrong in assign_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = p%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
p :type(field_dw_quark_wg), intent(in)

q <= p

[Source]

subroutine assign_f_dwf_wg(q,p)
!
! q <= p
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  type(field_dw_quark_wg), intent(in)    :: p
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q)) .or. (.not.is_allocated(p)) .or. (.not.is_same_size(q,p)) ) then
    call error_stop("5-dim size of q is wrong in assign_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = p%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)
p :type(field_dw_quark_wg), intent(in)

q <= p

[Source]

subroutine assign_f_dwf_wg(q,p)
!
! q <= p
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  type(field_dw_quark_wg), intent(in)    :: p
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q)) .or. (.not.is_allocated(p)) .or. (.not.is_same_size(q,p)) ) then
    call error_stop("5-dim size of q is wrong in assign_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = p%s(iw,it,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Assign subtraction

 q1 = q2

 on even/odd sites only.

[Source]

subroutine assign_eo(q1,q2,ieo)
!
! Assign subtraction
!
!  q1 = q2 
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Assign subtraction

 q1 = q2

 on even/odd sites only.

[Source]

subroutine assign_eo(q1,q2,ieo)
!
! Assign subtraction
!
!  q1 = q2 
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Assign subtraction

 q1 = q2

 on even/odd sites only.

[Source]

subroutine assign_eo(q1,q2,ieo)
!
! Assign subtraction
!
!  q1 = q2 
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q2%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  return
end subroutine
assign_add( q3, q1, q2 )
Subroutine :
q3 :type(field_quark_wg), intent(inout)
q1 :type(field_quark_wg), intent(in)
q2 :type(field_quark_wg), intent(in)

q3 <= q1 + q2

Original external subprogram is field_fermion_class#assign_add

assign_add( q3, q1, q2 )
Subroutine :
q3 :type(field_quark_wg), intent(inout)
q1 :type(field_quark_wg), intent(in)
q2 :type(field_quark_wg), intent(in)

q3 <= q1 + q2

Original external subprogram is field_fermion_class#assign_add

assign_add( q3, q1, q2 )
Subroutine :
q3 :type(field_quark_wg), intent(inout)
q1 :type(field_quark_wg), intent(in)
q2 :type(field_quark_wg), intent(in)

q3 <= q1 + q2

Original external subprogram is field_fermion_class#assign_add

assign_add( q3, q1, q2 )
Subroutine :
q3 :type(field_quark_wg), intent(inout)
q1 :type(field_quark_wg), intent(in)
q2 :type(field_quark_wg), intent(in)

q3 <= q1 + q2

Original external subprogram is field_fermion_class#assign_add

assign_add( q3, q1, q2 )
Subroutine :
q3 :type(field_quark_wg), intent(inout)
q1 :type(field_quark_wg), intent(in)
q2 :type(field_quark_wg), intent(in)

q3 <= q1 + q2

Original external subprogram is field_fermion_class#assign_add

assign_add( q3e, q1e, q2e )
Subroutine :
q3e :type(field_quark_eo_wg), intent(inout)
q1e :type(field_quark_eo_wg), intent(in)
q2e :type(field_quark_eo_wg), intent(in)

q3e <= q1e + q2e

Original external subprogram is field_fermion_class#assign_add

assign_add( q3e, q1e, q2e )
Subroutine :
q3e :type(field_quark_eo_wg), intent(inout)
q1e :type(field_quark_eo_wg), intent(in)
q2e :type(field_quark_eo_wg), intent(in)

q3e <= q1e + q2e

Original external subprogram is field_fermion_class#assign_add

assign_add( q3e, q1e, q2e )
Subroutine :
q3e :type(field_quark_eo_wg), intent(inout)
q1e :type(field_quark_eo_wg), intent(in)
q2e :type(field_quark_eo_wg), intent(in)

q3e <= q1e + q2e

Original external subprogram is field_fermion_class#assign_add

assign_add( q3e, q1e, q2e )
Subroutine :
q3e :type(field_quark_eo_wg), intent(inout)
q1e :type(field_quark_eo_wg), intent(in)
q2e :type(field_quark_eo_wg), intent(in)

q3e <= q1e + q2e

Original external subprogram is field_fermion_class#assign_add

assign_add( q3e, q1e, q2e )
Subroutine :
q3e :type(field_quark_eo_wg), intent(inout)
q1e :type(field_quark_eo_wg), intent(in)
q2e :type(field_quark_eo_wg), intent(in)

q3e <= q1e + q2e

Original external subprogram is field_fermion_class#assign_add

assign_add( u3e, u1e, u2e )
Subroutine :
u3e :type(sfield_gluon_eo_wg), intent(inout)
u1e :type(sfield_gluon_eo_wg), intent(in)
u2e :type(sfield_gluon_eo_wg), intent(in)

u3e <= u1e + u2e

Original external subprogram is field_gauge_class#assign_add

assign_add( u3e, u1e, u2e )
Subroutine :
u3e :type(sfield_gluon_eo_wg), intent(inout)
u1e :type(sfield_gluon_eo_wg), intent(in)
u2e :type(sfield_gluon_eo_wg), intent(in)

u3e <= u1e + u2e

Original external subprogram is field_gauge_class#assign_add

assign_add( u3e, u1e, u2e )
Subroutine :
u3e :type(sfield_gluon_eo_wg), intent(inout)
u1e :type(sfield_gluon_eo_wg), intent(in)
u2e :type(sfield_gluon_eo_wg), intent(in)

u3e <= u1e + u2e

Original external subprogram is field_gauge_class#assign_add

assign_add( u3e, u1e, u2e )
Subroutine :
u3e :type(sfield_gluon_eo_wg), intent(inout)
u1e :type(sfield_gluon_eo_wg), intent(in)
u2e :type(sfield_gluon_eo_wg), intent(in)

u3e <= u1e + u2e

Original external subprogram is field_gauge_class#assign_add

assign_add( u3e, u1e, u2e )
Subroutine :
u3e :type(sfield_gluon_eo_wg), intent(inout)
u1e :type(sfield_gluon_eo_wg), intent(in)
u2e :type(sfield_gluon_eo_wg), intent(in)

u3e <= u1e + u2e

Original external subprogram is field_gauge_class#assign_add

Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
q3 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Assign subtraction

 q1 = q2 - q3

 on even/odd sites only.

[Source]

subroutine assign_sub_eo(q1,q2,q3,ieo)
!
! Assign subtraction
!
!  q1 = q2 - q3
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  type(field_dw_quark_wg), intent(in)    :: q3
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q2%s(iw,it,iz,iy,ix)%y(:,:) -q3%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
q3 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Assign subtraction

 q1 = q2 - q3

 on even/odd sites only.

[Source]

subroutine assign_sub_eo(q1,q2,q3,ieo)
!
! Assign subtraction
!
!  q1 = q2 - q3
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  type(field_dw_quark_wg), intent(in)    :: q3
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q2%s(iw,it,iz,iy,ix)%y(:,:) -q3%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q1 :type(field_dw_quark_wg), intent(inout)
q2 :type(field_dw_quark_wg), intent(in)
q3 :type(field_dw_quark_wg), intent(in)
ieo :integer, intent(in)

Assign subtraction

 q1 = q2 - q3

 on even/odd sites only.

[Source]

subroutine assign_sub_eo(q1,q2,q3,ieo)
!
! Assign subtraction
!
!  q1 = q2 - q3
!
!  on even/odd sites only.
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q1
  type(field_dw_quark_wg), intent(in)    :: q2
  type(field_dw_quark_wg), intent(in)    :: q3
  integer, intent(in) :: ieo
  integer :: NS,ix,iy,iz,it,ieoxyz,ith,iw
  NS = q1%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
      q1%s(iw,it,iz,iy,ix)%y(:,:) = q2%s(iw,it,iz,iy,ix)%y(:,:) -q3%s(iw,it,iz,iy,ix)%y(:,:)
    enddo
    enddo
  enddo
  enddo
  enddo
  call inc(m_flop_counter,NX*NY*NZ*NTH*NS*COL*SPIN*C_ADD_C)
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

[Source]

subroutine clear_f_dwf_wg(q)
!
! q <= 0
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q))  ) then
    call error_stop("5-dim size of q is wrong in clear_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = Z0
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

[Source]

subroutine clear_f_dwf_wg(q)
!
! q <= 0
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q))  ) then
    call error_stop("5-dim size of q is wrong in clear_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = Z0
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

[Source]

subroutine clear_f_dwf_wg(q)
!
! q <= 0
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,NS
  if ( (.not.is_allocated(q))  ) then
    call error_stop("5-dim size of q is wrong in clear_f_dwf_wg.")
  endif
  NS = q%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    q%s(iw,it,iz,iy,ix)%y(:,:) = Z0
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
u :type(vfield_gluon_wg) , intent(in)
: even/odd site ordered gluon field
v :type(vfield_dw_gluon_wg), intent(out)
: normal site ordered gluon field

convert gauge field

u => v

[Source]

subroutine conv_f_dwg_wg(u,v)
!
! convert gauge field
!
! u => v
!
  implicit none
  type(vfield_gluon_wg) ,   intent(in)  :: u   ! even/odd site ordered gluon field
  type(vfield_dw_gluon_wg), intent(out) :: v   ! normal site ordered gluon field
  integer :: ix,iy,iz,it,itb,ieo,mu
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,itb,ieo,mu)
  do ix=0,NX1
  do iy=0,NY1
  do iz=0,NZ1
  do it=0,NT1
    ieo = mod(ipeo+it+iz+iy+ix,2)
    itb = it/2
    do mu=1,NDIM
      v%s(mu,it,iz,iy,ix) = u%eo(ieo)%mu(mu)%s(itb,iz,iy,ix)
    enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
u :type(vfield_gluon_wg) , intent(in)
: even/odd site ordered gluon field
v :type(vfield_dw_gluon_wg), intent(out)
: normal site ordered gluon field

convert gauge field

u => v

[Source]

subroutine conv_f_dwg_wg(u,v)
!
! convert gauge field
!
! u => v
!
  implicit none
  type(vfield_gluon_wg) ,   intent(in)  :: u   ! even/odd site ordered gluon field
  type(vfield_dw_gluon_wg), intent(out) :: v   ! normal site ordered gluon field
  integer :: ix,iy,iz,it,itb,ieo,mu
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,itb,ieo,mu)
  do ix=0,NX1
  do iy=0,NY1
  do iz=0,NZ1
  do it=0,NT1
    ieo = mod(ipeo+it+iz+iy+ix,2)
    itb = it/2
    do mu=1,NDIM
      v%s(mu,it,iz,iy,ix) = u%eo(ieo)%mu(mu)%s(itb,iz,iy,ix)
    enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
u :type(vfield_gluon_wg) , intent(in)
: even/odd site ordered gluon field
v :type(vfield_dw_gluon_wg), intent(out)
: normal site ordered gluon field

convert gauge field

u => v

[Source]

subroutine conv_f_dwg_wg(u,v)
!
! convert gauge field
!
! u => v
!
  implicit none
  type(vfield_gluon_wg) ,   intent(in)  :: u   ! even/odd site ordered gluon field
  type(vfield_dw_gluon_wg), intent(out) :: v   ! normal site ordered gluon field
  integer :: ix,iy,iz,it,itb,ieo,mu
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,itb,ieo,mu)
  do ix=0,NX1
  do iy=0,NY1
  do iz=0,NZ1
  do it=0,NT1
    ieo = mod(ipeo+it+iz+iy+ix,2)
    itb = it/2
    do mu=1,NDIM
      v%s(mu,it,iz,iy,ix) = u%eo(ieo)%mu(mu)%s(itb,iz,iy,ix)
    enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
s :type(field_quark_wg), intent(in)
w :type(field_dw_quark_wg), intent(inout)
iw :integer, intent(in)

[Source]

subroutine conv_wqf_to_dwqf(s,w,iw)
  implicit none
  type(field_quark_wg),    intent(in)    :: s
  type(field_dw_quark_wg), intent(inout) :: w
  integer,                 intent(in)    :: iw
  integer :: ix,iy,iz,it,ieo,ith,NEV,NS
  character(CHARLEN) :: str
  NS  = w%NS
  if (iw < 1 .or. NS < iw) then
    write(str,'(" in conv_wqf_to_dwqf@get_lowmode_sign_kernel. (w%NS=",I3," arg_index=",I3,")")') NS,iw
    call error_stop(TRIM(str))
  endif
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieo,ith)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
    ieo = mod(ipeo+it+iz+iy+ix,2)
    ith = it/2
    w%s(iw,it,iz,iy,ix)%y(:,:) = s%eo(ieo)%s(ith,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
s :type(field_quark_wg), intent(in)
w :type(field_dw_quark_wg), intent(inout)
iw :integer, intent(in)

[Source]

subroutine conv_wqf_to_dwqf(s,w,iw)
  implicit none
  type(field_quark_wg),    intent(in)    :: s
  type(field_dw_quark_wg), intent(inout) :: w
  integer,                 intent(in)    :: iw
  integer :: ix,iy,iz,it,ieo,ith,NEV,NS
  character(CHARLEN) :: str
  NS  = w%NS
  if (iw < 1 .or. NS < iw) then
    write(str,'(" in conv_wqf_to_dwqf@get_lowmode_sign_kernel. (w%NS=",I3," arg_index=",I3,")")') NS,iw
    call error_stop(TRIM(str))
  endif
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieo,ith)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
    ieo = mod(ipeo+it+iz+iy+ix,2)
    ith = it/2
    w%s(iw,it,iz,iy,ix)%y(:,:) = s%eo(ieo)%s(ith,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
s :type(field_quark_wg), intent(in)
w :type(field_dw_quark_wg), intent(inout)
iw :integer, intent(in)

[Source]

subroutine conv_wqf_to_dwqf(s,w,iw)
  implicit none
  type(field_quark_wg),    intent(in)    :: s
  type(field_dw_quark_wg), intent(inout) :: w
  integer,                 intent(in)    :: iw
  integer :: ix,iy,iz,it,ieo,ith,NEV,NS
  character(CHARLEN) :: str
  NS  = w%NS
  if (iw < 1 .or. NS < iw) then
    write(str,'(" in conv_wqf_to_dwqf@get_lowmode_sign_kernel. (w%NS=",I3," arg_index=",I3,")")') NS,iw
    call error_stop(TRIM(str))
  endif
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieo,ith)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
    ieo = mod(ipeo+it+iz+iy+ix,2)
    ith = it/2
    w%s(iw,it,iz,iy,ix)%y(:,:) = s%eo(ieo)%s(ith,iz,iy,ix)%y(:,:)
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

[Source]

subroutine copy_boundary_f_dwf_wg(q)
!
! \copy boundary
!
  use timer_class
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q

  type(fields_dw_fermion) :: fields
  integer :: iw,ix,iy,iz,it,ic,is,NS
  integer :: ibuff

  if (.not.is_allocated(q)) then
    call error_stop("5-dim size of q is wrong in copy_boundary_f_dwf_wg.")
  endif

  if (.not.m_is_initialized) call new_fields_dwf(fields)
  call tic(copy_fq_time)
#ifndef _singlePU
  call comlib_barrier
#endif

  NS = q%NS
!-------------------
! T-boundary
!-------------------
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do iw=1,NS
    q%s(iw,  0,iz,iy,ix) = q%s(iw,NT,iz,iy,ix)
    q%s(iw,NT1,iz,iy,ix) = q%s(iw, 1,iz,iy,ix)
  enddo
  enddo
  enddo
  enddo

!-------------------
! Z-boundary
!-------------------
#if _NDIMZ == 1
!$OMP PARALLEL DO PRIVATE(ix,iy,it,iw)
  do ix=1,NX
  do iy=1,NY
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,  0,iy,ix) = q%s(iw,it,NZ,iy,ix)
    q%s(iw,it,NZ1,iy,ix) = q%s(iw,it, 1,iy,ix)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(3),NS*FBUFF_SIZE(3))
  call set_edge(fbuffdn(3),NS*FBUFF_SIZE(3))
  ibuff = 0
  do ix=1,NX
  do iy=1,NY
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(3)%sbuff(ibuff) = q%s(iw,it,NZ,iy,ix)%y(ic,is)
      fbuffdn(3)%sbuff(ibuff) = q%s(iw,it, 1,iy,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(3)%id)
  call comlib_sendrecv(fbuffdn(3)%id)
  ibuff = 0
  do ix=1,NX
  do iy=1,NY
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,  0,iy,ix)%y(ic,is) = fbuffup(3)%rbuff(ibuff)
      q%s(iw,it,NZ1,iy,ix)%y(ic,is) = fbuffdn(3)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

!-------------------
! Y-boundary
!-------------------
#if _NDIMY == 1
!$OMP PARALLEL DO PRIVATE(ix,iz,it,iw)
  do ix=1,NX
  do iz=0,NZ1
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,iz,  0,ix) = q%s(iw,it,iz,NY,ix)
    q%s(iw,it,iz,NY1,ix) = q%s(iw,it,iz, 1,ix)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(2),NS*FBUFF_SIZE(2))
  call set_edge(fbuffdn(2),NS*FBUFF_SIZE(2))
  ibuff = 0
  do ix=1,NX
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(2)%sbuff(ibuff) = q%s(iw,it,iz,NY,ix)%y(ic,is)
      fbuffdn(2)%sbuff(ibuff) = q%s(iw,it,iz, 1,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(2)%id)
  call comlib_sendrecv(fbuffdn(2)%id)
  ibuff = 0
  do ix=1,NX
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,iz,  0,ix)%y(ic,is) = fbuffup(2)%rbuff(ibuff)
      q%s(iw,it,iz,NY1,ix)%y(ic,is) = fbuffdn(2)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

!-------------------
! X-boundary
!-------------------
#if _NDIMX == 1
!$OMP PARALLEL DO PRIVATE(iy,iz,it,iw)
  do iy=0,NY1
  do iz=0,NZ1
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,iz,iy,  0) = q%s(iw,it,iz,iy,NX)
    q%s(iw,it,iz,iy,NX1) = q%s(iw,it,iz,iy, 1)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(1),NS*FBUFF_SIZE(1))
  call set_edge(fbuffdn(1),NS*FBUFF_SIZE(1))
  ibuff = 0
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(1)%sbuff(ibuff) = q%s(iw,it,iz,iy,NX)%y(ic,is)
      fbuffdn(1)%sbuff(ibuff) = q%s(iw,it,iz,iy, 1)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(1)%id)
  call comlib_sendrecv(fbuffdn(1)%id)
  ibuff = 0
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,iz,iy,  0)%y(ic,is) = fbuffup(1)%rbuff(ibuff)
      q%s(iw,it,iz,iy,NX1)%y(ic,is) = fbuffdn(1)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

[Source]

subroutine copy_boundary_f_dwf_wg(q)
!
! \copy boundary
!
  use timer_class
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q

  type(fields_dw_fermion) :: fields
  integer :: iw,ix,iy,iz,it,ic,is,NS
  integer :: ibuff

  if (.not.is_allocated(q)) then
    call error_stop("5-dim size of q is wrong in copy_boundary_f_dwf_wg.")
  endif

  if (.not.m_is_initialized) call new_fields_dwf(fields)
  call tic(copy_fq_time)
#ifndef _singlePU
  call comlib_barrier
#endif

  NS = q%NS
!-------------------
! T-boundary
!-------------------
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do iw=1,NS
    q%s(iw,  0,iz,iy,ix) = q%s(iw,NT,iz,iy,ix)
    q%s(iw,NT1,iz,iy,ix) = q%s(iw, 1,iz,iy,ix)
  enddo
  enddo
  enddo
  enddo

!-------------------
! Z-boundary
!-------------------
#if _NDIMZ == 1
!$OMP PARALLEL DO PRIVATE(ix,iy,it,iw)
  do ix=1,NX
  do iy=1,NY
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,  0,iy,ix) = q%s(iw,it,NZ,iy,ix)
    q%s(iw,it,NZ1,iy,ix) = q%s(iw,it, 1,iy,ix)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(3),NS*FBUFF_SIZE(3))
  call set_edge(fbuffdn(3),NS*FBUFF_SIZE(3))
  ibuff = 0
  do ix=1,NX
  do iy=1,NY
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(3)%sbuff(ibuff) = q%s(iw,it,NZ,iy,ix)%y(ic,is)
      fbuffdn(3)%sbuff(ibuff) = q%s(iw,it, 1,iy,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(3)%id)
  call comlib_sendrecv(fbuffdn(3)%id)
  ibuff = 0
  do ix=1,NX
  do iy=1,NY
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,  0,iy,ix)%y(ic,is) = fbuffup(3)%rbuff(ibuff)
      q%s(iw,it,NZ1,iy,ix)%y(ic,is) = fbuffdn(3)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

!-------------------
! Y-boundary
!-------------------
#if _NDIMY == 1
!$OMP PARALLEL DO PRIVATE(ix,iz,it,iw)
  do ix=1,NX
  do iz=0,NZ1
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,iz,  0,ix) = q%s(iw,it,iz,NY,ix)
    q%s(iw,it,iz,NY1,ix) = q%s(iw,it,iz, 1,ix)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(2),NS*FBUFF_SIZE(2))
  call set_edge(fbuffdn(2),NS*FBUFF_SIZE(2))
  ibuff = 0
  do ix=1,NX
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(2)%sbuff(ibuff) = q%s(iw,it,iz,NY,ix)%y(ic,is)
      fbuffdn(2)%sbuff(ibuff) = q%s(iw,it,iz, 1,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(2)%id)
  call comlib_sendrecv(fbuffdn(2)%id)
  ibuff = 0
  do ix=1,NX
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,iz,  0,ix)%y(ic,is) = fbuffup(2)%rbuff(ibuff)
      q%s(iw,it,iz,NY1,ix)%y(ic,is) = fbuffdn(2)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

!-------------------
! X-boundary
!-------------------
#if _NDIMX == 1
!$OMP PARALLEL DO PRIVATE(iy,iz,it,iw)
  do iy=0,NY1
  do iz=0,NZ1
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,iz,iy,  0) = q%s(iw,it,iz,iy,NX)
    q%s(iw,it,iz,iy,NX1) = q%s(iw,it,iz,iy, 1)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(1),NS*FBUFF_SIZE(1))
  call set_edge(fbuffdn(1),NS*FBUFF_SIZE(1))
  ibuff = 0
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(1)%sbuff(ibuff) = q%s(iw,it,iz,iy,NX)%y(ic,is)
      fbuffdn(1)%sbuff(ibuff) = q%s(iw,it,iz,iy, 1)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(1)%id)
  call comlib_sendrecv(fbuffdn(1)%id)
  ibuff = 0
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,iz,iy,  0)%y(ic,is) = fbuffup(1)%rbuff(ibuff)
      q%s(iw,it,iz,iy,NX1)%y(ic,is) = fbuffdn(1)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

[Source]

subroutine copy_boundary_f_dwf_wg(q)
!
! \copy boundary
!
  use timer_class
  implicit none
  type(field_dw_quark_wg), intent(inout) :: q

  type(fields_dw_fermion) :: fields
  integer :: iw,ix,iy,iz,it,ic,is,NS
  integer :: ibuff

  if (.not.is_allocated(q)) then
    call error_stop("5-dim size of q is wrong in copy_boundary_f_dwf_wg.")
  endif

  if (.not.m_is_initialized) call new_fields_dwf(fields)
  call tic(copy_fq_time)
#ifndef _singlePU
  call comlib_barrier
#endif

  NS = q%NS
!-------------------
! T-boundary
!-------------------
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,iw)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do iw=1,NS
    q%s(iw,  0,iz,iy,ix) = q%s(iw,NT,iz,iy,ix)
    q%s(iw,NT1,iz,iy,ix) = q%s(iw, 1,iz,iy,ix)
  enddo
  enddo
  enddo
  enddo

!-------------------
! Z-boundary
!-------------------
#if _NDIMZ == 1
!$OMP PARALLEL DO PRIVATE(ix,iy,it,iw)
  do ix=1,NX
  do iy=1,NY
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,  0,iy,ix) = q%s(iw,it,NZ,iy,ix)
    q%s(iw,it,NZ1,iy,ix) = q%s(iw,it, 1,iy,ix)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(3),NS*FBUFF_SIZE(3))
  call set_edge(fbuffdn(3),NS*FBUFF_SIZE(3))
  ibuff = 0
  do ix=1,NX
  do iy=1,NY
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(3)%sbuff(ibuff) = q%s(iw,it,NZ,iy,ix)%y(ic,is)
      fbuffdn(3)%sbuff(ibuff) = q%s(iw,it, 1,iy,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(3)%id)
  call comlib_sendrecv(fbuffdn(3)%id)
  ibuff = 0
  do ix=1,NX
  do iy=1,NY
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,  0,iy,ix)%y(ic,is) = fbuffup(3)%rbuff(ibuff)
      q%s(iw,it,NZ1,iy,ix)%y(ic,is) = fbuffdn(3)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

!-------------------
! Y-boundary
!-------------------
#if _NDIMY == 1
!$OMP PARALLEL DO PRIVATE(ix,iz,it,iw)
  do ix=1,NX
  do iz=0,NZ1
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,iz,  0,ix) = q%s(iw,it,iz,NY,ix)
    q%s(iw,it,iz,NY1,ix) = q%s(iw,it,iz, 1,ix)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(2),NS*FBUFF_SIZE(2))
  call set_edge(fbuffdn(2),NS*FBUFF_SIZE(2))
  ibuff = 0
  do ix=1,NX
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(2)%sbuff(ibuff) = q%s(iw,it,iz,NY,ix)%y(ic,is)
      fbuffdn(2)%sbuff(ibuff) = q%s(iw,it,iz, 1,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(2)%id)
  call comlib_sendrecv(fbuffdn(2)%id)
  ibuff = 0
  do ix=1,NX
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,iz,  0,ix)%y(ic,is) = fbuffup(2)%rbuff(ibuff)
      q%s(iw,it,iz,NY1,ix)%y(ic,is) = fbuffdn(2)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

!-------------------
! X-boundary
!-------------------
#if _NDIMX == 1
!$OMP PARALLEL DO PRIVATE(iy,iz,it,iw)
  do iy=0,NY1
  do iz=0,NZ1
  do it=0,NT1
  do iw=1,NS
    q%s(iw,it,iz,iy,  0) = q%s(iw,it,iz,iy,NX)
    q%s(iw,it,iz,iy,NX1) = q%s(iw,it,iz,iy, 1)
  enddo
  enddo
  enddo
  enddo
#else
  call set_edge(fbuffup(1),NS*FBUFF_SIZE(1))
  call set_edge(fbuffdn(1),NS*FBUFF_SIZE(1))
  ibuff = 0
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      fbuffup(1)%sbuff(ibuff) = q%s(iw,it,iz,iy,NX)%y(ic,is)
      fbuffdn(1)%sbuff(ibuff) = q%s(iw,it,iz,iy, 1)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  call comlib_sendrecv(fbuffup(1)%id)
  call comlib_sendrecv(fbuffdn(1)%id)
  ibuff = 0
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      ibuff = ibuff + 1
      q%s(iw,it,iz,iy,  0)%y(ic,is) = fbuffup(1)%rbuff(ibuff)
      q%s(iw,it,iz,iy,NX1)%y(ic,is) = fbuffdn(1)%rbuff(ibuff)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
#endif

  return
end subroutine
copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_fermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_fermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_fermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_fermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_fermion_class#copy_fq_time

Subroutine :
y :type(field_dw_quark_wg), intent(inout)

[Source]

subroutine delete_f_dwf_wg(y)
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  if (allocated(y%s)) deallocate(y%s)
  y%NS = 0
  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(inout)

[Source]

subroutine delete_f_dwf_wg(y)
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  if (allocated(y%s)) deallocate(y%s)
  y%NS = 0
  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(inout)

[Source]

subroutine delete_f_dwf_wg(y)
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  if (allocated(y%s)) deallocate(y%s)
  y%NS = 0
  return
end subroutine
field_dw_quark_wg
Derived Type :
s(:,:,:,:,:) :type(su3fv_spinor), allocatable
NS = 0 :integer
idummy(3) = 0 :integer
field_dw_quark_wg
Derived Type :
s(:,:,:,:,:) :type(su3fv_spinor), allocatable
NS = 0 :integer
idummy(3) = 0 :integer
field_dw_quark_wg
Derived Type :
s(:,:,:,:,:) :type(su3fv_spinor), allocatable
NS = 0 :integer
idummy(3) = 0 :integer
field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wg

field_quark_eo_wog
Derived Type :
s(NTH,NZ,NY,NX) :type(su3fv_spinor)
ieo :integer
idummy(3) :integer
 quark field on even/odd sites without ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wog

field_quark_eo_wog
Derived Type :
s(NTH,NZ,NY,NX) :type(su3fv_spinor)
ieo :integer
idummy(3) :integer
 quark field on even/odd sites without ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wog

field_quark_eo_wog
Derived Type :
s(NTH,NZ,NY,NX) :type(su3fv_spinor)
ieo :integer
idummy(3) :integer
 quark field on even/odd sites without ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wog

field_quark_eo_wog
Derived Type :
s(NTH,NZ,NY,NX) :type(su3fv_spinor)
ieo :integer
idummy(3) :integer
 quark field on even/odd sites without ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wog

field_quark_eo_wog
Derived Type :
s(NTH,NZ,NY,NX) :type(su3fv_spinor)
ieo :integer
idummy(3) :integer
 quark field on even/odd sites without ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wog

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_fermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_fermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_fermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_fermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_fermion_class#field_quark_wg

field_quark_wog
Derived Type :
eo(0:1) :type(field_quark_eo_wog)
 quark field without ghost sites

Original external subprogram is field_fermion_class#field_quark_wog

field_quark_wog
Derived Type :
eo(0:1) :type(field_quark_eo_wog)
 quark field without ghost sites

Original external subprogram is field_fermion_class#field_quark_wog

field_quark_wog
Derived Type :
eo(0:1) :type(field_quark_eo_wog)
 quark field without ghost sites

Original external subprogram is field_fermion_class#field_quark_wog

field_quark_wog
Derived Type :
eo(0:1) :type(field_quark_eo_wog)
 quark field without ghost sites

Original external subprogram is field_fermion_class#field_quark_wog

field_quark_wog
Derived Type :
eo(0:1) :type(field_quark_eo_wog)
 quark field without ghost sites

Original external subprogram is field_fermion_class#field_quark_wog

Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

compute MD force from hopping matrix of Ddw operator

NS field contributions are accumulated on BB.

fx,fy, boundary sites are copied.

[Source]

subroutine force_hmc_hopping_dwq(BB,fcoef,fx,fy)
!
! compute MD force from hopping matrix of Ddw operator
!
! NS field contributions are accumulated on BB.
!
! fx,fy, boundary sites are copied.
!
!
  implicit none
  type(vfield_gluon_wg),   intent(inout) :: BB    ! contribution (\dot{u})
  real(DP),                intent(in)    :: fcoef ! force coefficient
  type(field_dw_quark_wg), intent(inout) :: fx    ! DW fermion
  type(field_dw_quark_wg), intent(inout) :: fy    ! DW fermion
  complex(DP) :: b1(COL,SPIN)
  complex(DP) :: b2(COL,SPIN)
  integer :: ix,iy,iz,it,iw,itb,ieo,ieoxyz,ic,jc,NS
  if (.not.is_same_size(fx,fy)) then
    call error_stop("wrong 5-Dim size for fx and/or fy in force_hmc_hopping_dwq.")
  endif
  call copy_boundary(fx)
  call copy_boundary(fy)
  NS = fx%NS

#define _GX_    itb,iz,iy,ix
#define _X_     it,iz,iy,ix
#define _XTUP_  it+1,iz,iy,ix
#define _XZUP_  it,iz+1,iy,ix
#define _XYUP_  it,iz,iy+1,ix
#define _XXUP_  it,iz,iy,ix+1
#define MULTJ(x) cmplx(-aimag(x),real(x),kind=DP)

!************************************************************************
!*
!*  BB = BB + fcoef * tr[(1-gamma_mu) fy(n+mu) fx(n)^{+}
!*                                  + fx(n+mu) fy(n)^{+} (1+gamma_mu)]
!*
!*     = BB + fcoef * tr[ b1(n) fx(n)^{+} + fx(n+mu) b2(n)^{+} ]
!*
!* where
!*
!*   b1(n)=(1-gamma_mu)fy(n+mu)
!*   b2(n)=(1+gamma_mu)fy(n)
!*
!************************************************************************
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieo,ieoxyz,itb,iw,b1,b2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
    itb = it/2
    ieo = mod(ipeo+it+iz+iy+ix,2)
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do iw=1,NS

!================
!  T-direction
!================
      b1(:,3) = fy%s(iw,_XTUP_)%y(:,3)*2.0_DP
      b1(:,4) = fy%s(iw,_XTUP_)%y(:,4)*2.0_DP

      b2(:,1) = fy%s(iw,_X_   )%y(:,1)*2.0_DP
      b2(:,2) = fy%s(iw,_X_   )%y(:,2)*2.0_DP

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(4)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(4)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XTUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XTUP_)%y(ic,2) *conjg(b2(jc,2)) )
      enddo
      enddo

!================
!  Z-direction
!================
      b1(:,1) =        fy%s(iw,_XZUP_)%y(:,1) + MULTJ(fy%s(iw,_XZUP_)%y(:,3))
      b1(:,2) =        fy%s(iw,_XZUP_)%y(:,2) - MULTJ(fy%s(iw,_XZUP_)%y(:,4))
      b1(:,3) = -MULTJ(b1(:,1))
      b1(:,4) = +MULTJ(b1(:,2))

      b2(:,1) =        fy%s(iw,_X_   )%y(:,1) - MULTJ(fy%s(iw,_X_   )%y(:,3))
      b2(:,2) =        fy%s(iw,_X_   )%y(:,2) + MULTJ(fy%s(iw,_X_   )%y(:,4))
      b2(:,3) = +MULTJ(b2(:,1))
      b2(:,4) = -MULTJ(b2(:,2))

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(3)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(3)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XZUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XZUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XZUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XZUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

!================
!  Y-direction
!================
      b1(:,1) = fy%s(iw,_XYUP_)%y(:,1) + fy%s(iw,_XYUP_)%y(:,4)
      b1(:,2) = fy%s(iw,_XYUP_)%y(:,2) - fy%s(iw,_XYUP_)%y(:,3)
      b1(:,3) = -b1(:,2)
      b1(:,4) = +b1(:,1)

      b2(:,1) = fy%s(iw,_X_   )%y(:,1) - fy%s(iw,_X_   )%y(:,4)
      b2(:,2) = fy%s(iw,_X_   )%y(:,2) + fy%s(iw,_X_   )%y(:,3)
      b2(:,3) = +b2(:,2)
      b2(:,4) = -b2(:,1)

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(2)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(2)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XYUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XYUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XYUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XYUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

!================
!  X-direction
!================
      b1(:,1) =        fy%s(iw,_XXUP_)%y(:,1) + MULTJ(fy%s(iw,_XXUP_)%y(:,4))
      b1(:,2) =        fy%s(iw,_XXUP_)%y(:,2) + MULTJ(fy%s(iw,_XXUP_)%y(:,3))
      b1(:,3) = -MULTJ(b1(:,2))
      b1(:,4) = -MULTJ(b1(:,1))

      b2(:,1) =        fy%s(iw,_X_   )%y(:,1) - MULTJ(fy%s(iw,_X_   )%y(:,4))
      b2(:,2) =        fy%s(iw,_X_   )%y(:,2) - MULTJ(fy%s(iw,_X_   )%y(:,3))
      b2(:,3) = +MULTJ(b2(:,2))
      b2(:,4) = +MULTJ(b2(:,1))
    
      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(1)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(1)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XXUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XXUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XXUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XXUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

    enddo ! end of do iw
  enddo 
  enddo 
  enddo 
  enddo ! end of do ix,iy,iz,it

  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*(44+76*3))

#undef _GX_
#undef _X_
#undef _XTUP_
#undef _XZUP_
#undef _XYUP_
#undef _XXUP_
#undef MULTJ

  return
end subroutine
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

compute MD force from hopping matrix of Ddw operator

NS field contributions are accumulated on BB.

fx,fy, boundary sites are copied.

[Source]

subroutine force_hmc_hopping_dwq(BB,fcoef,fx,fy)
!
! compute MD force from hopping matrix of Ddw operator
!
! NS field contributions are accumulated on BB.
!
! fx,fy, boundary sites are copied.
!
!
  implicit none
  type(vfield_gluon_wg),   intent(inout) :: BB    ! contribution (\dot{u})
  real(DP),                intent(in)    :: fcoef ! force coefficient
  type(field_dw_quark_wg), intent(inout) :: fx    ! DW fermion
  type(field_dw_quark_wg), intent(inout) :: fy    ! DW fermion
  complex(DP) :: b1(COL,SPIN)
  complex(DP) :: b2(COL,SPIN)
  integer :: ix,iy,iz,it,iw,itb,ieo,ieoxyz,ic,jc,NS
  if (.not.is_same_size(fx,fy)) then
    call error_stop("wrong 5-Dim size for fx and/or fy in force_hmc_hopping_dwq.")
  endif
  call copy_boundary(fx)
  call copy_boundary(fy)
  NS = fx%NS

#define _GX_    itb,iz,iy,ix
#define _X_     it,iz,iy,ix
#define _XTUP_  it+1,iz,iy,ix
#define _XZUP_  it,iz+1,iy,ix
#define _XYUP_  it,iz,iy+1,ix
#define _XXUP_  it,iz,iy,ix+1
#define MULTJ(x) cmplx(-aimag(x),real(x),kind=DP)

!************************************************************************
!*
!*  BB = BB + fcoef * tr[(1-gamma_mu) fy(n+mu) fx(n)^{+}
!*                                  + fx(n+mu) fy(n)^{+} (1+gamma_mu)]
!*
!*     = BB + fcoef * tr[ b1(n) fx(n)^{+} + fx(n+mu) b2(n)^{+} ]
!*
!* where
!*
!*   b1(n)=(1-gamma_mu)fy(n+mu)
!*   b2(n)=(1+gamma_mu)fy(n)
!*
!************************************************************************
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieo,ieoxyz,itb,iw,b1,b2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
    itb = it/2
    ieo = mod(ipeo+it+iz+iy+ix,2)
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do iw=1,NS

!================
!  T-direction
!================
      b1(:,3) = fy%s(iw,_XTUP_)%y(:,3)*2.0_DP
      b1(:,4) = fy%s(iw,_XTUP_)%y(:,4)*2.0_DP

      b2(:,1) = fy%s(iw,_X_   )%y(:,1)*2.0_DP
      b2(:,2) = fy%s(iw,_X_   )%y(:,2)*2.0_DP

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(4)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(4)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XTUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XTUP_)%y(ic,2) *conjg(b2(jc,2)) )
      enddo
      enddo

!================
!  Z-direction
!================
      b1(:,1) =        fy%s(iw,_XZUP_)%y(:,1) + MULTJ(fy%s(iw,_XZUP_)%y(:,3))
      b1(:,2) =        fy%s(iw,_XZUP_)%y(:,2) - MULTJ(fy%s(iw,_XZUP_)%y(:,4))
      b1(:,3) = -MULTJ(b1(:,1))
      b1(:,4) = +MULTJ(b1(:,2))

      b2(:,1) =        fy%s(iw,_X_   )%y(:,1) - MULTJ(fy%s(iw,_X_   )%y(:,3))
      b2(:,2) =        fy%s(iw,_X_   )%y(:,2) + MULTJ(fy%s(iw,_X_   )%y(:,4))
      b2(:,3) = +MULTJ(b2(:,1))
      b2(:,4) = -MULTJ(b2(:,2))

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(3)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(3)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XZUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XZUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XZUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XZUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

!================
!  Y-direction
!================
      b1(:,1) = fy%s(iw,_XYUP_)%y(:,1) + fy%s(iw,_XYUP_)%y(:,4)
      b1(:,2) = fy%s(iw,_XYUP_)%y(:,2) - fy%s(iw,_XYUP_)%y(:,3)
      b1(:,3) = -b1(:,2)
      b1(:,4) = +b1(:,1)

      b2(:,1) = fy%s(iw,_X_   )%y(:,1) - fy%s(iw,_X_   )%y(:,4)
      b2(:,2) = fy%s(iw,_X_   )%y(:,2) + fy%s(iw,_X_   )%y(:,3)
      b2(:,3) = +b2(:,2)
      b2(:,4) = -b2(:,1)

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(2)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(2)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XYUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XYUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XYUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XYUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

!================
!  X-direction
!================
      b1(:,1) =        fy%s(iw,_XXUP_)%y(:,1) + MULTJ(fy%s(iw,_XXUP_)%y(:,4))
      b1(:,2) =        fy%s(iw,_XXUP_)%y(:,2) + MULTJ(fy%s(iw,_XXUP_)%y(:,3))
      b1(:,3) = -MULTJ(b1(:,2))
      b1(:,4) = -MULTJ(b1(:,1))

      b2(:,1) =        fy%s(iw,_X_   )%y(:,1) - MULTJ(fy%s(iw,_X_   )%y(:,4))
      b2(:,2) =        fy%s(iw,_X_   )%y(:,2) - MULTJ(fy%s(iw,_X_   )%y(:,3))
      b2(:,3) = +MULTJ(b2(:,2))
      b2(:,4) = +MULTJ(b2(:,1))
    
      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(1)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(1)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XXUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XXUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XXUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XXUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

    enddo ! end of do iw
  enddo 
  enddo 
  enddo 
  enddo ! end of do ix,iy,iz,it

  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*(44+76*3))

#undef _GX_
#undef _X_
#undef _XTUP_
#undef _XZUP_
#undef _XYUP_
#undef _XXUP_
#undef MULTJ

  return
end subroutine
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

compute MD force from hopping matrix of Ddw operator

NS field contributions are accumulated on BB.

fx,fy, boundary sites are copied.

[Source]

subroutine force_hmc_hopping_dwq(BB,fcoef,fx,fy)
!
! compute MD force from hopping matrix of Ddw operator
!
! NS field contributions are accumulated on BB.
!
! fx,fy, boundary sites are copied.
!
!
  implicit none
  type(vfield_gluon_wg),   intent(inout) :: BB    ! contribution (\dot{u})
  real(DP),                intent(in)    :: fcoef ! force coefficient
  type(field_dw_quark_wg), intent(inout) :: fx    ! DW fermion
  type(field_dw_quark_wg), intent(inout) :: fy    ! DW fermion
  complex(DP) :: b1(COL,SPIN)
  complex(DP) :: b2(COL,SPIN)
  integer :: ix,iy,iz,it,iw,itb,ieo,ieoxyz,ic,jc,NS
  if (.not.is_same_size(fx,fy)) then
    call error_stop("wrong 5-Dim size for fx and/or fy in force_hmc_hopping_dwq.")
  endif
  call copy_boundary(fx)
  call copy_boundary(fy)
  NS = fx%NS

#define _GX_    itb,iz,iy,ix
#define _X_     it,iz,iy,ix
#define _XTUP_  it+1,iz,iy,ix
#define _XZUP_  it,iz+1,iy,ix
#define _XYUP_  it,iz,iy+1,ix
#define _XXUP_  it,iz,iy,ix+1
#define MULTJ(x) cmplx(-aimag(x),real(x),kind=DP)

!************************************************************************
!*
!*  BB = BB + fcoef * tr[(1-gamma_mu) fy(n+mu) fx(n)^{+}
!*                                  + fx(n+mu) fy(n)^{+} (1+gamma_mu)]
!*
!*     = BB + fcoef * tr[ b1(n) fx(n)^{+} + fx(n+mu) b2(n)^{+} ]
!*
!* where
!*
!*   b1(n)=(1-gamma_mu)fy(n+mu)
!*   b2(n)=(1+gamma_mu)fy(n)
!*
!************************************************************************
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieo,ieoxyz,itb,iw,b1,b2)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
    itb = it/2
    ieo = mod(ipeo+it+iz+iy+ix,2)
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do iw=1,NS

!================
!  T-direction
!================
      b1(:,3) = fy%s(iw,_XTUP_)%y(:,3)*2.0_DP
      b1(:,4) = fy%s(iw,_XTUP_)%y(:,4)*2.0_DP

      b2(:,1) = fy%s(iw,_X_   )%y(:,1)*2.0_DP
      b2(:,2) = fy%s(iw,_X_   )%y(:,2)*2.0_DP

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(4)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(4)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XTUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XTUP_)%y(ic,2) *conjg(b2(jc,2)) )
      enddo
      enddo

!================
!  Z-direction
!================
      b1(:,1) =        fy%s(iw,_XZUP_)%y(:,1) + MULTJ(fy%s(iw,_XZUP_)%y(:,3))
      b1(:,2) =        fy%s(iw,_XZUP_)%y(:,2) - MULTJ(fy%s(iw,_XZUP_)%y(:,4))
      b1(:,3) = -MULTJ(b1(:,1))
      b1(:,4) = +MULTJ(b1(:,2))

      b2(:,1) =        fy%s(iw,_X_   )%y(:,1) - MULTJ(fy%s(iw,_X_   )%y(:,3))
      b2(:,2) =        fy%s(iw,_X_   )%y(:,2) + MULTJ(fy%s(iw,_X_   )%y(:,4))
      b2(:,3) = +MULTJ(b2(:,1))
      b2(:,4) = -MULTJ(b2(:,2))

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(3)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(3)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XZUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XZUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XZUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XZUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

!================
!  Y-direction
!================
      b1(:,1) = fy%s(iw,_XYUP_)%y(:,1) + fy%s(iw,_XYUP_)%y(:,4)
      b1(:,2) = fy%s(iw,_XYUP_)%y(:,2) - fy%s(iw,_XYUP_)%y(:,3)
      b1(:,3) = -b1(:,2)
      b1(:,4) = +b1(:,1)

      b2(:,1) = fy%s(iw,_X_   )%y(:,1) - fy%s(iw,_X_   )%y(:,4)
      b2(:,2) = fy%s(iw,_X_   )%y(:,2) + fy%s(iw,_X_   )%y(:,3)
      b2(:,3) = +b2(:,2)
      b2(:,4) = -b2(:,1)

      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(2)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(2)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XYUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XYUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XYUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XYUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

!================
!  X-direction
!================
      b1(:,1) =        fy%s(iw,_XXUP_)%y(:,1) + MULTJ(fy%s(iw,_XXUP_)%y(:,4))
      b1(:,2) =        fy%s(iw,_XXUP_)%y(:,2) + MULTJ(fy%s(iw,_XXUP_)%y(:,3))
      b1(:,3) = -MULTJ(b1(:,2))
      b1(:,4) = -MULTJ(b1(:,1))

      b2(:,1) =        fy%s(iw,_X_   )%y(:,1) - MULTJ(fy%s(iw,_X_   )%y(:,4))
      b2(:,2) =        fy%s(iw,_X_   )%y(:,2) - MULTJ(fy%s(iw,_X_   )%y(:,3))
      b2(:,3) = +MULTJ(b2(:,2))
      b2(:,4) = +MULTJ(b2(:,1))
    
      do jc=1,COL
      do ic=1,COL
        BB%eo(ieo)%mu(1)%s(_GX_)%u(ic,jc)=BB%eo(ieo)%mu(1)%s(_GX_)%u(ic,jc) +fcoef*( +conjg( fx%s(iw,_X_   )%y(jc,1))*      b1(ic,1) +conjg( fx%s(iw,_X_   )%y(jc,2))*      b1(ic,2) +conjg( fx%s(iw,_X_   )%y(jc,3))*      b1(ic,3) +conjg( fx%s(iw,_X_   )%y(jc,4))*      b1(ic,4) +       fx%s(iw,_XXUP_)%y(ic,1) *conjg(b2(jc,1)) +       fx%s(iw,_XXUP_)%y(ic,2) *conjg(b2(jc,2)) +       fx%s(iw,_XXUP_)%y(ic,3) *conjg(b2(jc,3)) +       fx%s(iw,_XXUP_)%y(ic,4) *conjg(b2(jc,4)) )
      enddo
      enddo

    enddo ! end of do iw
  enddo 
  enddo 
  enddo 
  enddo ! end of do ix,iy,iz,it

  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*(44+76*3))

#undef _GX_
#undef _X_
#undef _XTUP_
#undef _XZUP_
#undef _XYUP_
#undef _XXUP_
#undef MULTJ

  return
end subroutine
Function :
is_allocated :logical
y :type(field_dw_quark_wg), intent(in)

[Source]

function is_allocated_f_dwf_wg(y) result(is_allocated)
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  logical :: is_allocated
  if (y%NS == 0 .or. (.not.allocated(y%s))) then
    is_allocated = .false.
  else
    is_allocated = .true.
  endif 
  return
end function
Function :
is_allocated :logical
y :type(field_dw_quark_wg), intent(in)

[Source]

function is_allocated_f_dwf_wg(y) result(is_allocated)
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  logical :: is_allocated
  if (y%NS == 0 .or. (.not.allocated(y%s))) then
    is_allocated = .false.
  else
    is_allocated = .true.
  endif 
  return
end function
Function :
is_allocated :logical
y :type(field_dw_quark_wg), intent(in)

[Source]

function is_allocated_f_dwf_wg(y) result(is_allocated)
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  logical :: is_allocated
  if (y%NS == 0 .or. (.not.allocated(y%s))) then
    is_allocated = .false.
  else
    is_allocated = .true.
  endif 
  return
end function
Function :
is_same :logical
y :type(field_dw_quark_wg), intent(in)
v :type(field_dw_quark_wg), intent(in)

[Source]

function is_same_size_f_dwf_wg(y,v) result(is_same)
  implicit none
  type(field_dw_quark_wg), intent(in) :: y,v
  logical :: is_same
  if (is_allocated(y) .and. is_allocated(v)) then
    if (y%NS == v%NS) then
      is_same = .true.
    else
      is_same = .false.
    endif 
  else
    is_same = .false.
  endif
  return
end function
Function :
is_same :logical
y :type(field_dw_quark_wg), intent(in)
v :type(field_dw_quark_wg), intent(in)

[Source]

function is_same_size_f_dwf_wg(y,v) result(is_same)
  implicit none
  type(field_dw_quark_wg), intent(in) :: y,v
  logical :: is_same
  if (is_allocated(y) .and. is_allocated(v)) then
    if (y%NS == v%NS) then
      is_same = .true.
    else
      is_same = .false.
    endif 
  else
    is_same = .false.
  endif
  return
end function
Function :
is_same :logical
y :type(field_dw_quark_wg), intent(in)
v :type(field_dw_quark_wg), intent(in)

[Source]

function is_same_size_f_dwf_wg(y,v) result(is_same)
  implicit none
  type(field_dw_quark_wg), intent(in) :: y,v
  logical :: is_same
  if (is_allocated(y) .and. is_allocated(v)) then
    if (y%NS == v%NS) then
      is_same = .true.
    else
      is_same = .false.
    endif 
  else
    is_same = .false.
  endif
  return
end function
mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

Multiply hopping matrix (odd->even/even->odd sites only)

User should copy boundary of the input field before calling this subroutine.

yde <= Meo yo

\[

 M(n,m) =  \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m}
                                  +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]

\]

Original external subprogram is field_fermion_class#mult_hopping_tzyx_eo

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

Multiply hopping matrix (odd->even/even->odd sites only)

User should copy boundary of the input field before calling this subroutine.

yde <= Meo yo

\[

 M(n,m) =  \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m}
                                  +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]

\]

Original external subprogram is field_fermion_class#mult_hopping_tzyx_eo

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

Multiply hopping matrix (odd->even/even->odd sites only)

User should copy boundary of the input field before calling this subroutine.

yde <= Meo yo

\[

 M(n,m) =  \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m}
                                  +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]

\]

Original external subprogram is field_fermion_class#mult_hopping_tzyx_eo

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

Multiply hopping matrix (odd->even/even->odd sites only)

User should copy boundary of the input field before calling this subroutine.

yde <= Meo yo

\[

 M(n,m) =  \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m}
                                  +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]

\]

Original external subprogram is field_fermion_class#mult_hopping_tzyx_eo

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

Multiply hopping matrix (odd->even/even->odd sites only)

User should copy boundary of the input field before calling this subroutine.

yde <= Meo yo

\[

 M(n,m) =  \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m}
                                  +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]

\]

Original external subprogram is field_fermion_class#mult_hopping_tzyx_eo

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_fermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_fermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_fermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_fermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_fermion_class#mult_iter

Subroutine :
y :type(field_dw_quark_wg), intent(inout)
NS :integer, intent(in)

[Source]

subroutine new_f_dwf_wg(y,NS)
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  integer, intent(in) :: NS
  integer :: iw
  if (allocated(y%s)) deallocate(y%s)
  if (NS /= 0) then
    allocate(y%s(1:NS,0:NT1,0:NZ1,0:NY1,0:NX1))
    y%NS = NS
  else
    call error_stop("5-dim size NS is wrong in new_f_dwf_wg.")
  endif
!  write(*,'("new_fdwf_wg: NS=",I3)')NS
  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(inout)
NS :integer, intent(in)

[Source]

subroutine new_f_dwf_wg(y,NS)
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  integer, intent(in) :: NS
  integer :: iw
  if (allocated(y%s)) deallocate(y%s)
  if (NS /= 0) then
    allocate(y%s(1:NS,0:NT1,0:NZ1,0:NY1,0:NX1))
    y%NS = NS
  else
    call error_stop("5-dim size NS is wrong in new_f_dwf_wg.")
  endif
!  write(*,'("new_fdwf_wg: NS=",I3)')NS
  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(inout)
NS :integer, intent(in)

[Source]

subroutine new_f_dwf_wg(y,NS)
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  integer, intent(in) :: NS
  integer :: iw
  if (allocated(y%s)) deallocate(y%s)
  if (NS /= 0) then
    allocate(y%s(1:NS,0:NT1,0:NZ1,0:NY1,0:NX1))
    y%NS = NS
  else
    call error_stop("5-dim size NS is wrong in new_f_dwf_wg.")
  endif
!  write(*,'("new_fdwf_wg: NS=",I3)')NS
  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(in)
v(1:NSITE*y%NS) :complex(DP), intent(out)

Pack field

[Source]

subroutine pack_f_dwf_wg(y,v)
!
! \Pack field
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  complex(DP), intent(out) :: v(1:NSITE*y%NS)
  integer :: ix,iy,iz,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(it-1) + COL*SPIN*NS*NT*(iz-1) + COL*SPIN*NS*NT*NZ*(iy-1) + COL*SPIN*NS*NT*NZ*NY*(ix-1)
      v(indx) = y%s(iw,it,iz,iy,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(in)
v(1:NSITE*y%NS) :complex(DP), intent(out)

Pack field

[Source]

subroutine pack_f_dwf_wg(y,v)
!
! \Pack field
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  complex(DP), intent(out) :: v(1:NSITE*y%NS)
  integer :: ix,iy,iz,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(it-1) + COL*SPIN*NS*NT*(iz-1) + COL*SPIN*NS*NT*NZ*(iy-1) + COL*SPIN*NS*NT*NZ*NY*(ix-1)
      v(indx) = y%s(iw,it,iz,iy,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(in)
v(1:NSITE*y%NS) :complex(DP), intent(out)

Pack field

[Source]

subroutine pack_f_dwf_wg(y,v)
!
! \Pack field
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  complex(DP), intent(out) :: v(1:NSITE*y%NS)
  integer :: ix,iy,iz,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(it-1) + COL*SPIN*NS*NT*(iz-1) + COL*SPIN*NS*NT*NZ*(iy-1) + COL*SPIN*NS*NT*NZ*NY*(ix-1)
      v(indx) = y%s(iw,it,iz,iy,ix)%y(ic,is)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(in)
v(1:NHSITE*y%NS) :complex(DP), intent(inout)
ieo :integer, intent(in)

Pack field on even/odd sites only

[Source]

subroutine pack_eo(y,v,ieo)
!
! \Pack field on even/odd sites only
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  complex(DP), intent(inout) :: v(1:NHSITE*y%NS)
  integer, intent(in) :: ieo
  integer :: ix,iy,iz,ieoxyz,ith,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(ith-1+ieoxyz) + COL*SPIN*NS*NTH*(iz-1) + COL*SPIN*NS*NTH*NZ*(iy-1) + COL*SPIN*NS*NTH*NZ*NY*(ix-1)
      v(indx) = y%s(iw,it,iz,iy,ix)%y(ic,is)
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(in)
v(1:NHSITE*y%NS) :complex(DP), intent(inout)
ieo :integer, intent(in)

Pack field on even/odd sites only

[Source]

subroutine pack_eo(y,v,ieo)
!
! \Pack field on even/odd sites only
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  complex(DP), intent(inout) :: v(1:NHSITE*y%NS)
  integer, intent(in) :: ieo
  integer :: ix,iy,iz,ieoxyz,ith,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(ith-1+ieoxyz) + COL*SPIN*NS*NTH*(iz-1) + COL*SPIN*NS*NTH*NZ*(iy-1) + COL*SPIN*NS*NTH*NZ*NY*(ix-1)
      v(indx) = y%s(iw,it,iz,iy,ix)%y(ic,is)
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Subroutine :
y :type(field_dw_quark_wg), intent(in)
v(1:NHSITE*y%NS) :complex(DP), intent(inout)
ieo :integer, intent(in)

Pack field on even/odd sites only

[Source]

subroutine pack_eo(y,v,ieo)
!
! \Pack field on even/odd sites only
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: y
  complex(DP), intent(inout) :: v(1:NHSITE*y%NS)
  integer, intent(in) :: ieo
  integer :: ix,iy,iz,ieoxyz,ith,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(ith-1+ieoxyz) + COL*SPIN*NS*NTH*(iz-1) + COL*SPIN*NS*NTH*NZ*(iy-1) + COL*SPIN*NS*NTH*NZ*NY*(ix-1)
      v(indx) = y%s(iw,it,iz,iy,ix)%y(ic,is)
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Function :
my_prod :complex(DP)
q :type(field_dw_quark_wg), intent(in)
p :type(field_dw_quark_wg), intent(in)

prod = q’ * p

[Source]

function prod_f_dwf_wg(q,p) result(my_prod)
!
! \prod = q' * p
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q, p
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,ic,is,NS
  if ( (.not.is_allocated(q)) .or. (.not.is_allocated(p)) .or. (.not.is_same_size(q,p)) ) then
    call error_stop("5-dim size of q,p is wrong in prod_f_dwf_wg.")
  endif
  NS = q%NS
  my_prod = Z0
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,is,ic) REDUCTION(+:my_prod)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      my_prod = my_prod +conjg(q%s(iw,it,iz,iy,ix)%y(ic,is)) *(p%s(iw,it,iz,iy,ix)%y(ic,is))
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(my_prod)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_PROD)
  return
end function
Function :
my_prod :complex(DP)
q :type(field_dw_quark_wg), intent(in)
p :type(field_dw_quark_wg), intent(in)

prod = q’ * p

[Source]

function prod_f_dwf_wg(q,p) result(my_prod)
!
! \prod = q' * p
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q, p
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,ic,is,NS
  if ( (.not.is_allocated(q)) .or. (.not.is_allocated(p)) .or. (.not.is_same_size(q,p)) ) then
    call error_stop("5-dim size of q,p is wrong in prod_f_dwf_wg.")
  endif
  NS = q%NS
  my_prod = Z0
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,is,ic) REDUCTION(+:my_prod)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      my_prod = my_prod +conjg(q%s(iw,it,iz,iy,ix)%y(ic,is)) *(p%s(iw,it,iz,iy,ix)%y(ic,is))
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(my_prod)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_PROD)
  return
end function
Function :
my_prod :complex(DP)
q :type(field_dw_quark_wg), intent(in)
p :type(field_dw_quark_wg), intent(in)

prod = q’ * p

[Source]

function prod_f_dwf_wg(q,p) result(my_prod)
!
! \prod = q' * p
!
  implicit none
  type(field_dw_quark_wg), intent(in) :: q, p
  complex(DP) :: my_prod
  integer :: iw,ix,iy,iz,it,ic,is,NS
  if ( (.not.is_allocated(q)) .or. (.not.is_allocated(p)) .or. (.not.is_same_size(q,p)) ) then
    call error_stop("5-dim size of q,p is wrong in prod_f_dwf_wg.")
  endif
  NS = q%NS
  my_prod = Z0
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,is,ic) REDUCTION(+:my_prod)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      my_prod = my_prod +conjg(q%s(iw,it,iz,iy,ix)%y(ic,is)) *(p%s(iw,it,iz,iy,ix)%y(ic,is))
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
#ifndef _singlePU
  call comlib_sumcast(my_prod)
#endif
  call inc(m_flop_counter,NX*NY*NZ*NT*NS*COL*SPIN*C_ADD_PROD)
  return
end function
set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)

Original external subprogram is field_gauge_class#set_gaussian_noise

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)

Original external subprogram is field_gauge_class#set_gaussian_noise

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)

Original external subprogram is field_gauge_class#set_gaussian_noise

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)

Original external subprogram is field_gauge_class#set_gaussian_noise

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)

Original external subprogram is field_gauge_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( ye )
Subroutine :
ye :type(field_quark_eo_wg), intent(inout)

set Gaussian noise on even/odd sites only

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( ye )
Subroutine :
ye :type(field_quark_eo_wg), intent(inout)

set Gaussian noise on even/odd sites only

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( ye )
Subroutine :
ye :type(field_quark_eo_wg), intent(inout)

set Gaussian noise on even/odd sites only

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( ye )
Subroutine :
ye :type(field_quark_eo_wg), intent(inout)

set Gaussian noise on even/odd sites only

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( ye )
Subroutine :
ye :type(field_quark_eo_wg), intent(inout)

set Gaussian noise on even/odd sites only

Original external subprogram is field_fermion_class#set_gaussian_noise

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_fermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_fermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_fermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_fermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_fermion_class#su3fv_spinor

Subroutine :
v(1:NSITE*y%NS) :complex(DP), intent(in)
y :type(field_dw_quark_wg), intent(inout)

unack field

[Source]

subroutine unpack_f_dwf_wg(v,y)
!
! \unack field
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  complex(DP), intent(in) :: v(1:NSITE*y%NS)
  integer :: ix,iy,iz,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(it-1) + COL*SPIN*NS*NT*(iz-1) + COL*SPIN*NS*NT*NZ*(iy-1) + COL*SPIN*NS*NT*NZ*NY*(ix-1)
      y%s(iw,it,iz,iy,ix)%y(ic,is) = v(indx)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
v(1:NSITE*y%NS) :complex(DP), intent(in)
y :type(field_dw_quark_wg), intent(inout)

unack field

[Source]

subroutine unpack_f_dwf_wg(v,y)
!
! \unack field
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  complex(DP), intent(in) :: v(1:NSITE*y%NS)
  integer :: ix,iy,iz,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(it-1) + COL*SPIN*NS*NT*(iz-1) + COL*SPIN*NS*NT*NZ*(iy-1) + COL*SPIN*NS*NT*NZ*NY*(ix-1)
      y%s(iw,it,iz,iy,ix)%y(ic,is) = v(indx)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
v(1:NSITE*y%NS) :complex(DP), intent(in)
y :type(field_dw_quark_wg), intent(inout)

unack field

[Source]

subroutine unpack_f_dwf_wg(v,y)
!
! \unack field
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  complex(DP), intent(in) :: v(1:NSITE*y%NS)
  integer :: ix,iy,iz,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
  do it=1,NT
  do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(it-1) + COL*SPIN*NS*NT*(iz-1) + COL*SPIN*NS*NT*NZ*(iy-1) + COL*SPIN*NS*NT*NZ*NY*(ix-1)
      y%s(iw,it,iz,iy,ix)%y(ic,is) = v(indx)
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
v(1:NHSITE*y%NS) :complex(DP), intent(in)
y :type(field_dw_quark_wg), intent(inout)
ieo :integer, intent(in)

Unpack field on even/odd sites only

[Source]

subroutine unpack_eo(v,y,ieo)
!
! \Unpack field on even/odd sites only
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  complex(DP), intent(in) :: v(1:NHSITE*y%NS)
  integer, intent(in) :: ieo
  integer :: ix,iy,iz,ieoxyz,ith,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(ith-1+ieoxyz) + COL*SPIN*NS*NTH*(iz-1) + COL*SPIN*NS*NTH*NZ*(iy-1) + COL*SPIN*NS*NTH*NZ*NY*(ix-1)
      y%s(iw,it,iz,iy,ix)%y(ic,is) = v(indx)
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Subroutine :
v(1:NHSITE*y%NS) :complex(DP), intent(in)
y :type(field_dw_quark_wg), intent(inout)
ieo :integer, intent(in)

Unpack field on even/odd sites only

[Source]

subroutine unpack_eo(v,y,ieo)
!
! \Unpack field on even/odd sites only
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  complex(DP), intent(in) :: v(1:NHSITE*y%NS)
  integer, intent(in) :: ieo
  integer :: ix,iy,iz,ieoxyz,ith,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(ith-1+ieoxyz) + COL*SPIN*NS*NTH*(iz-1) + COL*SPIN*NS*NTH*NZ*(iy-1) + COL*SPIN*NS*NTH*NZ*NY*(ix-1)
      y%s(iw,it,iz,iy,ix)%y(ic,is) = v(indx)
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Subroutine :
v(1:NHSITE*y%NS) :complex(DP), intent(in)
y :type(field_dw_quark_wg), intent(inout)
ieo :integer, intent(in)

Unpack field on even/odd sites only

[Source]

subroutine unpack_eo(v,y,ieo)
!
! \Unpack field on even/odd sites only
!
  implicit none
  type(field_dw_quark_wg), intent(inout) :: y
  complex(DP), intent(in) :: v(1:NHSITE*y%NS)
  integer, intent(in) :: ieo
  integer :: ix,iy,iz,ieoxyz,ith,it,iw,ic,is,NS,indx

  NS = y%NS
!$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ieoxyz,ith,iw,ic,is,indx)
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    ieoxyz=mod(ipeo+ix+iy+iz+ieo,2)
    do ith=1-ieoxyz,NTH-ieoxyz
    it = ith*2 + ieoxyz
    do iw=1,NS
    do is=1,SPIN
    do ic=1,COL
      indx = ic + COL*(is-1) + COL*SPIN*(iw-1) + COL*SPIN*NS*(ith-1+ieoxyz) + COL*SPIN*NS*NTH*(iz-1) + COL*SPIN*NS*NTH*NZ*(iy-1) + COL*SPIN*NS*NTH*NZ*NY*(ix-1)
      y%s(iw,it,iz,iy,ix)%y(ic,is) = v(indx)
    enddo
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
vfield_dw_gluon_wg
Derived Type :
s(NDIM,0:NT1,0:NZ1,0:NY1,0:NX1) :type(su3fm)
vfield_dw_gluon_wg
Derived Type :
s(NDIM,0:NT1,0:NZ1,0:NY1,0:NX1) :type(su3fm)
vfield_dw_gluon_wg
Derived Type :
s(NDIM,0:NT1,0:NZ1,0:NY1,0:NX1) :type(su3fm)