Newer
Older
!MNH_LIC Copyright 1994-2019 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.
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
! ##############################
MODULE MODI_ADVEC_WENO_K_3_AUX
! ##############################
!
INTERFACE
!
SUBROUTINE ADVEC_WENO_K_3_UX(HLBCX,PSRC, PRUCT, PR)
!
USE MODE_ll
USE MODD_LUNIT
USE MODD_CONF
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!---------------------------------------------------------------------------------
SUBROUTINE ADVEC_WENO_K_3_MX(HLBCX,PSRC, PRUCT, PR)
!
USE MODE_ll
USE MODD_LUNIT
USE MODD_CONF
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!---------------------------------------------------------------------------------
SUBROUTINE ADVEC_WENO_K_3_VY(HLBCY,PSRC, PRVCT, PR)
!
USE MODE_ll
USE MODD_LUNIT
USE MODD_CONF
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
!
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!---------------------------------------------------------------------------------
SUBROUTINE ADVEC_WENO_K_3_MY(HLBCY,PSRC, PRVCT, PR)
!
USE MODE_ll
USE MODD_LUNIT
USE MODD_CONF
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!---------------------------------------------------------------------------------
!
FUNCTION WENO_K_3_WZ(PSRC, PRWCT) RESULT(PR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
!
! output source term
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
!
END FUNCTION WENO_K_3_WZ
!
!---------------------------------------------------------------------------------
!
FUNCTION WENO_K_3_MZ(PSRC, PRWCT) RESULT(PR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
!
! output source term
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
!
END FUNCTION WENO_K_3_MZ
!
END INTERFACE
!
END MODULE MODI_ADVEC_WENO_K_3_AUX
!
!-----------------------------------------------------------------------------
!
! ############################################################
SUBROUTINE ADVEC_WENO_K_3_UX(HLBCX,PSRC, PRUCT, PR)
! ############################################################
!!
!!**** Computes PRUCT * PUT. Upstream fluxes of U in X direction.
!! Input PUT is on U Grid 'ie' (i,j,k) based on UGRID reference
!! Output PR is on mass Grid 'ie' (i+1/2,j,k) based on UGRID reference
!!
!! AUTHOR
!! ------
!! F. Visentin *CNRS/LA*
!!
!! MODIFICATIONS
!! -------------
!! T. Lunet 02/10/2014: Correction of periodic boudary conditions
!! Change of structure in order to adapt WENO to NHALOK
!! Suppression of second layer HALO pointers
!! Complete code documentation
!! J.Escobar : 25/09/2015 : WENO5 & JPHEXT <> 1
!! J.Escobar : 02/10/2015 : correction on CYCL/OPEN boundaries
!!
!-------------------------------------------------------------------------------
!
USE MODD_CONF
USE MODD_LUNIT
!
USE MODE_ll
use mode_msg
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER :: IIE,IJE ! End useful area in x,y,z directions
INTEGER :: IW,IE ! Physical boundary index
!
INTEGER:: ILUOUT,IRESP ! for prints
!
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
!
! intermediate reconstruction fluxes for negative wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
!
! WENO non-normalized weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2, ZOMP3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3
!
! EPSILON for weno weights calculation
!
REAL, PARAMETER :: ZEPS = 1.0E-15
!
!-----------------------------------------------------------------------------
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
!-------------------------------------------------------------------------------
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
ZFPOS2 = 0.0
Loading
Loading full blame...