From a999fb49a87fc20b542d335278c402134bb4d2d7 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Wed, 30 Nov 2022 13:36:40 +0100
Subject: [PATCH] Philippe 30/11/2022: compute XTHW_FLUX, XRCW_FLUX and
XSVW_FLUX only when needed
---
src/MNH/phys_paramn.f90 | 28 ++++++++++---------
src/MNH/turb_ver_sv_flux.f90 | 17 ++++++++----
src/MNH/turb_ver_thermo_flux.f90 | 47 +++++++++++++++++++-------------
3 files changed, 54 insertions(+), 38 deletions(-)
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index bb9291239..2c314509d 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -237,12 +237,14 @@ END MODULE MODI_PHYS_PARAM_n
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
! F. Auguste 02/2021: add IBM
! JL Redelsperger 03/2021: add the SW flux penetration for Ocean model case
+! P. Wautelet 30/11/2022: compute XTHW_FLUX, XRCW_FLUX and XSVW_FLUX only when needed
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ADV_n, ONLY : XRTKEMS
+USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
@@ -1460,25 +1462,25 @@ IF ( CTURB == 'TKEL' ) THEN
END IF
!
!
-IF(ALLOCATED(XTHW_FLUX)) THEN
- DEALLOCATE(XTHW_FLUX)
- ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+IF ( ALLOCATED( XTHW_FLUX ) ) DEALLOCATE( XTHW_FLUX )
+IF ( LFLYER ) THEN
+ ALLOCATE( XTHW_FLUX(SIZE( XTHT, 1 ), SIZE( XTHT, 2 ), SIZE( XTHT, 3 )) )
ELSE
- ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+ ALLOCATE( XTHW_FLUX(0, 0, 0) )
END IF
-IF(ALLOCATED(XRCW_FLUX)) THEN
- DEALLOCATE(XRCW_FLUX)
- ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+IF ( ALLOCATED( XRCW_FLUX ) ) DEALLOCATE( XRCW_FLUX )
+IF ( LFLYER ) THEN
+ ALLOCATE( XRCW_FLUX(SIZE( XTHT, 1 ), SIZE( XTHT, 2 ), SIZE( XTHT, 3 )) )
ELSE
- ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+ ALLOCATE( XRCW_FLUX(0, 0, 0) )
END IF
-!
-IF(ALLOCATED(XSVW_FLUX)) THEN
- DEALLOCATE(XSVW_FLUX)
- ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
+
+IF ( ALLOCATED( XSVW_FLUX ) ) DEALLOCATE( XSVW_FLUX )
+IF ( LFLYER ) THEN
+ ALLOCATE( XSVW_FLUX(SIZE( XSVT, 1 ), SIZE( XSVT, 2 ), SIZE( XSVT, 3 ), SIZE( XSVT, 4 )) )
ELSE
- ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
+ ALLOCATE( XSVW_FLUX(0, 0, 0, 0) )
END IF
!
CALL TURB( 1, IKU, 1, IMI, NRR, NRRL, NRRI, CLBCX, CLBCY, 1, NMODEL_CLOUD, &
diff --git a/src/MNH/turb_ver_sv_flux.f90 b/src/MNH/turb_ver_sv_flux.f90
index 8a742e185..a9dbae3d1 100644
--- a/src/MNH/turb_ver_sv_flux.f90
+++ b/src/MNH/turb_ver_sv_flux.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -263,11 +263,13 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! to avoid unknwon values outside physical domain
!! and avoid negative values in sv tendencies
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 30/11/2022: compute PWSV only when needed
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
USE MODD_CST
USE MODD_CTURB
use modd_field, only: tfieldmetadata, TYPEREAL
@@ -445,11 +447,14 @@ DO JSV=1,ISV
! extrapolates the flux under the ground so that the vertical average with
! the IKB flux gives the ground value
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- DO JK=IKTB+1,IKTE-1
- PWSV(:,:,JK,JSV)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWSV(:,:,IKB,JSV)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWSV(:,:,IKE,JSV)=PWSV(:,:,IKE-KKL,JSV)
+
+ IF ( LFLYER ) THEN
+ DO JK=IKTB+1,IKTE-1
+ PWSV(:,:,JK,JSV)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+ END DO
+ PWSV(:,:,IKB,JSV)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+ PWSV(:,:,IKE,JSV)=PWSV(:,:,IKE-KKL,JSV)
+ END IF
END IF
!
IF (OTURB_FLX .AND. tpfile%lopened) THEN
diff --git a/src/MNH/turb_ver_thermo_flux.f90 b/src/MNH/turb_ver_thermo_flux.f90
index 0febd151f..45f46987e 100644
--- a/src/MNH/turb_ver_thermo_flux.f90
+++ b/src/MNH/turb_ver_thermo_flux.f90
@@ -331,11 +331,13 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! June 2020 (B. Vie) Patch preventing negative rc and ri in 2.3 and 3.3
!! JL Redelsperger : 03/2021: Ocean and Autocoupling O-A LES Cases
!! Sfc flux shape for LDEEPOC Case
+! P. Wautelet 30/11/2022: compute PWTH and PWRC only when needed
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
USE MODD_CST
USE MODD_CTURB
use modd_field, only: tfieldmetadata, TYPEREAL
@@ -722,19 +724,24 @@ IF (LOCEAN) THEN
ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
END IF
!
-DO JK=IKTB+1,IKTE-1
- PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
-END DO
-!
-PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
-!
-IF (LOCEAN) THEN
- PWTH(:,:,IKE)=0.5*(ZFLXZ(:,:,IKE)+ZFLXZ(:,:,IKE+KKL))
- PWTH(:,:,KKA)=0.
- PWTH(:,:,KKU)=ZFLXZ(:,:,KKU)
-ELSE
- PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
- PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+IF ( LFLYER ) THEN
+ PWTH(:,:,:IKTB) = XUNDEF
+ PWTH(:,:,IKTE:) = XUNDEF
+ !
+ DO JK=IKTB+1,IKTE-1
+ PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+ END DO
+ !
+ PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+ !
+ IF (LOCEAN) THEN
+ PWTH(:,:,IKE)=0.5*(ZFLXZ(:,:,IKE)+ZFLXZ(:,:,IKE+KKL))
+ PWTH(:,:,KKA)=0.
+ PWTH(:,:,KKU)=ZFLXZ(:,:,KKU)
+ ELSE
+ PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
+ PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+ END IF
END IF
!
IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
@@ -966,12 +973,14 @@ IF (KRR /= 0) THEN
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
- DO JK=IKTB+1,IKTE-1
- PWRC(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWRC(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWRC(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
- PWRC(:,:,IKE)=PWRC(:,:,IKE-KKL)
+ IF ( LFLYER ) THEN
+ DO JK=IKTB+1,IKTE-1
+ PWRC(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+ END DO
+ PWRC(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+ PWRC(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+ PWRC(:,:,IKE)=PWRC(:,:,IKE-KKL)
+ END IF
!
!
IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
--
GitLab