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

Philippe 24/01/2022: OpenACC: model_n: allocate local arrays (used on GPU) with MNH_ALLOCATE_FLAT

parent 757c3c44
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/modeln.f90
+ 64
− 22
View file @ 4c884f83
!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
......@@ -377,6 +377,9 @@ USE MODE_ll
use mode_menu_diachro, only: MENU_DIACHRO
#endif
USE MODE_MNH_TIMING
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK, ONLY: MNH_ALLOCATE_FLAT, MNH_RELEASE_FLAT
#endif
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
USE MODE_MSG
......@@ -485,8 +488,11 @@ INTEGER :: ISYNCHRO ! model synchronic index relative to its father
! = 1 for the first time step in phase with DAD
! = 0 for the last time step (out of phase)
INTEGER :: IMI ! Current model index
REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA
REAL, DIMENSION(:,:),ALLOCATABLE :: ZTOWN
REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZSEA
REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZTOWN
#ifdef MNH_OPENACC
INTEGER :: IZSEA, IZTOWN
#endif
! Dummy pointers needed to correct an ifort Bug
REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
......@@ -539,9 +545,16 @@ LOGICAL :: KACTIT
LOGICAL :: KSEDI
LOGICAL :: KHHONI
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABST !To give pressure at t
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS,ZRVS
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWS
#ifdef MNH_OPENACC
INTEGER :: IZRWS
#endif
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPABST !To give pressure at t
! (and not t+1) to resolved_cloud
#ifdef MNH_OPENACC
INTEGER :: IZPABST
#endif
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ
!
TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
......@@ -562,13 +575,17 @@ TZOUTFILE=> NULL()
allocate( ZRUS (SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
allocate( ZRVS (SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
#ifndef MNH_OPENACC
allocate( ZRWS (SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
allocate( ZPABST(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
#else
IZRWS = MNH_ALLOCATE_FLAT( ZRWS, 1, SIZE( XTHT, 1 ), 1, SIZE( XTHT, 2 ), 1, SIZE( XTHT, 3 ) )
IZPABST = MNH_ALLOCATE_FLAT( ZPABST, 1, SIZE( XTHT, 1 ), 1, SIZE( XTHT, 2 ), 1, SIZE( XTHT, 3 ) )
IZSEA = -1 !Set to -1 because not (yet) allocated
IZTOWN = -1 !Set to -1 because not (yet) allocated
#endif
allocate( ZJ (SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
allocate( ZWETDEPAER(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) )
!$acc data create( zrws )
!
!* 0. MICROPHYSICAL SCHEME
! -------------------
......@@ -1639,7 +1656,7 @@ ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
!$acc kernels
!$acc kernels present( ZRWS )
ZRWS(:,:,:) = XRWS(:,:,:)
!$acc end kernels
!
......@@ -1652,7 +1669,7 @@ CALL GRAVITY_IMPL ( CLBCX, CLBCY, NRR, NRRL, NRRI,XTSTEP, &
! compensated by the pressure gradient
!
IF (KTCOUNT == 1 .AND. CCONF=='START') THEN
!$acc kernels
!$acc kernels present( ZRWS )
XRWS_PRES(:,:,:) = ZRWS(:,:,:) - XRWS(:,:,:)
!$acc end kernels
END IF
......@@ -1758,7 +1775,7 @@ CALL MPPDB_CHECKLB(XLBYVM,"modeln XLBYVM",PRECISION,'LBYV',NRIMY)
CALL MPPDB_CHECKLB(XLBXUS,"modeln XLBXUS",PRECISION,'LBXU',NRIMX)
CALL MPPDB_CHECKLB(XLBYVS,"modeln XLBYVS",PRECISION,'LBYV',NRIMY)
!
CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
XTSTEP, &
XDXHAT, XDYHAT, XZHAT, &
XUT, XVT, &
......@@ -1907,25 +1924,28 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XRTHS_CLD(:, :, : ) = XRTHS(:, :, : )
XRRS_CLD (:, :, :, : ) = XRRS(:, :, :, : )
XRSVS_CLD(:, :, :, : ) = XRSVS(:, :, :, : )
!$acc data present(XRHODJ) &
!$acc & copyin (XZZ, XRHODREF, XEXNREF, ZPABST, XTHT, XSIGS, VSIGQSAT, XMFCONV, XTHM, XPABSM, &
!$acc data present( XRHODJ, XRTHS, ZPABST ) &
!$acc & copyin (XZZ, XRHODREF, XEXNREF, XTHT, XSIGS, VSIGQSAT, XMFCONV, XTHM, XPABSM, &
!$acc & XRCM, XWT_ACT_NUC, XDTHRAD, XCF_MF, XRC_MF, XRI_MF, &
!$acc & XSOLORG, XMI) &
!$acc & copy (XSUPSAT, XNACT, XNPRO, XSSPRO, &
!$acc & XRTHS, XRT, XRRS, XSVT, XRSVS, XCLDFR, XCIT, XINPRR3D, XEVAP3D, &
!$acc & XRT, XRRS, XSVT, XRSVS, XCLDFR, XCIT, XINPRR3D, XEVAP3D, &
!$acc & XINPRC, XINPRR, XINPRS, XINPRG, XINPRH, XINDEP, &
!$acc & XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF) &
!$acc & copyout(XSRCT, XRAINFR)
!$acc update device ( XRTHS )
!$acc update device ( XRTHS, ZPABST )
IF (CSURF=='EXTE') THEN
#ifndef MNH_OPENACC
ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ZSEA(:,:) = 0.
ZTOWN(:,:)= 0.
#else
IZSEA = MNH_ALLOCATE_FLAT( ZSEA, 1, SIZE( XRHODJ, 1 ), 1, SIZE( XRHODJ, 2 ) )
IZTOWN = MNH_ALLOCATE_FLAT( ZTOWN, 1, SIZE( XRHODJ, 1 ), 1, SIZE( XRHODJ, 2 ) )
#endif
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
!$acc data copyin(ZSEA, ZTOWN )
!$acc update device( ZSEA, ZTOWN )
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, &
......@@ -1946,8 +1966,11 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
ZSEA, ZTOWN )
!$acc end data
#ifndef MNH_OPENACC
DEALLOCATE(ZTOWN)
#else
CALL MNH_RELEASE_FLAT( IZTOWN )
#endif
ELSE
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
......@@ -2029,10 +2052,13 @@ IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
XRRS_CLD = XRRS
XRSVS_CLD = XRSVS
IF (CSURF=='EXTE') THEN
#ifndef MNH_OPENACC
ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ZSEA(:,:) = 0.
ZTOWN(:,:)= 0.
#else
IZSEA = MNH_ALLOCATE_FLAT( ZSEA, 1, SIZE( XRHODJ, 1 ), 1, SIZE( XRHODJ, 2 ) )
IZTOWN = MNH_ALLOCATE_FLAT( ZTOWN, 1, SIZE( XRHODJ, 1 ), 1, SIZE( XRHODJ, 2 ) )
#endif
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
......@@ -2046,7 +2072,11 @@ IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
XINPRS, XINPRG, XINPRH, &
ZSEA, ZTOWN )
#ifndef MNH_OPENACC
DEALLOCATE(ZTOWN)
#else
CALL MNH_RELEASE_FLAT( IZTOWN )
#endif
ELSE
CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
......@@ -2376,6 +2406,18 @@ IF (OEXIT) THEN
!
END IF
!$acc end data
#ifndef MNH_OPENACC
IF ( ALLOCATED( ZSEA ) ) DEALLOCATE( ZSEA )
#else
IF ( IZSEA /= -1 ) CALL MNH_RELEASE_FLAT( IZSEA )
#endif
#ifndef MNH_OPENACC
DEALLOCATE( ZRWS )
DEALLOCATE( ZPABST )
#else
CALL MNH_RELEASE_FLAT( IZPABST )
CALL MNH_RELEASE_FLAT( IZRWS )
#endif
END SUBROUTINE MODEL_n
src/ZSOLVER/modeln.f90
+ 65
− 22
View file @ 4c884f83
!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
......@@ -377,6 +377,9 @@ USE MODE_ll
use mode_menu_diachro, only: MENU_DIACHRO
#endif
USE MODE_MNH_TIMING
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK, ONLY: MNH_ALLOCATE_FLAT, MNH_RELEASE_FLAT
#endif
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
USE MODE_MSG
......@@ -485,8 +488,11 @@ INTEGER :: ISYNCHRO ! model synchronic index relative to its father
! = 1 for the first time step in phase with DAD
! = 0 for the last time step (out of phase)
INTEGER :: IMI ! Current model index
REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA
REAL, DIMENSION(:,:),ALLOCATABLE :: ZTOWN
REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZSEA
REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZTOWN
#ifdef MNH_OPENACC
INTEGER :: IZSEA, IZTOWN
#endif
! Dummy pointers needed to correct an ifort Bug
REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
......@@ -539,9 +545,16 @@ LOGICAL :: KACTIT
LOGICAL :: KSEDI
LOGICAL :: KHHONI
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABST !To give pressure at t
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS,ZRVS
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWS
#ifdef MNH_OPENACC
INTEGER :: IZRWS
#endif
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPABST !To give pressure at t
! (and not t+1) to resolved_cloud
#ifdef MNH_OPENACC
INTEGER :: IZPABST
#endif
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ
!
TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
......@@ -562,13 +575,17 @@ TZOUTFILE=> NULL()
allocate( ZRUS (SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
allocate( ZRVS (SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
#ifndef MNH_OPENACC
allocate( ZRWS (SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
allocate( ZPABST(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
#else
IZRWS = MNH_ALLOCATE_FLAT( ZRWS, 1, SIZE( XTHT, 1 ), 1, SIZE( XTHT, 2 ), 1, SIZE( XTHT, 3 ) )
IZPABST = MNH_ALLOCATE_FLAT( ZPABST, 1, SIZE( XTHT, 1 ), 1, SIZE( XTHT, 2 ), 1, SIZE( XTHT, 3 ) )
IZSEA = -1 !Set to -1 because not (yet) allocated
IZTOWN = -1 !Set to -1 because not (yet) allocated
#endif
allocate( ZJ (SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) )
allocate( ZWETDEPAER(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) )
!$acc data create( zrws )
!
!* 0. MICROPHYSICAL SCHEME
! -------------------
......@@ -1639,7 +1656,7 @@ ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
!$acc kernels
!$acc kernels present( ZRWS )
ZRWS(:,:,:) = XRWS(:,:,:)
!$acc end kernels
!
......@@ -1652,7 +1669,7 @@ CALL GRAVITY_IMPL ( CLBCX, CLBCY, NRR, NRRL, NRRI,XTSTEP, &
! compensated by the pressure gradient
!
IF (KTCOUNT == 1 .AND. CCONF=='START') THEN
!$acc kernels
!$acc kernels present( ZRWS )
XRWS_PRES(:,:,:) = ZRWS(:,:,:) - XRWS(:,:,:)
!$acc end kernels
END IF
......@@ -1903,24 +1920,28 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XRTHS_CLD(:, :, : ) = XRTHS(:, :, : )
XRRS_CLD (:, :, :, : ) = XRRS(:, :, :, : )
XRSVS_CLD(:, :, :, : ) = XRSVS(:, :, :, : )
!$acc data present(XRHODJ) &
!$acc & copyin (XZZ, XRHODREF, XEXNREF, ZPABST, XTHT, XSIGS, VSIGQSAT, XMFCONV, XTHM, XPABSM, &
!$acc data present( XRHODJ, XRTHS, ZPABST ) &
!$acc & copyin (XZZ, XRHODREF, XEXNREF, XTHT, XSIGS, VSIGQSAT, XMFCONV, XTHM, XPABSM, &
!$acc & XRCM, XWT_ACT_NUC, XDTHRAD, XCF_MF, XRC_MF, XRI_MF, &
!$acc & XSOLORG, XMI) &
!$acc & copy (XSUPSAT, XNACT, XNPRO, XSSPRO, &
!$acc & XRT, XRRS, XSVT, XRSVS, XCLDFR, XCIT, XINPRR3D, XEVAP3D, &
!$acc & XINPRC, XINPRR, XINPRS, XINPRG, XINPRH, XINDEP) &
!$acc & XRT, XRRS, XSVT, XRSVS, XCLDFR, XCIT, XINPRR3D, XEVAP3D, &
!$acc & XINPRC, XINPRR, XINPRS, XINPRG, XINPRH, XINDEP, &
!$acc & XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF) &
!$acc & copyout(XSRCT, XRAINFR)
!$acc update device ( XRTHS )
!$acc update device ( XRTHS, ZPABST )
IF (CSURF=='EXTE') THEN
#ifndef MNH_OPENACC
ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ZSEA(:,:) = 0.
ZTOWN(:,:)= 0.
#else
IZSEA = MNH_ALLOCATE_FLAT( ZSEA, 1, SIZE( XRHODJ, 1 ), 1, SIZE( XRHODJ, 2 ) )
IZTOWN = MNH_ALLOCATE_FLAT( ZTOWN, 1, SIZE( XRHODJ, 1 ), 1, SIZE( XRHODJ, 2 ) )
#endif
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
!$acc data copyin(ZSEA, ZTOWN )
!$acc update device( ZSEA, ZTOWN )
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, &
......@@ -1941,8 +1962,11 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
ZSEA, ZTOWN )
!$acc end data
#ifndef MNH_OPENACC
DEALLOCATE(ZTOWN)
#else
CALL MNH_RELEASE_FLAT( IZTOWN )
#endif
ELSE
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
......@@ -2024,10 +2048,13 @@ IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
XRRS_CLD = XRRS
XRSVS_CLD = XRSVS
IF (CSURF=='EXTE') THEN
#ifndef MNH_OPENACC
ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ZSEA(:,:) = 0.
ZTOWN(:,:)= 0.
#else
IZSEA = MNH_ALLOCATE_FLAT( ZSEA, 1, SIZE( XRHODJ, 1 ), 1, SIZE( XRHODJ, 2 ) )
IZTOWN = MNH_ALLOCATE_FLAT( ZTOWN, 1, SIZE( XRHODJ, 1 ), 1, SIZE( XRHODJ, 2 ) )
#endif
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
......@@ -2041,7 +2068,11 @@ IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
XINPRS, XINPRG, XINPRH, &
ZSEA, ZTOWN )
#ifndef MNH_OPENACC
DEALLOCATE(ZTOWN)
#else
CALL MNH_RELEASE_FLAT( IZTOWN )
#endif
ELSE
CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
......@@ -2371,6 +2402,18 @@ IF (OEXIT) THEN
!
END IF
!$acc end data
#ifndef MNH_OPENACC
IF ( ALLOCATED( ZSEA ) ) DEALLOCATE( ZSEA )
#else
IF ( IZSEA /= -1 ) CALL MNH_RELEASE_FLAT( IZSEA )
#endif
#ifndef MNH_OPENACC
DEALLOCATE( ZRWS )
DEALLOCATE( ZPABST )
#else
CALL MNH_RELEASE_FLAT( IZPABST )
CALL MNH_RELEASE_FLAT( IZRWS )
#endif
END SUBROUTINE MODEL_n
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