FIXME : Add documentation
subroutine check_g2le
use file_utils, only: error_unit
use mp, only: finish_mp, iproc, proc0
use theta_grid, only: ntgrid
use gs2_layouts, only: g_lo, le_lo
use gs2_layouts, only: ig_idx, ik_idx, it_idx, il_idx, ie_idx, is_idx
use redistribute, only: gather, scatter, report_map_property
implicit none
integer :: iglo, ile, ig, isgn, ik, it, il, ie, is, ierr
integer :: ixi, je
complex, dimension (:,:,:), allocatable :: gtmp, letmp
if (proc0) then
ierr = error_unit()
else
ierr = 6
end if
! report the map property
if (proc0) print *, '=== g2le map property ==='
call report_map_property (g2le)
allocate (gtmp(-ntgrid:ntgrid, 2, g_lo%llim_proc:g_lo%ulim_alloc))
allocate (letmp(nlambda*2+1, negrid+1, le_lo%llim_proc:le_lo%ulim_alloc))
letmp = 0.
! gather check
gtmp = 0.0
do iglo = g_lo%llim_proc, g_lo%ulim_proc
ik = ik_idx(g_lo,iglo)
it = it_idx(g_lo,iglo)
il = il_idx(g_lo,iglo)
ie = ie_idx(g_lo,iglo)
is = is_idx(g_lo,iglo)
do isgn = 1, 2
do ig = -ntgrid, ntgrid
gtmp(ig,isgn,iglo) = rule(ig,isgn,ik,it,il,ie,is)
end do
end do
end do
call gather (g2le, gtmp, letmp)
do ile = le_lo%llim_proc, le_lo%ulim_proc
ig = ig_idx(le_lo,ile)
je = jend(ig)
ik = ik_idx(le_lo,ile)
it = it_idx(le_lo,ile)
is = is_idx(le_lo,ile)
do ie = 1, negrid
do ixi = 1, 2*nlambda
isgn = ixi_to_isgn(ixi, ig)
il = ixi_to_il(ixi, ig)
if (int(real(letmp(ixi,ie,ile))) /= rule(ig,isgn,ik,it,il,ie,is)) &
write (ierr,'(a,8i6)') 'ERROR: gather by g2le broken!', iproc
end do
end do
end do
if (proc0) write (ierr,'(a)') 'g2le gather check done'
! scatter check
gtmp = 0.0
call scatter (g2le, letmp, gtmp)
do iglo = g_lo%llim_proc, g_lo%ulim_proc
ik = ik_idx(g_lo,iglo)
it = it_idx(g_lo,iglo)
il = il_idx(g_lo,iglo)
ie = ie_idx(g_lo,iglo)
is = is_idx(g_lo,iglo)
do isgn = 1, 2
do ig = -ntgrid, ntgrid
if (int(real(gtmp(ig,isgn,iglo))) /= rule(ig,isgn,ik,it,il,ie,is)) &
write (ierr,'(a,i6)') 'ERROR: scatter by g2le broken!', iproc
end do
end do
end do
if (proc0) write (ierr,'(a)') 'g2le scatter check done'
deallocate (gtmp,letmp)
contains
function rule (ig, isgn, ik, it, il, ie, is)
integer, intent (in) :: ig, isgn, ik, it, il, ie, is
integer :: rule
rule = ig + isgn + ik + it + il + ie + is ! make whatever you want
end function rule
end subroutine check_g2le