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

Juan 26/10/2022:add orig advec_4th_order_aux.f90/advecuvw_4th.f90 in ZSOLVER for GPU port of CEN4TH

parent 018cc199
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
src/ZSOLVER/advec_4th_order_aux.f90 0 → 100644
+ 735
− 0
View file @ db35d861
This diff is collapsed.
src/ZSOLVER/advecuvw_4th.f90 0 → 100644
+ 382
− 0
View file @ db35d861
!MNH_LIC Copyright 2005-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.
!-----------------------------------------------------------------
! ###########################
MODULE MODI_ADVECUVW_4TH
! ###########################
!
INTERFACE
!
SUBROUTINE ADVECUVW_4TH ( HLBCX, HLBCY, PRUCT, PRVCT, PRWCT, &
PUT, PVT, PWT, PRUS, PRVS, PRWS, TPHALO2LIST )
!
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! U,V,W at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
!
TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
!
END SUBROUTINE ADVECUVW_4TH
!
END INTERFACE
!
END MODULE MODI_ADVECUVW_4TH
!
!
! ######################################################################
SUBROUTINE ADVECUVW_4TH ( HLBCX, HLBCY, PRUCT, PRVCT, PRWCT, &
PUT, PVT, PWT, PRUS, PRVS, PRWS, TPHALO2LIST )
! ######################################################################
!
!!**** *ADVECUVW_4TH * - routine to compute the 4th order centered
!! advection tendency of momentum (U,V,W)
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to call the ADVEC_4TH_ORDER_ALGO
!! routine for the horizontal advection and the MZM4 and MZF4 functions for
!! the vertical advection of momentum. The code is
!! parallelized and works for various boundary conditions.
!!
!!** METHOD
!! ------
!! For each wind component the ADVECUVW_4TH routine calls
!! the ADVEC_4TH_ORDER_ALGO routine which computes the numerical advection
!! of any 3D field.
!! The following variables are passed as argument to ADVEC_4TH_ORDER_ALGO :
!!
!! -- The variable at t
!! -- The second layer of the halo of the field at t
!! -- The horizontal advection fluxes
!! -- The localisation on the model grid :
!!
!! IGRID = 1 for mass grid point
!! IGRID = 2 for U grid point
!! IGRID = 3 for V grid point
!! IGRID = 4 for W grid point
!!
!! EXTERNAL
!! --------
!! BUDGET : Stores the different budget components
!! (not used in current version)
!! ADVEC_4TH_ORDER_ALGO : computes the horizontal advection fluxes
!! MZF4 and MZM4 : computes the vertical advection fluxes
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! MODULE MODD_BUDGET:
!! NBUMOD : model in which budget is calculated
!! CBUTYPE : type of desired budget
!! 'CART' for cartesian box configuration
!! 'MASK' for budget zone defined by a mask
!! 'NONE' ' for no budget
!! NBUPROCCTR : process counter used for each budget variable
!! Switches for budgets activations:
!!
!! MODULE MODD_ARGSLIST
!! HALO2LIST_ll : type for a list of "HALO2_lls"
!!
!! REFERENCE
!! ---------
!! Book2 of documentation ( routine ADVECUVW_4TH )
!!
!! AUTHOR
!! ------
!! J.-P. Pinty * Laboratoire d'Aerologie*
!!
!! MODIFICATIONS
!! -------------
!! Original 25/10/05
!! Modif
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
USE MODD_CONF
USE MODD_GRID_n
USE MODD_PARAMETERS
USE MODE_ll
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
use mode_mppdb
USE MODI_ADVEC_4TH_ORDER_AUX
#ifndef MNH_OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
!
TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
!
!* 0.2 Declarations of local variables :
!
TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
!
INTEGER :: IGRID ! localisation on the model grid
#ifndef MNH_OPENACC
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMEANX, ZMEANY ! fluxes
#else
INTEGER :: IIU, IJU, IKU
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZMEANX, ZMEANY ! fluxes
!
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZTEMP1, ZTEMP2, ZTEMP3, ZTEMP4
#endif
!
#if 0
#define dxm(PDXM,PA) PDXM(2:IIU,:,:) = PA(2:IIU,:,:) - PA(1:IIU-1,:,:) ; PDXM(1,:,:) = PDXM(IIU-2*JPHEXT+1,:,:) ! DXM(PDXM,PA)
#define mxf(PMXF,PA) PMXF(1:IIU-1,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXF(IIU,:,:) = PMXF(2*JPHEXT,:,:) ! MXF(PMXF,PA)
#define mxm(PMXM,PA) PMXM(2:IIU,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXM(1,:,:) = PMXM(IIU-2*JPHEXT+1,:,:) ! MXM(PMXM,PA)
#define dyf(PDYF,PA) PDYF(:,1:IJU-1,:) = PA(:,2:IJU,:) - PA(:,1:IJU-1,:) ; PDYF(:,IJU,:) = PDYF(:,2*JPHEXT,:) ! DYF(PDYF,PA)
#define dzf(PDZF,PA) PDZF(:,:,1:IKU-1) = PA(:,:,2:IKU) - PA(:,:,1:IKU-1) ; PDZF(:,:,IKU) = -999. ! DZF(PDZF,PA)
#define mzm4(PMZM4,PA) PMZM4(:,:,3:IKU-1) = (7.0*( PA(:,:,3:IKU-1)+PA(:,:,2:IKU-2) ) - (PA(:,:,4:IKU)+PA(:,:,1:IKU-3) ) )/12.0 ; \
PMZM4(:,:,2) = 0.5*( PA(:,:,2)+PA(:,:,1) ) ; PMZM4(:,:,IKU) = 0.5*( PA(:,:,IKU)+PA(:,:,IKU-1) ) ; PMZM4(:,:,1) = -999.
#define mym(PMYM,PA) PMYM(:,2:IJU,:) = 0.5*( PA(:,2:IJU,:)+PA(:,1:IJU-1,:) ) ; PMYM(:,1,:) = PMYM(:,IJU-2*JPHEXT+1,:) ! MYM(PMYM,PA)
#define dxf(PDXF,PA) PDXF(1:IIU-1,:,:) = PA(2:IIU,:,:) - PA(1:IIU-1,:,:) ; PDXF(IIU,:,:) = PDXF(2*JPHEXT,:,:) ! DXF(PDXF,PA)
#define myf(PMYF,PA) PMYF(:,1:IJU-1,:) = 0.5*( PA(:,1:IJU-1,:)+PA(:,2:IJU,:) ) ; PMYF(:,IJU,:) = PMYF(:,2*JPHEXT,:) ! MYF(PMYF,PA)
#define dym(PDYM,PA) PDYM(:,2:IJU,:) = PA(:,2:IJU,:) - PA(:,1:IJU-1,:) ; PDYM(:,1,:) = PDYM(:,IJU-2*JPHEXT+1,:) ! DYM(PDYM,PA)
#define mzm(PMZM,PA) PMZM(:,:,2:IKU) = 0.5*( PA(:,:,2:IKU)+PA(:,:,1:IKU-1) ) ; PMZM(:,:,1) = -999. ! MZM(PMZM,PA)
#define mzf(PMZF,PA) PMZF(:,:,1:IKU-1) = 0.5*( PA(:,:,1:IKU-1)+PA(:,:,2:IKU) ) ; PMZF(:,:,IKU) = -999. ! MZF(PMZF,PA)
#define dzm(PDZM,PA) PDZM(:,:,2:IKU) = PA(:,:,2:IKU) - PA(:,:,1:IKU-1) ; PDZM(:,:,1) = -999. ! DZM(PDZM,PA)
#define mzf4(PMZF4,PA) PMZF4(:,:,2:IKU-2) = (7.0*( PA(:,:,3:IKU-1)+PA(:,:,2:IKU-2) ) - (PA(:,:,4:IKU)+PA(:,:,1:IKU-3) ) )/12.0 ; \
PMZF4(:,:,1) = 0.5*( PA(:,:,2)+PA(:,:,1) ) ; PMZF4(:,:,IKU-1) = 0.5*( PA(:,:,IKU)+PA(:,:,IKU-1) ) ; PMZF4(:,:,IKU) = -999.
#endif
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PRUCT,"ADVECUVW_4TH beg:PRUCT")
CALL MPPDB_CHECK(PRVCT,"ADVECUVW_4TH beg:PRVCT")
CALL MPPDB_CHECK(PRWCT,"ADVECUVW_4TH beg:PRWCT")
CALL MPPDB_CHECK(PUT,"ADVECUVW_4TH beg:PUT")
CALL MPPDB_CHECK(PVT,"ADVECUVW_4TH beg:PVT")
CALL MPPDB_CHECK(PWT,"ADVECUVW_4TH beg:PWT")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRUS,"ADVECUVW_4TH beg:PRUS")
CALL MPPDB_CHECK(PRVS,"ADVECUVW_4TH beg:PRVS")
CALL MPPDB_CHECK(PRWS,"ADVECUVW_4TH beg:PRWS")
END IF
#ifdef MNH_OPENACC
IIU = SIZE( PUT, 1 )
IJU = SIZE( PUT, 2 )
IKU = SIZE( PUT, 3 )
!Pin positions in the pools of MNH memory
CALL MNH_MEM_POSITION_PIN()
CALL MNH_MEM_GET( ZMEANX, IIU, IJU, IKU )
CALL MNH_MEM_GET( ZMEANY, IIU, IJU, IKU )
CALL MNH_MEM_GET( ZTEMP1, IIU, IJU, IKU )
CALL MNH_MEM_GET( ZTEMP2, IIU, IJU, IKU )
CALL MNH_MEM_GET( ZTEMP3, IIU, IJU, IKU )
CALL MNH_MEM_GET( ZTEMP4, IIU, IJU, IKU )
#endif
!$acc data present( PRUCT, PRVCT, PRWCT, PUT, PVT, PWT, PRUS, PRVS, PRWS, ZMEANX, ZMEANY, ZTEMP1, ZTEMP2, ZTEMP3, ZTEMP4 )
!-------------------------------------------------------------------------------
!
!* 2. CALL THE ADVEC_4TH_ORDER_ALGO ROUTINE FOR MOMENTUM
! --------------------------------------------------
!
IGRID = 2
!!$IF(NHALO == 1) THEN
TZHALO2LIST => TPHALO2LIST
CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PUT, IGRID, ZMEANX, ZMEANY, &
TZHALO2LIST%HALO2 )
!!$ELSE
!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PUT, IGRID, ZMEANX, ZMEANY)
!!$ENDIF
!
#ifndef MNH_OPENACC
PRUS(:,:,:) = PRUS(:,:,:) &
-DXM( MXF(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!
PRUS(:,:,:) = PRUS(:,:,:) &
-DYF( MXM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!
PRUS(:,:,:) = PRUS(:,:,:) &
-DZF( MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
#else
call mxf_device(PRUCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
!$acc end kernels
call dxm_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
!$acc end kernels
!
call mxm_device(PRVCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
!$acc end kernels
call dyf_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
!$acc end kernels
!
ZTEMP1 = MZM4( PUT )
call mxm_device(PRWCT,ZTEMP2)
!$acc kernels
ZTEMP3 = ZTEMP1 * ZTEMP2
!$acc end kernels
call dzf_device( ZTEMP3, ZTEMP4 )
!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP4
!$acc end kernels
#endif
!
!
IGRID = 3
!!$IF(NHALO == 1) THEN
TZHALO2LIST => TZHALO2LIST%NEXT
CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PVT, IGRID, ZMEANX, ZMEANY, &
TZHALO2LIST%HALO2 )
!!$ELSE
!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PVT, IGRID, ZMEANX, ZMEANY)
!!$ENDIF
!
#ifndef MNH_OPENACC
PRVS(:,:,:) = PRVS(:,:,:) &
-DXF( MYM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!
PRVS(:,:,:) = PRVS(:,:,:) &
-DYM( MYF(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!
PRVS(:,:,:) = PRVS(:,:,:) &
-DZF( MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
#else
call mym_device(PRUCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
!$acc end kernels
call dxf_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
!$acc end kernels
!
call myf_device(PRVCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
!$acc end kernels
call dym_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
!$acc end kernels
!
call mym_device(PRWCT,ZTEMP1)
ZTEMP2 = MZM4( PVT )
!$acc kernels
ZTEMP3 = ZTEMP1 * ZTEMP2
!$acc end kernels
call dzf_device( ZTEMP3, ZTEMP4 )
!$acc kernels
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP4
!$acc end kernels
#endif
CALL MPPDB_CHECK(PRUCT,"ADVECUVW_4TH 02: PRUCT")
!
!
IGRID = 4
!
!!$IF(NHALO == 1) THEN
TZHALO2LIST => TZHALO2LIST%NEXT
CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PWT, IGRID, ZMEANX, ZMEANY, &
TZHALO2LIST%HALO2 )
!!$ELSE
!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PWT, IGRID, ZMEANX, ZMEANY)
!!$ENDIF
!
#ifndef MNH_OPENACC
PRWS(:,:,:) = PRWS(:,:,:) &
-DXF( MZM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!
PRWS(:,:,:) = PRWS(:,:,:) &
-DYF( MZM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!
PRWS(:,:,:) = PRWS(:,:,:) &
-DZM( MZF(PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
#else
call mzm_device(PRUCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
!$acc end kernels
call dxf_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
!$acc end kernels
!
call mzm_device(PRVCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
!$acc end kernels
call dyf_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
!$acc end kernels
!
call mzf_device( PRWCT, ZTEMP1 )
ZTEMP2 = MZF4( PWT )
!$acc kernels
ZTEMP1 = ZTEMP1 * ZTEMP2
!$acc end kernels
call dzm_device( ZTEMP1, ZTEMP4 )
!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP4
!$acc end kernels
#endif
!$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()
#endif
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRUS,"ADVECUVW_4TH end:PRUS")
CALL MPPDB_CHECK(PRVS,"ADVECUVW_4TH end:PRVS")
CALL MPPDB_CHECK(PRWS,"ADVECUVW_4TH end:PRWS")
END IF
!-------------------------------------------------------------------------------
!
!
END SUBROUTINE ADVECUVW_4TH
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