Skip to content
Snippets Groups Projects
Commit 76f03816 authored by ESCOBAR MUNOZ Juan's avatar ESCOBAR MUNOZ Juan
Browse files

Juan 15/03/2023:ZSOLVER/communication.f90.f90, Cray OPENACC Opt, pass... 

Juan 15/03/2023:ZSOLVER/communication.f90.f90, Cray OPENACC Opt, pass ztab_halo* by args + dim in haloswap_mnh
parent 0c45ccba
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/ZSOLVER/tensorproductmultigrid_Source/communication.f90
+ 124
− 55
View file @ 76f03816
......@@ -1125,6 +1125,77 @@ contains
requests_nsT(:) = MPI_REQUEST_NULL
requests_ewT(:) = MPI_REQUEST_NULL
!
! Init Pointer
!
#ifdef MNH_GPUDIRECT
if (LUseT) then
! Send to south
if (Gneighbour_s) then
ztab_halo_st_haloTin => tab_halo_st(level,m)%haloTin
end if
! Send to north
if (Gneighbour_n) then
ztab_halo_nt_haloTin => tab_halo_nt(level,m)%haloTin
end if
! Send to east
if (Gneighbour_e) then
ztab_halo_et_haloTin => tab_halo_et(level,m)%haloTin
end if
! Send to west
if (Gneighbour_w) then
ztab_halo_wt_haloTin => tab_halo_wt(level,m)%haloTin
end if
! Receive from north
if (Gneighbour_n) then
ztab_halo_nt_haloTout => tab_halo_nt(level,m)%haloTout
end if
! Receive from south
if (Gneighbour_s) then
ztab_halo_st_haloTout => tab_halo_st(level,m)%haloTout
end if
! Receive from west
if (Gneighbour_w) then
ztab_halo_wt_haloTout => tab_halo_wt(level,m)%haloTout
end if
! Receive from east
if (Gneighbour_e) then
ztab_halo_et_haloTout => tab_halo_et(level,m)%haloTout
end if
end if
#endif
!
call haloswap_mnh_dim(ztab_halo_st_haloTin,ztab_halo_nt_haloTin,&
ztab_halo_et_haloTin,ztab_halo_wt_haloTin,&
ztab_halo_nt_haloTout,ztab_halo_st_haloTout,&
ztab_halo_wt_haloTout,ztab_halo_et_haloTout,&
zst)
!
end if! (stepsize == 1) ...
if (comm_measuretime) then
call finish_timer(t_haloswap(level,m))
end if
end if ! (m > 0)
contains
subroutine haloswap_mnh_dim(pztab_halo_st_haloTin,pztab_halo_nt_haloTin,&
pztab_halo_et_haloTin,pztab_halo_wt_haloTin,&
pztab_halo_nt_haloTout,pztab_halo_st_haloTout,&
pztab_halo_wt_haloTout,pztab_halo_et_haloTout,&
pzst)
implicit none
real :: pztab_halo_st_haloTin(1:a_n,1:halo_size,1:nz+2), &
pztab_halo_nt_haloTin(1:a_n,1:halo_size,1:nz+2), &
pztab_halo_et_haloTin(1:halo_size,1:a_n+2*halo_size,1:nz+2), &
pztab_halo_wt_haloTin(1:halo_size,1:a_n+2*halo_size,1:nz+2), &
pztab_halo_nt_haloTout(1:a_n,1:halo_size,1:nz+2), &
pztab_halo_st_haloTout(1:a_n,1:halo_size,1:nz+2), &
pztab_halo_wt_haloTout(1:halo_size,1:a_n+2*halo_size,1:nz+2), &
pztab_halo_et_haloTout(1:halo_size,1:a_n+2*halo_size,1:nz+2), &
pzst(1-halo_size:a_n+halo_size,1-halo_size:a_n+halo_size,0:nz+1)
!
! Do Comm
!
#ifdef MNH_GPUDIRECT
if (LUseT) then
!
......@@ -1132,37 +1203,37 @@ contains
!
! Send to south
if (Gneighbour_s) then
ztab_halo_st_haloTin => tab_halo_st(level,m)%haloTin
!$acc kernels async(IS_SOUTH) present_cr(zst,ztab_halo_st_haloTin)
!!$ pztab_halo_st_haloTin => tab_halo_st(level,m)%haloTin
!$acc kernels async(IS_SOUTH) present_cr(pzst,pztab_halo_st_haloTin)
!$mnh_do_concurrent( ii=1:a_n,ij=1:halo_size,ik=1:nz+2 )
ztab_halo_st_haloTin(ii,ij,ik) = zst(ii,ij+a_n-halo_size,ik-1)
pztab_halo_st_haloTin(ii,ij,ik) = pzst(ii,ij+a_n-halo_size,ik-1)
!$mnh_end_do()
!$acc end kernels
end if
! Send to north
if (Gneighbour_n) then
ztab_halo_nt_haloTin => tab_halo_nt(level,m)%haloTin
!$acc kernels async(IS_NORTH) present_cr(zst,ztab_halo_nt_haloTin)
!!$ pztab_halo_nt_haloTin => tab_halo_nt(level,m)%haloTin
!$acc kernels async(IS_NORTH) present_cr(pzst,pztab_halo_nt_haloTin)
!$mnh_do_concurrent( ii=1:a_n,ij=1:halo_size,ik=1:nz+2 )
ztab_halo_nt_haloTin(ii,ij,ik) = zst(ii,ij,ik-1)
pztab_halo_nt_haloTin(ii,ij,ik) = pzst(ii,ij,ik-1)
!$mnh_end_do()
!$acc end kernels
end if
! Send to east
if (Gneighbour_e) then
ztab_halo_et_haloTin => tab_halo_et(level,m)%haloTin
!$acc kernels async(IS_EAST) present_cr(zst,ztab_halo_et_haloTin)
!!$ pztab_halo_et_haloTin => tab_halo_et(level,m)%haloTin
!$acc kernels async(IS_EAST) present_cr(pzst,pztab_halo_et_haloTin)
!$mnh_do_concurrent( ii=1:halo_size,ij=1:a_n+2*halo_size,ik=1:nz+2 )
ztab_halo_et_haloTin(ii,ij,ik) = zst(ii+a_n-halo_size,ij-halo_size,ik-1)
pztab_halo_et_haloTin(ii,ij,ik) = pzst(ii+a_n-halo_size,ij-halo_size,ik-1)
!$mnh_end_do()
!$acc end kernels
end if
! Send to west
if (Gneighbour_w) then
ztab_halo_wt_haloTin => tab_halo_wt(level,m)%haloTin
!$acc kernels async(IS_WEST) present_cr(zst,ztab_halo_wt_haloTin)
!!$ pztab_halo_wt_haloTin => tab_halo_wt(level,m)%haloTin
!$acc kernels async(IS_WEST) present_cr(pzst,pztab_halo_wt_haloTin)
!$mnh_do_concurrent( ii=1:halo_size,ij=1:a_n+2*halo_size,ik=1:nz+2 )
ztab_halo_wt_haloTin(ii,ij,ik) = zst(ii,ij-halo_size,ik-1)
pztab_halo_wt_haloTin(ii,ij,ik) = pzst(ii,ij-halo_size,ik-1)
!$mnh_end_do()
!$acc end kernels
end if
......@@ -1177,14 +1248,14 @@ contains
if (LUseT) then
#ifdef MNH_GPUDIRECT
if (Gneighbour_n) then
ztab_halo_nt_haloTout => tab_halo_nt(level,m)%haloTout
!$acc host_data use_device(ztab_halo_nt_haloTout)
call mpi_irecv(ztab_halo_nt_haloTout,size(ztab_halo_nt_haloTout), &
!!$ pztab_halo_nt_haloTout => tab_halo_nt(level,m)%haloTout
!$acc host_data use_device(pztab_halo_nt_haloTout)
call mpi_irecv(pztab_halo_nt_haloTout,size(pztab_halo_nt_haloTout), &
MPI_DOUBLE_PRECISION,neighbour_n_rank,recvtag, &
MPI_COMM_HORIZ, requests_nsT(1), ierr)
!$acc end host_data
end if
!print*,"mpi_irecv(ztab_halo_nt_haloTout,neighbour_n_rank=",neighbour_n_rank
!print*,"mpi_irecv(pztab_halo_nt_haloTout,neighbour_n_rank=",neighbour_n_rank
#else
call mpi_irecv(a%st(1,0-(halo_size-1),0),1, &
halo_nst(level,m),neighbour_n_rank,recvtag, &
......@@ -1200,14 +1271,14 @@ contains
if (LUseT) then
#ifdef MNH_GPUDIRECT
if (Gneighbour_s) then
ztab_halo_st_haloTout => tab_halo_st(level,m)%haloTout
!$acc host_data use_device (ztab_halo_st_haloTout)
call mpi_irecv(ztab_halo_st_haloTout,size(ztab_halo_st_haloTout), &
!!$ pztab_halo_st_haloTout => tab_halo_st(level,m)%haloTout
!$acc host_data use_device (pztab_halo_st_haloTout)
call mpi_irecv(pztab_halo_st_haloTout,size(pztab_halo_st_haloTout), &
MPI_DOUBLE_PRECISION,neighbour_s_rank,recvtag, &
MPI_COMM_HORIZ, requests_nsT(2), ierr)
!$acc end host_data
end if
!print*,"mpi_irecv(ztab_halo_st_haloTout,neighbour_s_rank=",neighbour_s_rank
!print*,"mpi_irecv(pztab_halo_st_haloTout,neighbour_s_rank=",neighbour_s_rank
#else
call mpi_irecv(a%st(1,a_n+1,0),1, &
halo_nst(level,m),neighbour_s_rank,recvtag, &
......@@ -1229,13 +1300,13 @@ contains
if (LUseT) then
#ifdef MNH_GPUDIRECT
if (Gneighbour_s) then
!$acc host_data use_device(ztab_halo_st_haloTin)
call mpi_isend(ztab_halo_st_haloTin,size(ztab_halo_st_haloTin), &
!$acc host_data use_device(pztab_halo_st_haloTin)
call mpi_isend(pztab_halo_st_haloTin,size(pztab_halo_st_haloTin), &
MPI_DOUBLE_PRECISION,neighbour_s_rank,sendtag, &
MPI_COMM_HORIZ, requests_nsT(3), ierr)
!$acc end host_data
end if
!print*,"mpi_isend(ztab_halo_st_haloTin,neighbour_s_rank=",neighbour_s_rank
!print*,"mpi_isend(pztab_halo_st_haloTin,neighbour_s_rank=",neighbour_s_rank
#else
call mpi_isend(a%st(1,a_n-(halo_size-1),0),1, &
halo_nst(level,m),neighbour_s_rank,sendtag, &
......@@ -1251,13 +1322,13 @@ contains
if (LUseT) then
#ifdef MNH_GPUDIRECT
if (Gneighbour_n) then
!$acc host_data use_device(ztab_halo_nt_haloTin)
call mpi_isend(ztab_halo_nt_haloTin,size(ztab_halo_nt_haloTin), &
!$acc host_data use_device(pztab_halo_nt_haloTin)
call mpi_isend(pztab_halo_nt_haloTin,size(pztab_halo_nt_haloTin), &
MPI_DOUBLE_PRECISION,neighbour_n_rank,sendtag, &
MPI_COMM_HORIZ, requests_nsT(4), ierr)
!$acc end host_data
end if
!print*,"mpi_isend(ztab_halo_nt_haloTin,neighbour_n_rank=",neighbour_n_rank
!print*,"mpi_isend(pztab_halo_nt_haloTin,neighbour_n_rank=",neighbour_n_rank
#else
call mpi_isend(a%st(1,1,0),1, &
halo_nst(level,m),neighbour_n_rank,sendtag, &
......@@ -1278,14 +1349,14 @@ contains
if (LUseT) then
#ifdef MNH_GPUDIRECT
if (Gneighbour_w) then
ztab_halo_wt_haloTout => tab_halo_wt(level,m)%haloTout
!$acc host_data use_device(ztab_halo_wt_haloTout)
call mpi_irecv(ztab_halo_wt_haloTout,size(ztab_halo_wt_haloTout), &
!!$ pztab_halo_wt_haloTout => tab_halo_wt(level,m)%haloTout
!$acc host_data use_device(pztab_halo_wt_haloTout)
call mpi_irecv(pztab_halo_wt_haloTout,size(pztab_halo_wt_haloTout), &
MPI_DOUBLE_PRECISION,neighbour_w_rank,recvtag, &
MPI_COMM_HORIZ, requests_ewT(1), ierr)
!$acc end host_data
end if
!print*,"mpi_irecv(ztab_halo_wt_haloTout,neighbour_w_rank=",neighbour_w_rank
!print*,"mpi_irecv(pztab_halo_wt_haloTout,neighbour_w_rank=",neighbour_w_rank
#else
call mpi_irecv(a%st(0-(halo_size-1),0,0),1, &
halo_wet(level,m),neighbour_w_rank,recvtag, &
......@@ -1301,14 +1372,14 @@ contains
if (LUseT) then
#ifdef MNH_GPUDIRECT
if (Gneighbour_e) then
ztab_halo_et_haloTout => tab_halo_et(level,m)%haloTout
!$acc host_data use_device(ztab_halo_et_haloTout)
call mpi_irecv(ztab_halo_et_haloTout,size(ztab_halo_et_haloTout), &
!!$ pztab_halo_et_haloTout => tab_halo_et(level,m)%haloTout
!$acc host_data use_device(pztab_halo_et_haloTout)
call mpi_irecv(pztab_halo_et_haloTout,size(pztab_halo_et_haloTout), &
MPI_DOUBLE_PRECISION,neighbour_e_rank,recvtag, &
MPI_COMM_HORIZ, requests_ewT(2), ierr)
!$acc end host_data
end if
!print*,"mpi_irecv(ztab_halo_et_haloTout,neighbour_e_rank=",neighbour_e_rank
!print*,"mpi_irecv(pztab_halo_et_haloTout,neighbour_e_rank=",neighbour_e_rank
#else
call mpi_irecv(a%st(a_n+1,0,0),1, &
halo_wet(level,m),neighbour_e_rank,recvtag, &
......@@ -1325,13 +1396,13 @@ contains
if (LUseT) then
#ifdef MNH_GPUDIRECT
if (Gneighbour_e) then
!$acc host_data use_device(ztab_halo_et_haloTin)
call mpi_isend(ztab_halo_et_haloTin,size(ztab_halo_et_haloTin), &
!$acc host_data use_device(pztab_halo_et_haloTin)
call mpi_isend(pztab_halo_et_haloTin,size(pztab_halo_et_haloTin), &
MPI_DOUBLE_PRECISION,neighbour_e_rank,sendtag, &
MPI_COMM_HORIZ, requests_ewT(3), ierr)
!$acc end host_data
end if
!print*,"mpi_isend(ztab_halo_et_haloTin,neighbour_e_rank=",neighbour_e_rank
!print*,"mpi_isend(pztab_halo_et_haloTin,neighbour_e_rank=",neighbour_e_rank
#else
call mpi_isend(a%st(a_n-(halo_size-1),0,0),1, &
halo_wet(level,m),neighbour_e_rank,sendtag, &
......@@ -1347,13 +1418,13 @@ contains
if (LUseT) then
#ifdef MNH_GPUDIRECT
if (Gneighbour_w) then
!$acc host_data use_device(ztab_halo_wt_haloTin)
call mpi_isend(ztab_halo_wt_haloTin,size(ztab_halo_wt_haloTin), &
!$acc host_data use_device(pztab_halo_wt_haloTin)
call mpi_isend(pztab_halo_wt_haloTin,size(pztab_halo_wt_haloTin), &
MPI_DOUBLE_PRECISION,neighbour_w_rank,sendtag, &
MPI_COMM_HORIZ, requests_ewT(4), ierr)
!$acc end host_data
end if
!print*,"mpi_isend(ztab_halo_wt_haloTin,neighbour_w_rank=",neighbour_w_rank
!print*,"mpi_isend(pztab_halo_wt_haloTin,neighbour_w_rank=",neighbour_w_rank
#else
call mpi_isend(a%st(1,0,0),1, &
halo_wet(level,m),neighbour_w_rank,sendtag, &
......@@ -1372,33 +1443,33 @@ contains
if (LUseT) then
if (Gneighbour_n) then
! copy north halo for GPU managed
!$acc kernels async(IS_NORTH) present_cr(zst,ztab_halo_nt_haloTout)
!$acc kernels async(IS_NORTH) present_cr(pzst,pztab_halo_nt_haloTout)
!$mnh_do_concurrent( ii=1:a_n,ij=1:halo_size,ik=1:nz+2 )
zst(ii,ij-halo_size,ik-1) = ztab_halo_nt_haloTout(ii,ij,ik)
pzst(ii,ij-halo_size,ik-1) = pztab_halo_nt_haloTout(ii,ij,ik)
!$mnh_end_do()
!$acc end kernels
end if
if (Gneighbour_s) then
! copy south halo for GPU managed
!$acc kernels async(IS_SOUTH) present_cr(zst,ztab_halo_st_haloTout)
!$acc kernels async(IS_SOUTH) present_cr(pzst,pztab_halo_st_haloTout)
!$mnh_do_concurrent( ii=1:a_n,ij=1:halo_size,ik=1:nz+2 )
zst(ii,ij+a_n,ik-1) = ztab_halo_st_haloTout(ii,ij,ik)
pzst(ii,ij+a_n,ik-1) = pztab_halo_st_haloTout(ii,ij,ik)
!$mnh_end_do()
!$acc end kernels
end if
if (Gneighbour_w) then
! copy west halo for GPU managed
!$acc kernels async(IS_WEST) present_cr(zst,ztab_halo_wt_haloTout)
!$acc kernels async(IS_WEST) present_cr(pzst,pztab_halo_wt_haloTout)
!$mnh_do_concurrent( ii=1:halo_size,ij=1:a_n+2*halo_size,ik=1:nz+2 )
zst(ii-halo_size,ij-halo_size,ik-1) = ztab_halo_wt_haloTout(ii,ij,ik)
pzst(ii-halo_size,ij-halo_size,ik-1) = pztab_halo_wt_haloTout(ii,ij,ik)
!$mnh_end_do()
!$acc end kernels
end if
if (Gneighbour_e) then
! copy east halo for GPU managed
!$acc kernels async(IS_EAST) present_cr(zst,ztab_halo_et_haloTout)
!$acc kernels async(IS_EAST) present_cr(pzst,pztab_halo_et_haloTout)
!$mnh_do_concurrent( ii=1:halo_size,ij=1:a_n+2*halo_size,ik=1:nz+2 )
zst(ii+a_n,ij-halo_size,ik-1) = ztab_halo_et_haloTout(ii,ij,ik)
pzst(ii+a_n,ij-halo_size,ik-1) = pztab_halo_et_haloTout(ii,ij,ik)
!$mnh_end_do()
!$acc end kernels
end if
......@@ -1406,13 +1477,11 @@ contains
call acc_wait_haloswap_mnh()
end if
#endif
end if! (stepsize == 1) ...
if (comm_measuretime) then
call finish_timer(t_haloswap(level,m))
end if
end if
contains
!
! End Comm
!
end subroutine haloswap_mnh_dim
subroutine acc_wait_haloswap_mnh()
if (Gneighbour_s) then
!$acc wait(IS_SOUTH)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme