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

Juan 21/09/2021:ZSOLVER/advection_uvw.f90, add orig for GPU opt

parent b0c44610
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/ZSOLVER/advection_uvw.f90 0 → 100644
+ 537
− 0
View file @ 514efa9a
!MNH_LIC Copyright 1994-2020 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.
!-----------------------------------------------------------------
! #########################
MODULE MODI_ADVECTION_UVW
! #########################
!
INTERFACE
SUBROUTINE ADVECTION_UVW (HUVW_ADV_SCHEME, &
HTEMP_SCHEME, KWENO_ORDER, OSPLIT_WENO, &
HLBCX, HLBCY, PTSTEP, &
PUT, PVT, PWT, &
PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
PRUS, PRVS, PRWS, &
PRUS_PRES, PRVS_PRES, PRWS_PRES )
!
CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! to the selected
CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
!
INTEGER, INTENT(IN) :: KWENO_ORDER ! Order of the WENO
! scheme (3 or 5)
LOGICAL, INTENT(IN) :: OSPLIT_WENO ! flag to add a time
! splitting to RK for WENO
!
CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
!
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
! Sources terms
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
!
END SUBROUTINE ADVECTION_UVW
!
END INTERFACE
!
END MODULE MODI_ADVECTION_UVW
! ##########################################################################
SUBROUTINE ADVECTION_UVW (HUVW_ADV_SCHEME, &
HTEMP_SCHEME, KWENO_ORDER, OSPLIT_WENO, &
HLBCX, HLBCY, PTSTEP, &
PUT, PVT, PWT, &
PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
PRUS, PRVS, PRWS, &
PRUS_PRES, PRVS_PRES, PRWS_PRES )
! ##########################################################################
!
!!**** *ADVECTION_UVW * - routine to call the specialized advection routines for wind
!!
!! PURPOSE
!! -------
!!
!!** METHOD
!! ------
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! NONE
!!
!! REFERENCE
!! ---------
!! Book1 and book2 ( routine ADVECTION )
!!
!! AUTHOR
!! ------
!! J.-P. Pinty * Laboratoire d'Aerologie*
!! J.-P. Lafore * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 06/07/94
!! 01/04/95 (Ph. Hereil J. Nicolau) add the model number
!! 23/10/95 (J. Vila and JP Lafore) advection schemes scalar
!! 16/01/97 (JP Pinty) change presentation
!! 30/04/98 (J. Stein P Jabouille) extrapolation for the cyclic
!! case and parallelisation
!! 24/06/99 (P Jabouille) case of NHALO>1
!! 25/10/05 (JP Pinty) 4th order scheme
!! 04/2011 (V. Masson & C. Lac) splits the routine and adds
!! time splitting
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! C.LAC 10/2016 : Add OSPLIT_WENO
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
USE MODD_PARAMETERS, ONLY : JPVEXT
USE MODD_CONF, ONLY : NHALO
USE MODD_BUDGET
!
#ifndef MNH_OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_CONTRAV
USE MODI_ADVECUVW_RK
USE MODI_ADV_BOUNDARIES
USE MODI_BUDGET
USE MODI_GET_HALO
!
#ifdef MNH_OPENACC
USE MODE_DEVICE
USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D, MNH_GET_ZT4D , MNH_REL_ZT4D
#endif
use mode_mppdb
!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! to the selected
CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
!
INTEGER, INTENT(IN) :: KWENO_ORDER ! Order of the WENO
! scheme (3 or 5)
LOGICAL, INTENT(IN) :: OSPLIT_WENO ! flag to add a time
! splitting to RK for WENO
!
CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
!
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
! Sources terms
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
!
!
!* 0.2 declarations of local variables
!
!
!
INTEGER :: IKE ! indice K End in z direction
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUT
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVT
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWT
! cartesian
! components of
! momentum
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUCT
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVCT
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWCT
! contravariant
! components
! of momentum
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU, ZV, ZW
! Guesses at the end of the sub time step
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS_OTHER
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVS_OTHER
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWS_OTHER
! Contribution of the RK time step
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS_ADV
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVS_ADV
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWS_ADV
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMXM_RHODJ
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMYM_RHODJ
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMZM_RHODJ
!
! Momentum tendencies due to advection
INTEGER :: ISPLIT ! Number of splitting loops
INTEGER :: JSPL ! Loop index
REAL :: ZTSTEP ! Sub Time step
!
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(LIST_ll), POINTER :: TZFIELD_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
!
#ifdef MNH_OPENACC
INTEGER :: ISPL, IZUT, IZVT, IZWT, IZ1, IZ2
INTEGER :: IZRUSB, IZRUSE, IZRVSB, IZRVSE, IZRWSB, IZRWSE
#endif
!
!
!-------------------------------------------------------------------------------
!
!* 0. INITIALIZATION
! --------------
!$acc data present( PUT, PVT, PWT, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, PRUS, PRVS, PRWS, PRUS_PRES, PRVS_PRES, PRWS_PRES )
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PUT,"ADVECTION_UVW beg:PUT")
CALL MPPDB_CHECK(PVT,"ADVECTION_UVW beg:PVT")
CALL MPPDB_CHECK(PWT,"ADVECTION_UVW beg:PWT")
CALL MPPDB_CHECK(PRHODJ,"ADVECTION_UVW beg:PRHODJ")
CALL MPPDB_CHECK(PDXX,"ADVECTION_UVW beg:PDXX")
CALL MPPDB_CHECK(PDYY,"ADVECTION_UVW beg:PDYY")
CALL MPPDB_CHECK(PDZZ,"ADVECTION_UVW beg:PDZZ")
CALL MPPDB_CHECK(PDZX,"ADVECTION_UVW beg:PDZX")
CALL MPPDB_CHECK(PDZY,"ADVECTION_UVW beg:PDZY")
CALL MPPDB_CHECK(PRUS_PRES,"ADVECTION_UVW beg:PRUS_PRES")
CALL MPPDB_CHECK(PRVS_PRES,"ADVECTION_UVW beg:PRVS_PRES")
CALL MPPDB_CHECK(PRWS_PRES,"ADVECTION_UVW beg:PRWS_PRES")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRUS,"ADVECTION_UVW beg:PRUS")
CALL MPPDB_CHECK(PRVS,"ADVECTION_UVW beg:PRVS")
CALL MPPDB_CHECK(PRWS,"ADVECTION_UVW beg:PRWS")
END IF
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( ZU ( SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3) ) )
ALLOCATE( ZV ( SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3) ) )
ALLOCATE( ZW ( SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3) ) )
ALLOCATE( ZRUS_OTHER( SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3) ) )
ALLOCATE( ZRVS_OTHER( SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3) ) )
ALLOCATE( ZRWS_OTHER( SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3) ) )
ALLOCATE( ZRUS_ADV ( SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3) ) )
ALLOCATE( ZRVS_ADV ( SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3) ) )
ALLOCATE( ZRWS_ADV ( 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) ) )
!$acc data create( zrut, zrvt, zrwt, zruct, zrvct, zrwct, zu, zv, zw, &
!$acc & zrus_other, zrvs_other, zrws_other, zrus_adv, zrvs_adv, zrws_adv, &
!$acc & zmxm_rhodj, zmym_rhodj, zmzm_rhodj )
#ifdef MNH_OPENACC
#if 0
CALL INIT_ON_HOST_AND_DEVICE(ZRUT,-1e99,'ADVECTION_UVW::ZRUT')
CALL INIT_ON_HOST_AND_DEVICE(ZRVT,-2e99,'ADVECTION_UVW::ZRVT')
CALL INIT_ON_HOST_AND_DEVICE(ZRWT,-3e99,'ADVECTION_UVW::ZRWT')
CALL INIT_ON_HOST_AND_DEVICE(ZRUCT,-1e98,'ADVECTION_UVW::ZRUCT')
CALL INIT_ON_HOST_AND_DEVICE(ZRVCT,-2e98,'ADVECTION_UVW::ZRVCT')
CALL INIT_ON_HOST_AND_DEVICE(ZRWCT,-3e98,'ADVECTION_UVW::ZRWCT')
CALL INIT_ON_HOST_AND_DEVICE(ZU,-1e99,'ADVECTION_UVW::ZU')
CALL INIT_ON_HOST_AND_DEVICE(ZV,-1e99,'ADVECTION_UVW::ZV')
CALL INIT_ON_HOST_AND_DEVICE(ZW,-1e99,'ADVECTION_UVW::ZW')
CALL INIT_ON_HOST_AND_DEVICE(ZRUS_OTHER,-1e99,'ADVECTION_UVW::ZRUS_OTHER')
CALL INIT_ON_HOST_AND_DEVICE(ZRVS_OTHER,-1e99,'ADVECTION_UVW::ZRVS_OTHER')
CALL INIT_ON_HOST_AND_DEVICE(ZRWS_OTHER,-1e99,'ADVECTION_UVW::ZRWS_OTHER')
CALL INIT_ON_HOST_AND_DEVICE(ZRUS_ADV,-1e99,'ADVECTION_UVW::ZRUS_ADV')
CALL INIT_ON_HOST_AND_DEVICE(ZRVS_ADV,-1e99,'ADVECTION_UVW::ZRVS_ADV')
CALL INIT_ON_HOST_AND_DEVICE(ZRWS_ADV,-1e99,'ADVECTION_UVW::ZRWS_ADV')
CALL INIT_ON_HOST_AND_DEVICE(ZMXM_RHODJ,-1e97,'ADVECTION_UVW::ZMXM_RHODJ')
CALL INIT_ON_HOST_AND_DEVICE(ZMYM_RHODJ,-2e97,'ADVECTION_UVW::ZMYM_RHODJ')
CALL INIT_ON_HOST_AND_DEVICE(ZMZM_RHODJ,-3e97,'ADVECTION_UVW::ZMZM_RHODJ')
#endif
!
SELECT CASE (HTEMP_SCHEME)
CASE('RK11')
ISPL = 1
CASE('RK21')
ISPL = 2
CASE('NP32')
ISPL = 3
CASE('SP32')
ISPL = 3
CASE('RK33')
ISPL = 3
CASE('RKC4')
ISPL = 4
CASE('RK4B')
ISPL = 4
CASE('RK53')
ISPL = 5
CASE('RK62')
ISPL = 6
CASE('RK65')
ISPL = 6
CASE DEFAULT
call Print_msg( NVERB_FATAL, 'GEN', 'ADVECTION_UVW', 'unknown htemp_scheme' )
END SELECT
!
CALL MNH_GET_ZT3D(IZUT, IZVT, IZWT, IZ1, IZ2)
CALL MNH_GET_ZT4D(ISPL, IZRUSB, IZRUSE)
CALL MNH_GET_ZT4D(ISPL, IZRVSB, IZRVSE)
CALL MNH_GET_ZT4D(ISPL, IZRWSB, IZRWSE)
#endif
!
IKE = SIZE(PWT,3) - JPVEXT
!
#ifndef MNH_OPENACC
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
ZMZM_RHODJ = MZM(PRHODJ)
#else
CALL MXM_DEVICE(PRHODJ,ZMXM_RHODJ)
CALL MYM_DEVICE(PRHODJ,ZMYM_RHODJ)
CALL MZM_DEVICE(PRHODJ,ZMZM_RHODJ)
#endif
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
! -------------------------------------
!
!$acc kernels
ZRUT(:,:,:) = PUT(:,:,:) * ZMXM_RHODJ(:,:,:)
ZRVT(:,:,:) = PVT(:,:,:) * ZMYM_RHODJ(:,:,:)
ZRWT(:,:,:) = PWT(:,:,:) * ZMZM_RHODJ(:,:,:)
!$acc end kernels
!
#ifndef MNH_OPENACC
NULLIFY(TZFIELD_ll)
!!$IF(NHALO == 1) THEN
CALL ADD3DFIELD_ll( TZFIELD_ll, ZRUT, 'ADVECTION_UVW::ZRUT' )
CALL ADD3DFIELD_ll( TZFIELD_ll, ZRVT, 'ADVECTION_UVW::ZRVT' )
CALL UPDATE_HALO_ll(TZFIELD_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELD_ll)
!!$END IF
#else
! acc update self(ZRUT,ZRVT)
CALL GET_HALO_D(ZRUT,HNAME='ADVECTION_UVW::ZRUT')
CALL GET_HALO_D(ZRVT,HNAME='ADVECTION_UVW::ZRVT')
! acc update device(ZRUT,ZRVT)
#endif
!
#ifndef MNH_OPENACC
CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4)
#else
CALL CONTRAV_DEVICE (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4,&
ZT3D(:,:,:,IZ1),ZT3D(:,:,:,IZ2),ODATA_ON_DEVICE=.TRUE.)
!Not necessary: already done in contrav_device !$acc update self(ZRUCT,ZRVCT,ZRWCT)
#endif
!
#ifndef MNH_OPENACC
NULLIFY(TZFIELDS_ll)
!!$IF(NHALO == 1) THEN
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRWCT, 'ADVECTION_UVW::ZRWCT' )
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRUCT, 'ADVECTION_UVW::ZRUCT' )
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRVCT, 'ADVECTION_UVW::ZRVCT' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!!$END IF
#else
CALL GET_HALO_D(ZRUCT,HNAME='ADVECTION_UVW::ZRUCT')
CALL GET_HALO_D(ZRVCT,HNAME='ADVECTION_UVW::ZRVCT')
CALL GET_HALO_D(ZRWCT,HNAME='ADVECTION_UVW::ZRWCT')
! acc update device(ZRUCT,ZRVCT,ZRWCT) !Needed in advecuvw_weno_k called by advecuvw_rk
#endif
!
!-------------------------------------------------------------------------------
!
!
!* 2. COMPUTES THE TENDENCIES SINCE THE BEGINNING OF THE TIME STEP
! ------------------------------------------------------------
!
!$acc kernels
ZRUS_OTHER(:,:,:) = PRUS(:,:,:) - ZRUT(:,:,:) / PTSTEP + PRUS_PRES(:,:,:)
ZRVS_OTHER(:,:,:) = PRVS(:,:,:) - ZRVT(:,:,:) / PTSTEP + PRVS_PRES(:,:,:)
ZRWS_OTHER(:,:,:) = PRWS(:,:,:) - ZRWT(:,:,:) / PTSTEP + PRWS_PRES(:,:,:)
!$acc end kernels
!
! Top and bottom Boundaries
!
#ifndef MNH_OPENACC
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRUS_OTHER)
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRVS_OTHER)
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRWS_OTHER)
#else
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRUS_OTHER)
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRVS_OTHER)
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRWS_OTHER)
#endif
!$acc kernels
ZRWS_OTHER(:,:,IKE+1) = 0.
!$acc end kernels
#ifndef MNH_OPENACC
NULLIFY(TZFIELDS0_ll)
!!$IF(NHALO == 1) THEN
CALL ADD3DFIELD_ll( TZFIELDS0_ll, ZRUS_OTHER, 'ADVECTION_UVW::ZRUS_OTHER' )
CALL ADD3DFIELD_ll( TZFIELDS0_ll, ZRVS_OTHER, 'ADVECTION_UVW::ZRVS_OTHER' )
CALL ADD3DFIELD_ll( TZFIELDS0_ll, ZRWS_OTHER, 'ADVECTION_UVW::ZRWS_OTHER' )
CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS0_ll)
!!$END IF
#else
! acc update self(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER)
CALL GET_HALO_D(ZRUS_OTHER,HNAME='ADVECTION_UVW::ZRUS_OTHER' )
CALL GET_HALO_D(ZRVS_OTHER,HNAME='ADVECTION_UVW::ZRVS_OTHER' )
CALL GET_HALO_D(ZRWS_OTHER,HNAME='ADVECTION_UVW::ZRWS_OTHER' )
! acc update device(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER)
#endif
!
!
!
!-------------------------------------------------------------------------------
!
IF ( HUVW_ADV_SCHEME == 'CEN4TH' ) THEN
ISPLIT = 1
ELSE IF (OSPLIT_WENO) THEN
ISPLIT = 2
ELSE
ISPLIT = 1
END IF
ZTSTEP = PTSTEP / REAL(ISPLIT)
!
!-------------------------------------------------------------------------------
!
!$acc kernels
ZU(:,:,:) = PUT(:,:,:)
ZV(:,:,:) = PVT(:,:,:)
ZW(:,:,:) = PWT(:,:,:)
!$acc end kernels
!$acc update self(ZU,ZV,ZW)
!
!
!* 3. TIME SPLITTING
! --------------
!
DO JSPL=1,ISPLIT
!
CALL ADVECUVW_RK (HUVW_ADV_SCHEME, &
HTEMP_SCHEME, KWENO_ORDER, &
HLBCX, HLBCY, ZTSTEP, &
ZU, ZV, ZW, &
PUT, PVT, PWT, &
ZMXM_RHODJ, ZMYM_RHODJ, ZMZM_RHODJ, &
ZRUCT, ZRVCT, ZRWCT, &
ZRUS_ADV, ZRVS_ADV, ZRWS_ADV, &
ZRUS_OTHER, ZRVS_OTHER, ZRWS_OTHER &
#ifndef MNH_OPENACC
)
#else
,ZT3D(:,:,:,IZUT), ZT3D(:,:,:,IZVT), ZT3D(:,:,:,IZWT), &
ZT3D(:,:,:,IZRUSB:IZRUSE), ZT3D(:,:,:,IZRVSB:IZRVSE), ZT3D(:,:,:,IZRWSB:IZRWSE) )
#endif
!
! Tendencies on wind
!$acc update device(ZRUS_ADV,ZRVS_ADV,ZRWS_ADV)
!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) + ZRUS_ADV(:,:,:) / ISPLIT
PRVS(:,:,:) = PRVS(:,:,:) + ZRVS_ADV(:,:,:) / ISPLIT
PRWS(:,:,:) = PRWS(:,:,:) + ZRWS_ADV(:,:,:) / ISPLIT
IF (JSPL<ISPLIT) THEN
!
! Guesses for next time splitting loop
!
ZU(:,:,:) = ZU(:,:,:) + ZTSTEP / ZMXM_RHODJ * &
(ZRUS_OTHER(:,:,:) + ZRUS_ADV(:,:,:))
ZV(:,:,:) = ZV(:,:,:) + ZTSTEP / ZMYM_RHODJ * &
(ZRVS_OTHER(:,:,:) + ZRVS_ADV(:,:,:))
ZW(:,:,:) = ZW(:,:,:) + ZTSTEP / ZMZM_RHODJ * &
(ZRWS_OTHER(:,:,:) + ZRWS_ADV(:,:,:))
END IF
!$acc end kernels
!
! Top and bottom Boundaries
!
IF (JSPL<ISPLIT) THEN
#ifndef MNH_OPENACC
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZU, PUT, 'U' )
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZV, PVT, 'V' )
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZW, PWT, 'W' )
#else
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZU, PUT, 'U' )
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZV, PVT, 'V' )
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZW, PWT, 'W' )
#endif
!$acc kernels
ZW (:,:,IKE+1 ) = 0.
!$acc end kernels
!$acc update self(ZU,ZV,ZW)
END IF
!
! End of the time splitting loop
END DO
!
!
!* 4. BUDGETS
! -------
!
IF (LBUDGET_U) THEN
!$acc update self(PRUS)
CALL BUDGET (PRUS,1,'ADV_BU_RU')
END IF
IF (LBUDGET_V) THEN
!$acc update self(PRVS)
CALL BUDGET (PRVS,2,'ADV_BU_RV')
END IF
IF (LBUDGET_W) THEN
!$acc update self(PRWS)
CALL BUDGET (PRWS,3,'ADV_BU_RW')
END IF
!-------------------------------------------------------------------------------
!
#ifdef MNH_OPENACC
CALL MNH_REL_ZT4D(ISPL, IZRWSB)
CALL MNH_REL_ZT4D(ISPL, IZRVSB)
CALL MNH_REL_ZT4D(ISPL, IZRUSB)
CALL MNH_REL_ZT3D(IZUT, IZVT, IZWT, IZ1, IZ2)
#endif
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRUS,"ADVECTION_UVW end:PRUS")
CALL MPPDB_CHECK(PRVS,"ADVECTION_UVW end:PRVS")
CALL MPPDB_CHECK(PRWS,"ADVECTION_UVW end:PRWS")
END IF
!$acc end data
!$acc end data
END SUBROUTINE ADVECTION_UVW
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