From 88e4a7a3e781f25644c7dd44712c2414f776a50a Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Wed, 14 Dec 2022 17:58:57 +0100
Subject: [PATCH] Quentin 14/12/2022: RMC01, generelize update of horizontal
final points in a packed horizontal dimension framework
---
src/common/turb/mode_rmc01.F90 | 19 ++++-
src/common/turb/mode_rmc01_3D.F90 | 99 ------------------------
src/common/turb/mode_update_iiju_phy.F90 | 71 +++++++++++++++++
3 files changed, 88 insertions(+), 101 deletions(-)
delete mode 100644 src/common/turb/mode_rmc01_3D.F90
create mode 100644 src/common/turb/mode_update_iiju_phy.F90
diff --git a/src/common/turb/mode_rmc01.F90 b/src/common/turb/mode_rmc01.F90
index c531453df..77d980793 100644
--- a/src/common/turb/mode_rmc01.F90
+++ b/src/common/turb/mode_rmc01.F90
@@ -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)
! --------------------------------------------------------------------
diff --git a/src/common/turb/mode_rmc01_3D.F90 b/src/common/turb/mode_rmc01_3D.F90
deleted file mode 100644
index 0619ca250..000000000
--- a/src/common/turb/mode_rmc01_3D.F90
+++ /dev/null
@@ -1,99 +0,0 @@
-!MNH_LIC Copyright 1994-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 MODE_RMC01_3D
-IMPLICIT NONE
-CONTAINS
-SUBROUTINE RMC01_3D(D,CST,PDXX,PDYY,PDZZ,PDIRCOSZW,PPHIM,PZC)
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-! ##############################################################
-!
-!!**** *RMC01* -
-!!
-!! PURPOSE
-!! -------
-!! This routine computes 3D parts of the rmc01.f90 routine
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! Q. Rodier - Meteo-France -
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 18/08/022
-!-------------------------------------------------------------------------------
-!
-!* 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
-!
-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
-IIE=D%NIEC
-IIB=D%NIBC
-IJE=D%NJEC
-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
-!
-IF (LHOOK) CALL DR_HOOK('RMC01_3D',1,ZHOOK_HANDLE)
-END SUBROUTINE RMC01_3D
-END MODULE MODE_RMC01_3D
diff --git a/src/common/turb/mode_update_iiju_phy.F90 b/src/common/turb/mode_update_iiju_phy.F90
new file mode 100644
index 000000000..b109abd04
--- /dev/null
+++ b/src/common/turb/mode_update_iiju_phy.F90
@@ -0,0 +1,71 @@
+!MNH_LIC Copyright 1994-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 MODE_UPDATE_IIJU_PHY
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE UPDATE_IIJU_PHY(D,PVAR)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! ##############################################################
+!
+!!**** *MODE_UPDATE_IIJU_PHY* -
+!!
+!! PURPOSE
+!! -------
+!! 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
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Q. Rodier - Meteo-France -
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/08/22
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PVAR ! working variable
+!
+INTEGER :: IIE,IIB,IJE,IJB,IIU,IJU
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('UPDATE_IIJU_PHY',0,ZHOOK_HANDLE)
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IIU=D%NIT
+IJU=D%NJT
+!
+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('UPDATE_IIJU_PHY',1,ZHOOK_HANDLE)
+END SUBROUTINE UPDATE_IIJU_PHY
+END MODULE MODE_UPDATE_IIJU_PHY
--
GitLab