Skip to content

trchdf and trcave gpu #5

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
dindon-sournois wants to merge 8 commits into
base: dev_gpu
Choose a base branch
from
Open

trchdf and trcave gpu #5

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
444e5f3
port trczdf to GPU
Apr 15, 2024
59e50e2
reduce vector length
Apr 16, 2024
c381702
move allocations, put async everywhere, use fsx macro
Apr 24, 2024
1c99915
fix serial kernel
Apr 24, 2024
539824a
remove duplicated mpplnk_my_openacc routine, just use mpplnk_my
May 7, 2024
8542c33
port trchdf on GPU
May 7, 2024
277e623
trcave GPU port
May 7, 2024
6b7c754
remove debug statement
May 13, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions src/BIO/trclec.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -141,6 +141,7 @@ SUBROUTINE trclec
if (ctr_hf(ji).eq.1) jptra_high = jptra_high + 1
enddo
allocate(highfreq_table(jptra_HIGH))
!$acc enter data create(highfreq_table)
highfreq_table = huge(highfreq_table(1))

jptra_high = 0
Expand All @@ -165,6 +166,7 @@ SUBROUTINE trclec

if (lwp) write(*,*) 'High freq diagnostics number :', jptra_dia_HIGH
allocate(highfreq_table_dia(jptra_dia_HIGH))
!$acc enter data create(highfreq_table_dia)

jptra_dia_high = 0

Expand All @@ -188,6 +190,7 @@ SUBROUTINE trclec

if (lwp) write(*,*) 'High freq diagnostics number 2d:', jptra_dia2d_HIGH
allocate(highfreq_table_dia2d(jptra_dia2d_HIGH))
!$acc enter data create(highfreq_table_dia2d)

jptra_dia2d_high = 0

Expand Down
20 changes: 17 additions & 3 deletions src/General/memory.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -516,7 +516,7 @@ subroutine alloc_tot()
gphiv = huge(gphiv(1,1))
allocate(gphif(jpj,jpi))
gphif = huge(gphif(1,1))
allocate(e1t(jpj,jpi))
allocate(e1t(jpj,jpi))
e1t = huge(e1t(1,1))
allocate(e1u(jpj,jpi))
e1u = huge(e1u(1,1))
Expand Down Expand Up @@ -790,10 +790,17 @@ subroutine alloc_tot()
allocate(DAY_LENGTH(jpj,jpi))
DAY_LENGTH = huge(DAY_LENGTH(1,1))
forcing_phys_initialized = .false.

!$acc enter data create(e1t,e2t,e3t,e3w,e3t_back,tra,trb,tmask,umask,&
!$acc& vmask,avt,e1u,e2u,e3u,e1v,e2v,e3v,un,vn,wn,trn,ahtt,traIO,traIO_HIGH,&
!$acc& snIO,tnIO,wnIO,avtIO,e3tIO,unIO,vnIO,vatmIO,empIO,qsrIO,sn,tn,&
!$acc& tra_DIA,tra_DIA_IO,tra_DIA_2d_IO,tra_DIA_2d,tra_DIA_IO_HIGH,&
!$acc& vatm,emp,qsr,tra_DIA_2d_IO_HIGH)

#ifdef Mem_Monitor
mem_all=get_mem(err) - aux_mem
#endif

END subroutine alloc_tot


Expand All @@ -802,6 +809,8 @@ subroutine clean_memory()

! myalloc (memory.f90)

!$acc exit data delete(e1t,e2t,e3t,e3w,e3t_back,tra,trb,tmask,umask,vmask,avt)

#ifdef key_mpp

!$acc exit data delete(te_send, tw_send, tn_send, ts_send) finalize
Expand Down Expand Up @@ -953,7 +962,7 @@ subroutine clean_memory()
deallocate(tra_DIA_2d_IO_HIGH)
deallocate(tra_PHYS_2d_IO)
deallocate(tra_PHYS_2d_IO_HIGH)


if(lwp) then
deallocate(tottrn)
Expand Down Expand Up @@ -991,10 +1000,15 @@ subroutine clean_memory()

! trclec

