Class | single_field_class |
In: |
GPUSolverClass_v1.2/single_field_class.F90
GPUSolverClass/single_field_class.F90 |
*********************************************************** $Id: single_field_class.F90,v 1.15 2011/10/30 02:41:55 ishikawa Exp $ Single precicion solver version without ghost sites ***********************************************************
Function : | |
a : | real(SP) |
y : | type(s_wqf_eo_blk_obj), intent(in) |
a = |y|^2
function abs2_swqf_blk(y) result(a) ! ! a = |y|^2 ! implicit none type(s_wqf_eo_blk_obj), intent(in) :: y real(SP) :: a integer :: ix,iy,iz,ieoxyz,ic,is integer :: ibx,iby,ibz,itht,ithz,ics a=0.0_SP do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ithz=1,NTHZ ix=ibx+(y%igx-1)*NBX iy=iby iz=ithz+(ibz-1)*NTHZ ieoxyz=mod(ipeo+ix+iy+iz+y%ieo,2) do ics=1,COL*2 #ifdef _SF do itht=1+ieoxyz,NTHT !ieoxyz=1 => itht = 2..NTHT, ieoxyz=0 => itht=1..NTHT #else do itht=1,NTHT #endif a = a + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w**2 enddo enddo enddo enddo enddo enddo #ifndef _singlePU call comlib_sumcast(a) #endif return end function
Function : | |
a : | real(SP) |
y : | type(s_wqf_eo_blk_obj), intent(in) |
a = |y|^2
function abs2_swqf_blk(y) result(a) ! ! a = |y|^2 ! implicit none type(s_wqf_eo_blk_obj), intent(in) :: y real(SP) :: a integer :: ix,iy,iz,ieoxyz,ic,is integer :: ibx,iby,ibz,itht,ithz,ics a=0.0_SP do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ithz=1,NTHZ ix=ibx+(y%igx-1)*NBX iy=iby iz=ithz+(ibz-1)*NTHZ ieoxyz=mod(ipeo+ix+iy+iz+y%ieo,2) do ics=1,COL*2 #ifdef _SF do itht=1+ieoxyz,NTHT !ieoxyz=1 => itht = 2..NTHT, ieoxyz=0 => itht=1..NTHT #else do itht=1,NTHT #endif a = a + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z**2 + y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w**2 enddo enddo enddo enddo enddo enddo #ifndef _singlePU call comlib_sumcast(a) #endif return end function
Function : | |
a : | real(SP) |
y : | type(s_wqf_eo_obj), intent(in) |
a = |y|^2
function abs2_swqf_eo(y) result(a) ! ! a = |y|^2 ! implicit none type(s_wqf_eo_obj), intent(in) :: y real(SP) :: a integer :: igx a = 0.0_SP !$OMP PARALLEL DO REDUCTION(+:a) do igx=1,NGX a = a + abs2(y%g(igx)) enddo return end function
Function : | |
a : | real(SP) |
y : | type(s_wqf_eo_obj), intent(in) |
a = |y|^2
function abs2_swqf_eo(y) result(a) ! ! a = |y|^2 ! implicit none type(s_wqf_eo_obj), intent(in) :: y real(SP) :: a integer :: igx a = 0.0_SP !$OMP PARALLEL DO REDUCTION(+:a) do igx=1,NGX a = a + abs2(y%g(igx)) enddo return end function
Function : | |
a : | real(SP) |
y : | type(s_wqf_obj), intent(in) |
a = |y|^2
function abs2_swqf(y) result(a) ! ! a = |y|^2 ! implicit none type(s_wqf_obj), intent(in) :: y real(SP) :: a integer :: ieo a = 0.0_SP do ieo=0,1 a = a + abs2(y%eo(ieo)) enddo return end function
Function : | |
a : | real(SP) |
y : | type(s_wqf_obj), intent(in) |
a = |y|^2
function abs2_swqf(y) result(a) ! ! a = |y|^2 ! implicit none type(s_wqf_obj), intent(in) :: y real(SP) :: a integer :: ieo a = 0.0_SP do ieo=0,1 a = a + abs2(y%eo(ieo)) enddo return end function
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe + qe
subroutine accum_add_swqf_blk(pe,qe) ! ! pe = pe + qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe type(s_wqf_eo_blk_obj), intent(in) :: qe integer :: ibx,iby,ibz,ics,ithz,itht if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_add_swqf_blk pe/=qe.") endif do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe + qe
subroutine accum_add_swqf_blk(pe,qe) ! ! pe = pe + qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe type(s_wqf_eo_blk_obj), intent(in) :: qe integer :: ibx,iby,ibz,ics,ithz,itht if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_add_swqf_blk pe/=qe.") endif do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe + qe
subroutine accum_add_swqf_eo(pe,qe) ! ! pe = pe + qe ! implicit none type(s_wqf_eo_obj), intent(inout) :: pe type(s_wqf_eo_obj), intent(in) :: qe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_add(pe%g(igx),qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe + qe
subroutine accum_add_swqf_eo(pe,qe) ! ! pe = pe + qe ! implicit none type(s_wqf_eo_obj), intent(inout) :: pe type(s_wqf_eo_obj), intent(in) :: qe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_add(pe%g(igx),qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
ccoef : | complex(SP), intent(in) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe + ccoef * qe
subroutine accum_add_cmult_swqf_blk(pe,ccoef,qe) ! ! pe = pe + ccoef * qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe complex(SP), intent(in) :: ccoef type(s_wqf_eo_blk_obj), intent(in) :: qe real(SP) :: cr,ci integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_add_cmult_swqf_blk pe/=qe.") endif cr = real(ccoef) ci = aimag(ccoef) do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL jcs=ics+COL do ithz=1,NTHZ do itht=1,NTHT pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * ci pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * ci pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * ci pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * ci pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * ci pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * ci pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * ci pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * ci enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
ccoef : | complex(SP), intent(in) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe + ccoef * qe
subroutine accum_add_cmult_swqf_blk(pe,ccoef,qe) ! ! pe = pe + ccoef * qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe complex(SP), intent(in) :: ccoef type(s_wqf_eo_blk_obj), intent(in) :: qe real(SP) :: cr,ci integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_add_cmult_swqf_blk pe/=qe.") endif cr = real(ccoef) ci = aimag(ccoef) do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL jcs=ics+COL do ithz=1,NTHZ do itht=1,NTHT pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * ci pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * ci pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * ci pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * cr - qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * ci pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * ci pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * ci pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * ci pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * cr + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * ci enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
ccoef : | complex(SP), intent(in) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe + ccoef * qe
subroutine accum_add_cmult_swqf_eo(pe,ccoef,qe) ! ! pe = pe + ccoef * qe ! implicit none type(s_wqf_eo_obj), intent(in) :: qe complex(SP), intent(in) :: ccoef type(s_wqf_eo_obj), intent(inout) :: pe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_add_mult(pe%g(igx),ccoef,qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
ccoef : | complex(SP), intent(in) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe + ccoef * qe
subroutine accum_add_cmult_swqf_eo(pe,ccoef,qe) ! ! pe = pe + ccoef * qe ! implicit none type(s_wqf_eo_obj), intent(in) :: qe complex(SP), intent(in) :: ccoef type(s_wqf_eo_obj), intent(inout) :: pe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_add_mult(pe%g(igx),ccoef,qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
rcoef : | real(SP), intent(in) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe + rcoef * qe
subroutine accum_add_rmult_swqf_blk(pe,rcoef,qe) ! ! pe = pe + rcoef * qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe real(SP), intent(in) :: rcoef type(s_wqf_eo_blk_obj), intent(in) :: qe integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_add_rmult_swqf_blk pe/=qe.") endif do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * rcoef pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * rcoef pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * rcoef pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * rcoef enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
rcoef : | real(SP), intent(in) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe + rcoef * qe
subroutine accum_add_rmult_swqf_blk(pe,rcoef,qe) ! ! pe = pe + rcoef * qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe real(SP), intent(in) :: rcoef type(s_wqf_eo_blk_obj), intent(in) :: qe integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_add_rmult_swqf_blk pe/=qe.") endif do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * rcoef pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * rcoef pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * rcoef pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * rcoef enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
rcoef : | real(SP), intent(in) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe + rcoef * qe
subroutine accum_add_rmult_swqf_eo(pe,rcoef,qe) ! ! pe = pe + rcoef * qe ! implicit none type(s_wqf_eo_obj), intent(in) :: qe real(SP), intent(in) :: rcoef type(s_wqf_eo_obj), intent(inout) :: pe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_add_mult(pe%g(igx),rcoef,qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
rcoef : | real(SP), intent(in) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe + rcoef * qe
subroutine accum_add_rmult_swqf_eo(pe,rcoef,qe) ! ! pe = pe + rcoef * qe ! implicit none type(s_wqf_eo_obj), intent(in) :: qe real(SP), intent(in) :: rcoef type(s_wqf_eo_obj), intent(inout) :: pe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_add_mult(pe%g(igx),rcoef,qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
ccoef : | complex(SP), intent(in) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe * ccoef + qe
subroutine accum_cmult_add_swqf_blk(pe,ccoef,qe) ! ! pe = pe * ccoef + qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe complex(SP), intent(in) :: ccoef type(s_wqf_eo_blk_obj), intent(in) :: qe type(myfloat4) :: pp(COL*2) real(SP) :: cr,ci integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_cmult_add_swqf_blk pe/=qe.") endif cr = real(ccoef) ci = aimag(ccoef) do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ithz=1,NTHZ do itht=1,NTHT do ics=1,COL jcs=ics+COL pp(ics)%x = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * ci pp(ics)%y = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * ci pp(ics)%z = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * ci pp(ics)%w = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * ci pp(jcs)%x = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * ci pp(jcs)%y = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * ci pp(jcs)%z = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * ci pp(jcs)%w = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * ci pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = pp(ics) pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz) = pp(jcs) enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
ccoef : | complex(SP), intent(in) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe * ccoef + qe
subroutine accum_cmult_add_swqf_blk(pe,ccoef,qe) ! ! pe = pe * ccoef + qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe complex(SP), intent(in) :: ccoef type(s_wqf_eo_blk_obj), intent(in) :: qe type(myfloat4) :: pp(COL*2) real(SP) :: cr,ci integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_cmult_add_swqf_blk pe/=qe.") endif cr = real(ccoef) ci = aimag(ccoef) do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ithz=1,NTHZ do itht=1,NTHT do ics=1,COL jcs=ics+COL pp(ics)%x = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * ci pp(ics)%y = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * ci pp(ics)%z = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * ci pp(ics)%w = qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * cr - pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * ci pp(jcs)%x = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * ci pp(jcs)%y = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * ci pp(jcs)%z = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * ci pp(jcs)%w = qe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w + pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w * cr + pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * ci pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = pp(ics) pe%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz) = pp(jcs) enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
ccoef : | complex(SP), intent(in) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe * ccoef + qe
subroutine accum_cmult_add_swqf_eo(pe,ccoef,qe) ! ! pe = pe * ccoef + qe ! implicit none type(s_wqf_eo_obj), intent(inout) :: pe complex(SP), intent(in) :: ccoef type(s_wqf_eo_obj), intent(in) :: qe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_mult_add(pe%g(igx),ccoef,qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
ccoef : | complex(SP), intent(in) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe * ccoef + qe
subroutine accum_cmult_add_swqf_eo(pe,ccoef,qe) ! ! pe = pe * ccoef + qe ! implicit none type(s_wqf_eo_obj), intent(inout) :: pe complex(SP), intent(in) :: ccoef type(s_wqf_eo_obj), intent(in) :: qe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_mult_add(pe%g(igx),ccoef,qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
rcoef : | real(SP), intent(in) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe * rcoef + qe
subroutine accum_rmult_add_swqf_blk(pe,rcoef,qe) ! ! pe = pe * rcoef + qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe real(SP), intent(in) :: rcoef type(s_wqf_eo_blk_obj), intent(in) :: qe real(SP) :: cr,ci integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_rmult_add_swqf_blk pe/=qe.") endif do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ithz=1,NTHZ do itht=1,NTHT do ics=1,COL*2 pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
rcoef : | real(SP), intent(in) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe * rcoef + qe
subroutine accum_rmult_add_swqf_blk(pe,rcoef,qe) ! ! pe = pe * rcoef + qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe real(SP), intent(in) :: rcoef type(s_wqf_eo_blk_obj), intent(in) :: qe real(SP) :: cr,ci integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_rmult_add_swqf_blk pe/=qe.") endif do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ithz=1,NTHZ do itht=1,NTHT do ics=1,COL*2 pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w * rcoef + qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
rcoef : | real(SP), intent(in) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe * rcoef + qe
subroutine accum_rmult_add_swqf_eo(pe,rcoef,qe) ! ! pe = pe * rcoef + qe ! implicit none type(s_wqf_eo_obj), intent(inout) :: pe real(SP), intent(in) :: rcoef type(s_wqf_eo_obj), intent(in) :: qe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_mult_add(pe%g(igx),rcoef,qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
rcoef : | real(SP), intent(in) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe * rcoef + qe
subroutine accum_rmult_add_swqf_eo(pe,rcoef,qe) ! ! pe = pe * rcoef + qe ! implicit none type(s_wqf_eo_obj), intent(inout) :: pe real(SP), intent(in) :: rcoef type(s_wqf_eo_obj), intent(in) :: qe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_mult_add(pe%g(igx),rcoef,qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe - qe
subroutine accum_sub_swqf_blk(pe,qe) ! ! pe = pe - qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe type(s_wqf_eo_blk_obj), intent(in) :: qe integer :: ibx,iby,ibz,ics,ithz,itht if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_sub_swqf_blk pe/=qe.") endif do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_blk_obj), intent(inout) |
qe : | type(s_wqf_eo_blk_obj), intent(in) |
pe = pe - qe
subroutine accum_sub_swqf_blk(pe,qe) ! ! pe = pe - qe ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: pe type(s_wqf_eo_blk_obj), intent(in) :: qe integer :: ibx,iby,ibz,ics,ithz,itht if (pe%ieo /= qe%ieo .or. pe%igx /= qe%igx) then call error_stop("index (ieo,igx) error in accum_sub_swqf_blk pe/=qe.") endif do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w = pe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w - qe%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe - qe
subroutine accum_sub_swqf_eo(pe,qe) ! ! pe = pe - qe ! implicit none type(s_wqf_eo_obj), intent(inout) :: pe type(s_wqf_eo_obj), intent(in) :: qe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_sub(pe%g(igx),qe%g(igx)) enddo return end subroutine
Subroutine : | |
pe : | type(s_wqf_eo_obj), intent(inout) |
qe : | type(s_wqf_eo_obj), intent(in) |
pe = pe - qe
subroutine accum_sub_swqf_eo(pe,qe) ! ! pe = pe - qe ! implicit none type(s_wqf_eo_obj), intent(inout) :: pe type(s_wqf_eo_obj), intent(in) :: qe integer :: igx !$OMP PARALLEL DO do igx=1,NGX call accum_sub(pe%g(igx),qe%g(igx)) enddo return end subroutine
Subroutine : | |
y2 : | type(s_wqf_eo_blk_obj), intent(inout) |
y1 : | type(s_wqf_eo_blk_obj), intent(in) |
y2 <= y1
assign including extended sites.
subroutine assign_swqf_blk(y2,y1) ! ! y2 <= y1 ! ! assign including extended sites. ! type(s_wqf_eo_blk_obj), intent(inout):: y2 type(s_wqf_eo_blk_obj), intent(in) :: y1 if (y1%ieo /= y2%ieo .and. y1%igx /= y2%igx) then call error_stop("index (ieo,igx) error in assign_wqf_blk") endif y2 = y1 return end subroutine
Subroutine : | |
y2 : | type(s_wqf_eo_blk_obj), intent(inout) |
y1 : | type(s_wqf_eo_blk_obj), intent(in) |
y2 <= y1
assign including extended sites.
subroutine assign_swqf_blk(y2,y1) ! ! y2 <= y1 ! ! assign including extended sites. ! type(s_wqf_eo_blk_obj), intent(inout):: y2 type(s_wqf_eo_blk_obj), intent(in) :: y1 if (y1%ieo /= y2%ieo .and. y1%igx /= y2%igx) then call error_stop("index (ieo,igx) error in assign_wqf_blk") endif y2 = y1 return end subroutine
Subroutine : | |
y2 : | type(s_wqf_eo_obj), intent(inout) |
y1 : | type(s_wqf_eo_obj), intent(in) |
y2 <= y1
subroutine assign_swqf_eo(y2,y1) ! ! y2 <= y1 ! type(s_wqf_eo_obj), intent(inout):: y2 type(s_wqf_eo_obj), intent(in) :: y1 integer :: igx if (y1%ieo /= y2%ieo) then call error_stop("index (ieo) error in assign_wqf_eo") endif !$OMP PARALLEL DO do igx=1,NGX call assign(y2%g(igx),y1%g(igx)) enddo return end subroutine
Subroutine : | |
y2 : | type(s_wqf_eo_obj), intent(inout) |
y1 : | type(s_wqf_eo_obj), intent(in) |
y2 <= y1
subroutine assign_swqf_eo(y2,y1) ! ! y2 <= y1 ! type(s_wqf_eo_obj), intent(inout):: y2 type(s_wqf_eo_obj), intent(in) :: y1 integer :: igx if (y1%ieo /= y2%ieo) then call error_stop("index (ieo) error in assign_wqf_eo") endif !$OMP PARALLEL DO do igx=1,NGX call assign(y2%g(igx),y1%g(igx)) enddo return end subroutine
Subroutine : | |
y2 : | type(s_wqf_obj), intent(inout) |
y1 : | type(s_wqf_obj), intent(in) |
y2 <= y1
subroutine assign_swqf(y2,y1) ! ! y2 <= y1 ! type(s_wqf_obj), intent(inout):: y2 type(s_wqf_obj), intent(in) :: y1 integer :: ieo do ieo=0,1 call assign(y2%eo(ieo),y1%eo(ieo)) enddo return end subroutine
Subroutine : | |
y2 : | type(s_wqf_obj), intent(inout) |
y1 : | type(s_wqf_obj), intent(in) |
y2 <= y1
subroutine assign_swqf(y2,y1) ! ! y2 <= y1 ! type(s_wqf_obj), intent(inout):: y2 type(s_wqf_obj), intent(in) :: y1 integer :: ieo do ieo=0,1 call assign(y2%eo(ieo),y1%eo(ieo)) enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_eo_blk_obj), intent(inout) |
y = 0
subroutine clear_swqf_blk(y) ! ! y = 0 ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: y integer :: ibx,iby,ibz,itht,ithz,ics type(myfloat4) :: Z0 Z0%x=0.0_SP Z0%y=0.0_SP Z0%z=0.0_SP Z0%w=0.0_SP do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0 y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0 enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_eo_blk_obj), intent(inout) |
y = 0
subroutine clear_swqf_blk(y) ! ! y = 0 ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: y integer :: ibx,iby,ibz,itht,ithz,ics type(myfloat4) :: Z0 Z0%x=0.0_SP Z0%y=0.0_SP Z0%z=0.0_SP Z0%w=0.0_SP do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0 y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0 enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_eo_obj), intent(inout) |
y = 0
subroutine clear_swqf_eo(y) ! ! y = 0 ! implicit none type(s_wqf_eo_obj), intent(inout) :: y integer :: igx !$OMP PARALLEL DO do igx=1,NGX call clear(y%g(igx)) enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_eo_obj), intent(inout) |
y = 0
subroutine clear_swqf_eo(y) ! ! y = 0 ! implicit none type(s_wqf_eo_obj), intent(inout) :: y integer :: igx !$OMP PARALLEL DO do igx=1,NGX call clear(y%g(igx)) enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_obj), intent(inout) |
y = 0
subroutine clear_swqf(y) ! ! y = 0 ! implicit none type(s_wqf_obj), intent(inout) :: y integer :: ieo do ieo=0,1 call clear(y%eo(ieo)) enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_obj), intent(inout) |
y = 0
subroutine clear_swqf(y) ! ! y = 0 ! implicit none type(s_wqf_obj), intent(inout) :: y integer :: ieo do ieo=0,1 call clear(y%eo(ieo)) enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_eo_blk_obj), intent(inout) |
y = 0
subroutine clear_swqf_blk_wg(y) ! ! y = 0 ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: y integer :: ibx,iby,ibz,itht,ithz,ics type(myfloat4) :: Z0 Z0%x=0.0_SP Z0%y=0.0_SP Z0%z=0.0_SP Z0%w=0.0_SP do ibx=1-NDEPTH,NBX+NDEPTH do iby=1-NDEPTH,NBY+NDEPTH do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0 y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0 enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_eo_blk_obj), intent(inout) |
y = 0
subroutine clear_swqf_blk_wg(y) ! ! y = 0 ! implicit none type(s_wqf_eo_blk_obj), intent(inout) :: y integer :: ibx,iby,ibz,itht,ithz,ics type(myfloat4) :: Z0 Z0%x=0.0_SP Z0%y=0.0_SP Z0%z=0.0_SP Z0%w=0.0_SP do ibx=1-NDEPTH,NBX+NDEPTH do iby=1-NDEPTH,NBY+NDEPTH do ibz=1,NBZ do ics=1,COL*2 do ithz=1,NTHZ do itht=1,NTHT y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0 y%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz) = Z0 enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_eo_obj), intent(inout) |
y = 0
subroutine clear_swqf_eo_wg(y) ! ! y = 0 ! implicit none type(s_wqf_eo_obj), intent(inout) :: y integer :: igx !$OMP PARALLEL DO do igx=1,NGX call clear_all(y%g(igx)) enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_eo_obj), intent(inout) |
y = 0
subroutine clear_swqf_eo_wg(y) ! ! y = 0 ! implicit none type(s_wqf_eo_obj), intent(inout) :: y integer :: igx !$OMP PARALLEL DO do igx=1,NGX call clear_all(y%g(igx)) enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_obj), intent(inout) |
y = 0
subroutine clear_swqf_wg(y) ! ! y = 0 ! implicit none type(s_wqf_obj), intent(inout) :: y integer :: ieo do ieo=0,1 call clear_all(y%eo(ieo)) enddo return end subroutine
Subroutine : | |
y : | type(s_wqf_obj), intent(inout) |
y = 0
subroutine clear_swqf_wg(y) ! ! y = 0 ! implicit none type(s_wqf_obj), intent(inout) :: y integer :: ieo do ieo=0,1 call clear_all(y%eo(ieo)) enddo return end subroutine
Subroutine : | |
sclv : | type(s_clvf_eo_obj), intent(out) |
dclv : | type(field_clover_term_eo), intent(in) |
subroutine conv_clv_eo(sclv,dclv) use field_clover_class implicit none type(s_clvf_eo_obj), intent(out) :: sclv type(field_clover_term_eo), intent(in) :: dclv complex(DP) :: ztmp type(clvmat) :: cc integer :: itht,ithz,ibz,iby,ibx,igx,ics,itht0 integer :: ix,iy,iz,ieoxyz,ieo ieo = dclv%ieo sclv%ieo = ieo sclv%ipeo = ipeo !$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht0,ix,iy,iz,ieoxyz,ics,cc) do igx=1,NGX sclv%g(igx)%ipeo=ipeo sclv%g(igx)%ieo=ieo sclv%g(igx)%igx=igx do ibx=1,NBX ix = ibx + (igx-1)*NBX do iby=1,NBY do ibz=1,NBZ iy = iby do ithz=1,NTHZ iz = ithz + (ibz-1)*NTHZ ieoxyz=mod(ipeo+ieo+ix+iy+iz,2) do itht0=1,NTHT do ics=1,CLSPH cc%c1r(ics) = REAL(dclv%l(ics,1,itht0,iz,iy,ix)) cc%c1i(ics) = AIMAG(dclv%l(ics,1,itht0,iz,iy,ix)) cc%c2r(ics) = REAL(dclv%l(ics,2,itht0,iz,iy,ix)) cc%c2i(ics) = AIMAG(dclv%l(ics,2,itht0,iz,iy,ix)) enddo sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%x = cc%c1r( 1) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%y = cc%c1r( 2) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%z = cc%c1r( 3) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%w = cc%c1r( 4) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%x = cc%c1r( 5) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%y = cc%c1r( 6) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%z = cc%c1r( 7) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%w = cc%c1r( 8) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%x = cc%c1r( 9) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%y = cc%c1r(10) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%z = cc%c1r(11) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%w = cc%c1r(12) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%x = cc%c1r(13) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%y = cc%c1r(14) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%z = cc%c1r(15) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%w = cc%c1r(16) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%x = cc%c1r(17) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%y = cc%c1r(18) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%z = cc%c1r(19) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%w = cc%c1r(20) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%x = cc%c1r(21) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%y = cc%c1i( 1) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%z = cc%c1i( 2) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%w = cc%c1i( 3) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%x = cc%c1i( 4) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%y = cc%c1i( 5) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%z = cc%c1i( 6) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%w = cc%c1i( 7) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%x = cc%c1i( 8) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%y = cc%c1i( 9) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%z = cc%c1i(10) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%w = cc%c1i(11) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%x = cc%c1i(12) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%y = cc%c1i(13) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%z = cc%c1i(14) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%w = cc%c1i(15) sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%x = cc%c1i(16) sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%y = cc%c1i(17) sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%z = cc%c1i(18) sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%w = cc%c1i(19) sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%x = cc%c1i(20) sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%y = cc%c1i(21) sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%z = cc%c2r( 1) sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%w = cc%c2r( 2) sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%x = cc%c2r( 3) sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%y = cc%c2r( 4) sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%z = cc%c2r( 5) sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%w = cc%c2r( 6) sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%x = cc%c2r( 7) sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%y = cc%c2r( 8) sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%z = cc%c2r( 9) sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%w = cc%c2r(10) sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%x = cc%c2r(11) sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%y = cc%c2r(12) sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%z = cc%c2r(13) sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%w = cc%c2r(14) sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%x = cc%c2r(15) sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%y = cc%c2r(16) sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%z = cc%c2r(17) sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%w = cc%c2r(18) sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%x = cc%c2r(19) sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%y = cc%c2r(20) sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%z = cc%c2r(21) sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%w = cc%c2i( 1) sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%x = cc%c2i( 2) sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%y = cc%c2i( 3) sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%z = cc%c2i( 4) sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%w = cc%c2i( 5) sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%x = cc%c2i( 6) sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%y = cc%c2i( 7) sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%z = cc%c2i( 8) sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%w = cc%c2i( 9) sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%x = cc%c2i(10) sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%y = cc%c2i(11) sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%z = cc%c2i(12) sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%w = cc%c2i(13) sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%x = cc%c2i(14) sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%y = cc%c2i(15) sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%z = cc%c2i(16) sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%w = cc%c2i(17) sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%x = cc%c2i(18) sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%y = cc%c2i(19) sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%z = cc%c2i(20) sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%w = cc%c2i(21) enddo enddo enddo enddo enddo enddo !$OMP END PARALLEL DO call copy_boundary(sclv) return end subroutine
Subroutine : | |
sclv : | type(s_clvf_eo_obj), intent(out) |
dclv : | type(field_clover_term_eo), intent(in) |
subroutine conv_clv_eo(sclv,dclv) use field_clover_class implicit none type(s_clvf_eo_obj), intent(out) :: sclv type(field_clover_term_eo), intent(in) :: dclv complex(DP) :: ztmp type(clvmat) :: cc integer :: itht,ithz,ibz,iby,ibx,igx,ics,itht0 integer :: ix,iy,iz,ieoxyz,ieo ieo = dclv%ieo sclv%ieo = ieo sclv%ipeo = ipeo !$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht0,ix,iy,iz,ieoxyz,ics,cc) do igx=1,NGX sclv%g(igx)%ipeo=ipeo sclv%g(igx)%ieo=ieo sclv%g(igx)%igx=igx do ibx=1,NBX ix = ibx + (igx-1)*NBX do iby=1,NBY do ibz=1,NBZ iy = iby do ithz=1,NTHZ iz = ithz + (ibz-1)*NTHZ ieoxyz=mod(ipeo+ieo+ix+iy+iz,2) do itht0=1,NTHT do ics=1,CLSPH cc%c1r(ics) = REAL(dclv%l(ics,1,itht0,iz,iy,ix)) cc%c1i(ics) = AIMAG(dclv%l(ics,1,itht0,iz,iy,ix)) cc%c2r(ics) = REAL(dclv%l(ics,2,itht0,iz,iy,ix)) cc%c2i(ics) = AIMAG(dclv%l(ics,2,itht0,iz,iy,ix)) enddo sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%x = cc%c1r( 1) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%y = cc%c1r( 2) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%z = cc%c1r( 3) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 1)%f(itht0,ithz)%w = cc%c1r( 4) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%x = cc%c1r( 5) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%y = cc%c1r( 6) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%z = cc%c1r( 7) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 2)%f(itht0,ithz)%w = cc%c1r( 8) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%x = cc%c1r( 9) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%y = cc%c1r(10) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%z = cc%c1r(11) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 3)%f(itht0,ithz)%w = cc%c1r(12) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%x = cc%c1r(13) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%y = cc%c1r(14) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%z = cc%c1r(15) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 4)%f(itht0,ithz)%w = cc%c1r(16) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%x = cc%c1r(17) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%y = cc%c1r(18) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%z = cc%c1r(19) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 5)%f(itht0,ithz)%w = cc%c1r(20) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%x = cc%c1r(21) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%y = cc%c1i( 1) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%z = cc%c1i( 2) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 6)%f(itht0,ithz)%w = cc%c1i( 3) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%x = cc%c1i( 4) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%y = cc%c1i( 5) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%z = cc%c1i( 6) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 7)%f(itht0,ithz)%w = cc%c1i( 7) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%x = cc%c1i( 8) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%y = cc%c1i( 9) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%z = cc%c1i(10) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 8)%f(itht0,ithz)%w = cc%c1i(11) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%x = cc%c1i(12) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%y = cc%c1i(13) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%z = cc%c1i(14) sclv%g(igx)%blk(ibz,iby,ibx)%thd( 9)%f(itht0,ithz)%w = cc%c1i(15) sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%x = cc%c1i(16) sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%y = cc%c1i(17) sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%z = cc%c1i(18) sclv%g(igx)%blk(ibz,iby,ibx)%thd(10)%f(itht0,ithz)%w = cc%c1i(19) sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%x = cc%c1i(20) sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%y = cc%c1i(21) sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%z = cc%c2r( 1) sclv%g(igx)%blk(ibz,iby,ibx)%thd(11)%f(itht0,ithz)%w = cc%c2r( 2) sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%x = cc%c2r( 3) sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%y = cc%c2r( 4) sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%z = cc%c2r( 5) sclv%g(igx)%blk(ibz,iby,ibx)%thd(12)%f(itht0,ithz)%w = cc%c2r( 6) sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%x = cc%c2r( 7) sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%y = cc%c2r( 8) sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%z = cc%c2r( 9) sclv%g(igx)%blk(ibz,iby,ibx)%thd(13)%f(itht0,ithz)%w = cc%c2r(10) sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%x = cc%c2r(11) sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%y = cc%c2r(12) sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%z = cc%c2r(13) sclv%g(igx)%blk(ibz,iby,ibx)%thd(14)%f(itht0,ithz)%w = cc%c2r(14) sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%x = cc%c2r(15) sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%y = cc%c2r(16) sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%z = cc%c2r(17) sclv%g(igx)%blk(ibz,iby,ibx)%thd(15)%f(itht0,ithz)%w = cc%c2r(18) sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%x = cc%c2r(19) sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%y = cc%c2r(20) sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%z = cc%c2r(21) sclv%g(igx)%blk(ibz,iby,ibx)%thd(16)%f(itht0,ithz)%w = cc%c2i( 1) sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%x = cc%c2i( 2) sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%y = cc%c2i( 3) sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%z = cc%c2i( 4) sclv%g(igx)%blk(ibz,iby,ibx)%thd(17)%f(itht0,ithz)%w = cc%c2i( 5) sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%x = cc%c2i( 6) sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%y = cc%c2i( 7) sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%z = cc%c2i( 8) sclv%g(igx)%blk(ibz,iby,ibx)%thd(18)%f(itht0,ithz)%w = cc%c2i( 9) sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%x = cc%c2i(10) sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%y = cc%c2i(11) sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%z = cc%c2i(12) sclv%g(igx)%blk(ibz,iby,ibx)%thd(19)%f(itht0,ithz)%w = cc%c2i(13) sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%x = cc%c2i(14) sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%y = cc%c2i(15) sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%z = cc%c2i(16) sclv%g(igx)%blk(ibz,iby,ibx)%thd(20)%f(itht0,ithz)%w = cc%c2i(17) sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%x = cc%c2i(18) sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%y = cc%c2i(19) sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%z = cc%c2i(20) sclv%g(igx)%blk(ibz,iby,ibx)%thd(21)%f(itht0,ithz)%w = cc%c2i(21) enddo enddo enddo enddo enddo enddo !$OMP END PARALLEL DO call copy_boundary(sclv) return end subroutine
Subroutine : | |
sclv : | type(s_clvf_obj), intent(out) |
dclv : | type(field_clover_term), intent(in) |
subroutine conv_clv(sclv,dclv) use field_clover_class implicit none type(s_clvf_obj), intent(out) :: sclv type(field_clover_term), intent(in) :: dclv integer :: ieo do ieo=0,1 call conv_clv_eo(sclv%eo(ieo),dclv%eo(ieo)) enddo return end subroutine
Subroutine : | |
sclv : | type(s_clvf_obj), intent(out) |
dclv : | type(field_clover_term), intent(in) |
subroutine conv_clv(sclv,dclv) use field_clover_class implicit none type(s_clvf_obj), intent(out) :: sclv type(field_clover_term), intent(in) :: dclv integer :: ieo do ieo=0,1 call conv_clv_eo(sclv%eo(ieo),dclv%eo(ieo)) enddo return end subroutine
Subroutine : | |
su : | type(s_gvf_eo_obj), intent(out) |
du : | type(vfield_gluon_eo_wg), intent(in) |
subroutine conv_u_d2s_eo(su,du) use field_gauge_class implicit none type(s_gvf_eo_obj), intent(out) :: su type(vfield_gluon_eo_wg), intent(in) :: du type(su3mat) :: uu complex(DP) :: ztmp integer :: itht,ithz,ibz,iby,ibx,igx,ic,jc,mu,itht0 integer :: ix,iy,iz,ieoxyz,ieo integer :: itx,ity,ipu character(len=256) :: str(0:NPU-1) ieo = du%ieo su%ieo = ieo su%ipeo = ipeo !$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,jc,mu,ztmp,uu) do igx=1,NGX su%g(igx)%ipeo=ipeo su%g(igx)%ieo=ieo su%g(igx)%igx=igx do ibx=1,NBX ix = ibx + (igx-1)*NBX do iby=1,NBY do ibz=1,NBZ iy = iby do mu=1,NDIM do ithz=1,NTHZ iz = ithz + (ibz-1)*NTHZ ieoxyz=mod(ipeo+ieo+ix+iy+iz,2) do itht=1-ieoxyz,NTHT-ieoxyz itht0=itht+ieoxyz do jc=1,COL-1 do ic=1,COL ztmp = du%mu(mu)%s(itht,iz,iy,ix)%u(ic,jc) uu%ur(ic,jc) = REAL(ztmp) uu%ui(ic,jc) = AIMAG(ztmp) enddo enddo su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%x = uu%ur(1,1) su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%y = uu%ur(2,1) su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%z = uu%ur(3,1) su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%w = uu%ur(1,2) su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%x = uu%ur(2,2) su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%y = uu%ur(3,2) su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%z = uu%ui(1,1) su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%w = uu%ui(2,1) su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%x = uu%ui(3,1) su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%y = uu%ui(1,2) su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%z = uu%ui(2,2) su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%w = uu%ui(3,2) enddo enddo enddo enddo enddo enddo enddo !$OMP END PARALLEL DO call copy_boundary(su) return end subroutine
Subroutine : | |
su : | type(s_gvf_eo_obj), intent(out) |
du : | type(vfield_gluon_eo_wg), intent(in) |
subroutine conv_u_d2s_eo(su,du) use field_gauge_class implicit none type(s_gvf_eo_obj), intent(out) :: su type(vfield_gluon_eo_wg), intent(in) :: du type(su3mat) :: uu complex(DP) :: ztmp integer :: itht,ithz,ibz,iby,ibx,igx,ic,jc,mu,itht0 integer :: ix,iy,iz,ieoxyz,ieo integer :: itx,ity,ipu character(len=256) :: str(0:NPU-1) ieo = du%ieo su%ieo = ieo su%ipeo = ipeo !$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,jc,mu,ztmp,uu) do igx=1,NGX su%g(igx)%ipeo=ipeo su%g(igx)%ieo=ieo su%g(igx)%igx=igx do ibx=1,NBX ix = ibx + (igx-1)*NBX do iby=1,NBY do ibz=1,NBZ iy = iby do mu=1,NDIM do ithz=1,NTHZ iz = ithz + (ibz-1)*NTHZ ieoxyz=mod(ipeo+ieo+ix+iy+iz,2) do itht=1-ieoxyz,NTHT-ieoxyz itht0=itht+ieoxyz do jc=1,COL-1 do ic=1,COL ztmp = du%mu(mu)%s(itht,iz,iy,ix)%u(ic,jc) uu%ur(ic,jc) = REAL(ztmp) uu%ui(ic,jc) = AIMAG(ztmp) enddo enddo su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%x = uu%ur(1,1) su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%y = uu%ur(2,1) su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%z = uu%ur(3,1) su%g(igx)%blk(ibz,iby,ibx)%thd(1,mu)%f(itht0,ithz)%w = uu%ur(1,2) su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%x = uu%ur(2,2) su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%y = uu%ur(3,2) su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%z = uu%ui(1,1) su%g(igx)%blk(ibz,iby,ibx)%thd(2,mu)%f(itht0,ithz)%w = uu%ui(2,1) su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%x = uu%ui(3,1) su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%y = uu%ui(1,2) su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%z = uu%ui(2,2) su%g(igx)%blk(ibz,iby,ibx)%thd(3,mu)%f(itht0,ithz)%w = uu%ui(3,2) enddo enddo enddo enddo enddo enddo enddo !$OMP END PARALLEL DO call copy_boundary(su) return end subroutine
Subroutine : | |
su : | type(s_gvf_obj), intent(out) |
du : | type(vfield_gluon_wg), intent(in) |
subroutine conv_u_d2s(su,du) use field_gauge_class implicit none type(s_gvf_obj), intent(out) :: su type(vfield_gluon_wg), intent(in) :: du integer :: ieo do ieo=0,1 call conv_u_d2s_eo(su%eo(ieo),du%eo(ieo)) enddo return end subroutine
Subroutine : | |
su : | type(s_gvf_obj), intent(out) |
du : | type(vfield_gluon_wg), intent(in) |
subroutine conv_u_d2s(su,du) use field_gauge_class implicit none type(s_gvf_obj), intent(out) :: su type(vfield_gluon_wg), intent(in) :: du integer :: ieo do ieo=0,1 call conv_u_d2s_eo(su%eo(ieo),du%eo(ieo)) enddo return end subroutine
Subroutine : | |
sclv : | type(s_clvf_eo_obj), intent(inout) |
subroutine copy_boundary_sclv_eo(sclv) implicit none type(s_clvf_eo_obj), intent(inout) :: sclv integer :: ibz,iby,igx,ibx integer :: igx_dn,igx_up integer :: itht,ithz,ic,ibuff type(single_field_world) :: sp_lattice if (.not. m_is_initialized) call new(sp_lattice) #ifndef _singlePU call comlib_barrier #endif do igx=1,NGX igx_up=mod(igx-1+1+NGX,NGX)+1 igx_dn=mod(igx-1-1+NGX,NGX)+1 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz) do iby=1,NBY do ibz=1,NBZ sclv%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = sclv%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx) sclv%g(igx)%blk(ibz,iby, NBX+1+ibx) = sclv%g(igx_up)%blk(ibz,iby, 1+ibx) enddo enddo enddo enddo do igx=1,NGX do iby=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(ibx,ibz) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = sclv%g(igx )%blk(ibz,NBY-NDEPTH+1+iby,ibx) sclv%g(igx)%blk(ibz, NBY+1+iby,ibx) = sclv%g(igx )%blk(ibz, 1+iby,ibx) enddo enddo enddo enddo #if _NDIMX != 1 ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do ic=1,CLSPH do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (iby-1)*2*NTHT*NTHZ*CLSPH*NBZ + (ibx)*2*NTHT*NTHZ*CLSPH*NBZ*NBY clvf_buff(1)%buff_up(ibuff+1,1) = cmplx(sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%y) clvf_buff(1)%buff_up(ibuff+2,1) = cmplx(sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%w) clvf_buff(1)%buff_dn(ibuff+1,1) = cmplx(sclv%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%x, sclv%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%y) clvf_buff(1)%buff_dn(ibuff+2,1) = cmplx(sclv%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%z, sclv%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo call comlib_sendrecv(clvf_buff(1)%id_sendup) call comlib_sendrecv(clvf_buff(1)%id_senddn) ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do ic=1,CLSPH do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (iby-1)*2*NTHT*NTHZ*CLSPH*NBZ + (ibx)*2*NTHT*NTHZ*CLSPH*NBZ*NBY sclv%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%x = real(clvf_buff(1)%buff_dn(ibuff+1,2)) sclv%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(1)%buff_dn(ibuff+1,2)) sclv%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%z = real(clvf_buff(1)%buff_dn(ibuff+2,2)) sclv%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(1)%buff_dn(ibuff+2,2)) sclv%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%x = real(clvf_buff(1)%buff_up(ibuff+1,2)) sclv%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(1)%buff_up(ibuff+1,2)) sclv%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%z = real(clvf_buff(1)%buff_up(ibuff+2,2)) sclv%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(1)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo #endif #if _NDIMY != 1 ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do ic=1,CLSPH do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (ibx-1+NDEPTH)*2*NTHT*NTHZ*CLSPH*NBZ + (igx-1)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH)*NGX clvf_buff(2)%buff_up(ibuff+1,1) = cmplx(sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%y) clvf_buff(2)%buff_up(ibuff+2,1) = cmplx(sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%w) clvf_buff(2)%buff_dn(ibuff+1,1) = cmplx(sclv%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%y) clvf_buff(2)%buff_dn(ibuff+2,1) = cmplx(sclv%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo call comlib_sendrecv(clvf_buff(2)%id_sendup) call comlib_sendrecv(clvf_buff(2)%id_senddn) ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do ic=1,CLSPH do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (ibx-1+NDEPTH)*2*NTHT*NTHZ*CLSPH*NBZ + (igx-1)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH)*NGX sclv%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%x = real(clvf_buff(2)%buff_dn(ibuff+1,2)) sclv%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(2)%buff_dn(ibuff+1,2)) sclv%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%z = real(clvf_buff(2)%buff_dn(ibuff+2,2)) sclv%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(2)%buff_dn(ibuff+2,2)) sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%x = real(clvf_buff(2)%buff_up(ibuff+1,2)) sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(2)%buff_up(ibuff+1,2)) sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%z = real(clvf_buff(2)%buff_up(ibuff+2,2)) sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(2)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo #endif return end subroutine
Subroutine : | |
sclv : | type(s_clvf_eo_obj), intent(inout) |
subroutine copy_boundary_sclv_eo(sclv) implicit none type(s_clvf_eo_obj), intent(inout) :: sclv integer :: ibz,iby,igx,ibx integer :: igx_dn,igx_up integer :: itht,ithz,ic,ibuff type(single_field_world) :: sp_lattice if (.not. m_is_initialized) call new(sp_lattice) #ifndef _singlePU call comlib_barrier #endif do igx=1,NGX igx_up=mod(igx-1+1+NGX,NGX)+1 igx_dn=mod(igx-1-1+NGX,NGX)+1 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz) do iby=1,NBY do ibz=1,NBZ sclv%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = sclv%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx) sclv%g(igx)%blk(ibz,iby, NBX+1+ibx) = sclv%g(igx_up)%blk(ibz,iby, 1+ibx) enddo enddo enddo enddo do igx=1,NGX do iby=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(ibx,ibz) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = sclv%g(igx )%blk(ibz,NBY-NDEPTH+1+iby,ibx) sclv%g(igx)%blk(ibz, NBY+1+iby,ibx) = sclv%g(igx )%blk(ibz, 1+iby,ibx) enddo enddo enddo enddo #if _NDIMX != 1 ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do ic=1,CLSPH do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (iby-1)*2*NTHT*NTHZ*CLSPH*NBZ + (ibx)*2*NTHT*NTHZ*CLSPH*NBZ*NBY clvf_buff(1)%buff_up(ibuff+1,1) = cmplx(sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%y) clvf_buff(1)%buff_up(ibuff+2,1) = cmplx(sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%w) clvf_buff(1)%buff_dn(ibuff+1,1) = cmplx(sclv%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%x, sclv%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%y) clvf_buff(1)%buff_dn(ibuff+2,1) = cmplx(sclv%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%z, sclv%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo call comlib_sendrecv(clvf_buff(1)%id_sendup) call comlib_sendrecv(clvf_buff(1)%id_senddn) ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do ic=1,CLSPH do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (iby-1)*2*NTHT*NTHZ*CLSPH*NBZ + (ibx)*2*NTHT*NTHZ*CLSPH*NBZ*NBY sclv%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%x = real(clvf_buff(1)%buff_dn(ibuff+1,2)) sclv%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(1)%buff_dn(ibuff+1,2)) sclv%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%z = real(clvf_buff(1)%buff_dn(ibuff+2,2)) sclv%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(1)%buff_dn(ibuff+2,2)) sclv%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%x = real(clvf_buff(1)%buff_up(ibuff+1,2)) sclv%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(1)%buff_up(ibuff+1,2)) sclv%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%z = real(clvf_buff(1)%buff_up(ibuff+2,2)) sclv%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(1)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo #endif #if _NDIMY != 1 ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do ic=1,CLSPH do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (ibx-1+NDEPTH)*2*NTHT*NTHZ*CLSPH*NBZ + (igx-1)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH)*NGX clvf_buff(2)%buff_up(ibuff+1,1) = cmplx(sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%y) clvf_buff(2)%buff_up(ibuff+2,1) = cmplx(sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%w) clvf_buff(2)%buff_dn(ibuff+1,1) = cmplx(sclv%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sclv%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%y) clvf_buff(2)%buff_dn(ibuff+2,1) = cmplx(sclv%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sclv%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo call comlib_sendrecv(clvf_buff(2)%id_sendup) call comlib_sendrecv(clvf_buff(2)%id_senddn) ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do ic=1,CLSPH do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*CLSPH + (ibx-1+NDEPTH)*2*NTHT*NTHZ*CLSPH*NBZ + (igx-1)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*CLSPH*NBZ*(NBX+2*NDEPTH)*NGX sclv%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%x = real(clvf_buff(2)%buff_dn(ibuff+1,2)) sclv%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(2)%buff_dn(ibuff+1,2)) sclv%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%z = real(clvf_buff(2)%buff_dn(ibuff+2,2)) sclv%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(2)%buff_dn(ibuff+2,2)) sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%x = real(clvf_buff(2)%buff_up(ibuff+1,2)) sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(clvf_buff(2)%buff_up(ibuff+1,2)) sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%z = real(clvf_buff(2)%buff_up(ibuff+2,2)) sclv%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(clvf_buff(2)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo #endif return end subroutine
Subroutine : | |
sclv : | type(s_clvf_obj), intent(inout) |
subroutine copy_boundary_sclv(sclv) implicit none type(s_clvf_obj), intent(inout) :: sclv integer :: ieo do ieo=0,1 call copy_boundary(sclv%eo(ieo)) enddo end subroutine
Subroutine : | |
sclv : | type(s_clvf_obj), intent(inout) |
subroutine copy_boundary_sclv(sclv) implicit none type(s_clvf_obj), intent(inout) :: sclv integer :: ieo do ieo=0,1 call copy_boundary(sclv%eo(ieo)) enddo end subroutine
Subroutine : | |
sq : | type(s_wqf_eo_obj), intent(inout) |
subroutine copy_boundary_sq_eo(sq) implicit none type(s_wqf_eo_obj), intent(inout) :: sq integer :: ibx,ibz,iby,igx,idx integer :: igx_up integer :: igx_dn integer :: itht,ithz,ic,ibuff type(su3ferm) :: yy,ww type(single_field_world) :: sp_lattice if (.not. m_is_initialized) call new(sp_lattice) #ifndef _singlePU call comlib_barrier #endif do igx=1,NGX igx_up=mod(igx-1+1+NGX,NGX)+1 igx_dn=mod(igx-1-1+NGX,NGX)+1 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz) do iby=1,NBY do ibz=1,NBZ sq%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = sq%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx) sq%g(igx)%blk(ibz,iby, NBX+1+ibx) = sq%g(igx_up)%blk(ibz,iby, 1+ibx) enddo enddo enddo enddo do igx=1,NGX do iby=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(ibx,ibz) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = sq%g(igx )%blk(ibz,NBY-NDEPTH+1+iby,ibx) sq%g(igx)%blk(ibz, NBY+1+iby,ibx) = sq%g(igx )%blk(ibz, 1+iby,ibx) enddo enddo enddo enddo #if _NDIMX != 1 ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do ic=1,CLSP/2 do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (iby-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (ibx)*2*NTHT*NTHZ*(CLSP/2)*NBZ*NBY wqf_buff(1)%buff_up(ibuff+1,1) = cmplx(sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%x, sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%y) wqf_buff(1)%buff_up(ibuff+2,1) = cmplx(sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%z, sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%w) wqf_buff(1)%buff_dn(ibuff+1,1) = cmplx(sq%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%x, sq%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%y) wqf_buff(1)%buff_dn(ibuff+2,1) = cmplx(sq%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%z, sq%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo call comlib_sendrecv(wqf_buff(1)%id_sendup) call comlib_sendrecv(wqf_buff(1)%id_senddn) ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do ic=1,CLSP/2 do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (iby-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (ibx)*2*NTHT*NTHZ*(CLSP/2)*NBZ*NBY sq%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%x = real(wqf_buff(1)%buff_dn(ibuff+1,2)) sq%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(1)%buff_dn(ibuff+1,2)) sq%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%z = real(wqf_buff(1)%buff_dn(ibuff+2,2)) sq%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(1)%buff_dn(ibuff+2,2)) sq%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%x = real(wqf_buff(1)%buff_up(ibuff+1,2)) sq%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(1)%buff_up(ibuff+1,2)) sq%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%z = real(wqf_buff(1)%buff_up(ibuff+2,2)) sq%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(1)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo #endif #if _NDIMY != 1 ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do ic=1,CLSP/2 do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (ibx-1+NDEPTH)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (igx-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH)*NGX wqf_buff(2)%buff_up(ibuff+1,1) = cmplx(sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%y) wqf_buff(2)%buff_up(ibuff+2,1) = cmplx(sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%w) wqf_buff(2)%buff_dn(ibuff+1,1) = cmplx(sq%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sq%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%y) wqf_buff(2)%buff_dn(ibuff+2,1) = cmplx(sq%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sq%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo call comlib_sendrecv(wqf_buff(2)%id_sendup) call comlib_sendrecv(wqf_buff(2)%id_senddn) ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do ic=1,CLSP/2 do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (ibx-1+NDEPTH)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (igx-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH)*NGX sq%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%x = real(wqf_buff(2)%buff_dn(ibuff+1,2)) sq%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(2)%buff_dn(ibuff+1,2)) sq%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%z = real(wqf_buff(2)%buff_dn(ibuff+2,2)) sq%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(2)%buff_dn(ibuff+2,2)) sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%x = real(wqf_buff(2)%buff_up(ibuff+1,2)) sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(2)%buff_up(ibuff+1,2)) sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%z = real(wqf_buff(2)%buff_up(ibuff+2,2)) sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(2)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo #endif return end subroutine
Subroutine : | |
sq : | type(s_wqf_eo_obj), intent(inout) |
subroutine copy_boundary_sq_eo(sq) implicit none type(s_wqf_eo_obj), intent(inout) :: sq integer :: ibx,ibz,iby,igx,idx integer :: igx_up integer :: igx_dn integer :: itht,ithz,ic,ibuff type(su3ferm) :: yy,ww type(single_field_world) :: sp_lattice if (.not. m_is_initialized) call new(sp_lattice) #ifndef _singlePU call comlib_barrier #endif do igx=1,NGX igx_up=mod(igx-1+1+NGX,NGX)+1 igx_dn=mod(igx-1-1+NGX,NGX)+1 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz) do iby=1,NBY do ibz=1,NBZ sq%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = sq%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx) sq%g(igx)%blk(ibz,iby, NBX+1+ibx) = sq%g(igx_up)%blk(ibz,iby, 1+ibx) enddo enddo enddo enddo do igx=1,NGX do iby=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(ibx,ibz) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = sq%g(igx )%blk(ibz,NBY-NDEPTH+1+iby,ibx) sq%g(igx)%blk(ibz, NBY+1+iby,ibx) = sq%g(igx )%blk(ibz, 1+iby,ibx) enddo enddo enddo enddo #if _NDIMX != 1 ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do ic=1,CLSP/2 do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (iby-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (ibx)*2*NTHT*NTHZ*(CLSP/2)*NBZ*NBY wqf_buff(1)%buff_up(ibuff+1,1) = cmplx(sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%x, sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%y) wqf_buff(1)%buff_up(ibuff+2,1) = cmplx(sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%z, sq%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic)%f(itht,ithz)%w) wqf_buff(1)%buff_dn(ibuff+1,1) = cmplx(sq%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%x, sq%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%y) wqf_buff(1)%buff_dn(ibuff+2,1) = cmplx(sq%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%z, sq%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo call comlib_sendrecv(wqf_buff(1)%id_sendup) call comlib_sendrecv(wqf_buff(1)%id_senddn) ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do ic=1,CLSP/2 do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (iby-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (ibx)*2*NTHT*NTHZ*(CLSP/2)*NBZ*NBY sq%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%x = real(wqf_buff(1)%buff_dn(ibuff+1,2)) sq%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(1)%buff_dn(ibuff+1,2)) sq%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%z = real(wqf_buff(1)%buff_dn(ibuff+2,2)) sq%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(1)%buff_dn(ibuff+2,2)) sq%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%x = real(wqf_buff(1)%buff_up(ibuff+1,2)) sq%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(1)%buff_up(ibuff+1,2)) sq%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%z = real(wqf_buff(1)%buff_up(ibuff+2,2)) sq%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(1)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo #endif #if _NDIMY != 1 ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do ic=1,CLSP/2 do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (ibx-1+NDEPTH)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (igx-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH)*NGX wqf_buff(2)%buff_up(ibuff+1,1) = cmplx(sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%y) wqf_buff(2)%buff_up(ibuff+2,1) = cmplx(sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sq%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic)%f(itht,ithz)%w) wqf_buff(2)%buff_dn(ibuff+1,1) = cmplx(sq%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%x, sq%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%y) wqf_buff(2)%buff_dn(ibuff+2,1) = cmplx(sq%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%z, sq%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo call comlib_sendrecv(wqf_buff(2)%id_sendup) call comlib_sendrecv(wqf_buff(2)%id_senddn) ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do ic=1,CLSP/2 do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (ibz-1)*2*NTHT*NTHZ*(CLSP/2) + (ibx-1+NDEPTH)*2*NTHT*NTHZ*(CLSP/2)*NBZ + (igx-1)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*(CLSP/2)*NBZ*(NBX+2*NDEPTH)*NGX sq%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%x = real(wqf_buff(2)%buff_dn(ibuff+1,2)) sq%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(2)%buff_dn(ibuff+1,2)) sq%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%z = real(wqf_buff(2)%buff_dn(ibuff+2,2)) sq%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(2)%buff_dn(ibuff+2,2)) sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%x = real(wqf_buff(2)%buff_up(ibuff+1,2)) sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%y = aimag(wqf_buff(2)%buff_up(ibuff+1,2)) sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%z = real(wqf_buff(2)%buff_up(ibuff+2,2)) sq%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic)%f(itht,ithz)%w = aimag(wqf_buff(2)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo #endif return end subroutine
Subroutine : | |
sq : | type(s_wqf_obj), intent(inout) |
subroutine copy_boundary_sq(sq) implicit none type(s_wqf_obj), intent(inout) :: sq integer :: ieo do ieo=0,1 call copy_boundary(sq%eo(ieo)) enddo return end subroutine
Subroutine : | |
sq : | type(s_wqf_obj), intent(inout) |
subroutine copy_boundary_sq(sq) implicit none type(s_wqf_obj), intent(inout) :: sq integer :: ieo do ieo=0,1 call copy_boundary(sq%eo(ieo)) enddo return end subroutine
Subroutine : | |
su : | type(s_gvf_eo_obj), intent(inout) |
subroutine copy_boundary_su_eo(su) implicit none type(s_gvf_eo_obj), intent(inout) :: su integer :: ibz,iby,igx,ibx integer :: igx_dn,igx_up integer :: itht,ithz,ic,mu,ibuff type(single_field_world) :: sp_lattice if (.not. m_is_initialized) call new(sp_lattice) #ifndef _singlePU call comlib_barrier #endif do igx=1,NGX igx_up=mod(igx-1+1+NGX,NGX)+1 igx_dn=mod(igx-1-1+NGX,NGX)+1 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz) do iby=1,NBY do ibz=1,NBZ su%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = su%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx) su%g(igx)%blk(ibz,iby, NBX+1+ibx) = su%g(igx_up)%blk(ibz,iby, 1+ibx) enddo enddo enddo enddo do igx=1,NGX do iby=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(ibx,ibz) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = su%g(igx )%blk(ibz,NBY-NDEPTH+1+iby,ibx) su%g(igx)%blk(ibz, NBY+1+iby,ibx) = su%g(igx )%blk(ibz, 1+iby,ibx) enddo enddo enddo enddo #if _NDIMX != 1 ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,mu,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do mu=1,NDIM do ic=1,COL do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (iby-1)*2*NTHT*NTHZ*COL*NDIM*NBZ + (ibx)*2*NTHT*NTHZ*COL*NDIM*NBZ*NBY gvf_buff(1)%buff_up(ibuff+1,1) = cmplx(su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%y) gvf_buff(1)%buff_up(ibuff+2,1) = cmplx(su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%w) gvf_buff(1)%buff_dn(ibuff+1,1) = cmplx(su%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic,mu)%f(itht,ithz)%y) gvf_buff(1)%buff_dn(ibuff+2,1) = cmplx(su%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic,mu)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo call comlib_sendrecv(gvf_buff(1)%id_sendup) call comlib_sendrecv(gvf_buff(1)%id_senddn) ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,mu,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do mu=1,NDIM do ic=1,COL do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (iby-1)*2*NTHT*NTHZ*COL*NDIM*NBZ + (ibx)*2*NTHT*NTHZ*COL*NDIM*NBZ*NBY su%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%x = real(gvf_buff(1)%buff_dn(ibuff+1,2)) su%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(1)%buff_dn(ibuff+1,2)) su%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%z = real(gvf_buff(1)%buff_dn(ibuff+2,2)) su%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(1)%buff_dn(ibuff+2,2)) su%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%x = real(gvf_buff(1)%buff_up(ibuff+1,2)) su%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(1)%buff_up(ibuff+1,2)) su%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%z = real(gvf_buff(1)%buff_up(ibuff+2,2)) su%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(1)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo #endif #if _NDIMY != 1 ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,mu,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do mu=1,NDIM do ic=1,COL do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (ibx-1+NDEPTH)*2*NTHT*NTHZ*COL*NDIM*NBZ + (igx-1)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH)*NGX gvf_buff(2)%buff_up(ibuff+1,1) = cmplx(su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y) gvf_buff(2)%buff_up(ibuff+2,1) = cmplx(su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w) gvf_buff(2)%buff_dn(ibuff+1,1) = cmplx(su%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y) gvf_buff(2)%buff_dn(ibuff+2,1) = cmplx(su%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo enddo call comlib_sendrecv(gvf_buff(2)%id_sendup) call comlib_sendrecv(gvf_buff(2)%id_senddn) ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,mu,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do mu=1,NDIM do ic=1,COL do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (ibx-1+NDEPTH)*2*NTHT*NTHZ*COL*NDIM*NBZ + (igx-1)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH)*NGX su%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x = real(gvf_buff(2)%buff_dn(ibuff+1,2)) su%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(2)%buff_dn(ibuff+1,2)) su%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z = real(gvf_buff(2)%buff_dn(ibuff+2,2)) su%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(2)%buff_dn(ibuff+2,2)) su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x = real(gvf_buff(2)%buff_up(ibuff+1,2)) su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(2)%buff_up(ibuff+1,2)) su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z = real(gvf_buff(2)%buff_up(ibuff+2,2)) su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(2)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo enddo #endif return end subroutine
Subroutine : | |
su : | type(s_gvf_eo_obj), intent(inout) |
subroutine copy_boundary_su_eo(su) implicit none type(s_gvf_eo_obj), intent(inout) :: su integer :: ibz,iby,igx,ibx integer :: igx_dn,igx_up integer :: itht,ithz,ic,mu,ibuff type(single_field_world) :: sp_lattice if (.not. m_is_initialized) call new(sp_lattice) #ifndef _singlePU call comlib_barrier #endif do igx=1,NGX igx_up=mod(igx-1+1+NGX,NGX)+1 igx_dn=mod(igx-1-1+NGX,NGX)+1 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz) do iby=1,NBY do ibz=1,NBZ su%g(igx)%blk(ibz,iby,1-NDEPTH+ibx) = su%g(igx_dn)%blk(ibz,iby,NBX-NDEPTH+1+ibx) su%g(igx)%blk(ibz,iby, NBX+1+ibx) = su%g(igx_up)%blk(ibz,iby, 1+ibx) enddo enddo enddo enddo do igx=1,NGX do iby=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(ibx,ibz) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx) = su%g(igx )%blk(ibz,NBY-NDEPTH+1+iby,ibx) su%g(igx)%blk(ibz, NBY+1+iby,ibx) = su%g(igx )%blk(ibz, 1+iby,ibx) enddo enddo enddo enddo #if _NDIMX != 1 ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,mu,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do mu=1,NDIM do ic=1,COL do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (iby-1)*2*NTHT*NTHZ*COL*NDIM*NBZ + (ibx)*2*NTHT*NTHZ*COL*NDIM*NBZ*NBY gvf_buff(1)%buff_up(ibuff+1,1) = cmplx(su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%y) gvf_buff(1)%buff_up(ibuff+2,1) = cmplx(su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(NGX)%blk(ibz,iby,NBX-NDEPTH+1+ibx)%thd(ic,mu)%f(itht,ithz)%w) gvf_buff(1)%buff_dn(ibuff+1,1) = cmplx(su%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic,mu)%f(itht,ithz)%y) gvf_buff(1)%buff_dn(ibuff+2,1) = cmplx(su%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g( 1)%blk(ibz,iby, 1+ibx)%thd(ic,mu)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo call comlib_sendrecv(gvf_buff(1)%id_sendup) call comlib_sendrecv(gvf_buff(1)%id_senddn) ibuff=0 do ibx=0,NDEPTH-1 !$OMP PARALLEL DO PRIVATE(iby,ibz,mu,ic,ithz,itht,ibuff) do iby=1,NBY do ibz=1,NBZ do mu=1,NDIM do ic=1,COL do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (iby-1)*2*NTHT*NTHZ*COL*NDIM*NBZ + (ibx)*2*NTHT*NTHZ*COL*NDIM*NBZ*NBY su%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%x = real(gvf_buff(1)%buff_dn(ibuff+1,2)) su%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(1)%buff_dn(ibuff+1,2)) su%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%z = real(gvf_buff(1)%buff_dn(ibuff+2,2)) su%g(NGX)%blk(ibz,iby, NBX+1+ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(1)%buff_dn(ibuff+2,2)) su%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%x = real(gvf_buff(1)%buff_up(ibuff+1,2)) su%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(1)%buff_up(ibuff+1,2)) su%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%z = real(gvf_buff(1)%buff_up(ibuff+2,2)) su%g( 1)%blk(ibz,iby,1-NDEPTH+ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(1)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo #endif #if _NDIMY != 1 ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,mu,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do mu=1,NDIM do ic=1,COL do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (ibx-1+NDEPTH)*2*NTHT*NTHZ*COL*NDIM*NBZ + (igx-1)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH)*NGX gvf_buff(2)%buff_up(ibuff+1,1) = cmplx(su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y) gvf_buff(2)%buff_up(ibuff+2,1) = cmplx(su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(igx)%blk(ibz,NBY-NDEPTH+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w) gvf_buff(2)%buff_dn(ibuff+1,1) = cmplx(su%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x, su%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y) gvf_buff(2)%buff_dn(ibuff+2,1) = cmplx(su%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z, su%g(igx)%blk(ibz, 1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo enddo call comlib_sendrecv(gvf_buff(2)%id_sendup) call comlib_sendrecv(gvf_buff(2)%id_senddn) ibuff=0 do iby=0,NDEPTH-1 do igx=1,NGX !$OMP PARALLEL DO PRIVATE(ibx,ibz,mu,ic,ithz,itht,ibuff) do ibx=1-NDEPTH,NBX+NDEPTH do ibz=1,NBZ do mu=1,NDIM do ic=1,COL do ithz=1,NTHZ do itht=1,NTHT ibuff = (itht-1)*2 + (ithz-1)*2*NTHT + (ic-1)*2*NTHT*NTHZ + (mu-1)*2*NTHT*NTHZ*COL + (ibz-1)*2*NTHT*NTHZ*COL*NDIM + (ibx-1+NDEPTH)*2*NTHT*NTHZ*COL*NDIM*NBZ + (igx-1)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH) + (iby)*2*NTHT*NTHZ*COL*NDIM*NBZ*(NBX+2*NDEPTH)*NGX su%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x = real(gvf_buff(2)%buff_dn(ibuff+1,2)) su%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(2)%buff_dn(ibuff+1,2)) su%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z = real(gvf_buff(2)%buff_dn(ibuff+2,2)) su%g(igx)%blk(ibz, NBY+1+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(2)%buff_dn(ibuff+2,2)) su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%x = real(gvf_buff(2)%buff_up(ibuff+1,2)) su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%y = aimag(gvf_buff(2)%buff_up(ibuff+1,2)) su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%z = real(gvf_buff(2)%buff_up(ibuff+2,2)) su%g(igx)%blk(ibz,1-NDEPTH+iby,ibx)%thd(ic,mu)%f(itht,ithz)%w = aimag(gvf_buff(2)%buff_up(ibuff+2,2)) ! ibuff=ibuff+2 enddo enddo enddo enddo enddo enddo enddo enddo #endif return end subroutine
Subroutine : | |
su : | type(s_gvf_obj), intent(inout) |
subroutine copy_boundary_su(su) implicit none type(s_gvf_obj), intent(inout) :: su integer :: ieo do ieo=0,1 call copy_boundary(su%eo(ieo)) enddo return end subroutine
Subroutine : | |
su : | type(s_gvf_obj), intent(inout) |
subroutine copy_boundary_su(su) implicit none type(s_gvf_obj), intent(inout) :: su integer :: ieo do ieo=0,1 call copy_boundary(su%eo(ieo)) enddo return end subroutine
Subroutine : | |
sclv : | type(s_clvf_obj), intent(inout) |
subroutine new_sclv(sclv) implicit none type(s_clvf_obj), intent(inout) :: sclv integer :: ieo sclv%ipeo=ipeo do ieo=0,1 call new(sclv%eo(ieo),ieo) enddo return end subroutine
Subroutine : | |
sclv : | type(s_clvf_obj), intent(inout) |
subroutine new_sclv(sclv) implicit none type(s_clvf_obj), intent(inout) :: sclv integer :: ieo sclv%ipeo=ipeo do ieo=0,1 call new(sclv%eo(ieo),ieo) enddo return end subroutine
Subroutine : | |
sclv : | type(s_clvf_eo_obj), intent(inout) |
ieo : | integer, intent(in) |
subroutine new_sclv_eo(sclv,ieo) implicit none type(s_clvf_eo_obj), intent(inout) :: sclv integer, intent(in) :: ieo integer :: igx sclv%ieo=ieo sclv%ipeo=ipeo do igx=1,NGX sclv%g(igx)%ieo=ieo sclv%g(igx)%igx=igx sclv%g(igx)%ipeo=ipeo enddo return end subroutine
Subroutine : | |
sclv : | type(s_clvf_eo_obj), intent(inout) |
ieo : | integer, intent(in) |
subroutine new_sclv_eo(sclv,ieo) implicit none type(s_clvf_eo_obj), intent(inout) :: sclv integer, intent(in) :: ieo integer :: igx sclv%ieo=ieo sclv%ipeo=ipeo do igx=1,NGX sclv%g(igx)%ieo=ieo sclv%g(igx)%igx=igx sclv%g(igx)%ipeo=ipeo enddo return end subroutine
Subroutine : | |
sq : | type(s_wqf_obj), intent(inout) |
subroutine new_sq(sq) implicit none type(s_wqf_obj), intent(inout) :: sq integer :: ieo sq%ipeo = ipeo do ieo = 0,1 call new(sq%eo(ieo),ieo) enddo return end subroutine
Subroutine : | |
sq : | type(s_wqf_obj), intent(inout) |
subroutine new_sq(sq) implicit none type(s_wqf_obj), intent(inout) :: sq integer :: ieo sq%ipeo = ipeo do ieo = 0,1 call new(sq%eo(ieo),ieo) enddo return end subroutine
Subroutine : | |
sq : | type(s_wqf_eo_obj), intent(inout) |
ieo : | integer, intent(in) |
subroutine new_sq_eo(sq,ieo) implicit none type(s_wqf_eo_obj), intent(inout) :: sq integer, intent(in) :: ieo integer :: igx sq%ieo=ieo sq%ipeo = ipeo do igx=1,NGX sq%g(igx)%ieo=ieo sq%g(igx)%igx=igx sq%g(igx)%ipeo=ipeo enddo return end subroutine
Subroutine : | |
sq : | type(s_wqf_eo_obj), intent(inout) |
ieo : | integer, intent(in) |
subroutine new_sq_eo(sq,ieo) implicit none type(s_wqf_eo_obj), intent(inout) :: sq integer, intent(in) :: ieo integer :: igx sq%ieo=ieo sq%ipeo = ipeo do igx=1,NGX sq%g(igx)%ieo=ieo sq%g(igx)%igx=igx sq%g(igx)%ipeo=ipeo enddo return end subroutine
Subroutine : | |
su : | type(s_gvf_obj), intent(inout) |
subroutine new_su(su) implicit none type(s_gvf_obj), intent(inout) :: su integer :: ieo su%ipeo=ipeo do ieo=0,1 call new(su%eo(ieo),ieo) enddo return end subroutine
Subroutine : | |
su : | type(s_gvf_obj), intent(inout) |
subroutine new_su(su) implicit none type(s_gvf_obj), intent(inout) :: su integer :: ieo su%ipeo=ipeo do ieo=0,1 call new(su%eo(ieo),ieo) enddo return end subroutine
Subroutine : | |
su : | type(s_gvf_eo_obj), intent(inout) |
ieo : | integer, intent(in) |
subroutine new_su_eo(su,ieo) implicit none type(s_gvf_eo_obj), intent(inout) :: su integer, intent(in) :: ieo integer :: igx su%ieo=ieo su%ipeo=ipeo do igx=1,NGX su%g(igx)%ieo=ieo su%g(igx)%igx=igx su%g(igx)%ipeo=ipeo enddo return end subroutine
Subroutine : | |
su : | type(s_gvf_eo_obj), intent(inout) |
ieo : | integer, intent(in) |
subroutine new_su_eo(su,ieo) implicit none type(s_gvf_eo_obj), intent(inout) :: su integer, intent(in) :: ieo integer :: igx su%ieo=ieo su%ipeo=ipeo do igx=1,NGX su%g(igx)%ieo=ieo su%g(igx)%igx=igx su%g(igx)%ipeo=ipeo enddo return end subroutine
Subroutine : | |
this : | type(single_field_world), intent(inout) |
subroutine new_single_fields(this) use error_class implicit none type(single_field_world), intent(inout) :: this integer :: imu((NDIM-1)*2) integer :: mu type(lattice_world) :: lattice if (.not.is_initialized(lattice)) then call error_stop("Lattice is not initialized. stop.") endif if (m_is_initialized) return this%dummy = 1 m_is_initialized = .false. #ifndef _singlePU wqhf_buff(1)%size= (CLSP/2)*NTHT*NTHZ*NBZ*NBY ! half spin/single edge wqhf_buff(2)%size= (CLSP/2)*NTHT*NTHZ*NBZ*NBX*NGX ! half spin/single edge wqf_buff(1)%size= CLSP *NTHT*NTHZ*NBZ*NBY*NDEPTH wqf_buff(2)%size= CLSP *NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH gvf_buff(1)%size= COL*(COL-1)*NTHT*NTHZ*NBZ*NBY*NDEPTH*NDIM gvf_buff(2)%size= COL*(COL-1)*NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH*NDIM #ifdef _CLOVER clvf_buff(1)%size= CLSPH*2 *NTHT*NTHZ*NBZ*NBY*NDEPTH clvf_buff(2)%size= CLSPH*2 *NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH #endif do mu=1,NDIM-2 allocate(wqhf_buff(mu)%buff_up(wqhf_buff(mu)%size,2)) allocate(wqhf_buff(mu)%buff_dn(wqhf_buff(mu)%size,2)) allocate( wqf_buff(mu)%buff_up( wqf_buff(mu)%size,2)) allocate( wqf_buff(mu)%buff_dn( wqf_buff(mu)%size,2)) allocate( gvf_buff(mu)%buff_up( gvf_buff(mu)%size,2)) allocate( gvf_buff(mu)%buff_dn( gvf_buff(mu)%size,2)) #ifdef _CLOVER allocate(clvf_buff(mu)%buff_up(clvf_buff(mu)%size,2)) allocate(clvf_buff(mu)%buff_dn(clvf_buff(mu)%size,2)) #endif enddo imu(1)=1 imu(2)=2 imu(3)=3 imu(4)=1 imu(5)=1 imu(6)=2 do mu=1,NDIM-2 wqhf_buff(mu)%buff_up(:,:) = Z0 wqhf_buff(mu)%buff_dn(:,:) = Z0 call comlib_make2(wqhf_buff(mu)%id_sendup,nodeidup(imu(mu)), wqhf_buff(mu)%buff_up(:,1), wqhf_buff(mu)%buff_up(:,2),wqhf_buff(mu)%size) call comlib_make2(wqhf_buff(mu)%id_senddn,nodeiddn(imu(mu)), wqhf_buff(mu)%buff_dn(:,1), wqhf_buff(mu)%buff_dn(:,2),wqhf_buff(mu)%size) wqf_buff(mu)%buff_up(:,:) = Z0 wqf_buff(mu)%buff_dn(:,:) = Z0 call comlib_make2(wqf_buff(mu)%id_sendup,nodeidup(imu(mu)), wqf_buff(mu)%buff_up(:,1), wqf_buff(mu)%buff_up(:,2),wqf_buff(mu)%size) call comlib_make2(wqf_buff(mu)%id_senddn,nodeiddn(imu(mu)), wqf_buff(mu)%buff_dn(:,1), wqf_buff(mu)%buff_dn(:,2),wqf_buff(mu)%size) gvf_buff(mu)%buff_up(:,:) = Z0 gvf_buff(mu)%buff_dn(:,:) = Z0 call comlib_make2(gvf_buff(mu)%id_sendup,nodeidup(imu(mu)), gvf_buff(mu)%buff_up(:,1), gvf_buff(mu)%buff_up(:,2),gvf_buff(mu)%size) call comlib_make2(gvf_buff(mu)%id_senddn,nodeiddn(imu(mu)), gvf_buff(mu)%buff_dn(:,1), gvf_buff(mu)%buff_dn(:,2),gvf_buff(mu)%size) #ifdef _CLOVER clvf_buff(mu)%buff_up(:,:) = Z0 clvf_buff(mu)%buff_dn(:,:) = Z0 call comlib_make2(clvf_buff(mu)%id_sendup,nodeidup(imu(mu)), clvf_buff(mu)%buff_up(:,1), clvf_buff(mu)%buff_up(:,2),clvf_buff(mu)%size) call comlib_make2(clvf_buff(mu)%id_senddn,nodeiddn(imu(mu)), clvf_buff(mu)%buff_dn(:,1), clvf_buff(mu)%buff_dn(:,2),clvf_buff(mu)%size) #endif enddo #endif m_is_initialized = .true. return end subroutine
Subroutine : | |
this : | type(single_field_world), intent(inout) |
subroutine new_single_fields(this) use error_class implicit none type(single_field_world), intent(inout) :: this integer :: imu((NDIM-1)*2) integer :: mu type(lattice_world) :: lattice if (.not.is_initialized(lattice)) then call error_stop("Lattice is not initialized. stop.") endif if (m_is_initialized) return this%dummy = 1 m_is_initialized = .false. #ifndef _singlePU wqhf_buff(1)%size= (CLSP/2)*NTHT*NTHZ*NBZ*NBY ! half spin/single edge wqhf_buff(2)%size= (CLSP/2)*NTHT*NTHZ*NBZ*NBX*NGX ! half spin/single edge wqf_buff(1)%size= CLSP *NTHT*NTHZ*NBZ*NBY*NDEPTH wqf_buff(2)%size= CLSP *NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH gvf_buff(1)%size= COL*(COL-1)*NTHT*NTHZ*NBZ*NBY*NDEPTH*NDIM gvf_buff(2)%size= COL*(COL-1)*NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH*NDIM #ifdef _CLOVER clvf_buff(1)%size= CLSPH*2 *NTHT*NTHZ*NBZ*NBY*NDEPTH clvf_buff(2)%size= CLSPH*2 *NTHT*NTHZ*NBZ*(NBX+NDEPTH*2)*NGX*NDEPTH #endif do mu=1,NDIM-2 allocate(wqhf_buff(mu)%buff_up(wqhf_buff(mu)%size,2)) allocate(wqhf_buff(mu)%buff_dn(wqhf_buff(mu)%size,2)) allocate( wqf_buff(mu)%buff_up( wqf_buff(mu)%size,2)) allocate( wqf_buff(mu)%buff_dn( wqf_buff(mu)%size,2)) allocate( gvf_buff(mu)%buff_up( gvf_buff(mu)%size,2)) allocate( gvf_buff(mu)%buff_dn( gvf_buff(mu)%size,2)) #ifdef _CLOVER allocate(clvf_buff(mu)%buff_up(clvf_buff(mu)%size,2)) allocate(clvf_buff(mu)%buff_dn(clvf_buff(mu)%size,2)) #endif enddo imu(1)=1 imu(2)=2 imu(3)=3 imu(4)=1 imu(5)=1 imu(6)=2 do mu=1,NDIM-2 wqhf_buff(mu)%buff_up(:,:) = Z0 wqhf_buff(mu)%buff_dn(:,:) = Z0 call comlib_make2(wqhf_buff(mu)%id_sendup,nodeidup(imu(mu)), wqhf_buff(mu)%buff_up(:,1), wqhf_buff(mu)%buff_up(:,2),wqhf_buff(mu)%size) call comlib_make2(wqhf_buff(mu)%id_senddn,nodeiddn(imu(mu)), wqhf_buff(mu)%buff_dn(:,1), wqhf_buff(mu)%buff_dn(:,2),wqhf_buff(mu)%size) wqf_buff(mu)%buff_up(:,:) = Z0 wqf_buff(mu)%buff_dn(:,:) = Z0 call comlib_make2(wqf_buff(mu)%id_sendup,nodeidup(imu(mu)), wqf_buff(mu)%buff_up(:,1), wqf_buff(mu)%buff_up(:,2),wqf_buff(mu)%size) call comlib_make2(wqf_buff(mu)%id_senddn,nodeiddn(imu(mu)), wqf_buff(mu)%buff_dn(:,1), wqf_buff(mu)%buff_dn(:,2),wqf_buff(mu)%size) gvf_buff(mu)%buff_up(:,:) = Z0 gvf_buff(mu)%buff_dn(:,:) = Z0 call comlib_make2(gvf_buff(mu)%id_sendup,nodeidup(imu(mu)), gvf_buff(mu)%buff_up(:,1), gvf_buff(mu)%buff_up(:,2),gvf_buff(mu)%size) call comlib_make2(gvf_buff(mu)%id_senddn,nodeiddn(imu(mu)), gvf_buff(mu)%buff_dn(:,1), gvf_buff(mu)%buff_dn(:,2),gvf_buff(mu)%size) #ifdef _CLOVER clvf_buff(mu)%buff_up(:,:) = Z0 clvf_buff(mu)%buff_dn(:,:) = Z0 call comlib_make2(clvf_buff(mu)%id_sendup,nodeidup(imu(mu)), clvf_buff(mu)%buff_up(:,1), clvf_buff(mu)%buff_up(:,2),clvf_buff(mu)%size) call comlib_make2(clvf_buff(mu)%id_senddn,nodeiddn(imu(mu)), clvf_buff(mu)%buff_dn(:,1), clvf_buff(mu)%buff_dn(:,2),clvf_buff(mu)%size) #endif enddo #endif m_is_initialized = .true. return end subroutine
Subroutine : | |
sq : | type(s_wqf_eo_obj), intent(inout) |
vec(:) : | complex(DP), intent(inout) |
norm : | real(DP), intent(in) |
vec <= sq * norm
subroutine pack_s2d_eo(sq,vec,norm) ! ! vec <= sq * norm ! implicit none type(s_wqf_eo_obj), intent(inout) :: sq complex(DP), intent(inout) :: vec(:) real(DP), intent(in) :: norm type(su3ferm) :: yy integer :: igx,ibx,iby,ibz,ithz,itht,itht0 integer :: ix,iy,iz,ieoxyz,ith,is,ic,isite,ieo ieo = sq%ieo !$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,is,isite,yy) do igx=1,NGX do ibx=1,NBX ix = ibx + (igx-1)*NBX do iby=1,NBY do ibz=1,NBZ iy = iby do ithz=1,NTHZ iz = ithz + (ibz-1)*NTHZ ieoxyz=mod(ipeo+ieo+ix+iy+iz,2) do itht=1-ieoxyz,NTHT-ieoxyz itht0=itht+ieoxyz yy%yr(1,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%x yy%yr(2,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%y yy%yr(3,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%z yy%yr(1,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%w yy%yr(2,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%x yy%yr(3,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%y yy%yr(1,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%z yy%yr(2,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%w yy%yr(3,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%x yy%yr(1,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%y yy%yr(2,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%z yy%yr(3,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%w yy%yi(1,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%x yy%yi(2,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%y yy%yi(3,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%z yy%yi(1,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%w yy%yi(2,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%x yy%yi(3,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%y yy%yi(1,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%z yy%yi(2,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%w yy%yi(3,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%x yy%yi(1,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%y yy%yi(2,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%z yy%yi(3,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%w do is=1,SPIN do ic=1,COL isite = ic + (is-1)*COL + (itht0-1)*CLSP + (iz-1)*CLSP*NTH + (iy-1)*CLSP*NTH*NZ + (ix-1)*CLSP*NTH*NZ*NY vec(isite) = CMPLX(yy%yr(ic,is),yy%yi(ic,is),kind=KIND(DP))*norm enddo enddo enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
sq : | type(s_wqf_eo_obj), intent(inout) |
vec(:) : | complex(DP), intent(inout) |
norm : | real(DP), intent(in) |
vec <= sq * norm
subroutine pack_s2d_eo(sq,vec,norm) ! ! vec <= sq * norm ! implicit none type(s_wqf_eo_obj), intent(inout) :: sq complex(DP), intent(inout) :: vec(:) real(DP), intent(in) :: norm type(su3ferm) :: yy integer :: igx,ibx,iby,ibz,ithz,itht,itht0 integer :: ix,iy,iz,ieoxyz,ith,is,ic,isite,ieo ieo = sq%ieo !$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,is,isite,yy) do igx=1,NGX do ibx=1,NBX ix = ibx + (igx-1)*NBX do iby=1,NBY do ibz=1,NBZ iy = iby do ithz=1,NTHZ iz = ithz + (ibz-1)*NTHZ ieoxyz=mod(ipeo+ieo+ix+iy+iz,2) do itht=1-ieoxyz,NTHT-ieoxyz itht0=itht+ieoxyz yy%yr(1,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%x yy%yr(2,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%y yy%yr(3,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%z yy%yr(1,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%w yy%yr(2,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%x yy%yr(3,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%y yy%yr(1,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%z yy%yr(2,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%w yy%yr(3,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%x yy%yr(1,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%y yy%yr(2,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%z yy%yr(3,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%w yy%yi(1,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%x yy%yi(2,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%y yy%yi(3,1) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%z yy%yi(1,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%w yy%yi(2,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%x yy%yi(3,2) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%y yy%yi(1,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%z yy%yi(2,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%w yy%yi(3,3) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%x yy%yi(1,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%y yy%yi(2,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%z yy%yi(3,4) = sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%w do is=1,SPIN do ic=1,COL isite = ic + (is-1)*COL + (itht0-1)*CLSP + (iz-1)*CLSP*NTH + (iy-1)*CLSP*NTH*NZ + (ix-1)*CLSP*NTH*NZ*NY vec(isite) = CMPLX(yy%yr(ic,is),yy%yi(ic,is),kind=KIND(DP))*norm enddo enddo enddo enddo enddo enddo enddo enddo return end subroutine
Function : | |
p : | complex(SP) |
y1 : | type(s_wqf_eo_blk_obj), intent(in) |
y2 : | type(s_wqf_eo_blk_obj), intent(in) |
p = <y1|y2>
function prod_swqf_blk(y1,y2) result(p) ! ! p = <y1|y2> ! implicit none type(s_wqf_eo_blk_obj), intent(in) :: y1,y2 complex(SP) :: p real(SP) :: pr,pi integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (y1%ieo /= y2%ieo .or. y1%igx /= y2%igx) then call error_stop("index (ieo,igx) error in prod_swqf_blk.") endif pr=0.0_SP pi=0.0_SP do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ithz=1,NTHZ ix=ibx+(y1%igx-1)*NBX iy=iby iz=ithz+(ibz-1)*NTHZ ieoxyz=mod(ipeo+ix+iy+iz+y1%ieo,2) do ics=1,COL jcs=ics+COL #ifdef _SF do itht=1+ieoxyz,NTHT #else do itht=1,NTHT #endif pr = pr + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w pi = pi + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w enddo enddo enddo enddo enddo enddo p = cmplx(pr,pi) #ifndef _singlePU call comlib_sumcast(p) #endif return end function
Function : | |
p : | complex(SP) |
y1 : | type(s_wqf_eo_blk_obj), intent(in) |
y2 : | type(s_wqf_eo_blk_obj), intent(in) |
p = <y1|y2>
function prod_swqf_blk(y1,y2) result(p) ! ! p = <y1|y2> ! implicit none type(s_wqf_eo_blk_obj), intent(in) :: y1,y2 complex(SP) :: p real(SP) :: pr,pi integer :: ix,iy,iz,ieoxyz,ics,jcs integer :: ibx,iby,ibz,itht,ithz if (y1%ieo /= y2%ieo .or. y1%igx /= y2%igx) then call error_stop("index (ieo,igx) error in prod_swqf_blk.") endif pr=0.0_SP pi=0.0_SP do ibx=1,NBX do iby=1,NBY do ibz=1,NBZ do ithz=1,NTHZ ix=ibx+(y1%igx-1)*NBX iy=iby iz=ithz+(ibz-1)*NTHZ ieoxyz=mod(ipeo+ix+iy+iz+y1%ieo,2) do ics=1,COL jcs=ics+COL #ifdef _SF do itht=1+ieoxyz,NTHT #else do itht=1,NTHT #endif pr = pr + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w pi = pi + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z + y1%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%x *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%x - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%y *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%y - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%z *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%z - y1%blk(ibz,iby,ibx)%thd(jcs)%f(itht,ithz)%w *y2%blk(ibz,iby,ibx)%thd(ics)%f(itht,ithz)%w enddo enddo enddo enddo enddo enddo p = cmplx(pr,pi) #ifndef _singlePU call comlib_sumcast(p) #endif return end function
Function : | |
p : | complex(SP) |
y1 : | type(s_wqf_eo_obj), intent(in) |
y2 : | type(s_wqf_eo_obj), intent(in) |
p = <y1|y2>
function prod_swqf_eo(y1,y2) result(p) ! ! p = <y1|y2> ! implicit none type(s_wqf_eo_obj), intent(in) :: y1,y2 complex(SP) :: p integer :: igx p = (0.0_SP,0.0_SP) !$OMP PARALLEL DO REDUCTION(+:p) do igx=1,NGX p = p + prod(y1%g(igx),y2%g(igx)) enddo return end function
Function : | |
p : | complex(SP) |
y1 : | type(s_wqf_eo_obj), intent(in) |
y2 : | type(s_wqf_eo_obj), intent(in) |
p = <y1|y2>
function prod_swqf_eo(y1,y2) result(p) ! ! p = <y1|y2> ! implicit none type(s_wqf_eo_obj), intent(in) :: y1,y2 complex(SP) :: p integer :: igx p = (0.0_SP,0.0_SP) !$OMP PARALLEL DO REDUCTION(+:p) do igx=1,NGX p = p + prod(y1%g(igx),y2%g(igx)) enddo return end function
Function : | |
p : | complex(SP) |
y1 : | type(s_wqf_obj), intent(in) |
y2 : | type(s_wqf_obj), intent(in) |
p = <y1|y2>
function prod_swqf(y1,y2) result(p) ! ! p = <y1|y2> ! implicit none type(s_wqf_obj), intent(in) :: y1,y2 complex(SP) :: p integer :: ieo p = (0.0_SP,0.0_SP) do ieo=0,1 p = p + prod(y1%eo(ieo),y2%eo(ieo)) enddo return end function
Function : | |
p : | complex(SP) |
y1 : | type(s_wqf_obj), intent(in) |
y2 : | type(s_wqf_obj), intent(in) |
p = <y1|y2>
function prod_swqf(y1,y2) result(p) ! ! p = <y1|y2> ! implicit none type(s_wqf_obj), intent(in) :: y1,y2 complex(SP) :: p integer :: ieo p = (0.0_SP,0.0_SP) do ieo=0,1 p = p + prod(y1%eo(ieo),y2%eo(ieo)) enddo return end function
Subroutine : | |
vec(:) : | complex(DP), intent(inout) |
sq : | type(s_wqf_eo_obj), intent(inout) |
norm : | real(DP), intent(out) |
norm = |vec| sq <= vec/norm
subroutine unpack_d2s_eo(vec,sq,norm) ! ! norm = |vec| ! sq <= vec/norm ! implicit none complex(DP), intent(inout) :: vec(:) type(s_wqf_eo_obj), intent(inout) :: sq real(DP), intent(out) :: norm type(su3ferm) :: yy real(DP) :: rtmp complex(DP) :: ztmp integer :: igx,ibx,iby,ibz,ithz,itht,itht0 integer :: ix,iy,iz,ieoxyz,ith,is,ic,isite,ieo ieo = sq%ieo norm = 0.0_DP !$OMP PARALLEL DO PRIVATE(isite) REDUCTION(+:norm) do isite=1,SIZE(vec) norm = norm + REAL(vec(isite))**2 + AIMAG(vec(isite))**2 enddo #ifndef _singlePU call comlib_sumcast(norm) #endif norm = SQRT(norm) rtmp = 1.0_DP/norm !$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,is,isite,yy,ztmp) do igx=1,NGX do ibx=1,NBX ix = ibx + (igx-1)*NBX do iby=1,NBY do ibz=1,NBZ iy = iby do ithz=1,NTHZ iz = ithz + (ibz-1)*NTHZ ieoxyz=mod(ipeo+ieo+ix+iy+iz,2) do itht=1-ieoxyz,NTHT-ieoxyz itht0=itht+ieoxyz do is=1,SPIN do ic=1,COL isite = ic + (is-1)*COL + (itht0-1)*CLSP + (iz-1)*CLSP*NTH + (iy-1)*CLSP*NTH*NZ + (ix-1)*CLSP*NTH*NZ*NY ztmp = vec(isite)*rtmp yy%yr(ic,is) = REAL(ztmp) yy%yi(ic,is) = AIMAG(ztmp) enddo enddo sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%x = yy%yr(1,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%y = yy%yr(2,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%z = yy%yr(3,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%w = yy%yr(1,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%x = yy%yr(2,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%y = yy%yr(3,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%z = yy%yr(1,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%w = yy%yr(2,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%x = yy%yr(3,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%y = yy%yr(1,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%z = yy%yr(2,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%w = yy%yr(3,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%x = yy%yi(1,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%y = yy%yi(2,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%z = yy%yi(3,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%w = yy%yi(1,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%x = yy%yi(2,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%y = yy%yi(3,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%z = yy%yi(1,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%w = yy%yi(2,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%x = yy%yi(3,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%y = yy%yi(1,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%z = yy%yi(2,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%w = yy%yi(3,4) enddo enddo enddo enddo enddo enddo call copy_boundary(sq) return end subroutine
Subroutine : | |
vec(:) : | complex(DP), intent(inout) |
sq : | type(s_wqf_eo_obj), intent(inout) |
norm : | real(DP), intent(out) |
norm = |vec| sq <= vec/norm
subroutine unpack_d2s_eo(vec,sq,norm) ! ! norm = |vec| ! sq <= vec/norm ! implicit none complex(DP), intent(inout) :: vec(:) type(s_wqf_eo_obj), intent(inout) :: sq real(DP), intent(out) :: norm type(su3ferm) :: yy real(DP) :: rtmp complex(DP) :: ztmp integer :: igx,ibx,iby,ibz,ithz,itht,itht0 integer :: ix,iy,iz,ieoxyz,ith,is,ic,isite,ieo ieo = sq%ieo norm = 0.0_DP !$OMP PARALLEL DO PRIVATE(isite) REDUCTION(+:norm) do isite=1,SIZE(vec) norm = norm + REAL(vec(isite))**2 + AIMAG(vec(isite))**2 enddo #ifndef _singlePU call comlib_sumcast(norm) #endif norm = SQRT(norm) rtmp = 1.0_DP/norm !$OMP PARALLEL DO PRIVATE(igx,ibx,iby,ibz,ithz,itht,itht0,ix,iy,iz,ieoxyz,ic,is,isite,yy,ztmp) do igx=1,NGX do ibx=1,NBX ix = ibx + (igx-1)*NBX do iby=1,NBY do ibz=1,NBZ iy = iby do ithz=1,NTHZ iz = ithz + (ibz-1)*NTHZ ieoxyz=mod(ipeo+ieo+ix+iy+iz,2) do itht=1-ieoxyz,NTHT-ieoxyz itht0=itht+ieoxyz do is=1,SPIN do ic=1,COL isite = ic + (is-1)*COL + (itht0-1)*CLSP + (iz-1)*CLSP*NTH + (iy-1)*CLSP*NTH*NZ + (ix-1)*CLSP*NTH*NZ*NY ztmp = vec(isite)*rtmp yy%yr(ic,is) = REAL(ztmp) yy%yi(ic,is) = AIMAG(ztmp) enddo enddo sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%x = yy%yr(1,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%y = yy%yr(2,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%z = yy%yr(3,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(1)%f(itht0,ithz)%w = yy%yr(1,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%x = yy%yr(2,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%y = yy%yr(3,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%z = yy%yr(1,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(2)%f(itht0,ithz)%w = yy%yr(2,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%x = yy%yr(3,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%y = yy%yr(1,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%z = yy%yr(2,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(3)%f(itht0,ithz)%w = yy%yr(3,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%x = yy%yi(1,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%y = yy%yi(2,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%z = yy%yi(3,1) sq%g(igx)%blk(ibz,iby,ibx)%thd(4)%f(itht0,ithz)%w = yy%yi(1,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%x = yy%yi(2,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%y = yy%yi(3,2) sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%z = yy%yi(1,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(5)%f(itht0,ithz)%w = yy%yi(2,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%x = yy%yi(3,3) sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%y = yy%yi(1,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%z = yy%yi(2,4) sq%g(igx)%blk(ibz,iby,ibx)%thd(6)%f(itht0,ithz)%w = yy%yi(3,4) enddo enddo enddo enddo enddo enddo call copy_boundary(sq) return end subroutine