diff --git a/src/MNH/BASIC.f90 b/src/MNH/BASIC.f90 index b08332e85019c776d75d871cf4e911c01bb5683e..d5183c46758b2534ba86787e61b908d9530ecb0e 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 38a1f31f78be4392ac61536b8ba75ca7b948fed7..c0a594d24f25de91df0509934c932a29ff7c171c 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 b4077f482973eae9d4a477d9cb2d91f89aef9411..36300b07e7020d88a8a605c4812d5416d1ad93f9 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 371a45d76c8dcbf86fb2d72cc6996d06c6bb047a..4a3044dc4323cd93b96373c5eed40cb7ffeb2aed 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