!$acc exit data delete(highfreq_table,highfreq_table_dia,highfreq_table_dia2d)
deallocate(highfreq_table)
deallocate(highfreq_table_dia)
deallocate(highfreq_table_dia2d)

!$acc exit data delete(trn, e1u, e2u, e3u, e1v, e2v, e3v, un, vn, wn,&
!$acc& ahtt, traio,traIO_HIGH,snIO,tnIO,wnIO,avtIO,e3tIO,unIO,vnIO,vatmIO,empIO,qsrIO,sn,tn,&
!$acc& tra_DIA,tra_DIA_IO,tra_DIA_2d_IO,tra_DIA_2d,tra_DIA_IO_HIGH,vatm,emp,qsr,tra_DIA_2d_IO_HIGH)

end subroutine clean_memory

INTEGER FUNCTION find_index_var(string)
Expand Down
8 changes: 8 additions & 0 deletions src/General/step.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -265,6 +265,10 @@ SUBROUTINE trcstp
! with surface boundary condition
! with IMPLICIT vertical diffusion

! XXX: to be removed
use DIA_mem, only: diaflx,flx_ridxt
use myalloc, only: tra,trb,e1t,e3t_back,e2t,e3t,e3w,umask,vmask,tmask,avt,ahtt

IMPLICIT NONE
integer jn,jk,ji,jj
trcstpparttime = MPI_WTIME() ! cronometer-start
Expand All @@ -289,14 +293,18 @@ SUBROUTINE trcstp
! tracers: horizontal diffusion IF namelist flags are activated
! -----------------------------

!$acc update device(umask,vmask,tmask,trb,ahtt,tra,diaflx,flx_ridxt) if(lhdf)
IF (lhdf) CALL trchdf
!$acc update host(diaflx,tra) if(lhdf)

! tracers: sink and source (must be parallelized on vertical slab)
IF (lsbc) CALL trcsbc ! surface cell processes, default lsbc = False

IF (lbfm) CALL trcsms

!$acc update device(e1t,diaflx,e3t_back,e2t,trb,tmask,e3t,tra,avt,e3w) if (lzdf)
IF (lzdf) CALL trczdf ! tracers: vertical diffusion
!$acc update host(diaflx,tra) if (lzdf)

IF (lsnu) CALL snutel

Expand Down
2 changes: 2 additions & 0 deletions src/IO/DIA_mem.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,7 @@ SUBROUTINE alloc_DIA_local_flx()
INDflxDUMP = huge(INDflxDUMP(1))
allocate(diaflx (7, Fsize, jptra ))
diaflx = 0
!$acc enter data create(flx_ridxt,diaflx)
END SUBROUTINE alloc_DIA_local_flx


Expand Down Expand Up @@ -95,6 +96,7 @@ subroutine clean_memory_dia()

if (allocated(diaflx)) then
deallocate(diaflx)
!$acc exit data delete(diaflx)
endif

if (allocated(INDflxDUMPZERO)) then
Expand Down
165 changes: 3 additions & 162 deletions src/MPI/ogstm_mpi.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -118,168 +118,7 @@ SUBROUTINE mynode
!! nono : number for local neighboring processors
!!
!!----------------------------------------------------------------------
SUBROUTINE mpplnk_my(ptab)

double precision ptab(jpk,jpj,jpi)


#ifdef key_mpp_mpi

INTEGER jk,jj,ji
INTEGER reqs1, reqs2, reqr1, reqr2
INTEGER reqs3, reqs4, reqr3, reqr4
INTEGER jw, packsize

!! trcadvparttime = MPI_WTIME()

!!
!!2. East and west directions exchange
!!------------------------------------



!!
!!2.2 Migrations
!!
!!
! 3 4
! | ^
! | |
! v |
! ________________
! | |
! 1<-- | | 1 <--
! 2--> | | 2 -->
! |________________|
! 3 4
! | ^
! | |
! v |

packsize=jpk*jpj

IF(nbondi.eq.-1) THEN ! We are at the west side of the domain

CALL mppsend(2,ptab(:,:,jpi-1),packsize,noea,0,reqs1)
CALL mpprecv(1,ptab(:,:, jpi),packsize,reqr1)

