From 0f8028a84e6d1ce953f06b853c5a466aba0d401d Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 11 Jun 2020 18:20:26 +0200
Subject: [PATCH] Philippe 11/06/2020: bugfix: correct scalar-variables array
indices
---
src/MNH/advection_metsv.f90 | 18 ++++++-------
src/MNH/resolved_cloud.f90 | 53 +++++++++++++++++++------------------
src/MNH/turb.f90 | 18 ++++++-------
3 files changed, 43 insertions(+), 46 deletions(-)
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index 93c1b7edb..e5cf670a1 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###########################
@@ -138,6 +138,7 @@ END MODULE MODI_ADVECTION_METSV
!! the surface for the blowing snow scheme
!! 03/2020 (B.Vie) : LIMA negativity checks after turbulence, advection and
!! microphysics budgets
+! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -737,19 +738,16 @@ SELECT CASE ( HCLOUD )
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
+ WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,NSV_C2R2BEG+1) < 0.)
+ PRSVS(:,:,:,NSV_C2R2BEG) = 0.0
END WHERE
DO JSV = 2, 3
- WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
+ WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,NSV_C2R2BEG-1+JSV) < 0.)
PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
ZCPH(:,:,:) / ZEXN(:,:,:)
PRRS(:,:,:,JSV) = 0.0
- PRSVS(:,:,:,JSV) = 0.0
+ PRSVS(:,:,:,NSV_C2R2BEG-1+JSV) = 0.0
END WHERE
END DO
!
@@ -790,7 +788,7 @@ SELECT CASE ( HCLOUD )
END WHERE
END IF
!
- PRSVS(:,:,:,:) = MAX( 0.0,PRSVS(:,:,:,:) )
+ PRSVS(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) = MAX( 0.0, PRSVS(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) )
PRRS(:,:,:,:) = MAX( 0.0,PRRS(:,:,:,:) )
!
END SELECT
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 4595a1411..34945c07d 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -270,6 +270,7 @@ END MODULE MODI_RESOLVED_CLOUD
!! P. Wautelet 24/02/2020: bugfix: corrected budget name (DEPI->CDEPI) for ice_adjust
!! 03/2020 (B.Vie) : LIMA negativity checks after turbulence, advection and microphysics budgets
!! B.Vié 03/03/2020 : use DTHRAD instead of dT/dt in Smax diagnostic computation
+! P. Wautelet 11/06/2020: bugfix: correct ZSVS array indices
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -723,32 +724,32 @@ SELECT CASE ( HCLOUD )
CASE('LIMA')
! Correction where rc<0 or Nc<0
IF (OWARM) THEN
- WHERE (PRS(:,:,:,2) < YRTMIN(2)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NC) < YCTMIN(2)/PTSTEP)
+ WHERE (PRS(:,:,:,2) < YRTMIN(2)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NC-NSV_LIMA_BEG+1) < YCTMIN(2)/PTSTEP)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
ZCPH(:,:,:) / ZEXN(:,:,:)
PRS(:,:,:,2) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NC) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NC-NSV_LIMA_BEG+1) = 0.0
END WHERE
END IF
! Correction where rr<0 or Nr<0
IF (OWARM .AND. ORAIN) THEN
- WHERE (PRS(:,:,:,3) < YRTMIN(3)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NR) < YCTMIN(3)/PTSTEP)
+ WHERE (PRS(:,:,:,3) < YRTMIN(3)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NR-NSV_LIMA_BEG+1) < YCTMIN(3)/PTSTEP)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,3)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,3) * ZLV(:,:,:) / &
ZCPH(:,:,:) / ZEXN(:,:,:)
PRS(:,:,:,3) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NR) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NR-NSV_LIMA_BEG+1) = 0.0
END WHERE
END IF
! Correction where ri<0 or Ni<0
IF (LCOLD) THEN
- WHERE (PRS(:,:,:,4) < YRTMIN(4)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NI) < YCTMIN(4)/PTSTEP)
+ WHERE (PRS(:,:,:,4) < YRTMIN(4)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NI-NSV_LIMA_BEG+1) < YCTMIN(4)/PTSTEP)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
ZCPH(:,:,:) / ZEXN(:,:,:)
PRS(:,:,:,4) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NI) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NI-NSV_LIMA_BEG+1) = 0.0
END WHERE
END IF
!
@@ -772,19 +773,19 @@ IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5) * PRHODJ(:,:,:),10,'NEGA_BU_RRS')
IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6) * PRHODJ(:,:,:),11,'NEGA_BU_RRG')
IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:),12,'NEGA_BU_RRH')
IF (LBUDGET_SV .AND. (HCLOUD == 'LIMA')) THEN
- IF (OWARM) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NC) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'NEGA_BU_RSV')
- IF (OWARM.AND.ORAIN) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NR) * PRHODJ(:,:,:),12+NSV_LIMA_NR,'NEGA_BU_RSV')
- IF (LCOLD) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NI) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'NEGA_BU_RSV')
+ IF (OWARM) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NC-NSV_LIMA_BEG+1) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'NEGA_BU_RSV')
+ IF (OWARM.AND.ORAIN) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NR-NSV_LIMA_BEG+1) * PRHODJ(:,:,:),12+NSV_LIMA_NR,'NEGA_BU_RSV')
+ IF (LCOLD) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NI-NSV_LIMA_BEG+1) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'NEGA_BU_RSV')
IF (NMOD_CCN.GE.1) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1)* &
- PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'NEGA_BU_RSV')
+ CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-NSV_LIMA_BEG)* &
+ PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'NEGA_BU_RSV')
END DO
END IF
IF (NMOD_IFN.GE.1) THEN
DO JL=1, NMOD_IFN
- CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1)* &
- PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'NEGA_BU_RSV')
+ CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-NSV_LIMA_BEG)* &
+ PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'NEGA_BU_RSV')
END DO
END IF
END IF
@@ -1250,32 +1251,32 @@ SELECT CASE ( HCLOUD )
CASE('LIMA')
! Correction where rc<0 or Nc<0
IF (OWARM) THEN
- WHERE (PRS(:,:,:,2) < YRTMIN(2)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NC) < YCTMIN(2)/PTSTEP)
+ WHERE (PRS(:,:,:,2) < YRTMIN(2)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NC-NSV_LIMA_BEG+1) < YCTMIN(2)/PTSTEP)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
ZCPH(:,:,:) / ZEXN(:,:,:)
PRS(:,:,:,2) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NC) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NC-NSV_LIMA_BEG+1) = 0.0
END WHERE
END IF
! Correction where rr<0 or Nr<0
IF (OWARM .AND. ORAIN) THEN
- WHERE (PRS(:,:,:,3) < YRTMIN(3)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NR) < YCTMIN(3)/PTSTEP)
+ WHERE (PRS(:,:,:,3) < YRTMIN(3)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NR-NSV_LIMA_BEG+1) < YCTMIN(3)/PTSTEP)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,3)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,3) * ZLV(:,:,:) / &
ZCPH(:,:,:) / ZEXN(:,:,:)
PRS(:,:,:,3) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NR) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NR-NSV_LIMA_BEG+1) = 0.0
END WHERE
END IF
! Correction where ri<0 or Ni<0
IF (LCOLD) THEN
- WHERE (PRS(:,:,:,4) < YRTMIN(4)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NI) < YCTMIN(4)/PTSTEP)
+ WHERE (PRS(:,:,:,4) < YRTMIN(4)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NI-NSV_LIMA_BEG+1) < YCTMIN(4)/PTSTEP)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
ZCPH(:,:,:) / ZEXN(:,:,:)
PRS(:,:,:,4) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NI) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NI-NSV_LIMA_BEG+1) = 0.0
END WHERE
END IF
!
@@ -1297,19 +1298,19 @@ IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5) * PRHODJ(:,:,:),10,'NECON_BU_RRS')
IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6) * PRHODJ(:,:,:),11,'NECON_BU_RRG')
IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:),12,'NECON_BU_RRH')
IF (LBUDGET_SV .AND. (HCLOUD == 'LIMA')) THEN
- IF (OWARM) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NC) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'NECON_BU_RSV')
- IF (OWARM.AND.ORAIN) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NR) * PRHODJ(:,:,:),12+NSV_LIMA_NR,'NECON_BU_RSV')
- IF (LCOLD) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NI) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'NECON_BU_RSV')
+ IF (OWARM) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NC-NSV_LIMA_BEG+1) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'NECON_BU_RSV')
+ IF (OWARM.AND.ORAIN) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NR-NSV_LIMA_BEG+1) * PRHODJ(:,:,:),12+NSV_LIMA_NR,'NECON_BU_RSV')
+ IF (LCOLD) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NI-NSV_LIMA_BEG+1) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'NECON_BU_RSV')
IF (NMOD_CCN.GE.1) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1)* &
- PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'NECON_BU_RSV')
+ CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-NSV_LIMA_BEG)* &
+ PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'NECON_BU_RSV')
END DO
END IF
IF (NMOD_IFN.GE.1) THEN
DO JL=1, NMOD_IFN
- CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1)* &
- PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'NECON_BU_RSV')
+ CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-NSV_LIMA_BEG)* &
+ PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'NECON_BU_RSV')
END DO
END IF
END IF
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index 547a1a573..ac6bbfa34 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ################
@@ -341,6 +341,7 @@ END MODULE MODI_TURB
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 01/2018 (Q.Rodier) Introduction of RM17
!! 03/2020 (B.Vie) : LIMA negativity checks after turbulence, advection and microphysics budgets
+! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1165,19 +1166,16 @@ SELECT CASE ( HCLOUD )
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
+ WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,NSV_C2R2BEG+1) < 0.)
+ PRSVS(:,:,:,NSV_C2R2BEG) = 0.0
END WHERE
DO JSV = 2, 3
- WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
+ WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,NSV_C2R2BEG-1+JSV) < 0.)
PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
ZCPH(:,:,:) / ZEXNE(:,:,:)
PRRS(:,:,:,JSV) = 0.0
- PRSVS(:,:,:,JSV) = 0.0
+ PRSVS(:,:,:,NSV_C2R2BEG-1+JSV) = 0.0
END WHERE
END DO
!
@@ -1218,7 +1216,7 @@ SELECT CASE ( HCLOUD )
END WHERE
END IF
!
- PRSVS(:,:,:,:) = MAX( 0.0,PRSVS(:,:,:,:) )
+ PRSVS(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) = MAX( 0.0, PRSVS(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) )
PRRS(:,:,:,:) = MAX( 0.0,PRRS(:,:,:,:) )
!
END SELECT
--
GitLab