Skip to content
Snippets Groups Projects
Commit 88e4a7a3 authored by RODIER Quentin's avatar RODIER Quentin
Browse files

Quentin 14/12/2022: RMC01, generelize update of horizontal final points in a... 

Quentin 14/12/2022: RMC01, generelize update of horizontal final points in a packed horizontal dimension framework
parent 82118f8b
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/common/turb/mode_rmc01.F90
+ 17
− 2
View file @ 88e4a7a3
......@@ -50,7 +50,7 @@ USE MODD_CST, ONLY : CST_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CTURB, ONLY: CSTURB_t
!
USE MODE_RMC01_3D, ONLY: RMC01_3D
USE MODE_UPDATE_IIJU_PHY, ONLY: UPDATE_IIJU_PHY
USE MODE_SBL_PHY, ONLY: BUSINGER_PHIM, BUSINGER_PHIE
!
USE SHUMAN_PHY, ONLY: MZF_PHY, MYF_PHY, MXF_PHY
......@@ -96,6 +96,7 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZZC ! alt. where turb. is isotr.
! size
REAL, DIMENSION(D%NIJT,D%NKT) :: ZL ! SBL length
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1, ZWORK2
REAL, DIMENSION(D%NIJT,D%NKT) :: ZDH ! hor. grid mesh
!-------------------------------------------------------------------------------
!
!* 1. Initializations
......@@ -164,7 +165,21 @@ SELECT CASE (HTURBLEN)
! same law as in the neutral case (i.e. with Phim = 1).
!
CASE ('DELT','DEAR')
CALL RMC01_3D(D,CST,PDXX,PDYY,PDZZ,PDIRCOSZW,ZPHIM,ZZC)
CALL MXF_PHY(D,PDXX,ZWORK1)
CALL MYF_PHY(D,PDYY,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT)
ZDH(IIJB:IIJE,1:D%NKT) = SQRT(ZWORK1(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT))
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT)
!
CALL UPDATE_IIJU_PHY(D,ZZC)
!
DO JK=1,D%NKT
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZZC(IIJB:IIJE,JK) = 2.*MIN(ZPHIM(IIJB:IIJE,JK),1.)/CST%XKARMAN &
* MAX( PDZZ(IIJB:IIJE,JK)*PDIRCOSZW(IIJB:IIJE) , &
ZDH(IIJB:IIJE,JK)/PDIRCOSZW(IIJB:IIJE)/3. )
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
!* 4. factor controling the transition between SBL and free isotropic turb. (3D case)
! --------------------------------------------------------------------
......
src/common/turb/mode_rmc01_3D.F90 → src/common/turb/mode_update_iiju_phy.F90
+ 71
− 0
View file @ 88e4a7a3
......@@ -2,19 +2,21 @@
!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 MODE_RMC01_3D
MODULE MODE_UPDATE_IIJU_PHY
IMPLICIT NONE
CONTAINS
SUBROUTINE RMC01_3D(D,CST,PDXX,PDYY,PDZZ,PDIRCOSZW,PPHIM,PZC)
SUBROUTINE UPDATE_IIJU_PHY(D,PVAR)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ##############################################################
!
!!**** *RMC01* -
!!**** *MODE_UPDATE_IIJU_PHY* -
!!
!! PURPOSE
!! -------
!! This routine computes 3D parts of the rmc01.f90 routine
!! This routine update IIU-1 and IJU-1 values to (IIU,IJU) values in the PHYEX
!! package where all arrays have a single dimension for the horizontal coordinates
!! i.e. ni*nj
!!
!!** METHOD
!! ------
......@@ -36,42 +38,24 @@ SUBROUTINE RMC01_3D(D,CST,PDXX,PDYY,PDZZ,PDIRCOSZW,PPHIM,PZC)
!!
!! MODIFICATIONS
!! -------------
!! Original 18/08/022
!! Original 18/08/22
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST, ONLY : CST_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
USE SHUMAN_PHY, ONLY: MYF_PHY, MXF_PHY
!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDXX ! width of grid mesh (X dir)
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDYY ! width of grid mesh (Y dir)
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! width of vert. layers
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPHIM ! MO function
REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PDIRCOSZW ! Director Cosinus
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PZC ! alt. where turb. is isotr.
REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2
REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZDH ! hor. grid mesh
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PVAR ! working variable
!
INTEGER :: IKB,IKE ! first,last physical level
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
INTEGER :: JK,JI,JJ ! loop counter
INTEGER :: IIE,IIB,IJE,IJB,IIU,IJU
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('RMC01_3D',0,ZHOOK_HANDLE)
IKTB=D%NKTB
IKTE=D%NKTE
IKB=D%NKB
IKE=D%NKE
IF (LHOOK) CALL DR_HOOK('UPDATE_IIJU_PHY',0,ZHOOK_HANDLE)
IIE=D%NIEC
IIB=D%NIBC
IJE=D%NJEC
......@@ -79,21 +63,9 @@ IJB=D%NJBC
IIU=D%NIT
IJU=D%NJT
!
CALL MXF_PHY(D,PDXX,ZWORK1)
CALL MYF_PHY(D,PDYY,ZWORK2)
!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT)
ZDH(IIB:IIE,IJB:IJE,1:D%NKT) = SQRT(ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT)*ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT))
!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT)
ZDH(IIU,IJB:IJE,1:D%NKT) = ZDH(IIU-1,IJB:IJE,1:D%NKT)
ZDH(IIB:IIE,IJU,1:D%NKT) = ZDH(IIB:IIE,IJU-1,1:D%NKT)
DO JK=1,D%NKT
!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
PZC(IIB:IIE,IJB:IJE,JK) = 2.*MIN(PPHIM(IIB:IIE,IJB:IJE,JK),1.)/CST%XKARMAN &
* MAX( PDZZ(IIB:IIE,IJB:IJE,JK)*PDIRCOSZW(IIB:IIE,IJB:IJE) , &
ZDH(IIB:IIE,IJB:IJE,JK)/PDIRCOSZW(IIB:IIE,IJB:IJE)/3. )
!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
END DO
PVAR(IIU,IJB:IJE,1:D%NKT) = PVAR(IIU-1,IJB:IJE,1:D%NKT)
PVAR(IIB:IIE,IJU,1:D%NKT) = PVAR(IIB:IIE,IJU-1,1:D%NKT)
!
IF (LHOOK) CALL DR_HOOK('RMC01_3D',1,ZHOOK_HANDLE)
END SUBROUTINE RMC01_3D
END MODULE MODE_RMC01_3D
IF (LHOOK) CALL DR_HOOK('UPDATE_IIJU_PHY',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_IIJU_PHY
END MODULE MODE_UPDATE_IIJU_PHY
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