ELSE IF(nbondi.eq.0) THEN
CALL mppsend(1, ptab(:,: ,2),packsize,nowe,0,reqs1)
CALL mppsend(2, ptab(:,:,jpi-1),packsize,noea,0,reqs2)

CALL mpprecv(1,ptab(:,:,jpi),packsize,reqr1)
CALL mpprecv(2,ptab(:,:, 1),packsize,reqr2)

ELSE IF(nbondi.eq.1) THEN ! We are at the east side of the domain

CALL mppsend(1,ptab(:,:,2), packsize, nowe,0, reqs1)
CALL mpprecv(2,ptab(:,:,1), packsize, reqr1)


ENDIF


!!
!!
!!3. North and south directions
!!-----------------------------
!!
!!3.1 Read Dirichlet lateral conditions
!!


IF(nbondj.eq.0.or.nbondj.eq.-1) THEN
DO jw=1,NORTH_count_send
ji = NORTHpoints_send(1,jw)
jk = NORTHpoints_send(2,jw)
tn_send(jw) = ptab(jk,jpj-1,ji)
ENDDO
ENDIF
IF(nbondj.eq.0.or.nbondj.eq.1) THEN
DO jw=1,SOUTH_count_send
ji = SOUTHpoints_send(1,jw)
jk = SOUTHpoints_send(2,jw)
ts_send(jw) = ptab(jk,2,ji)
ENDDO


ENDIF! PACK_LOOP4


!!
!!2.2 Migrations
!!
!!

IF(nbondj.eq.-1) THEN ! We are at the south side of the domain
CALL mppsend(4,tn_send,NORTH_count_send,nono,0,reqs4)
CALL mpprecv(3,tn_recv,NORTH_count_recv,reqr3)
CALL mppwait(reqs4)
CALL mppwait(reqr3)
ELSE IF(nbondj.eq.0) THEN
CALL mppsend(4, tn_send,NORTH_count_send,nono,0,reqs4)
CALL mppsend(3, ts_send,SOUTH_count_send,noso,0,reqs3)
CALL mpprecv(3,tn_recv,NORTH_count_recv,reqr3)
CALL mpprecv(4,ts_recv,SOUTH_count_recv,reqr4)

CALL mppwait(reqs4)
CALL mppwait(reqs3)
CALL mppwait(reqr3)
CALL mppwait(reqr4)
ELSE IF(nbondj.eq.1) THEN ! We are at the north side of the domain
CALL mppsend(3,ts_send, SOUTH_count_send, noso,0, reqs3)
CALL mpprecv(4,ts_recv, SOUTH_count_recv, reqr4)
CALL mppwait(reqs3)
CALL mppwait(reqr4)
ENDIF



!!
!!2.3 Write Dirichlet lateral conditions
!!

IF(nbondj.eq.0.or.nbondj.eq.1) THEN ! All but south boundary, we received from south

DO jw=1,SOUTH_count_recv
ji = SOUTHpoints_recv(1,jw)
jk = SOUTHpoints_recv(2,jw)
ptab(jk,1,ji)= ts_recv(jw)
ENDDO

ENDIF

IF(nbondj.eq.-1.or.nbondj.eq.0) THEN ! All but north boundary, we received from north

DO jw=1,NORTH_count_recv
ji = NORTHpoints_recv(1,jw)
jk = NORTHpoints_recv(2,jw)
ptab(jk,jpj,ji)= tn_recv(jw)
ENDDO

ENDIF ! PACK_LOOP5


!!! East - West waits

IF(nbondi.eq.-1) THEN ! We are at the west side of the domain
CALL mppwait(reqs1)
CALL mppwait(reqr1)
ELSE IF(nbondi.eq.0) THEN
CALL mppwait(reqs1)
CALL mppwait(reqs2)
CALL mppwait(reqr1)
CALL mppwait(reqr2)
ELSE IF(nbondi.eq.1) THEN ! We are at the east side of the domain
CALL mppwait(reqs1)
CALL mppwait(reqr1)
ENDIF

#endif

END SUBROUTINE

SUBROUTINE mpplnk_my_openacc(ptab,gpu)
SUBROUTINE mpplnk_my(ptab,gpu)

