From 87436a419775b32a742e89541c0f337f44720462 Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Thu, 8 Sep 2022 14:40:57 +0200
Subject: [PATCH] Quentin 08/09/2022: fix: reapply lost fix from ICCARE_BASE
branch (use of Print_msg; comments and set_mask.f90 user routine set as 5.5.1
version)
---
src/MNH/BASIC.f90 | 18 ++++---
src/MNH/ch_ini_orilam.f90 | 12 +++--
src/MNH/set_mask.f90 | 96 +++++-----------------------------
src/SURFEX/allocate_physio.F90 | 1 +
4 files changed, 30 insertions(+), 97 deletions(-)
diff --git a/src/MNH/BASIC.f90 b/src/MNH/BASIC.f90
index b08332e85..d5183c467 100644
--- a/src/MNH/BASIC.f90
+++ b/src/MNH/BASIC.f90
@@ -1,3 +1,5 @@
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!========================================================================
!
@@ -36038,7 +36040,7 @@ CONTAINS
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -36049,7 +36051,7 @@ CONTAINS
IMPLICIT NONE
! check if output array is large enough
IF (KINDEXDIM.LT.951) THEN
- STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_NONZEROTERMS_AQ', 'array KINDEX is too small' )
END IF
KINDEX(1, 1)=3
KINDEX(2, 1)=1
@@ -37992,7 +37994,7 @@ END SUBROUTINE CH_NONZEROTERMS_AQ
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -38003,7 +38005,7 @@ END SUBROUTINE CH_NONZEROTERMS_AQ
IMPLICIT NONE
! check if output array is large enough
IF (KINDEXDIM.LT.615) THEN
- STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_NONZEROTERMS_GAZ', 'array KINDEX is too small' )
END IF
KINDEX(1, 1)=3
KINDEX(2, 1)=1
@@ -39348,7 +39350,7 @@ CONTAINS
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -39367,7 +39369,7 @@ IMPLICIT NONE
!! ---------------------
! check if output array is large enough
IF (KSPARSEDIM.LT.753) THEN
- STOP 'CH_SPARSE ERROR: array KSPARSE is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SPARSE_AQ', 'array KSPARSE is too small' )
END IF
!O3/O3
KSPARSE(1, 1)=1
@@ -41664,7 +41666,7 @@ END SUBROUTINE CH_SPARSE_AQ
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -41683,7 +41685,7 @@ IMPLICIT NONE
!! ---------------------
! check if output array is large enough
IF (KSPARSEDIM.LT.457) THEN
- STOP 'CH_SPARSE ERROR: array KSPARSE is too small!'
++ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SPARSE_GAZ', 'array KSPARSE is too small' )
END IF
!O3/O3
KSPARSE(1, 1)=1
diff --git a/src/MNH/ch_ini_orilam.f90 b/src/MNH/ch_ini_orilam.f90
index 38a1f31f7..c0a594d24 100644
--- a/src/MNH/ch_ini_orilam.f90
+++ b/src/MNH/ch_ini_orilam.f90
@@ -1,4 +1,4 @@
-!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!ORILAM_LIC for details.
@@ -56,6 +56,8 @@ END MODULE MODI_CH_INI_ORILAM
!! MODIFICATIONS
!! -------------
!! Original
+!! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!!
!!
!! EXTERNAL
!! --------
@@ -80,6 +82,7 @@ USE MODD_CST, ONLY : &
,XRD & ! Gaz constant for dry air
,XCPD ! Cpd (dry air)
USE MODD_CONF, ONLY : NVERB
+use mode_msg
!
IMPLICIT NONE
!
@@ -99,6 +102,7 @@ CHARACTER(LEN=10), INTENT(IN) :: GSCHEME
!
!* 0.2 declarations of local variables
!
+character(len=10) :: yspec ! String for error message
REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZDMINTRA, ZDMINTER, ZDMCOND, ZDMNUCL, ZDMMERG
REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZMASK, ZSOLORG
REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZMBEG, ZMINT, ZMEND
@@ -158,10 +162,8 @@ ENDDO
! verify that all array elements are defined
DO JI = 1, SIZE(XRHOI)
IF (XRHOI(JI) .LE. 0.0) THEN
- PRINT *, 'CH_AER_MOD_INIT ERROR: density for species ', JI, ' not defined'
- ! callabortstop
- CALL ABORT
- STOP 'CH_AER_MOD_INIT ERROR: density not defined'
+ write( yspec, '( I10 )' ) JI
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_AER_MOD_INIT', 'density for species '//trim(yspec)//' not defined' )
END IF
ENDDO
!
diff --git a/src/MNH/set_mask.f90 b/src/MNH/set_mask.f90
index b4077f482..36300b07e 100644
--- a/src/MNH/set_mask.f90
+++ b/src/MNH/set_mask.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2021 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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/set_mask.f90,v $ $Revision: 1.2.2.1.2.1.18.2 $
-! MASDEV4_7 budget 2006/09/08 10:35:15
-!-----------------------------------------------------------------
! ###################
SUBROUTINE SET_MASK
! ###################
@@ -26,7 +21,7 @@
!! According to each criterion associated to one zone, the mask is
!! set to TRUE at each point where the criterion is confirmed, at each
!! time step of the model. Finally, The number of occurence of this criteria is
-!! increased by 1 and stored in the array XBUSURF.
+!! increased by 1 and stored in the array NBUSURF.
!! Caution : The mask is defined on the inner domain.
!!
!!
@@ -39,7 +34,7 @@
!! Module MODD_BUDGET
!! LBU_MASK : logical array mask defining the zones
!! NBUTIME : number of the budget step
-!! XBUSURF : mask tracer array (surface array)
+!! NBUSURF : mask tracer array (surface array)
!!
!! REFERENCE
!! ---------
@@ -65,13 +60,8 @@
!
USE MODD_BUDGET
USE MODE_ll
-USE MODD_FIELD_n, ONLY : XWT, XRT
+USE MODD_FIELD_n , ONLY : XWT , XRT
!
-USE MODD_PRECIP_n, ONLY : XINPRR
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_REF_n, ONLY : XRHODREF
-USE MODD_GRID_n, ONLY : XZZ
-USE MODD_CST, ONLY : XRHOLW
!
IMPLICIT NONE
!
@@ -82,15 +72,6 @@ INTEGER :: IIB,IJB ! Lower bounds of the physical
! sub-domain in x and y directions
INTEGER :: IIE,IJE ! Upper bounds of the physical
! sub-domain in x and y directions
-!
-INTEGER :: IKB, IKE
-INTEGER :: IIU, IJU ! Array sizes in i,j directions
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHIC, ZTHRW, ZTHCW, ZTHSN, ZTHGR
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTH_LIQ, ZTH_ICE
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDUM
-INTEGER :: JK ! loop index
-!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
@@ -107,65 +88,12 @@ LBU_MASK(:,:,:)=.FALSE.
!==============================================================================
! Change the following lines to set the criterion for each of the NBUMASK masks
!
-IKB = 1 + JPVEXT
-IKE = SIZE(XRHODREF,3) - JPVEXT
-IIU = IIE + JPHEXT
-IJU = IJE + JPHEXT
-!
-ALLOCATE(ZTHIC(IIU,IJU)) ; ZTHIC(:,:) = 0.0
-ALLOCATE(ZTHRW(IIU,IJU)) ; ZTHRW(:,:) = 0.0
-ALLOCATE(ZTHCW(IIU,IJU)) ; ZTHCW(:,:) = 0.0
-ALLOCATE(ZTHSN(IIU,IJU)) ; ZTHSN(:,:) = 0.0
-ALLOCATE(ZTHGR(IIU,IJU)) ; ZTHGR(:,:) = 0.0
-ALLOCATE(ZDUM(IIU,IJU)) ; ZDUM(:,:) = 0.0
-!
-DO JK = IKB, IKE
- ZDUM(:,:) = XRHODREF(:,:,JK) * (XZZ(:,:,JK+1) - XZZ(:,:,JK)) / XRHOLW
- ZTHIC(:,:) = ZTHIC(:,:) + XRT(:,:,JK,4) * ZDUM(:,:)
- ZTHRW(:,:) = ZTHRW(:,:) + XRT(:,:,JK,3) * ZDUM(:,:)
- ZTHCW(:,:) = ZTHCW(:,:) + XRT(:,:,JK,2) * ZDUM(:,:)
- ZTHSN(:,:) = ZTHSN(:,:) + XRT(:,:,JK,5) * ZDUM(:,:)
- ZTHGR(:,:) = ZTHGR(:,:) + XRT(:,:,JK,6) * ZDUM(:,:)
-END DO
-!
-! m --> mm
-ZTHIC(:,:) = ZTHIC(:,:) * 1000.
-ZTHRW(:,:) = ZTHRW(:,:) * 1000.
-ZTHCW(:,:) = ZTHCW(:,:) * 1000.
-ZTHSN(:,:) = ZTHSN(:,:) * 1000.
-ZTHGR(:,:) = ZTHGR(:,:) * 1000.
-!
-ALLOCATE(ZTH_LIQ(IIU,IJU)) ; ZTH_LIQ(:,:) = 0.0
-ALLOCATE(ZTH_ICE(IIU,IJU)) ; ZTH_ICE(:,:) = 0.0
-!
-ZTH_LIQ(:,:) = ZTHCW(:,:) + ZTHRW(:,:)
-ZTH_ICE(:,:) = ZTHIC(:,:) + ZTHSN(:,:) + ZTHGR(:,:)
-!print*, nbutime, ' - min-max inprr = ', minval(xinprr*3600.), maxval(xinprr*3600.)
-!print*, nbutime, ' - min-max zth_liq = ', minval(zth_liq), maxval(zth_liq)
-!print*, nbutime, ' - min-max zth_ice = ', minval(zth_ice), maxval(zth_ice)
-!
-LBU_MASK(IIB:IIE,IJB:IJE,1) = (XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 5.
-!LBU_MASK(IIB:IIE,IJB:IJE,2) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. &
-! (XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 0.5 .AND. &
-! ZTH_LIQ(IIB:IIE,IJB:IJE) >= 0.01 .AND. &
-! ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.1
-LBU_MASK(IIB:IIE,IJB:IJE,2) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. &
- ((XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 0.5 .OR. &
- ZTH_LIQ(IIB:IIE,IJB:IJE) >= 0.01 .AND. &
- ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.1)
-LBU_MASK(IIB:IIE,IJB:IJE,3) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. &
- .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,2)) .AND. &
- ZTH_LIQ(IIB:IIE,IJB:IJE) < 0.01 .AND. &
- ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.01
-!
-DEALLOCATE(ZTHIC)
-DEALLOCATE(ZTHRW)
-DEALLOCATE(ZTHCW)
-DEALLOCATE(ZTHSN)
-DEALLOCATE(ZTHGR)
-DEALLOCATE(ZTH_LIQ)
-DEALLOCATE(ZTH_ICE)
-DEALLOCATE(ZDUM)
+! 1st mask on vertical velocity at level k=10
+LBU_MASK(IIB:IIE,IJB:IJE,1)=XWT(IIB:IIE,IJB:IJE,10)>0.
+!
+!2rd mask on rain mixing ratio at level k=2
+IF (NBUMASK>=2) &
+ LBU_MASK(IIB:IIE,IJB:IJE,2)=XRT(IIB:IIE,IJB:IJE,2,3)>1.E-8
!
!==============================================================================
!
@@ -173,7 +101,7 @@ DEALLOCATE(ZDUM)
! -------------------------
!
WHERE (LBU_MASK(:,:,:))
- NBUSURF(:,:,:,NBUTIME)=NBUSURF(:,:,:,NBUTIME)+1
+ NBUSURF(:,:,:,NBUTIME) = NBUSURF(:,:,:,NBUTIME) + 1
END WHERE
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/allocate_physio.F90 b/src/SURFEX/allocate_physio.F90
index 371a45d76..4a3044dc4 100644
--- a/src/SURFEX/allocate_physio.F90
+++ b/src/SURFEX/allocate_physio.F90
@@ -33,6 +33,7 @@
!! -------------
!! Original xx/xxxx
!! Modified 10/2014 P. Samuelsson MEB
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!
!
USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
--
GitLab