From b3954b2c6171d7c08cba6d20b2d39312fc96304d Mon Sep 17 00:00:00 2001
From: Gaelle Tanguy <gaelle.tanguy@meteo.fr>
Date: Tue, 10 May 2016 07:58:03 +0000
Subject: [PATCH] Christine 10/5/2016 : correction negative contribution to the
budget
---
src/MNH/advection_metsv.f90 | 7 +++++++
src/MNH/phys_paramn.f90 | 2 +-
src/MNH/resolved_cloud.f90 | 6 ++++++
src/MNH/turb.f90 | 36 ++++++++++++++++++++++++++++++++++--
4 files changed, 48 insertions(+), 3 deletions(-)
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index 05db3f1b1..60d68a9f6 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -152,6 +152,7 @@ USE MODI_PPM_MET
USE MODI_PPM_SCALAR
USE MODI_ADV_BOUNDARIES
USE MODI_BUDGET
+USE MODI_GET_HALO
!
USE MODE_FMWRIT
!-------------------------------------------------------------------------------
@@ -570,6 +571,12 @@ IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+! CALL GET_HALO(PRRS(:,:,:,2))
+! CALL GET_HALO(PRSVS(:,:,:,2))
+! CALL GET_HALO(PRSVS(:,:,:,3))
+ WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
+ PRSVS(:,:,:,1) = 0.0
+ END WHERE
DO JSV = 2, 3
WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 4c738b31b..53a1a07b3 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -1326,7 +1326,7 @@ END IF
!
CALL TURB(1,IKU,1,IMI,NRR, NRRL, NRRI, CLBCX, CLBCY, 1,NMODEL_CLOUD, &
OCLOSE_OUT,LTURB_FLX,LTURB_DIAG,LSUBG_COND,LRMC01, &
- CTURBDIM,CTURBLEN,CTOM,CTURBLEN_CLOUD,XIMPL, &
+ CTURBDIM,CTURBLEN,CTOM,CTURBLEN_CLOUD,CCLOUD,XIMPL, &
XTSTEP,HFMFILE,CLUOUT, &
XDXX,XDYY,XDZZ,XDZX,XDZY,XZZ, &
XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE, &
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 28deb1488..b463a9c4b 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -920,6 +920,12 @@ SELECT CASE ( HCLOUD )
END SELECT
!
IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
+! CALL GET_HALO(PRS(:,:,:,2))
+! CALL GET_HALO(ZSVS(:,:,:,2))
+! CALL GET_HALO(ZSVS(:,:,:,3))
+ WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
+ ZSVS(:,:,:,1) = 0.0
+ END WHERE
DO JSV = 2, 3
WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index 4e937eb99..ba6694e45 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -11,7 +11,7 @@ INTERFACE
SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
KSPLIT,KMODEL_CL, &
OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,PIMPL, &
+ HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
PTSTEP,HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF,PRHODREF, &
@@ -50,6 +50,7 @@ CHARACTER*4 , INTENT(IN) :: HTOM ! kind of Third Order Mome
CHARACTER*4 , INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
! surface friction flux
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
! FM-file
@@ -138,7 +139,7 @@ END MODULE MODI_TURB
! #################################################################
SUBROUTINE TURB(KKA,KKU,KKL,KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KSPLIT,KMODEL_CL, &
OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,PIMPL, &
+ HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
PTSTEP,HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF,PRHODREF, &
@@ -338,6 +339,7 @@ END MODULE MODI_TURB
!! vertical levels
!! 10/2012 (J. Colin) Correct bug in DearDoff for dry simulations
!! 10/2012 J.Escobar Bypass PGI bug , redefine some allocatable array inplace of automatic
+!! 04/2016 (C.Lac) correction of negativity for KHKO
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -364,6 +366,7 @@ USE MODI_RMC01
USE MODI_GRADIENT_W
USE MODI_TM06
USE MODI_UPDATE_LM
+USE MODI_GET_HALO
!
USE MODE_SBL
USE MODE_FMWRIT
@@ -405,6 +408,7 @@ CHARACTER*4 , INTENT(IN) :: HTURBLEN ! kind of mixing length
CHARACTER*4 , INTENT(IN) :: HTOM ! kind of Third Order Moment
CHARACTER*4 , INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
! FM-file
@@ -540,6 +544,7 @@ REAL :: ZALPHA ! proportionnality constant between Dz/2 and
! ! BL89 mixing length near the surface
!
REAL :: ZTIME1, ZTIME2
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH
!
!------------------------------------------------------------------------------------------
ALLOCATE ( &
@@ -1065,6 +1070,33 @@ IF ( KRRL >= 1 ) THEN
END IF
END IF
!
+IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
+ ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
+ ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZTT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+! CALL GET_HALO(PRRS(:,:,:,2))
+! CALL GET_HALO(PRSVS(:,:,:,2))
+! CALL GET_HALO(PRSVS(:,:,:,3))
+ WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
+ PRSVS(:,:,:,1) = 0.0
+ END WHERE
+ DO JSV = 2, 3
+ WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXNE(:,:,:)
+ PRRS(:,:,:,JSV) = 0.0
+ PRSVS(:,:,:,JSV) = 0.0
+ END WHERE
+ END DO
+!
+ IF (LBUDGET_TH) CALL BUDGET (PRTHLS(:,:,:), 4,'NETUR_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), 6,'NETUR_BU_RRV')
+ IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), 7,'NETUR_BU_RRC')
+END IF
+!
!----------------------------------------------------------------------------
!
!* 9. LES averaged surface fluxes
--
GitLab