double precision ptab(jpk,jpj,jpi)
#ifdef key_mpp_mpi
Expand Down Expand Up @@ -413,6 +252,7 @@ SUBROUTINE mpplnk_my_openacc(ptab,gpu)
!$acc kernels default(present) if(use_gpu)
IF(nbondj.eq.0.or.nbondj.eq.1) THEN ! All but south boundary, we received from south

!$acc loop independent
DO jw=1,SOUTH_count_recv
ji = SOUTHpoints_recv(1,jw)
jk = SOUTHpoints_recv(2,jw)
Expand All @@ -423,6 +263,7 @@ SUBROUTINE mpplnk_my_openacc(ptab,gpu)

IF(nbondj.eq.-1.or.nbondj.eq.0) THEN ! All but north boundary, we received from north

!$acc loop independent
DO jw=1,NORTH_count_recv
ji = NORTHpoints_recv(1,jw)
jk = NORTHpoints_recv(2,jw)
Expand Down
6 changes: 6 additions & 0 deletions src/PHYS/ADV_mem.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -114,6 +114,9 @@ subroutine myalloc_ADV()
mem_all=get_mem(err) - aux_mem
#endif

!$acc enter data create(advmask,zaa,zbb,zcc,inv_eu,inv_ev,inv_et,&
!$acc& big_fact_zaa,big_fact_zbb,big_fact_zcc,zbtr_arr)

END subroutine myalloc_ADV
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1

Expand All @@ -133,6 +136,9 @@ subroutine clean_memory_adv()
deallocate(big_fact_zcc)
deallocate(zbtr_arr)

!$acc exit data delete(advmask,zaa,zbb,zcc,inv_eu,inv_ev,inv_et,&
!$acc& big_fact_zaa,big_fact_zbb,big_fact_zcc,zbtr_arr)

end subroutine clean_memory_adv


Expand Down
29 changes: 28 additions & 1 deletion src/PHYS/ZDF_mem.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,9 @@ subroutine myalloc_ZDF()
jarr_zdf = huge(jarr_zdf(1,1))
allocate(jarr_zdf_flx(jpi*jpj,jpk))
jarr_zdf_flx = huge(jarr_zdf_flx(1,1))
!$acc enter data create(jarr_zdf,jarr_zdf_flx)
!$acc update device(jarr_zdf,jarr_zdf_flx)
#ifndef _OPENACC
allocate(zwd(jpk, ntids))
zwd = huge(zwd(1,1))
allocate(zws(jpk, ntids))
Expand All @@ -60,14 +63,36 @@ subroutine myalloc_ZDF()
zwz = huge(zwz(1,1))
allocate(zwt(jpk, ntids))
zwt = huge(zwt(1,1))
#endif

#ifdef Mem_Monitor
mem_all=get_mem(err) - aux_mem
#endif


END subroutine myalloc_ZDF


#ifdef _OPENACC
subroutine myalloc_ZDF_gpu()
allocate(zwd(jpk, dimen_jvzdf))
zwd = huge(zwd(1,1))
allocate(zws(jpk, dimen_jvzdf))
zws = huge(zws(1,1))
allocate(zwi(jpk, dimen_jvzdf))
zwi = huge(zwi(1,1))
allocate(zwx(jpk, dimen_jvzdf))
zwx = huge(zwx(1,1))
allocate(zwy(jpk, dimen_jvzdf))
zwy = huge(zwy(1,1))
allocate(zwz(jpk, dimen_jvzdf))
zwz = huge(zwz(1,1))
allocate(zwt(jpk, dimen_jvzdf))
zwt = huge(zwt(1,1))

!$acc enter data create(zwd,zwi,zwx,zws,zwz,zwy,zwt)
!$acc update device(zwd,zwi,zwx,zws,zwz,zwy,zwt)
END subroutine myalloc_ZDF_gpu
#endif


subroutine clean_memory_zdf()
Expand All @@ -82,6 +107,8 @@ subroutine clean_memory_zdf()
deallocate(zwz)
deallocate(zwt)

!$acc exit data delete(jarr_zdf,jarr_zdf_flx,zwd,zwi,zwx,zws,zwz,zwy,zwt)

end subroutine clean_memory_zdf


Expand Down
Loading