Class | field_5dfermion_class |
In: |
OBSOLETES/PREPROC/field_5dfermion_class.F90
QuarkDwOvlpClass/field_5dfermion_class.F90 QuarkDwOvlpClass_v0.1/field_5dfermion_class.F90 |
This will be used for 5D representation of overlap fermions
$Id: field_5dfermion_class.F90,v 1.7 2011/06/13 12:04:00 ishikawa Exp $
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
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
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
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.
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.
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.
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
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
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
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.
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.
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.
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
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
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
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
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
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
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.
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.
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.
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
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
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
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.
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.
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.
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
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
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
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.
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.
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.
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 : | |
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
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
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
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
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
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
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
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
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
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
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 : | |
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 : | |
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 : | |
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 : | |
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.
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.
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.
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
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
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
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)
| ||
v : | type(vfield_dw_gluon_wg),
intent(out)
|
convert gauge field
u => v
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)
| ||
v : | type(vfield_dw_gluon_wg),
intent(out)
|
convert gauge field
u => v
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)
| ||
v : | type(vfield_dw_gluon_wg),
intent(out)
|
convert gauge field
u => v
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) |
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) |
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) |
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
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
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
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
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_fermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_fermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_fermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_fermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_fermion_class#copy_fq_time
Subroutine : | |
y : | type(field_dw_quark_wg), intent(inout) |
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) |
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) |
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
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wg
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
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
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
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
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
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_fermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_fermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_fermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_fermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_fermion_class#field_quark_wg
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
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
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
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
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)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
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)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
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)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
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) |
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) |
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) |
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) |
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) |
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) |
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
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
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
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
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
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
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
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
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
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
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
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_fermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_fermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_fermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_fermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_fermion_class#mult_iter
Subroutine : | |
y : | type(field_dw_quark_wg), intent(inout) |
NS : | integer, intent(in) |
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) |
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) |
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
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
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
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
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
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
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
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
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
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
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
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
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
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
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
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
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
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
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
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
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_fermion_class#set_gaussian_noise
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
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
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
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
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
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_fermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_fermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_fermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_fermion_class#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
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
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
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
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
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
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