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

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)
 !         --------------------------------------------------------------------

src/common/turb/mode_rmc01_3D.F90 → src/common/turb/mode_update_iiju_phy.F90

@@ -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