Newer
Older
WAUTELET Philippe
committed
!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
WAUTELET Philippe
committed
!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_CEN
! #####################
!
INTERFACE
SUBROUTINE ADVECTION_UVW_CEN(HUVW_ADV_SCHEME, &
HLBCX, HLBCY, &
PTSTEP, KTCOUNT, &
PUM, PVM, PWM, &
PDUM, PDVM, PDWM, &
PUT, PVT, PWT, &
PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
PRUS,PRVS, PRWS, &
TPHALO2MLIST )
!
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!
CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
!
CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
!
REAL, INTENT(IN) :: PTSTEP! time step
INTEGER, INTENT(IN) :: KTCOUNT
WAUTELET Philippe
committed
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM
!$acc declare pcopyin(PUM,PVM,PWM)
! Variables at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM, PDVM, PDWM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT, PRHODJ
WAUTELET Philippe
committed
!$acc declare pcopyin(PUT,PVT,PWT,PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
WAUTELET Philippe
committed
!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS , PRWS
! Sources terms
!
! halo lists for 4th order advection
TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
!
END SUBROUTINE ADVECTION_UVW_CEN
!
END INTERFACE
!
END MODULE MODI_ADVECTION_UVW_CEN
! ##########################################################################
SUBROUTINE ADVECTION_UVW_CEN(HUVW_ADV_SCHEME, &
HLBCX, HLBCY, &
PTSTEP, KTCOUNT, &
PUM, PVM, PWM, &
PDUM, PDVM, PDWM, &
PUT, PVT, PWT, &
PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
PRUS,PRVS, PRWS, &
TPHALO2MLIST )
! ##########################################################################
!
!!**** *ADVECTION * - routine to call the specialized advection routines
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to control the advection routines.
!! For that, it is first necessary to compute the metric coefficients
!! and the contravariant components of the momentum.
!!
!!** METHOD
!! ------
!! The advection of momenta is calculated using a centred (second order)
!! scheme.
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! NONE
!!
!! REFERENCE
!! ---------
!! Book1 and book2 ( routine ADVECTION )
!!
!! AUTHOR
!! ------
!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 01/2013 (from ADVECTION routine)
ESCOBAR MUNOZ Juan
committed
!! Modif
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
WAUTELET Philippe
committed
! 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_CONF
USE MODD_PARAMETERS
USE MODD_GRID_n
!
WAUTELET Philippe
committed
#ifndef _OPENACC
WAUTELET Philippe
committed
#else
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_CONTRAV
USE MODI_ADVECUVW_2ND
USE MODI_ADVECUVW_4TH
!
USE MODD_BUDGET
USE MODI_BUDGET
!
WAUTELET Philippe
committed
#ifdef _OPENACC
USE MODE_DEVICE
USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
#endif
!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
!
CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
!
REAL, INTENT(IN) :: PTSTEP! time step
INTEGER, INTENT(IN) :: KTCOUNT
WAUTELET Philippe
committed
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM
!$acc declare pcopyin(PUM,PVM,PWM)
! Variables at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM, PDVM, PDWM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT, PRHODJ
WAUTELET Philippe
committed
!$acc declare pcopyin(PUT,PVT,PWT,PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
WAUTELET Philippe
committed
!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS , PRWS
! Sources terms
!
! halo lists for 4th order advection
TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
!
!
!* 0.2 declarations of local variables
!
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZVS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZWS
WAUTELET Philippe
committed
!$acc declare create(ZUS,ZVS,ZWS)
! guess of cartesian components of
! momentum at future (+PTSTEP) timestep
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS
WAUTELET Philippe
committed
!$acc declare create(ZRUS,ZRVS,ZRWS)
! cartesian components of
! rhodJ times the tendency of
! momentum from previous (-PTSTEP)
! to future (+PTSTEP) timestep
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
WAUTELET Philippe
committed
!$acc declare create(ZRUT,ZRVT,ZRWT)
! cartesian
! components of
! momentum
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCT
WAUTELET Philippe
committed
!$acc declare create(ZRUCT,ZRVCT,ZRWCT)
! contravariant
! components
! of momentum
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMXM_RHODJ
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMYM_RHODJ
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMZM_RHODJ
WAUTELET Philippe
committed
!$acc declare create(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
!
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
INTEGER :: IKU
INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! index values for the physical subdomain
WAUTELET Philippe
committed
#ifdef _OPENACC
INTEGER :: IZ1, IZ2
#endif
WAUTELET Philippe
committed
#ifdef _OPENACC
PRINT *,'OPENACC: ADVECTION_UVW_CEN not yet tested'
#endif
!-------------------------------------------------------------------------------
!
WAUTELET Philippe
committed
#ifdef _OPENACC
CALL INIT_ON_HOST_AND_DEVICE(ZUS,-1e99,'ADVECTION_UVW_CEN::ZUS')
CALL INIT_ON_HOST_AND_DEVICE(ZVS,-2e99,'ADVECTION_UVW_CEN::ZVS')
CALL INIT_ON_HOST_AND_DEVICE(ZWS,-3e99,'ADVECTION_UVW_CEN::ZWS')
CALL INIT_ON_HOST_AND_DEVICE(ZRUS,-1e99,'ADVECTION_UVW_CEN::ZRUS')
CALL INIT_ON_HOST_AND_DEVICE(ZRVS,-2e99,'ADVECTION_UVW_CEN::ZRVS')
CALL INIT_ON_HOST_AND_DEVICE(ZRWS,-3e99,'ADVECTION_UVW_CEN::ZRWS')
CALL INIT_ON_HOST_AND_DEVICE(ZRUT,-1e99,'ADVECTION_UVW_CEN::ZRUT')
CALL INIT_ON_HOST_AND_DEVICE(ZRVT,-2e99,'ADVECTION_UVW_CEN::ZRVT')
CALL INIT_ON_HOST_AND_DEVICE(ZRWT,-3e99,'ADVECTION_UVW_CEN::ZRWT')
CALL INIT_ON_HOST_AND_DEVICE(ZRUCT,-1e98,'ADVECTION_UVW_CEN::ZRUCT')
CALL INIT_ON_HOST_AND_DEVICE(ZRVCT,-2e98,'ADVECTION_UVW_CEN::ZRVCT')
CALL INIT_ON_HOST_AND_DEVICE(ZRWCT,-3e98,'ADVECTION_UVW_CEN::ZRWCT')
CALL INIT_ON_HOST_AND_DEVICE(ZMXM_RHODJ,-1e97,'ADVECTION_UVW_CEN::ZMXM_RHODJ')
CALL INIT_ON_HOST_AND_DEVICE(ZMYM_RHODJ,-2e97,'ADVECTION_UVW_CEN::ZMYM_RHODJ')
CALL INIT_ON_HOST_AND_DEVICE(ZMZM_RHODJ,-3e97,'ADVECTION_UVW_CEN::ZMZM_RHODJ')
!
CALL MNH_GET_ZT3D(IZ1, IZ2)
#endif
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKU = SIZE(XZHAT)
IKB=1+JPVEXT
IKE=IKU-JPVEXT
WAUTELET Philippe
committed
!
#ifndef _OPENACC
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
WAUTELET Philippe
committed
#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
! -------------------------------------
!
WAUTELET Philippe
committed
!$acc kernels present(ZRUT,ZRVT,ZRWT,PUT,PVT,PWT,ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
WAUTELET Philippe
committed
ZRUT(:,:,:) = PUT(:,:,:) * ZMXM_RHODJ(:,:,:)
ZRVT(:,:,:) = PVT(:,:,:) * ZMYM_RHODJ(:,:,:)
ZRWT(:,:,:) = PWT(:,:,:) * ZMZM_RHODJ(:,:,:)
WAUTELET Philippe
committed
!$acc end kernels
WAUTELET Philippe
committed
#ifndef _OPENACC
WAUTELET Philippe
committed
IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,2)
ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4)
END IF
WAUTELET Philippe
committed
#else
WAUTELET Philippe
committed
IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
WAUTELET Philippe
committed
CALL CONTRAV_DEVICE (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,2, &
ZT3D(:,:,:,IZ1),ZT3D(:,:,:,IZ2),ODATA_ON_DEVICE=.TRUE.)
ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
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.)
END IF
!Not necessary: already done in contrav_device !$acc update self(ZRUCT,ZRVCT,ZRWCT)
#endif
ESCOBAR MUNOZ Juan
committed
!!$IF(NHALO == 1) THEN
WAUTELET Philippe
committed
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRWCT, 'ADVECTION_UVW_CEN::ZRWCT' )
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRUCT, 'ADVECTION_UVW_CEN::ZRUCT' )
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRVCT, 'ADVECTION_UVW_CEN::ZRVCT' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
WAUTELET Philippe
committed
!$acc update device(ZRUCT, ZRVCT, ZRWCT)
ESCOBAR MUNOZ Juan
committed
!!$END IF
!
!-------------------------------------------------------------------------------
!
!* 2. TERM FROM PREVIOUS TIME-STEP (from initial_guess)
! ----------------------------
!
WAUTELET Philippe
committed
!$acc kernels present(ZRUS,ZRVS,ZRWS,PUM,PVM,PWM,ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
WAUTELET Philippe
committed
ZRUS(:,:,:) = PUM(:,:,:) * ZMXM_RHODJ(:,:,:)/(2.*PTSTEP)
ZRVS(:,:,:) = PVM(:,:,:) * ZMYM_RHODJ(:,:,:)/(2.*PTSTEP)
ZRWS(:,:,:) = PWM(:,:,:) * ZMZM_RHODJ(:,:,:)/(2.*PTSTEP)
WAUTELET Philippe
committed
!$acc end kernels
!
!-------------------------------------------------------------------------------
!
!* 3. CALLS THE ADVECTION ROUTINES FOR THE MOMENTUM
! ---------------------------------------------
!
! choose between 2nd and 4th order momentum advection.
IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
!
WAUTELET Philippe
committed
#ifdef _OPENACC
PRINT *,'OPENACC: advection_uvw_cen::ADVECUVW_2ND not yet implemented'
CALL ABORT
#endif
CALL ADVECUVW_2ND (PUT,PVT,PWT,ZRUCT,ZRVCT,ZRWCT,ZRUS,ZRVS,ZRWS)
!
ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
!
CALL ADVECUVW_4TH ( HLBCX, HLBCY, ZRUCT, ZRVCT, ZRWCT, &
WAUTELET Philippe
committed
PUT, PVT, PWT, ZRUS, ZRVS, ZRWS, TPHALO2MLIST )
WAUTELET Philippe
committed
!$acc kernels present(ZRUS,ZRVS,ZRWS) present(ZUS,ZVS,ZWS) present(PUM,PVM,PWM) &
!$acc & present(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ) pcopy(PDUM,PDVM,PDWM,PRUS,PRVS,PRWS)
!default added in OpenACC 2.5 !!$acc & default(none)
WAUTELET Philippe
committed
ZUS(:,:,:) = ZRUS(:,:,:)/ZMXM_RHODJ(:,:,:)*2.*PTSTEP
ZVS(:,:,:) = ZRVS(:,:,:)/ZMYM_RHODJ(:,:,:)*2.*PTSTEP
ZWS(:,:,:) = ZRWS(:,:,:)/ZMZM_RHODJ(:,:,:)*2.*PTSTEP
!-------------------------------------------------------------------------------
!
!* 5. Extracts the variation between current and future time step
! -----------------------------------------------------------
!
WAUTELET Philippe
committed
PRUS(:,:,:) = PRUS(:,:,:) + ( ZUS(:,:,:) - PUM(:,:,:) - 0.5* PDUM(:,:,:)) * ZMXM_RHODJ(:,:,:)/(PTSTEP)
PRVS(:,:,:) = PRVS(:,:,:) + ( ZVS(:,:,:) - PVM(:,:,:) - 0.5* PDVM(:,:,:)) * ZMYM_RHODJ(:,:,:)/(PTSTEP)
PRWS(:,:,:) = PRWS(:,:,:) + ( ZWS(:,:,:) - PWM(:,:,:) - 0.5* PDWM(:,:,:)) * ZMZM_RHODJ(:,:,:)/(PTSTEP)
WAUTELET Philippe
committed
PDUM(:,:,:) = ZUS(:,:,:) - PUM(:,:,:)
PDVM(:,:,:) = ZVS(:,:,:) - PVM(:,:,:)
PDWM(:,:,:) = ZWS(:,:,:) - PWM(:,:,:)
WAUTELET Philippe
committed
!$acc end kernels
!
IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADV_BU_RU')
IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADV_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADV_BU_RW')
!
WAUTELET Philippe
committed
#ifdef _OPENACC
CALL MNH_REL_ZT3D(IZ1, IZ2)
#endif
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVECTION_UVW_CEN