Skip to content
Snippets Groups Projects
Commit f2ab98e8 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 30/03/2022: OpenACC: use MNH_MEM_GET family calls in more ZSOLVER/ subroutines

parent 710d5394
Branches
Tags
1 merge request!4Jean Wurtz 30/04/2025 : Bugfixes mainly for TEB and for simple precision
Expand all Hide whitespace changes
Inline Side-by-side
src/ZSOLVER/advection_uvw_cen.f90
+ 82
− 18
View file @ f2ab98e8
......@@ -105,6 +105,7 @@ use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
#ifdef MNH_OPENACC
USE MODE_DEVICE
USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
use mode_msg
#endif
use mode_mppdb
......@@ -146,6 +147,8 @@ TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
!* 0.2 declarations of local variables
!
!
INTEGER :: IIU, IJU, IKU
#ifndef MNH_OPENACC
REAL, DIMENSION(:,:,:), allocatable :: ZUS
REAL, DIMENSION(:,:,:), allocatable :: ZVS
REAL, DIMENSION(:,:,:), allocatable :: ZWS
......@@ -175,6 +178,37 @@ REAL, DIMENSION(:,:,:), allocatable :: ZRWCT
REAL, DIMENSION(:,:,:), allocatable :: ZMXM_RHODJ
REAL, DIMENSION(:,:,:), allocatable :: ZMYM_RHODJ
REAL, DIMENSION(:,:,:), allocatable :: ZMZM_RHODJ
#else
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZUS
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZVS
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZWS
! guess of cartesian components of
! momentum at future (+PTSTEP) timestep
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRUS
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRVS
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRWS
! cartesian components of
! rhodJ times the tendency of
! momentum from previous (-PTSTEP)
! to future (+PTSTEP) timestep
!
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRUT
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRVT
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRWT
! cartesian
! components of
! momentum
!
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRUCT
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRVCT
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRWCT
! contravariant
! components
! of momentum
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZMXM_RHODJ
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZMYM_RHODJ
REAL, DIMENSION(:,:,:), pointer, contiguous :: ZMZM_RHODJ
#endif
!
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
......@@ -209,24 +243,49 @@ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus(:, :,
if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
allocate( zus ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zvs ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zws ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zrus ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zrvs ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zrws ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zrut ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zrvt ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zrwt ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zruct ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zrvct ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zrwct ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zmxm_rhodj ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zmym_rhodj ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zmzm_rhodj ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
IIU = SIZE( put, 1 )
IJU = SIZE( put, 2 )
IKU = SIZE( put, 3 )
#ifndef MNH_OPENACC
allocate( zus ( iiu, iju, iku ) )
allocate( zvs ( iiu, iju, iku ) )
allocate( zws ( iiu, iju, iku ) )
allocate( zrus ( iiu, iju, iku ) )
allocate( zrvs ( iiu, iju, iku ) )
allocate( zrws ( iiu, iju, iku ) )
allocate( zrut ( iiu, iju, iku ) )
allocate( zrvt ( iiu, iju, iku ) )
allocate( zrwt ( iiu, iju, iku ) )
allocate( zruct ( iiu, iju, iku ) )
allocate( zrvct ( iiu, iju, iku ) )
allocate( zrwct ( iiu, iju, iku ) )
allocate( zmxm_rhodj ( iiu, iju, iku ) )
allocate( zmym_rhodj ( iiu, iju, iku ) )
allocate( zmzm_rhodj ( iiu, iju, iku ) )
#else
!Pin positions in the pools of MNH memory
CALL MNH_MEM_POSITION_PIN( 'ADVECTION_UVW_CEN' )
CALL MNH_MEM_GET( zus, iiu, iju, iku )
CALL MNH_MEM_GET( zvs, iiu, iju, iku )
CALL MNH_MEM_GET( zws, iiu, iju, iku )
CALL MNH_MEM_GET( zrus, iiu, iju, iku )
CALL MNH_MEM_GET( zrvs, iiu, iju, iku )
CALL MNH_MEM_GET( zrws, iiu, iju, iku )
CALL MNH_MEM_GET( zrut, iiu, iju, iku )
CALL MNH_MEM_GET( zrvt, iiu, iju, iku )
CALL MNH_MEM_GET( zrwt, iiu, iju, iku )
CALL MNH_MEM_GET( zruct, iiu, iju, iku )
CALL MNH_MEM_GET( zrvct, iiu, iju, iku )
CALL MNH_MEM_GET( zrwct, iiu, iju, iku )
CALL MNH_MEM_GET( zmxm_rhodj, iiu, iju, iku )
CALL MNH_MEM_GET( zmym_rhodj, iiu, iju, iku )
CALL MNH_MEM_GET( zmzm_rhodj, iiu, iju, iku )
!$acc data create( zus, zvs, zws, zrus, zrvs, zrws, zrut, zrvt, zrwt, &
!$acc & zruct, zrvct, zrwct, zmxm_rhodj, zmym_rhodj, zmzm_rhodj )
!$acc data present( zus, zvs, zws, zrus, zrvs, zrws, zrut, zrvt, zrwt, &
!$acc & zruct, zrvct, zrwct, zmxm_rhodj, zmym_rhodj, zmzm_rhodj )
#endif
#ifdef MNH_OPENACC
CALL INIT_ON_HOST_AND_DEVICE(ZUS,-1e99,'ADVECTION_UVW_CEN::ZUS')
......@@ -323,7 +382,7 @@ ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
!
END IF
!
!$acc kernels
!$acc kernels present( ZRUS, ZRVS, ZRWS, ZMXM_RHODJ, ZMYM_RHODJ, ZMZM_RHODJ )
ZUS(:,:,:) = ZRUS(:,:,:)/ZMXM_RHODJ(:,:,:)*2.*PTSTEP
ZVS(:,:,:) = ZRVS(:,:,:)/ZMYM_RHODJ(:,:,:)*2.*PTSTEP
ZWS(:,:,:) = ZRWS(:,:,:)/ZMZM_RHODJ(:,:,:)*2.*PTSTEP
......@@ -354,6 +413,11 @@ END IF
!$acc end data
#ifdef MNH_OPENACC
!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
CALL MNH_MEM_RELEASE( 'ADVECTION_UVW_CEN' )
#endif
!$acc end data
!-------------------------------------------------------------------------------
......
src/ZSOLVER/modeln.f90
+ 7
− 0
View file @ f2ab98e8
......@@ -545,10 +545,17 @@ LOGICAL :: KACTIT
LOGICAL :: KSEDI
LOGICAL :: KHHONI
!
#ifndef MNH_OPENACC
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS,ZRVS
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWS
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABST !To give pressure at t
! (and not t+1) to resolved_cloud
#else
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRUS,ZRVS
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWS
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPABST !To give pressure at t
! (and not t+1) to resolved_cloud
#endif
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ
!
TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
......
src/ZSOLVER/rain_ice_red.f90
+ 437
− 38
View file @ f2ab98e8
This diff is collapsed.
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

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