diff --git a/A-INSTALL b/A-INSTALL index 1a1a6d61efc83d7bb5d825e445cd638ca14b5d49..706b184e120f08545f02dd0d2703dd195fd41e01 100644 --- a/A-INSTALL +++ b/A-INSTALL @@ -1084,7 +1084,19 @@ etc ... # c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF # -------------------------------------- # -# The full ECRAD package was not included into the open source version of Meso-NH +# The default version of ECRAD is 1.4.0 (open-source) +# +# Configure & Compilation +export MNH_ECRAD=1 +./configure + +etc ... +# The version of ECRAD is set by (by default): +# export VER_ECRAD=140 +# +# To use the previous version 1.0.1: +# +# The full ECRAD package 1.0.1 was not included into the open source version of Meso-NH # because it needs a licence agrement. # # See here to get the licence & full sources : https://software.ecmwf.int/wiki/display/ECRAD/ECMWF+Radiation+Scheme+Home @@ -1098,6 +1110,7 @@ tar xvfz ecrad-1.0.1.tar.gz # Configure & Compilation export MNH_ECRAD=1 +export VER_ECRAD=101 ./configure etc ... @@ -1107,8 +1120,8 @@ etc ... # # Usage : # 1) In namelist replace RAD='ECMW' by RAD='ECRA' -# 2) Add link to all 'ecrad-1.0.1/data' files in your mesonh run directory -ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/* . +# 2) Add link to all 'ecrad-1.X.X/data' files in your mesonh run directory +ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.X.X/data/* . # # REM : you can replace CDATADIR = "." by CDATADIR = "data" of ini_radiations_ecrad.f90 to link only the data folder instead of all the files one by one # diff --git a/MY_RUN/KTEST/003_KW78/004_python/plot_003_KW78.py b/MY_RUN/KTEST/003_KW78/004_python/plot_003_KW78.py index 9ec2501f9495c586925e8dc649351a883f6db275..139b4a13f35d2d4fdd92d5e94b46716cf7f170ca 100644 --- a/MY_RUN/KTEST/003_KW78/004_python/plot_003_KW78.py +++ b/MY_RUN/KTEST/003_KW78/004_python/plot_003_KW78.py @@ -69,7 +69,7 @@ Ltitle = ['Wind at K=2', 'Wind at 3000m', 'Wind at 5000m'] Lxlab = ['x (m)']*len(Lplot) Lylab = ['y (m)']*len(Lplot) Llegendval = [10,10,10] -Lcbarlabel = ['m/s']*len(Lplot) +Llegendlabel = ['m/s']*len(Lplot) Larrowstep = [1]*len(Lplot) Lwidth = [0.002]*len(Lplot) Lcolor = ['black']*len(Lplot) @@ -79,7 +79,7 @@ lat = [Dvar['f1']['nj_u'], Dvar['f2']['nj'], Dvar['f2']['nj'] ] Lscale = [200]*len(Lplot) fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[500,23500,500,23500], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, - Lcolor=Lcolor, Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[4,6,8], ax=fig1.axes, Lscale=Lscale) + Lcolor=Lcolor, Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[4,6,8], ax=fig1.axes, Lscale=Lscale) # Oblique projection i_beg, j_beg = (3,0) i_end, j_end = (22,21) @@ -133,13 +133,13 @@ Lplot1 = [ WIND_sec1] Lplot2 = [ WT_sec1] Ltitle = ['Wind'] Llegendval = [25] -Lcbarlabel = ['m/s']*len(Lplot) +Llegendlabel = ['m/s']*len(Lplot) Larrowstep = [1]*len(Lplot) Lwidth = [0.004]*len(Lplot) Lscale = [200]*len(Lplot) fig4 = Panel2.pvector(Lxx=LaxeX, Lyy=LaxeZ, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, - Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig3.axes, Lscale=Lscale) + Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[0], ax=fig3.axes, Lscale=Lscale) Lplot = [RRT_sec1] LaxeX = [axe_m1] @@ -195,13 +195,13 @@ Lplot1 = [ Dvar['f1']['VM'][:,:,13]] Lplot2 = [ Dvar['f1']['WM'][:,:,13]] Ltitle = ['Wind'] Llegendval = [25] -Lcbarlabel = ['m/s']*len(Lplot) +Llegendlabel = ['m/s']*len(Lplot) Larrowstep = [1]*len(Lplot) Lwidth = [0.004]*len(Lplot) Lscale = [200]*len(Lplot) fig7 = Panel3.pvector(Lxx=LaxeX, Lyy=LaxeZ, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, - Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig6.axes, Lscale=Lscale) + Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[0], ax=fig6.axes, Lscale=Lscale) Lplot = [Dvar['f1']['RRT'][:,:,13]] diff --git a/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py b/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py index ea59e343330e5dfc43a383bb976da141751a6705..5de8f4b897fab5ecd28427472f553f42100b6f99 100644 --- a/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py +++ b/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py @@ -23,7 +23,8 @@ os.system('rm -f tempgraph*') LnameFiles = ['REUNI.1.00A20.004dia.nc', 'REUNI.1.00A20.004.nc'] Dvar_input = { -'f1':['ZS', 'UT', 'VT', 'WT', 'THT', 'ALT_PRESSURE','ALT_U','ALT_V','ALT_THETA','level','ZTOP', 'longitude','latitude','level_w','time'], +'f1':['ZS', 'UT', 'VT', 'WT', 'THT', 'ALT_PRESSURE','ALT_U','ALT_V','ALT_THETA','level','ZTOP', 'longitude','latitude','level_w','time', + 'RN', 'H','LE','GFLUX','HU2M','T2M','W10M','CD','CH','Z0','CE','TS','Z0H'], 'f2':['LSTHM', 'LSVM']} # Read the variables in the files @@ -65,7 +66,7 @@ Ltitle = ['wind vectors at K=2', 'wind vectors at z = 1500m '] Lxlab = ['longitude']*len(Lplot1) Lylab = ['latitude']*len(Lplot1) Llegendval = [25,25] -Lcbarlabel = ['(m/s)']*len(Lplot1) +Llegendlabel = ['(m/s)']*len(Lplot1) Larrowstep = [4]*len(Lplot1) Lwidth = [0.003]*len(Lplot1) Lcolor = ['black']*len(Lplot1) @@ -73,7 +74,7 @@ Lprojection = [ccrs.PlateCarree()]*len(Lplot1) Llvl = [0]*len(Lplot1) Lscale = [400]*len(Lplot1) fig2 = Panel1.pvector(Lxx=LaxeX, Lyy=LaxeY, Llevel=Llvl, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, - Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lproj=Lprojection, Lid_overlap=[2,6], ax=fig1.axes, Lscale=Lscale) + Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lproj=Lprojection, Lid_overlap=[2,6], ax=fig1.axes, Lscale=Lscale) ################################################################ ######### PANEL 2 # Vertical cross-section @@ -122,7 +123,7 @@ Lplot1 = [ Dvar['f1']['VM'][:,:,i_slice]] Lplot2 = [ Dvar['f1']['WM'][:,:,i_slice]] Ltitle = ['Wind'] Llegendval = [15] -Lcbarlabel = ['m/s']*len(Lplot) +Llegendlabel = ['m/s']*len(Lplot) Lxlab = ['longitude']*len(Lplot) Lylab = ['altitude (m)']*len(Lplot) Larrowstep = [1]*len(Lplot) @@ -133,6 +134,6 @@ Lxlim = [(-21.3,-20.9)]*len(Lplot) Lcolor=['lightgray'] fig4 = Panel2.pvector(Lxx=LaxeX, Lyy=LaxeZ, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, - Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[6], ax=fig3.axes, Lscale=Lscale, Lylim=Lylim, Lxlim=Lxlim, Lcolor=Lcolor) + Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[6], ax=fig3.axes, Lscale=Lscale, Lylim=Lylim, Lxlim=Lxlim, Lcolor=Lcolor) -Panel2.save_graph(2,fig4) \ No newline at end of file +Panel2.save_graph(2,fig4) diff --git a/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py b/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py index 03bec46158136aacebbe3bb40e9d216a9c16aa85..f5292605c7d9fe3c358ad25b49fc999224725bf9 100644 --- a/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py +++ b/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py @@ -58,7 +58,7 @@ Ltitle = ['Wind at 850hPa', 'Wind at 700hPa', 'Wind at 9000m'] Lxlab = ['longitude']*len(Lplot1) Lylab = ['latitude']*len(Lplot1) Llegendval = [20,20,40] -Lcbarlabel = ['(m/s)']*len(Lplot1) +Llegendlabel = ['(m/s)']*len(Lplot1) Larrowstep = [2]*len(Lplot1) Lwidth = [0.002]*len(Lplot1) Lcolor = ['black']*len(Lplot1) @@ -66,7 +66,7 @@ Lprojection = [ccrs.PlateCarree()]*len(Lplot1) Llvl = [0]*len(Lplot1) fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, Lproj=Lprojection, - Lcolor=Lcolor, Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[2,4,6], ax=fig1.axes) + Lcolor=Lcolor, Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[2,4,6], ax=fig1.axes) Panel1.save_graph(1,fig2) @@ -99,7 +99,7 @@ Ltitle = ['Wind at 850hPa', 'Wind at 700hPa', 'Wind at 9000m'] Llegendval = [20,20,40] Lxlab = ['longitude']*len(Lplot1) Lylab = ['latitude']*len(Lplot1) -Lcbarlabel = ['(m/s)']*len(Lplot1) +Llegendlabel = ['(m/s)']*len(Lplot1) Larrowstep = [2]*len(Lplot1) Lwidth = [0.002]*len(Lplot1) Lcolor = ['black']*len(Lplot1) @@ -107,6 +107,6 @@ Lprojection = [ccrs.PlateCarree()]*len(Lplot1) Llvl = [0]*len(Lplot1) fig2 = Panel2.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, Lproj=Lprojection, - Lcolor=Lcolor, Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[2,4,6], ax=fig1.axes) + Lcolor=Lcolor, Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[2,4,6], ax=fig1.axes) Panel2.save_graph(2,fig2) diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py b/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py index 3f792a31363a78a8d5db2c9e5163afa1597afc82..9666ee0c3614aea18c5a55add922bbde82015df1 100644 --- a/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py +++ b/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py @@ -68,7 +68,7 @@ Ltitle = ['Wind at K=2', 'Wind at 3000m', 'Wind at 5000m'] Lxlab = ['x (m)']*len(Lplot) Lylab = ['y (m)']*len(Lplot) Llegendval = [10,10,10] -Lcbarlabel = ['m/s']*len(Lplot) +Llegendlabel = ['m/s']*len(Lplot) Larrowstep = [1]*len(Lplot) Lwidth = [0.002]*len(Lplot) Lcolor = ['black']*len(Lplot) @@ -78,7 +78,7 @@ lat = [Dvar['f1']['nj_u'], Dvar['f2']['nj'], Dvar['f2']['nj'] ] Lscale = [200]*len(Lplot) fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[500,23500,500,23500], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, - Lcolor=Lcolor, Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[4,6,8], ax=fig1.axes, Lscale=Lscale) + Lcolor=Lcolor, Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[4,6,8], ax=fig1.axes, Lscale=Lscale) # Oblique projection i_beg, j_beg = (2,0) i_end, j_end = (21,22) @@ -163,13 +163,13 @@ Lplot1 = [ WIND_sec1] Lplot2 = [ WT_sec1] Ltitle = ['Wind'] Llegendval = [25] -Lcbarlabel = ['m/s']*len(Lplot) +Llegendlabel = ['m/s']*len(Lplot) Larrowstep = [1]*len(Lplot) Lwidth = [0.004]*len(Lplot) Lscale = [200]*len(Lplot) fig4 = Panel3.pvector(Lxx=LaxeX, Lyy=LaxeZ, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, - Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig3.axes, Lscale=Lscale) + Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[0], ax=fig3.axes, Lscale=Lscale) Lplot = [RRT_sec1] LaxeX = [axe_m1] @@ -287,4 +287,4 @@ fig8 = Panel5.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lyl Lstep=Lstep, Lstepticks=Lstepticks, LcolorLine=LcolorLine, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv, Lpltype=Lpltype, ax=fig7.axes,Lid_overlap=[0, 2, 4, 6, 8, 10, 12, 14, 16],colorbar=False) -Panel5.save_graph(5,fig8) \ No newline at end of file +Panel5.save_graph(5,fig8) diff --git a/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py b/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py index 2116f12329b9163e64761721f006b0e9e06efd1f..34819dabe4071852324a264955e5668dc147fe89 100644 --- a/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py +++ b/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py @@ -64,14 +64,14 @@ Lplot1 = [ Dvar['f1']['UM']] Lplot2 = [ Dvar['f1']['VM']] Ltitle = [' vectors at 1st level'] Llegendval = [20] -Lcbarlabel = ['m/s']*len(Lplot) +Llegendlabel = ['m/s']*len(Lplot) Larrowstep = [1]*len(Lplot) Lwidth = [0.002]*len(Lplot) Lcolor = ['black']*len(Lplot) Lscale = [200]*len(Lplot) fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Llevel=Llvl, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, - Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig1.axes, Lscale=Lscale) + Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[0], ax=fig1.axes, Lscale=Lscale) Panel1.save_graph(1,fig2) @@ -121,4 +121,4 @@ fig4 = Panel3.psectionH(lon=lon, lat=lat, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Lstep=[], Lstepticks=[], Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,Lcarte=Lcarte, Ltime=Ltime, LaddWhite_cm=LaddWhite, Lproj=Lprojection, ax=[]) -Panel3.save_graph(3,fig4) \ No newline at end of file +Panel3.save_graph(3,fig4) diff --git a/README_MNH_CONDA b/README_MNH_CONDA index d8b0bc0d7f56205e27f10717bcdd302162e0b205..5aa86aa5914c7678202a888b28399675e4c6d7fc 100644 --- a/README_MNH_CONDA +++ b/README_MNH_CONDA @@ -67,7 +67,7 @@ source ${MNH_MINICONDA}/miniconda3/etc/profile.d/conda.sh conda create -n mnh_conda_cartopy_offlinedata conda activate mnh_conda_cartopy_offlinedata -conda install -c conda-forge netcdf4 cartopy matlibplot +conda install -c conda-forge netcdf4 cartopy matplotlib # # this is the minimum packages needed for the MesoNH script of the test cases diff --git a/src/LIB/MPIvide/mpi.h b/src/LIB/MPIvide/mpi.h index 72a1b9a677de36d2a4923e7d4a9c2ae22108ab70..0676c6749831d4b43a2c5bd299881de5fe02efc7 100644 --- a/src/LIB/MPIvide/mpi.h +++ b/src/LIB/MPIvide/mpi.h @@ -4,6 +4,10 @@ * (C) 1993 by Argonne National Laboratory and Mississipi State University. * All rights reserved. See COPYRIGHT in top-level directory. */ +/* Modifications: + P.Wautelet 19/11/2021: add MPI_LOGICAL4 and MPI_LOGICAL8 optional types +! + modify MPI_REAL4/8 and MPI_INTEGER4/8 +*/ /* user include file for MPI programs */ @@ -94,6 +98,13 @@ typedef int MPI_Datatype; #define MPI_2DOUBLE_PRECISION ((MPI_Datatype)33) #define MPI_CHARACTER ((MPI_Datatype)1) +#define MPI_INTEGER4 ((MPI_Datatype)34) +#define MPI_INTEGER8 ((MPI_Datatype)35) +#define MPI_LOGICAL4 ((MPI_Datatype)36) +#define MPI_LOGICAL8 ((MPI_Datatype)37) +#define MPI_REAL4 ((MPI_Datatype)38) +#define MPI_REAL8 ((MPI_Datatype)39) + /* Communicators */ typedef int MPI_Comm; #define MPI_COMM_WORLD 91 diff --git a/src/LIB/MPIvide/mpif.h b/src/LIB/MPIvide/mpif.h index 97f91109c93e21ebb5e4b2f2131e79459448cb28..3557e3f48a6dc9f63d4bae9675f239d208534d7c 100644 --- a/src/LIB/MPIvide/mpif.h +++ b/src/LIB/MPIvide/mpif.h @@ -1,3 +1,6 @@ +!Modifications: +! P.Wautelet 19/11/2021: add MPI_LOGICAL4 and MPI_LOGICAL8 optional types +! + modify MPI_REAL4/8 and MPI_INTEGER4/8 ! ! ! (C) 1993 by Argonne National Laboratory and Mississipi State University. @@ -125,7 +128,7 @@ PARAMETER (MPI_2REAL=32,MPI_2DOUBLE_PRECISION=33,MPI_CHARACTER=1) PARAMETER (MPI_BYTE=3,MPI_UB=16,MPI_LB=15,MPI_PACKED=14) - INTEGER MPI_ORDER_C, MPI_ORDER_FORTRAN + INTEGER MPI_ORDER_C, MPI_ORDER_FORTRAN PARAMETER (MPI_ORDER_C=56, MPI_ORDER_FORTRAN=57) INTEGER MPI_DISTRIBUTE_BLOCK, MPI_DISTRIBUTE_CYCLIC INTEGER MPI_DISTRIBUTE_NONE, MPI_DISTRIBUTE_DFLT_DARG @@ -144,16 +147,19 @@ INTEGER MPI_INTEGER16 INTEGER MPI_REAL4, MPI_REAL8, MPI_REAL16 INTEGER MPI_COMPLEX8, MPI_COMPLEX16, MPI_COMPLEX32 + INTEGER MPI_LOGICAL4, MPI_LOGICAL8 PARAMETER (MPI_INTEGER1=1,MPI_INTEGER2=4) - PARAMETER (MPI_INTEGER4=6) - PARAMETER (MPI_INTEGER8=13) + PARAMETER (MPI_INTEGER4=34) + PARAMETER (MPI_INTEGER8=35) PARAMETER (MPI_INTEGER16=0) - PARAMETER (MPI_REAL4=10) - PARAMETER (MPI_REAL8=11) + PARAMETER (MPI_REAL4=38) + PARAMETER (MPI_REAL8=39) PARAMETER (MPI_REAL16=0) PARAMETER (MPI_COMPLEX8=23) PARAMETER (MPI_COMPLEX16=24) PARAMETER (MPI_COMPLEX32=0) + PARAMETER (MPI_LOGICAL4=36) + PARAMETER (MPI_LOGICAL8=37) COMMON /MPIPRIV/ MPI_BOTTOM,MPI_STATUS_IGNORE,MPI_STATUSES_IGNORE ! diff --git a/src/LIB/MPIvide/mpivide.c b/src/LIB/MPIvide/mpivide.c index 313f162a8e4d4717add7bf80eeb03ddd0a144f20..eebe91b71a8e3178634fb98688f9118c8325037b 100644 --- a/src/LIB/MPIvide/mpivide.c +++ b/src/LIB/MPIvide/mpivide.c @@ -1,51 +1,39 @@ -/* -MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +/* +MNH_LIC Copyright 1994-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. -*/ +*/ +/* Modifications : + P. Wautelet 19/11/2021: add function findtypesize + improve/add support for 32 and 64 bits variables + add mpi_reduce +*/ + +#include <stdio.h> #include <string.h> #include "mpi.h" -/* Variables defined in meso-nh code */ -#ifdef FUJI -#if MNH_REAL == 4 - #define MPI_PRECISION MPI_REAL - #define MPI_2PRECISION MPI_2REAL -#else - #define MPI_PRECISION MPI_DOUBLE_PRECISION - #define MPI_2PRECISION MPI_2DOUBLE_PRECISION -#endif -#else - #define MPI_PRECISION MPI_REAL - #define MPI_2PRECISION MPI_2REAL -#endif +/* MPI_INTEGER is defined in mpi.h */ +#define SIZEINTEGER4 4 +#define SIZEINTEGER8 8 -/* MPI_INTEGER is defined in mpi.h */ +#define SIZELOGICAL4 4 +#define SIZELOGICAL8 8 -#define MPI_INTEGER8 MPI_LONG_LONG_INT +#define SIZEREAL4 4 +#define SIZEREAL8 8 -#ifdef FUJI -#if MNH_INT == 8 +#if MNH_INT == 8 #define SIZEINTEGER 8 -#define SIZEINTEGER8 8 #define SIZELOGICAL 8 #else #define SIZEINTEGER 4 -#define SIZEINTEGER8 8 #define SIZELOGICAL 4 #endif #if MNH_REAL == 4 #define SIZEPRECISION 4 #define SIZE2PRECISION 8 #else -#define SIZEPRECISION 8 -#define SIZE2PRECISION 16 -#endif -#else -#define SIZEINTEGER 8 -#define SIZEINTEGER8 8 #define SIZEPRECISION 8 #define SIZE2PRECISION 16 #endif @@ -65,6 +53,57 @@ char *fct; /* printf("MPIVIDE::Passage dans %s \n", fct); */ } +int findtypesize(int type) +{ + int size; + + switch(type) + { + case MPI_INTEGER4: + size = SIZEINTEGER4 ; + break; + case MPI_INTEGER8: + size = SIZEINTEGER8 ; + break; + case MPI_LOGICAL4: + size = SIZELOGICAL4 ; + break; + case MPI_LOGICAL8: + size = SIZELOGICAL8 ; + break; + case MPI_REAL4: + size = SIZEREAL4 ; + break; + case MPI_REAL8: + size = SIZEREAL8 ; + break; + case MPI_2REAL: + size = 2*SIZEPRECISION ; + break; + case MPI_2DOUBLE_PRECISION: + size = 2*SIZE2PRECISION ; + break; + case MPI_INTEGER: + size = SIZEINTEGER; + break; + case MPI_REAL: + size = SIZEPRECISION; + break; + case MPI_DOUBLEDOUBLE: + size = SIZE_DOUBLEDOUBLE; + break; + case MPI_LOGICAL: + size = SIZELOGICAL ; + break; + default: + printf("ERROR : unknown precision in findtypesize (MPIVIDE library)\n"); + size = SIZEPRECISION; + break; + } + + return size; +} + #pragma weak mpi_cart_sub__ = mpi_cart_sub #pragma weak mpi_cart_sub_ = mpi_cart_sub void mpi_cart_sub @@ -127,26 +166,10 @@ void mpi_alltoallv(void *sendbuf, int *sendcounts, void *recvbuf, int *recvcounts, int *rdispls, int *recvtype, int *comm, int *__ierr) { - int size = SIZE2PRECISION; + int size; + disppass("alltoallv"); - switch(*sendtype) - { - case MPI_INTEGER: - size = SIZEINTEGER; - break; - case MPI_PRECISION: - size = SIZEPRECISION; - break; - case MPI_2PRECISION: - size = SIZE2PRECISION; - break; - case MPI_DOUBLEDOUBLE: - size = SIZE_DOUBLEDOUBLE; - break; - case MPI_LOGICAL: - size = SIZELOGICAL ; - break; - } + size = findtypesize(*sendtype); memcpy(recvbuf, sendbuf, (*recvcounts)*size); *__ierr = 0; @@ -176,30 +199,10 @@ int *recvtype; int *comm; int *__ierr; { - int size = SIZE2PRECISION; - disppass("allgatherv"); - - switch(*sendtype) - { - case MPI_INTEGER: - size = SIZEINTEGER; - break; - case MPI_INTEGER8: - size = SIZEINTEGER8; - break; - case MPI_PRECISION: - size = SIZEPRECISION; - break; - case MPI_2PRECISION: - size = SIZE2PRECISION; - break; - case MPI_DOUBLEDOUBLE: - size = SIZE_DOUBLEDOUBLE; - break; - case MPI_LOGICAL: - size = SIZELOGICAL ; - break; - } + int size; + + disppass("allgatherv"); + size = findtypesize(*sendtype); memcpy(recvbuf, sendbuf, (*recvcounts)*size); *__ierr = 0; } @@ -219,29 +222,10 @@ int *root; int *comm; int *__ierr; { - int size = SIZE2PRECISION; + int size; + disppass("gather"); - switch(*sendtype) - { - case MPI_INTEGER: - size = SIZEINTEGER; - break; - case MPI_PRECISION: - size = SIZEPRECISION; - break; - case MPI_2PRECISION: - size = SIZE2PRECISION; - break; - case MPI_DOUBLEDOUBLE: - size = SIZE_DOUBLEDOUBLE; - break; - case MPI_DOUBLE: - size = 8 ; - break; - case MPI_LOGICAL: - size = SIZELOGICAL ; - break; - } + size = findtypesize(*sendtype); memcpy(recvbuf, sendbuf, (*recvcount)*size); *__ierr = 0; @@ -263,26 +247,10 @@ int *root; int *comm; int *__ierr; { - int size = SIZE2PRECISION; + int size; + disppass("gatherv"); - switch(*sendtype) - { - case MPI_INTEGER: - size = SIZEINTEGER; - break; - case MPI_PRECISION: - size = SIZEPRECISION; - break; - case MPI_2PRECISION: - size = SIZE2PRECISION; - break; - case MPI_DOUBLEDOUBLE: - size = SIZE_DOUBLEDOUBLE; - break; - case MPI_LOGICAL: - size = SIZELOGICAL ; - break; - } + size = findtypesize(*sendtype); memcpy(recvbuf, sendbuf, (*recvcounts)*size); *__ierr = 0; @@ -352,26 +320,10 @@ int *recvtype; int *comm; int *__ierr; { - int size = SIZE2PRECISION; + int size; + disppass("allgather"); - switch(*sendtype) - { - case MPI_INTEGER: - size = SIZEINTEGER; - break; - case MPI_PRECISION: - size = SIZEPRECISION; - break; - case MPI_2PRECISION: - size = SIZE2PRECISION; - break; - case MPI_DOUBLEDOUBLE: - size = SIZE_DOUBLEDOUBLE; - break; - case MPI_LOGICAL: - size = SIZELOGICAL ; - break; - } + size = findtypesize(*sendtype); memcpy(recvbuf, sendbuf, (*recvcount)*size); *__ierr = 0; @@ -425,28 +377,32 @@ int *comm; int *op; int *__ierr; { - int size = SIZE2PRECISION; + int size; disppass("allreduce"); - switch(*datatype) - { - case MPI_INTEGER: - size = SIZEINTEGER; - break; - case MPI_PRECISION: - size = SIZEPRECISION; - break; - case MPI_2PRECISION: - size = SIZE2PRECISION; - break; - case MPI_DOUBLE: - size = 8 ; - break; - case MPI_LOGICAL: - size = SIZELOGICAL ; - break; - } - memcpy(recvbuf, sendbuf, (*count)*size); + size = findtypesize(*datatype); + memcpy(recvbuf, sendbuf, (*count)*size); + *__ierr = 0; +} + +#pragma weak mpi_reduce__ = mpi_reduce +#pragma weak mpi_reduce_ = mpi_reduce +void mpi_reduce +( sendbuf, recvbuf, count, datatype, op, root, comm, __ierr ) +void *sendbuf; +void *recvbuf; +int *count; +int *datatype; +int *root; +int *comm; +int *op; +int *__ierr; +{ + int size; + + disppass("reduce"); + size = findtypesize(*datatype); + memcpy(recvbuf, sendbuf, (*count)*size); *__ierr = 0; } diff --git a/src/LIB/Python/Panel_Plot.py b/src/LIB/Python/Panel_Plot.py index 8e095faf07fd46b6dcd4f01df5dddca6b0b5759a..2072d1cf9225c27f14b79849e8b11e5e49885ce8 100644 --- a/src/LIB/Python/Panel_Plot.py +++ b/src/LIB/Python/Panel_Plot.py @@ -9,7 +9,7 @@ MNH_LIC for details. version 1. @author: 07/2021 Quentin Rodier """ import matplotlib as mpl -mpl.use('Agg') +#mpl.use('Agg') import matplotlib.pyplot as plt from matplotlib import cm from matplotlib.colors import ListedColormap @@ -20,33 +20,55 @@ import cartopy.feature as cfeature class PanelPlot(): def __init__(self, nb_l, nb_c, Lfigsize, bigtitle, titlepad=40, minmaxpad=1.03, timepad=-0.06, lateralminmaxpad=0.86, - labelcolorbarpad=6.0, colorbaraspect=20, colorbarpad=0.04 ): - self.bigtitle = bigtitle - self.Lfigsize = Lfigsize - self.nb_l = nb_l - self.nb_c = nb_c + labelcolorbarpad=6.0, colorbaraspect=20, colorbarpad=0.04, tickspad=0.8, + minmaxTextSize=10, bigtitleSize=13, titleSize=12, legendSize=10, + xlabelSize=11, ylabelSize=11, timeSize=11, cbTicksLabelSize=11, cbTitleSize=11, xyTicksLabelSize=10, figBoxLinewidth=1, + xyTicksWidth=1, xyTicksLength=6): + + self.bigtitle = bigtitle # Panel title + self.Lfigsize = Lfigsize # Panel size + self.nb_l = nb_l # Panel number of lines + self.nb_c = nb_c # Panel number of rows self.nb_graph = 0 # New independent graph within the subplot + self.titlepad = titlepad # Title pad (vertical shift) from graph + self.tickspad = tickspad # Ticks pad (between ticks and axis label) self.minmaxpad = minmaxpad # Min/Max print pad (vertical shift) self.timepad = timepad # Time print pad (vertical shift) self.colorbarpad = colorbarpad # Colorbar pad (horizontal shift from graph) self.lateralminmaxpad = lateralminmaxpad - self.labelcolorbarpad = labelcolorbarpad # Vertical colorbal label pad - self.colorbaraspect = colorbaraspect # Ratio of long to short dimensions of colorbar w.r.t. the figure - + self.labelcolorbarpad = labelcolorbarpad # Vertical colorbal label pad + self.colorbaraspect = colorbaraspect # Ratio of long to short dimensions of colorbar w.r.t. the figure + + self.minmaxTextSize = minmaxTextSize # min/max text fontsize + self.bigtitleSize = bigtitleSize # Panel title fontsize + self.titleSize = titleSize # Graph title fontsize + self.xlabelSize = xlabelSize # X-label fontsize + self.ylabelSize = ylabelSize # Y-label fontsize + self.legendSize = legendSize # X/Y plot legend fontsize + self.timeSize = timeSize # Time attribute of the graphs fontsize + self.cbTicksLabelSize = cbTicksLabelSize # Colorbar ticks label fontsize + self.cbTitleSize = cbTitleSize # Colorbar title fontsize + self.xyTicksLabelSize = xyTicksLabelSize # X/Y ticks label fontsize + self.figBoxLinewidth = figBoxLinewidth # Figure Box contour line width + + self.xyTicksWidth = xyTicksWidth # Ticks width + self.xyTicksLength = xyTicksLength # Ticks length + # Initialization of the panel plots self.fig = plt.figure(figsize=(self.Lfigsize[0],self.Lfigsize[1])) self.fig.set_dpi(125) - self.fig.suptitle(self.bigtitle,fontsize=16) + self.fig.suptitle(self.bigtitle,fontsize=bigtitleSize) - def save_graph(self, iplt, fig): + def save_graph(self, iplt, fig, fig_name='tempgraph'): """ - Create a temporary png file of (sub)-plot(s) which can be converted to PDF + Create a temporary png file of the panel plot which can be converted to PDF """ self.iplt = iplt self.fig = fig + self.fig_name=fig_name # .png figure prefix name - self.fig.savefig('tempgraph'+str(self.iplt)) #TODO possibility to change the default value of .png file name + self.fig.savefig(self.fig_name+str(self.iplt)) self.iplt+=1 return self.iplt @@ -57,7 +79,7 @@ class PanelPlot(): self.drawCoastLines = drawCoastLines self.projo = projo - # Grid lines and labels + # Grid lines and labels if 'PlateCarree' in str(projo): gl = ax.gridlines(crs=self.projo, draw_labels=True, linewidth=1, color='gray') if float(cartopy.__version__[:4]) >= 0.18: @@ -67,7 +89,7 @@ class PanelPlot(): gl.xlabels_top = False gl.ylabels_right = False - # Coastlines + # Coastlines if self.drawCoastLines and 'GeoAxes' in str(type(ax)): ax.coastlines(resolution='10m') @@ -75,14 +97,19 @@ class PanelPlot(): ax.add_feature(cfeature.BORDERS) ax.add_feature(cfeature.LAKES, alpha=0.7) - def addWhitecm(self, Laddwhite, colormap_in, nb_level): - if Laddwhite: + def addWhitecm(self, colormap_in, nb_level,whiteTop=False): + """ + Add a white color at the top (whiteTop=True) or bottom of the colormap w.r.t. the number of independent colors used + """ color_map = cm.get_cmap(colormap_in, 256) newcolor_map = color_map(np.linspace(0, 1, 256)) whites = np.array([1, 1, 1, 1]) #RBG code + opacity - for i in range(int(256/nb_level)): newcolor_map[:i, :] = whites + if whiteTop: + for i in range(int(256/nb_level)): newcolor_map[-i, :] = whites + else: + for i in range(int(256/nb_level)): newcolor_map[:i, :] = whites newcmp = ListedColormap(newcolor_map) - return newcmp + return newcmp def set_Title(self, ax, i, title, Lid_overlap, xlab, ylab): @@ -97,10 +124,10 @@ class PanelPlot(): self.i = i #self.ax[self.i].set_xlabel("test", fontweight='bold') if not Lid_overlap: - self.ax[self.i].set_title(title, pad=self.titlepad) + self.ax[self.i].set_title(title, pad=self.titlepad, fontsize=self.titleSize) else: # If graph overlap, title is concatenated new_title = self.ax[self.i].get_title() + ' and ' + title - self.ax[self.i].set_title(new_title, pad=self.titlepad) + self.ax[self.i].set_title(new_title, pad=self.titlepad, fontsize=self.titleSize) def set_xlim(self, ax, i, xlim): """ @@ -110,7 +137,7 @@ class PanelPlot(): self.xlim = xlim self.i = i - self.ax[self.i].set_xlim(xlim[0],xlim[1]) + self.ax[self.i].set_xlim(xlim[0],xlim[1])#, fontsize=self.xlabelSize) def set_ylim(self, ax, i, ylim): """ @@ -120,7 +147,7 @@ class PanelPlot(): self.ylim = ylim self.i = i - self.ax[self.i].set_ylim(ylim[0],ylim[1]) + self.ax[self.i].set_ylim(ylim[0],ylim[1])#, fontsize=self.ylabelSize) def set_XYaxislab(self, ax, i, xlab, ylab): """ @@ -136,14 +163,14 @@ class PanelPlot(): # https://github.com/SciTools/cartopy/issues/1332 if 'GeoAxes' in str(type(self.ax[self.i])): self.ax[self.i].text(-0.11, 0.45, ylab, verticalalignment='top', horizontalalignment='left', - rotation='vertical', rotation_mode='anchor', transform=self.ax[self.i].transAxes, color='black', fontsize=11) + rotation='vertical', rotation_mode='anchor', transform=self.ax[self.i].transAxes, color='black', fontsize=self.ylabelSize) self.ax[self.i].text(0.45, -0.06, xlab, verticalalignment='top', horizontalalignment='left', - rotation='horizontal', rotation_mode='anchor', transform=self.ax[self.i].transAxes, color='black', fontsize=11) + rotation='horizontal', rotation_mode='anchor', transform=self.ax[self.i].transAxes, color='black', fontsize=self.xlabelSize) else: - self.ax[self.i].set_xlabel(xlab) - self.ax[self.i].set_ylabel(ylab) + self.ax[self.i].set_xlabel(xlab, fontsize=self.xlabelSize, labelpad=0.1) + self.ax[self.i].set_ylabel(ylab, fontsize=self.ylabelSize, labelpad=0.1) - def addLine(self, ax, beg_coord, end_coord, color='black', linewidth=1): + def addLine(self, ax, beg_coord, end_coord, color='black', linewidth=0.2): self.ax = ax self.beg_coord = beg_coord self.end_coord = end_coord @@ -171,10 +198,10 @@ class PanelPlot(): strtext = " min = " + "{:.3e}".format(np.nanmin(var*facconv)) + " max = " + "{:.3e}".format(np.nanmax(var*facconv)) if not Lid_overlap: self.ax[self.i].text(0.01, self.minmaxpad, strtext, verticalalignment='top', horizontalalignment='left', - transform=self.ax[self.i].transAxes, color='black', fontsize=10) + transform=self.ax[self.i].transAxes, color='black', fontsize=self.minmaxTextSize) else: self.ax[self.i].text(self.lateralminmaxpad, self.minmaxpad, strtext, verticalalignment='top', horizontalalignment='right', - transform=self.ax[self.i].transAxes, color='black', fontsize=10) + transform=self.ax[self.i].transAxes, color='black', fontsize=self.minmaxTextSize) # Print to help choose min/max value for ticks self.print_minmax(var*facconv, title) @@ -188,14 +215,14 @@ class PanelPlot(): strtext = "Time = " + timetxt self.ax[self.i].text(0.0, self.timepad, strtext, verticalalignment='top', horizontalalignment='left', - transform=self.ax[self.i].transAxes, color='black', fontsize=10) + transform=self.ax[self.i].transAxes, color='black', fontsize=self.timeSize) def psectionV(self, Lxx=[], Lzz=[], Lvar=[], Lxlab=[], Lylab=[], Ltitle=[], Lminval=[], Lmaxval=[], Lstep=[], Lstepticks=[], Lcolormap=[], Lcbarlabel=[], LcolorLine=[], - Lfacconv=[], ax=[], Lid_overlap=[], colorbar=True, orog=[], Lxlim=[], Lylim=[], Ltime=[], Lpltype=[], LaddWhite_cm=[]): + Lfacconv=[], ax=[], Lid_overlap=[], colorbar=True, orog=[], Lxlim=[], Lylim=[], Ltime=[], Lpltype=[], LaddWhite_cm=[], LwhiteTop=[]): """ - Horizontal cross section plot + Vertical cross section plot Parameters : - Lxx : List of x or y coordinate variable or time axis - Lzz : List of z coordinates variable @@ -216,9 +243,11 @@ class PanelPlot(): - Lfacconv : List of factors for unit conversion of each variables - ax : List of fig.axes for ploting multiple different types of plots in a subplot panel - Lid_overlap: List of number index of plot to overlap current variables - - Lpltype : List of types of plot 'cf' or 'c'. cf=contourf, c=contour (lines only) + - Lpltype : List of types of plot 'cf' or 'c'. cf=contourf, c=contour (lines only) - colorbar : show colorbar or not - - LaddWhite_cm : List of boolean to add white color to a colormap at the first (low value) tick colorbar + - LaddWhite_cm : List of boolean to add white color to a colormap at the last bottom (low value) tick colorbar + - LwhiteTop : List of boolean to add the white color at the first top (high value). If false, the white is added at the bottom if Laddwhite_cm=T + - orog : Orography variable """ self.ax = ax firstCall = (len(self.ax) == 0) @@ -235,6 +264,7 @@ class PanelPlot(): if not Lcolormap: LcolorLine=['black']*len(Lvar) if not Lpltype: Lpltype=['cf']*len(Lvar) if not LaddWhite_cm: LaddWhite_cm=[False]*len(Lvar) + if not LwhiteTop: LwhiteTop=[False]*len(Lvar) if not Lylab: Lylab = ['']*len(Lvar) if not Lxlab: Lxlab = ['']*len(Lvar) # Add an extra percentage of the top max value for forcing the colorbar show the true user maximum value (correct a bug) @@ -261,7 +291,7 @@ class PanelPlot(): # Print time validity if Ltime: self.showTimeText(self.ax, iax, str(Ltime[i])) - + # Number of contours level if not Lstep[i]: # Default value of number of steps is 20 Lstep[i] = (Lmaxval[i] - Lminval[i])/20 @@ -270,16 +300,16 @@ class PanelPlot(): levels_contour = np.arange(Lminval[i],Lmaxval[i],step=Lstep[i]) # Add White to colormap - if LaddWhite_cm[i] and Lcolormap: Lcolormap[i]=self.addWhitecm(LaddWhite_cm[i], Lcolormap[i], len(levels_contour)) + if LaddWhite_cm[i] and Lcolormap: Lcolormap[i]=self.addWhitecm(Lcolormap[i], len(levels_contour), LwhiteTop[i]) # Plot if Lpltype[i]=='c': # Contour if LcolorLine: cf = self.ax[iax].contour(Lxx[i], Lzz[i], var*Lfacconv[i], levels=levels_contour, - norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], colors=LcolorLine[i]) + norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], colors=LcolorLine[i], linewidths=0.1) else: cf = self.ax[iax].contour(Lxx[i], Lzz[i], var*Lfacconv[i], levels=levels_contour, - norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i]) + norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i], linewidths=0.1) else: # Contourf cf = self.ax[iax].contourf(Lxx[i], Lzz[i], var*Lfacconv[i], levels=levels_contour, norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i]) @@ -289,6 +319,13 @@ class PanelPlot(): # X/Y Axis label self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i]) + + # Ticks label + self.ax[iax].tick_params(axis='both', labelsize=self.xyTicksLabelSize, width=self.xyTicksWidth, length=self.xyTicksLength, pad=self.tickspad) + + # Bounding box of the plot line width + for axis in ['top','bottom','left','right']: + self.ax[iax].spines[axis].set_linewidth(self.figBoxLinewidth) # X/Y Axis limits value if Lxlim: @@ -304,17 +341,17 @@ class PanelPlot(): # Color label on contour-line if Lpltype[i]=='c': # Contour - self.ax[iax].clabel(cf) - #self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i])) #TODO bug, levels not recognized + self.ax[iax].clabel(cf, fontsize=self.cbTicksLabelSize) + #self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i]), fontsize=self.cbTicksLabelSize) #TODO bug, levels not recognized #Filling area under topography if not orog==[]: - self.ax[iax].fill_between(Lxx[i][0,:], orog, color='black') + self.ax[iax].fill_between(Lxx[i][0,:], orog, color='black', linewidth=0.2) # Colorbar if colorbar: cb=plt.colorbar(cf, ax=self.ax[iax], fraction=0.031, pad=self.colorbarpad, ticks=np.arange(Lminval[i],Lmaxval[i],Lstepticks[i]), aspect=self.colorbaraspect) - cb.ax.set_title(Lcbarlabel[i], pad = self.labelcolorbarpad, loc='left') #This creates a new AxesSubplot only for the colorbar y=0 ==> location at the bottom + cb.ax.set_title(Lcbarlabel[i], pad=self.labelcolorbarpad, loc='left', fontsize=self.cbTitleSize) # This creates a new AxesSubplot only for the colorbar y=0 ==> location at the bottom return self.fig @@ -324,7 +361,7 @@ class PanelPlot(): """ XY (multiple)-lines plot Parameters : - - Lxx : List of variables to plot or coordinates along the X axis #TODO : ajouter Lfacconv pour les deux axes. Impact tous les cas test avec lignes X/Y + - Lxx : List of variables to plot or coordinates along the X axis - Lyy : List of variables to plot or coordinates along the Y axis - Lxlab : List of x-axis label - Lylab : List of y-axis label @@ -377,13 +414,16 @@ class PanelPlot(): # Legend #TODO : Handling legend with overlap two axis lines in the same box. For now, placement is by hand if not id_overlap: - self.ax[iax].legend(loc='upper right', bbox_to_anchor=(1, 0.95)) + self.ax[iax].legend(loc='upper right', bbox_to_anchor=(1, 0.95),fontsize=self.legendSize) else: - self.ax[iax].legend(loc='upper right', bbox_to_anchor=(1, 0.90)) + self.ax[iax].legend(loc='upper right', bbox_to_anchor=(1, 0.90),fontsize=self.legendSize) # Title if Ltitle: self.set_Title(self.ax, iax, Ltitle[i], id_overlap,Lxlab[i], Lylab[i]) + # Ticks label + self.ax[iax].tick_params(axis='both', labelsize=self.xyTicksLabelSize, width=self.xyTicksWidth, length=self.xyTicksLength, pad=self.tickspad) + # X/Y Axis label if id_overlap: self.ax[iax].xaxis.tick_top() @@ -410,7 +450,7 @@ class PanelPlot(): def psectionH(self, lon=[],lat=[], Lvar=[], Lcarte=[], Llevel=[], Lxlab=[], Lylab=[], Ltitle=[], Lminval=[], Lmaxval=[], Lstep=[], Lstepticks=[], Lcolormap=[], LcolorLine=[], Lcbarlabel=[], Lproj=[], Lfacconv=[], coastLines=True, ax=[], - Lid_overlap=[], colorbar=True, Ltime=[], LaddWhite_cm=[], Lpltype=[], Lcbformatlabel=[]): + Lid_overlap=[], colorbar=True, Ltime=[], LaddWhite_cm=[], LwhiteTop=[], Lpltype=[], Lcbformatlabel=[]): """ Horizontal cross section plot Parameters : @@ -438,6 +478,7 @@ class PanelPlot(): - colorbar : show colorbar or not - Lpltype : List of types of plot 'cf' or 'c'. cf=contourf, c=contour (lines only) - LaddWhite_cm : List of boolean to add white color to a colormap at the first (low value) tick colorbar + - LwhiteTop : List of boolean to add the white color at the first top (high value). If false, the white is added at the bottom if Laddwhite_cm=T - Lcbformatlabel: List of boolean to reduce the format to exponential 1.1E+02 format colorbar label """ self.ax = ax @@ -457,6 +498,7 @@ class PanelPlot(): if not Lcolormap: LcolorLine=['black']*len(Lvar) if not Lpltype: Lpltype=['cf']*len(Lvar) if not LaddWhite_cm: LaddWhite_cm=[False]*len(Lvar) + if not LwhiteTop: LwhiteTop=[False]*len(Lvar) if not Lcbformatlabel: Lcbformatlabel=[False]*len(Lvar) # Add an extra percentage of the top max value for forcing the colorbar show the true user maximum value (correct a bug) if Lstep: Lmaxval = list(map(lambda x, y: x + 1E-6*y, Lmaxval, Lstep) ) #The extra value is 1E-6 times the step ticks of the colorbar @@ -511,7 +553,7 @@ class PanelPlot(): levels_contour = np.arange(Lminval[i],Lmaxval[i],step=Lstep[i]) # Add White to colormap - if LaddWhite_cm[i] and Lcolormap: Lcolormap[i]=self.addWhitecm(LaddWhite_cm[i], Lcolormap[i], len(levels_contour)) + if LaddWhite_cm[i] and Lcolormap: Lcolormap[i]=self.addWhitecm(Lcolormap[i], len(levels_contour), LwhiteTop[i]) # Plot if Lproj: @@ -540,28 +582,30 @@ class PanelPlot(): # X/Y Axis self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i]) - + # Ticks label + self.ax[iax].tick_params(axis='both', labelsize=self.xyTicksLabelSize, width=self.xyTicksWidth, length=self.xyTicksLength, pad=self.tickspad) + # Color label on contour-line if Lpltype[i]=='c': # Contour if 'GeoAxes' in str(type(self.ax[self.i])): # cartopy does not like the levels arguments in clabel, known issue - self.ax[iax].clabel(cf) + self.ax[iax].clabel(cf, fontsize=self.cbTicksLabelSize) else: - self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i])) + self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i]), fontsize=self.cbTicksLabelSize) # Colorbar if colorbar: cb=plt.colorbar(cf, ax=self.ax[iax], fraction=0.031, pad=self.colorbarpad, ticks=np.arange(Lminval[i],Lmaxval[i],Lstepticks[i]), aspect=self.colorbaraspect) - cb.ax.set_title(Lcbarlabel[i], pad = self.labelcolorbarpad, loc='left') #This creates a new AxesSubplot only for the colorbar y=0 ==> location at the bottom + cb.ax.set_title(Lcbarlabel[i], pad = self.labelcolorbarpad, loc='left', fontsize=self.cbTitleSize) #This creates a new AxesSubplot only for the colorbar y=0 ==> location at the bottom if Lcbformatlabel[i]: cb.ax.set_yticklabels(["{:.1E}".format(i) for i in cb.get_ticks()]) return self.fig def pvector(self, Lxx=[], Lyy=[], Lvar1=[], Lvar2=[], Lcarte=[], Llevel=[], Lxlab=[], Lylab=[], - Ltitle=[], Lwidth=[], Larrowstep=[], Lcolor=[], Llegendval=[], Lcbarlabel=[], + Ltitle=[], Lwidth=[], Larrowstep=[], Lcolor=[], Llegendval=[], Llegendlabel=[], Lproj=[], Lfacconv=[], ax=[], coastLines=True, Lid_overlap=[], Ltime=[], Lscale=[], Lylim=[], Lxlim=[]): """ - Horizontal vectors lines + Vectors Parameters : - Lxx : List of x or y coordinate variable (lat or ni or nm) - Lyy : List of y coordinates variable (lon or level) @@ -580,7 +624,7 @@ class PanelPlot(): - Larrowstep : List of sub-sample (frequency) if too much arrows - Lcolor : List of colors for the arrows (default: black) - Llegendval : List of value for the legend of the default arrow - - Lcbarlabel : List of labels for the legend of the default arrow + - Llegendlabel : List of labels for the legend of the default arrow - Lproj : List of ccrs cartopy projection - Lfacconv : List of factors for unit conversion of each variables - coastLines : Boolean to plot coast lines and grid lines @@ -666,7 +710,7 @@ class PanelPlot(): if Lproj: self.draw_Backmap(coastLines, self.ax[iax], Lproj[i]) # Arrow legend key - qk = self.ax[iax].quiverkey(cf, 1.0, -0.05, Llegendval[i], str(Llegendval[i]) + Lcbarlabel[i], labelpos='E', color='black') + qk = self.ax[iax].quiverkey(cf, 1.0, -0.05, Llegendval[i], str(Llegendval[i]) + Llegendlabel[i], labelpos='E', color='black') return self.fig diff --git a/src/LIB/Python/misc_functions.py b/src/LIB/Python/misc_functions.py index aa91aa7a311dc721c17f3f28cc7a8fd4f78df5b1..efc0916e04a60a7ee3cd2a276d1bb1eba3de0182 100644 --- a/src/LIB/Python/misc_functions.py +++ b/src/LIB/Python/misc_functions.py @@ -67,12 +67,12 @@ def windvec_verti_proj(u, v, level, angle): return projected_wind def oblique_proj(var, ni, nj, lvl, i_beg, j_beg, i_end, j_end): - """Compute an oblique projection of a 3D variable w.r.t. its axes + """Compute an oblique projection of a variable w.r.t. its axes Parameters ---------- - var : array 3D - the 3D variable to project (e.g. THT) + var : array 3D or 2D + the variable to project (e.g. THT, ZS) ni : array 1D 1D x-axis of the 3D dimension @@ -94,27 +94,37 @@ def oblique_proj(var, ni, nj, lvl, i_beg, j_beg, i_end, j_end): angle_proj : float the angle (radian) of the new axe w.r.t the x/ni axes (West-East) - out_var : array 2D - a 2D (z,m) variable projected on the oblique axe + out_var : array 2D or 1D + a 2D (z,m) or 1D (m) variable projected on the oblique axe axe_m : array 1D a 1D m new axe (distance from the beggining point) """ - dist_seg=np.sqrt((i_end-i_beg)**2.0 + (j_end-j_beg)**2.0) # Distance de la section oblique m - out_var = np.zeros((len(lvl),int(dist_seg)+1)) # Initialisation du nouveau champs projeté dans la coupe (z,m) - axe_m = np.zeros(int(dist_seg)+1) #Axe des abscisses qui sera tracé selon la coupe - axe_m_coord = [] #Coordonnées x,y des points qui composent l'axe - axe_m_coord.append( (ni[i_beg],nj[j_beg]) ) #Le premier point est celui donné par l'utilisateur - for m in range(int(dist_seg)): #Discrétisation selon distance de la coupe / int(distance_de_la_coupe) + dist_seg=np.sqrt((i_end-i_beg)**2.0 + (j_end-j_beg)**2.0) # Distance de la section oblique m + if var.ndim ==3: + out_var = np.zeros((len(lvl),int(dist_seg)+1)) # Initialisation du nouveau champs projeté dans la coupe (z,m) + else: # 2D + out_var = np.zeros(int(dist_seg)+1) # Initialisation du nouveau champs projeté dans la coupe (m) + + axe_m = np.zeros(int(dist_seg)+1) # Axe des abscisses qui sera tracé selon la coupe + axe_m_coord = [] # Coordonnées x,y des points qui composent l'axe + axe_m_coord.append( (ni[i_beg],nj[j_beg]) ) # Le premier point est celui donné par l'utilisateur + + for m in range(int(dist_seg)): # Discrétisation selon distance de la coupe / int(distance_de_la_coupe) axe_m_coord.append( (axe_m_coord[0][0] + (ni[i_end]-ni[i_beg])/(int(dist_seg))*(m+1), axe_m_coord[0][1] + (nj[j_end]-nj[j_beg])/(int(dist_seg))*(m+1) )) axe_m[m+1] = np.sqrt((ni[i_beg]-axe_m_coord[m+1][0])**2 + (nj[j_beg]-axe_m_coord[m+1][1])**2) - - for k in range(len(lvl)): - a=RectBivariateSpline(ni, nj,var[k,:,:],kx=1,ky=1) #Interpolation par niveau à l'ordre 1 pour éviter des valeurs négatives de champs strictement > 0 + + if var.ndim ==3: # 3D variables to project + for k in range(len(lvl)): + a=RectBivariateSpline(ni, nj,var[k,:,:],kx=1,ky=1) # Interpolation par niveau à l'ordre 1 pour éviter des valeurs négatives de champs strictement > 0 + for m in range(int(dist_seg)+1): + out_var[k,m] = a.ev(axe_m_coord[m][0],axe_m_coord[m][1]) # La fonction ev de RectBivariate retourne la valeur la plus proche du point considéré + else: # 2D variables to project + a=RectBivariateSpline(ni, nj,var[:,:],kx=1,ky=1) for m in range(int(dist_seg)+1): - out_var[k,m] = a.ev(axe_m_coord[m][0],axe_m_coord[m][1]) # La fonction ev de RectBivariate retourne la valeur la plus proche du point considéré + out_var[m] = a.ev(axe_m_coord[m][0],axe_m_coord[m][1]) angle_proj = math.acos((ni[i_end]-ni[i_beg])/axe_m[-1]) return angle_proj, out_var, axe_m @@ -206,4 +216,4 @@ def comp_altitude2DVar(oneVar3D, orography, ztop, level, n_y, n_x): else: for k in range(len(level)): altitude[k,j,i] = orography[j,i] + level[k]*((ztop-orography[j,i])/ztop) - return altitude, n_x3D, n_y3D \ No newline at end of file + return altitude, n_x3D, n_y3D diff --git a/src/LIB/Python/read_MNHfile.py b/src/LIB/Python/read_MNHfile.py index 6c1311c1730eddb20446c428ddedc1de2d683cf2..38072becffe3b1d8c066c6f370683b4988cf7ccf 100644 --- a/src/LIB/Python/read_MNHfile.py +++ b/src/LIB/Python/read_MNHfile.py @@ -11,6 +11,47 @@ MNH_LIC for details. version 1. import netCDF4 as nc import numpy as np +def read_withEPY(LnameFiles,Dvar_input, Dvar_output={}, path='.'): + import epygram + epygram.init_env() + for i,keyFiles in enumerate(Dvar_input.keys()): + print('Reading file ' + keyFiles) + theFile = epygram.formats.resource(LnameFiles[i],'r') + Dvar_output[keyFiles] = {} #initialize dic for each files + for var in Dvar_input[keyFiles]: #For each files + # Read variables + if(theFile.format == 'FA'): + Dvar_output[keyFiles][var] = theFile.readfield(var) + elif(theFile.format == 'LFI'): + if(var[1]==None or var[1]==0): # 2D Field + Dvar_output[keyFiles][var[0]] = theFile.readfield(var) + else: # 3D Field + Dvar_output[keyFiles][var[0]+str(var[1])] = theFile.readfield(var).getlevel(k=var[1]) + elif(theFile.format == 'netCDFMNH'): + if(var[1]==None or var[1]==0): # 2D Field + Dvar_output[keyFiles][var[0]] = theFile.readfield(var[0]) + else: + Dvar_output[keyFiles][var[0]+str(var[1])] = theFile.readfield(var[0]).getlevel(k=var[1]) + elif(theFile.format == 'GRIB'): + if len(var)==6: # GRIB2 + Dvar_output[keyFiles][var[5]] = theFile.readfield({'discipline': var[0], 'parameterCategory': var[1], 'typeOfFirstFixedSurface': var[2],'parameterNumber': var[3], 'level': var[4]}) + elif len(var)==5: # GRIB1 + Dvar_output[keyFiles][var[4]] = theFile.readfield({'indicatorOfParameter': var[0], 'paramId': var[1], 'indicatorOfTypeOfLevel': var[2], 'level': var[3]}) + else: epygramError("GRIB format error. GRIB1 expects 4 values : [indicatorOfParameter, paramId, indicatorOfTypeOfLevel, level, 'casual name'], GRIB2 expects 5 values [discipline, parameterCategory, typeOfFirstFixedSurface, parameterNumber, level, casual name]") + else: + raise epygramError("Unknown format file, please use FA, LFI, GRIB or MNH NetCDF") + theFile.close() + + # Transform spectral data to physics space (for AROME and ARPEGE) + for f in Dvar_output: + for var in Dvar_output[f]: + try: + if(Dvar_output[f][var].spectral): + Dvar_output[f][var].sp2gp() + except: + break + return Dvar_output + def read_netcdf(LnameFiles, Dvar_input, path='.', get_data_only=True, del_empty_dim=True, removeHALO=True): """Read a netCDF4 Meso-NH file For each file, call functions to read diachronic or synchronous file @@ -20,9 +61,9 @@ def read_netcdf(LnameFiles, Dvar_input, path='.', get_data_only=True, del_empty_ LnameFiles : list of str list of Meso-NH netCDF4 file (diachronic or synchronous) - Dvar_input : Dict{'fileNumber' : 'var_name',('group_name','var_name')} + Dvar_input : Dict{'keyFile' : 'var_name',('group_name','var_name')} where - 'fileNumber' is a str corresponding to 'f' + the file number in LnameFiles (by order) + 'keyFile' is a str corresponding to a key for the file number in LnameFiles (by order) 'var_name' is the exact str of the netCDF4 variable name ('group_name','var_name') is the exact tuple of the (sub-)groups name and the netCDF4 variable name e.g. : {'f1':['ZS', 'WT','ni', 'level'], @@ -51,23 +92,22 @@ def read_netcdf(LnameFiles, Dvar_input, path='.', get_data_only=True, del_empty_ Dvar[ifile][('group_name','var_name')] if the group contains more than one variable """ Dvar = {} - for i,nameFiles in enumerate(LnameFiles): - f_nb = 'f' + str(i+1) - print('Reading file ' + f_nb) - print(path + nameFiles) - theFile = nc.Dataset(path + nameFiles,'r') - Dvar[f_nb] = {} - if '000' in nameFiles[-6:-3]: + for i,keyFiles in enumerate(Dvar_input.keys()): + print('Reading file ' + keyFiles) + print(path + LnameFiles[i]) + theFile = nc.Dataset(path + LnameFiles[i],'r') + Dvar[keyFiles] = {} + if '000' in LnameFiles[i][-6:-3]: if theFile['MASDEV'][0] <= 54: raise TypeError('The python lib is available for MNH >= 5.5') else: - Dvar[f_nb] = read_TIMESfiles_55(theFile, Dvar_input[f_nb], Dvar[f_nb], get_data_only, del_empty_dim, removeHALO) + Dvar[keyFiles] = read_TIMESfiles_55(theFile, Dvar_input[keyFiles], Dvar[keyFiles], get_data_only, del_empty_dim, removeHALO) else: - Dvar[f_nb]= read_BACKUPfile(theFile, Dvar_input[f_nb], Dvar[f_nb], get_data_only, del_empty_dim, removeHALO) - theFile.close() + Dvar[keyFiles]= read_BACKUPfile(theFile, Dvar_input[keyFiles], Dvar[keyFiles], get_data_only, del_empty_dim, removeHALO) + #theFile.close() return Dvar -def read_var(theFile, Dvar, var_name, get_data_only=True, del_empty_dim=True, removeHALO=True): +def read_var(theFile, Dvar, var_name, get_data_only, del_empty_dim=True, removeHALO=True): """Read a netCDF4 variable Parameters @@ -101,7 +141,6 @@ def read_var(theFile, Dvar, var_name, get_data_only=True, del_empty_dim=True, re var_dim_name = theFile.variables[var_name].dimensions except: raise KeyError("Group and variable name not found in the file, check the group/variable name with ncdump -h YourMNHFile.000.nc. You asked for variable : " + var_name) - if not get_data_only: Dvar[var_name] = theFile.variables[var_name] else: @@ -140,11 +179,10 @@ def read_var(theFile, Dvar, var_name, get_data_only=True, del_empty_dim=True, re except IndexError: break Ldimtosqueeze=tuple(Ldimtosqueeze) - Dvar[var_name] = np.squeeze(Dvar[var_name], axis=Ldimtosqueeze) - + Dvar[var_name] = np.squeeze(Dvar[var_name], axis=Ldimtosqueeze) return Dvar -def read_from_group(theFile, Dvar, group_name, var_name, get_data_only=True, del_empty_dim=True,removeHALO=True): +def read_from_group(theFile, Dvar, group_name, var_name, get_data_only, del_empty_dim=True,removeHALO=True): """Read a variable from a netCDF4 group Parameters @@ -227,7 +265,7 @@ def read_from_group(theFile, Dvar, group_name, var_name, get_data_only=True, del Dvar[(group_name,var_name)] = Dvar[(group_name,var_name)].T return Dvar -def read_BACKUPfile(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_dim=True, removeHALO=True): +def read_BACKUPfile(theFile, Dvar_input, Dvar, get_data_only, del_empty_dim=True, removeHALO=True): """Read variables from Meso-NH MASDEV >= 5.5.0 synchronous file For all variables in Dvar_input of one file, call functions to read the variable of the group+variable @@ -261,19 +299,18 @@ def read_BACKUPfile(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_dim # Reading date since beginning of the model run Dvar['time'] = theFile.variables['time'][0] Dvar['date'] = nc.num2date(Dvar['time'],units=theFile.variables['time'].units, calendar = theFile.variables['time'].calendar) - for var in Dvar_input: if type(var) == tuple: Dvar = read_from_group(theFile, Dvar, var[0], var[1], get_data_only, del_empty_dim, removeHALO) else: Dvar = read_var(theFile, Dvar, var, get_data_only, del_empty_dim, removeHALO) - # For all variables except scalars, change Fill_Value to NaN - Dvar[var]= np.where(Dvar[var] != -99999.0, Dvar[var], np.nan) - Dvar[var]= np.where(Dvar[var] != 999.0, Dvar[var], np.nan) + if get_data_only: + Dvar[var]= np.where(Dvar[var] != -99999.0, Dvar[var], np.nan) + Dvar[var]= np.where(Dvar[var] != 999.0, Dvar[var], np.nan) return Dvar -def read_TIMESfiles_55(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_dim=True, removeHALO=True): +def read_TIMESfiles_55(theFile, Dvar_input, Dvar, get_data_only, del_empty_dim=True, removeHALO=True): """Read variables from Meso-NH MASDEV >= 5.5.0 diachronic file For all variables in Dvar_input of one file, call functions to read the variable of the group+variable @@ -305,7 +342,6 @@ def read_TIMESfiles_55(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_ Dvar[ifile][('group_name','var_name')] if the group contains more than one variable """ for var in Dvar_input: - print(var) if type(var) == tuple: Dvar = read_from_group(theFile, Dvar, var[0], var[1], get_data_only, del_empty_dim, removeHALO) else: @@ -314,6 +350,8 @@ def read_TIMESfiles_55(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_ def removetheHALO(idim, var): """Remove a NHALO=1 point [1:-1] at a given dimension idim of a variable var + TODO: with NHALO=3 with WENO5 + TODO: with the use of get_data_only=False (NetCDF4 output) Parameters ---------- diff --git a/src/LIB/Python/readme b/src/LIB/Python/readme new file mode 100644 index 0000000000000000000000000000000000000000..ddb601ec1ec0ed8b757ed310dda73811edb0840d --- /dev/null +++ b/src/LIB/Python/readme @@ -0,0 +1 @@ +Tutorial given the 17/03/2022 to use the library can be found at https://github.com/QuentinRodier/MNHPy/blob/main/examples/mnhpy.ipynb diff --git a/src/LIB/RAD/data_mnh/spectral_albedo.nc b/src/LIB/RAD/data_mnh/spectral_albedo.nc new file mode 100644 index 0000000000000000000000000000000000000000..d6e6335e8a63baeeafd7fdf57fac27eff43bfbb7 Binary files /dev/null and b/src/LIB/RAD/data_mnh/spectral_albedo.nc differ diff --git a/src/LIB/RAD/data_mnh/spectral_emissivity.nc b/src/LIB/RAD/data_mnh/spectral_emissivity.nc new file mode 100644 index 0000000000000000000000000000000000000000..14ac4ae328034fb4ef41b4850e05b80faa51dd2d Binary files /dev/null and b/src/LIB/RAD/data_mnh/spectral_emissivity.nc differ diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90 index 97466a414e1dbb88e5fb8746cb10d3e65706df1c..648ac8b7546ff473b262245e84e3f186abd6fa6c 100644 --- a/src/LIB/SURCOUCHE/src/mode_field.f90 +++ b/src/LIB/SURCOUCHE/src/mode_field.f90 @@ -2002,6 +2002,20 @@ ALLOCATE(TFIELDLIST(IDX)%TFIELD_X0D(IMODEL)) IDX = IDX+1 ! IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST() +TFIELDLIST(IDX)%CMNHNAME = 'DRYMASSS' +TFIELDLIST(IDX)%CSTDNAME = '' +TFIELDLIST(IDX)%CLONGNAME = 'DRYMASSS' +TFIELDLIST(IDX)%CUNITS = 'kg' +TFIELDLIST(IDX)%CDIR = '--' +TFIELDLIST(IDX)%CCOMMENT = 'Total Dry Mass Source' +TFIELDLIST(IDX)%NGRID = 0 +TFIELDLIST(IDX)%NTYPE = TYPEREAL +TFIELDLIST(IDX)%NDIMS = 0 +TFIELDLIST(IDX)%LTIMEDEP = .TRUE. +ALLOCATE(TFIELDLIST(IDX)%TFIELD_X0D(IMODEL)) +IDX = IDX+1 +! +IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST() TFIELDLIST(IDX)%CMNHNAME = 'BL_DEPTH' TFIELDLIST(IDX)%CSTDNAME = '' TFIELDLIST(IDX)%CLONGNAME = 'BL_DEPTH' @@ -2302,6 +2316,20 @@ ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL)) IDX = IDX+1 ! IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST() +TFIELDLIST(IDX)%CMNHNAME = 'ICEFR' +TFIELDLIST(IDX)%CSTDNAME = '' +TFIELDLIST(IDX)%CLONGNAME = 'ICEFR' +TFIELDLIST(IDX)%CUNITS = '1' +TFIELDLIST(IDX)%CDIR = 'XY' +TFIELDLIST(IDX)%CCOMMENT = 'X_Y_Z_ICE cloud FRaction' +TFIELDLIST(IDX)%NGRID = 1 +TFIELDLIST(IDX)%NTYPE = TYPEREAL +TFIELDLIST(IDX)%NDIMS = 3 +TFIELDLIST(IDX)%LTIMEDEP = .TRUE. +ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL)) +IDX = IDX+1 +! +IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST() TFIELDLIST(IDX)%CMNHNAME = 'CIT' TFIELDLIST(IDX)%CSTDNAME = '' TFIELDLIST(IDX)%CLONGNAME = 'CIT' @@ -3740,6 +3768,13 @@ IF (.NOT.ASSOCIATED(XDRYMASST)) THEN TFIELDLIST(IID)%TFIELD_X0D(1)%DATA=>XDRYMASST END IF ! +IF (.NOT.ASSOCIATED(XDRYMASSS)) THEN + CALL PRINT_MSG(NVERB_DEBUG,'GEN','INI_FIELD_SCALARS',' XDRYMASSS was not associated') + ALLOCATE(XDRYMASSS) + CALL FIND_FIELD_ID_FROM_MNHNAME('DRYMASSS',IID,IRESP) + TFIELDLIST(IID)%TFIELD_X0D(1)%DATA=>XDRYMASSS +END IF +! IF (.NOT.ASSOCIATED(NRIMX)) THEN CALL PRINT_MSG(NVERB_DEBUG,'GEN','INI_FIELD_SCALARS',' NRIMX was not associated') ALLOCATE(NRIMX) @@ -4341,6 +4376,14 @@ IF (.NOT.ASSOCIATED(TFIELDLIST(IID)%TFIELD_X0D(KTO)%DATA)) THEN END IF XDRYMASST => TFIELDLIST(IID)%TFIELD_X0D(KTO)%DATA ! +CALL FIND_FIELD_ID_FROM_MNHNAME('DRYMASSS',IID,IRESP) +IF (.NOT.ASSOCIATED(TFIELDLIST(IID)%TFIELD_X0D(KTO)%DATA)) THEN + CALL PRINT_MSG(NVERB_DEBUG,'GEN','FIELDLIST_GOTO_MODEL',& + 'TFIELDLIST(IID)%TFIELD_X0D(KTO)%DATA was not associated for '//TFIELDLIST(IID)%CMNHNAME) + ALLOCATE(TFIELDLIST(IID)%TFIELD_X0D(KTO)%DATA) +END IF +XDRYMASSS => TFIELDLIST(IID)%TFIELD_X0D(KTO)%DATA +! ! MODD_DYN_n variables ! CALL FIND_FIELD_ID_FROM_MNHNAME('RIMX',IID,IRESP) diff --git a/src/LIB/SURCOUCHE/src/mode_io_file.f90 b/src/LIB/SURCOUCHE/src/mode_io_file.f90 index c78973780f94f376e49a7249cbf2d26425da2760..e269accf0320ac26d31879e4ea155bc61ecc2d17 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_file.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_file.f90 @@ -555,7 +555,7 @@ SELECT CASE(TPFILE%CTYPE) !Remark: 'MNH' is more general than MNHBACKUP and could be in fact a MNHBACKUP file CASE ('MNH', 'MNHBACKUP', 'MNHDIACHRONIC', 'MNHDIAG', 'MNHOUTPUT', 'PGD') !Do not close (non-existing) '.des' file if OUTPUT - IF(TPFILE%CTYPE/='OUTPUT' .AND. CPROGRAM/='LFICDF') THEN + IF(TPFILE%CTYPE/='MNHOUTPUT' .AND. CPROGRAM/='LFICDF') THEN CALL IO_File_find_byname(TRIM(TPFILE%CNAME)//'.des',TZFILE_DES,IRESP) IF (IRESP/=0) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_close','file '//TRIM(TPFILE%CNAME)//'.des not in filelist') CALL IO_File_close(TZFILE_DES,KRESP=IRESP,HPROGRAM_ORIG=HPROGRAM_ORIG) diff --git a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 index 6329b59e7daff34a3c40211ba8e0025cf97c290d..f7954781fd46754679b6f25aeb2c6fc018a19b6b 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 @@ -959,7 +959,7 @@ SELECT CASE(TPFILE%CTYPE) TPFILE%NLFITYPE = ILFITYPE TPFILE%NLFIVERB = ILFIVERB ! - IF (TRIM(HTYPE)=='OUTPUT') THEN + IF (TRIM(HTYPE)=='MNHOUTPUT') THEN TPFILE%LNCREDUCE_FLOAT_PRECISION = LOUT_REDUCE_FLOAT_PRECISION(IMI) TPFILE%LNCCOMPRESS = LOUT_COMPRESS(IMI) TPFILE%NNCCOMPRESS_LEVEL = NOUT_COMPRESS_LEVEL(IMI) diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 index 1e704e9353370d54127bacf6a7596437f2ef4115..f98999c1ea643987e3825b791b28d30d41a151fa 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 @@ -16,7 +16,7 @@ module mode_io_read_lfi use modd_field, only: tfielddata USE MODD_IO USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH -use modd_precision, only: LFIINT +use modd_precision, only: LFIINT, MNHINT64, MNHREAL32, MNHREAL64 ! USE MODE_MSG ! @@ -57,11 +57,11 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -REAL,DIMENSION(1) :: ZFIELD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +REAL,DIMENSION(1) :: ZFIELD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -96,10 +96,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -130,10 +130,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -164,10 +164,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -198,10 +198,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occur ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -232,10 +232,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occ ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -266,10 +266,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems o ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -300,10 +300,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -334,10 +334,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -368,10 +368,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occure ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -402,10 +402,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occu ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -436,11 +436,11 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER :: IFIELD -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER :: IFIELD +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -483,12 +483,12 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER :: JI -INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER :: JI +INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -538,10 +538,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP,ITOTAL -INTEGER :: ILENG, ILENGMAX, JLOOP -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD +INTEGER(KIND=LFIINT) :: IRESP,ITOTAL +INTEGER :: ILENG, ILENGMAX, JLOOP +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -588,13 +588,13 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured ! !* 0.2 Declarations of local variables ! -INTEGER(KIND=LFIINT) :: IRESP, ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -TYPE(TFIELDDATA) :: TZFIELD -INTEGER, DIMENSION(3) :: ITDATE ! date array -REAL,DIMENSION(1) :: ZTIME +INTEGER(KIND=LFIINT) :: IRESP, ITOTAL +INTEGER :: ILENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +TYPE(TFIELDDATA) :: TZFIELD +INTEGER, DIMENSION(3) :: ITDATE ! date array +REAL,DIMENSION(1) :: ZTIME ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) ! @@ -648,13 +648,13 @@ SUBROUTINE IO_Field_read_check_lfi(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,KRESP,OGOOD ! USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN ! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -INTEGER, INTENT(IN) :: KLENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KWORK -INTEGER(KIND=LFIINT), INTENT(OUT) :: KTOTAL -INTEGER(KIND=LFIINT), INTENT(OUT) :: KRESP -LOGICAL, INTENT(OUT) :: OGOOD +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +INTEGER, INTENT(IN) :: KLENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KWORK +INTEGER(KIND=LFIINT), INTENT(OUT) :: KTOTAL +INTEGER(KIND=LFIINT), INTENT(OUT) :: KRESP +LOGICAL, INTENT(OUT) :: OGOOD ! INTEGER :: IERRLEVEL,IROW,J INTEGER,DIMENSION(JPXKRK) :: ICOMMENT @@ -788,12 +788,12 @@ END SUBROUTINE IO_Field_read_check_lfi ! FUNCTION TRANSFER_I8_R(KFIELDIN) RESULT(PFIELDOUT) ! -INTEGER(KIND=8),DIMENSION(:),INTENT(IN) :: KFIELDIN +INTEGER(KIND=MNHINT64),DIMENSION(:),INTENT(IN) :: KFIELDIN REAL,DIMENSION(SIZE(KFIELDIN)) :: PFIELDOUT ! INTEGER :: ILENG #if (MNH_REAL == 4) -REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: ZFIELD8 +REAL(KIND=MNHREAL64),DIMENSION(:),ALLOCATABLE :: ZFIELD8 #endif ! ILENG = SIZE(PFIELDOUT) @@ -803,7 +803,7 @@ ILENG = SIZE(PFIELDOUT) #else ALLOCATE(ZFIELD8(ILENG)) ZFIELD8(:) = TRANSFER(KFIELDIN,ZFIELD8(1),ILENG) - PFIELDOUT(:) = REAL(ZFIELD8(:),KIND=4) + PFIELDOUT(:) = REAL(ZFIELD8(:),KIND=MNHREAL32) DEALLOCATE(ZFIELD8) #endif ! diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90 index f78a0e5fae68fe82c2df56794b1c9b89d777e5ca..430f06ccfed1c5d64d8daeec50f95164be6d1ed7 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90 @@ -17,7 +17,7 @@ module mode_io_write_lfi use modd_field, only: tfielddata USE MODD_IO USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH -use modd_precision, only: LFIINT +use modd_precision, only: LFIINT, MNHINT64, MNHREAL64 ! USE MODE_MSG ! @@ -59,10 +59,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(KIND=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(KIND=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X0','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -98,10 +98,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X1','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -145,13 +145,13 @@ INTEGER,OPTIONAL, INTENT(IN) :: KZFILE ! Number of the Z-level split fi ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=4) :: YSUFFIX -CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME -CHARACTER(LEN=LEN_HREC) :: YRECFM -TYPE(TFILEDATA),POINTER :: TZFILE +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=4) :: YSUFFIX +CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME +CHARACTER(LEN=LEN_HREC) :: YRECFM +TYPE(TFILEDATA),POINTER :: TZFILE ! IRESP=0 ! @@ -209,10 +209,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X3','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -254,10 +254,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X4','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -299,10 +299,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X5','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -344,10 +344,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems arais ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X6','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -389,10 +389,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N0','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -428,10 +428,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N1','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -473,10 +473,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N2','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -518,10 +518,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N3','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -564,10 +564,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araise ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N4','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -610,11 +610,11 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: IFIELD -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: IFIELD +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_L0','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -657,11 +657,11 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_L1','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -712,10 +712,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG, ILENGMAX, JLOOP -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG, ILENGMAX, JLOOP +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_C0','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -770,12 +770,12 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -TYPE(TFIELDDATA) :: TZFIELD -INTEGER, DIMENSION(3) :: ITDATE ! date array -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +TYPE(TFIELDDATA) :: TZFIELD +INTEGER, DIMENSION(3) :: ITDATE ! date array +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_T0','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -846,13 +846,13 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems a ! !* 0.2 Declarations of local variables ! -INTEGER :: ILENG, IPOS -INTEGER :: JI -INTEGER(kind=LFIINT) :: IRESP, ITOTAL -TYPE(TFIELDDATA) :: TZFIELD -INTEGER, DIMENSION(:), ALLOCATABLE :: ITDATE ! date array -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -CHARACTER(LEN=LEN_HREC) :: YRECFM +INTEGER :: ILENG, IPOS +INTEGER :: JI +INTEGER(kind=LFIINT) :: IRESP, ITOTAL +TYPE(TFIELDDATA) :: TZFIELD +INTEGER, DIMENSION(:), ALLOCATABLE :: ITDATE ! date array +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK +CHARACTER(LEN=LEN_HREC) :: YRECFM ! CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_T1','writing '//TRIM(TPFIELD%CMNHNAME)) ! @@ -924,11 +924,11 @@ END SUBROUTINE IO_Field_write_lfi_T1 ! SUBROUTINE WRITE_PREPARE(TPFIELD,KLENG,KWORK,KTOTAL,KRESP) ! -TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD -INTEGER, INTENT(IN) :: KLENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE,INTENT(INOUT) :: KWORK -INTEGER(kind=LFIINT), INTENT(OUT) :: KTOTAL -INTEGER(kind=LFIINT), INTENT(OUT) :: KRESP +TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD +INTEGER, INTENT(IN) :: KLENG +INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE,INTENT(INOUT) :: KWORK +INTEGER(kind=LFIINT), INTENT(OUT) :: KTOTAL +INTEGER(kind=LFIINT), INTENT(OUT) :: KRESP ! INTEGER :: ICOMLEN INTEGER :: J @@ -971,12 +971,12 @@ END SUBROUTINE WRITE_PREPARE ! SUBROUTINE TRANSFER_R_I8(PFIELDIN,KFIELDOUT) ! -REAL,DIMENSION(:), INTENT(IN) :: PFIELDIN -INTEGER(KIND=8),DIMENSION(:),INTENT(OUT) :: KFIELDOUT +REAL,DIMENSION(:), INTENT(IN) :: PFIELDIN +INTEGER(KIND=MNHINT64),DIMENSION(:),INTENT(OUT) :: KFIELDOUT ! INTEGER :: ILENG #if (MNH_REAL == 4) -REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: ZFIELD8 +REAL(KIND=MNHREAL64),DIMENSION(:),ALLOCATABLE :: ZFIELD8 #endif ! ILENG = SIZE(PFIELDIN) @@ -985,7 +985,7 @@ ILENG = SIZE(PFIELDIN) KFIELDOUT(:) = TRANSFER(PFIELDIN,KFIELDOUT(1),ILENG) #else ALLOCATE(ZFIELD8(ILENG)) - ZFIELD8(:) = REAL(PFIELDIN(:),KIND=8) + ZFIELD8(:) = REAL(PFIELDIN(:),KIND=MNHREAL64) KFIELDOUT(:) = TRANSFER(ZFIELD8,KFIELDOUT(1),ILENG) DEALLOCATE(ZFIELD8) #endif diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 index cc24abb6fb9727634dcf7b04dfc413c34ba28049..53053069c936e71c6df416594babe000686782a7 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 @@ -35,7 +35,7 @@ module mode_io_write_nc4 use modd_field, only: tfielddata use modd_io, only: gsmonoproc, tfiledata use modd_parameters, only: NMNHNAMELGTMAX -use modd_precision, only: CDFINT, MNHINT_NF90, MNHREAL_MPI, MNHREAL_NF90 +use modd_precision, only: CDFINT, MNHINT_NF90, MNHREAL32, MNHREAL_MPI, MNHREAL_NF90 use mode_io_tools_nc4, only: IO_Mnhname_clean, IO_Vdims_fill_nc4, IO_Dim_find_create_nc4, IO_Strdimid_get_nc4, IO_Err_handle_nc4 use mode_msg @@ -340,7 +340,7 @@ IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN ! * it cannot be modified if some data has already been written (->check OEXISTED) IF(.NOT.OEXISTED) THEN IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN - istatus = NF90_PUT_ATT(INCID, KVARID,'_FillValue', REAL(TPFIELD%XFILLVALUE,KIND=4)) + istatus = NF90_PUT_ATT(INCID, KVARID,'_FillValue', REAL(TPFIELD%XFILLVALUE,KIND=MNHREAL32)) ELSE istatus = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%XFILLVALUE) END IF @@ -349,14 +349,14 @@ IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN ! ! Valid_min/max (CF/COMODO convention) IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN - istatus = NF90_PUT_ATT(INCID, KVARID,'valid_min', REAL(TPFIELD%XVALIDMIN,KIND=4)) + istatus = NF90_PUT_ATT(INCID, KVARID,'valid_min', REAL(TPFIELD%XVALIDMIN,KIND=MNHREAL32)) ELSE istatus = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%XVALIDMIN) END IF IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_min') ! IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN - istatus = NF90_PUT_ATT(INCID, KVARID,'valid_max', REAL(TPFIELD%XVALIDMAX,KIND=4)) + istatus = NF90_PUT_ATT(INCID, KVARID,'valid_max', REAL(TPFIELD%XVALIDMAX,KIND=MNHREAL32)) ELSE istatus = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%XVALIDMAX) END IF diff --git a/src/LIB/SURCOUCHE/src/mode_mppdb.f90 b/src/LIB/SURCOUCHE/src/mode_mppdb.f90 index cc3b67c97202e5cde8110d15df720aa5355eacf9..e696435f6a2afcc9dfd1d86d31625cfd57e446d4 100644 --- a/src/LIB/SURCOUCHE/src/mode_mppdb.f90 +++ b/src/LIB/SURCOUCHE/src/mode_mppdb.f90 @@ -49,6 +49,7 @@ MODULE MODE_MPPDB REAL :: PRECISION = 1e-8 * 0.0 LOGICAL :: MPPDB_CHECK_LB = .FALSE. + LOGICAL :: MPPDB_ACTIVED = .FALSE. CONTAINS @@ -92,6 +93,7 @@ CONTAINS IF (MPPDB_INITIALIZED) RETURN ! MPPDB_INITIALIZED = .TRUE. + MPPDB_ACTIVED = .TRUE. ! ! Init MPI ! @@ -251,8 +253,28 @@ CONTAINS END SUBROUTINE MPPDB_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE MPPDB_START_DEBUG() + IMPLICIT NONE + MPPDB_ACTIVED = .TRUE. + END SUBROUTINE MPPDB_START_DEBUG !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - + SUBROUTINE MPPDB_STOP_DEBUG() + IMPLICIT NONE + MPPDB_ACTIVED = .FALSE. + END SUBROUTINE MPPDB_STOP_DEBUG +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE MPPDB_GET_ACTIVED(OACTIVE) + IMPLICIT NONE + LOGICAL , INTENT(OUT) :: OACTIVE + OACTIVE = MPPDB_ACTIVED + END SUBROUTINE MPPDB_GET_ACTIVED +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE MPPDB_SET_ACTIVED(OACTIVE) + IMPLICIT NONE + LOGICAL , INTENT(IN) :: OACTIVE + MPPDB_ACTIVED = OACTIVE + END SUBROUTINE MPPDB_SET_ACTIVED +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE MPPDB_BARRIER() #ifdef MNH_SP4 !pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ... @@ -263,7 +285,7 @@ CONTAINS ! ! synchronize all father & sons ! - IF ( .NOT. MPPDB_INITIALIZED ) RETURN + IF (( .NOT. MPPDB_INITIALIZED ) .OR. ( .NOT. MPPDB_ACTIVED )) RETURN ! CALL MPI_BARRIER(MPPDB_INTRA_COMM,IERR) ! @@ -279,6 +301,7 @@ CONTAINS use modd_precision, only: MNHINT_MPI, MNHREAL_MPI USE MODD_MPIF , ONLY : MPI_STATUS_IGNORE, MPI_SUM USE MODE_GATHER_ll + USE MODE_MODELN_HANDLER, ONLY : GET_CURRENT_MODEL_INDEX IMPLICIT NONE @@ -310,12 +333,13 @@ CONTAINS INTEGER :: IIU_SON_ll,IJU_SON_ll,IKU_SON_ll INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll INTEGER :: IHEXT_SON_ll , IDIFF_HEXT + INTEGER :: IMI #ifdef MNH_SP4 !pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ... RETURN #else - IF ( ( .NOT. MPPDB_INITIALIZED ) ) RETURN + IF ( ( .NOT. MPPDB_INITIALIZED ) .OR. ( .NOT. MPPDB_ACTIVED ) ) RETURN !get the global size of PTAB CALL MPI_ALLREDUCE(SIZE(PTAB), IGLBSIZEPTAB, 1,MNHINT_MPI, MPI_SUM, MPPDB_INTER_COMM, IINFO_ll) IF ( IGLBSIZEPTAB == 0 ) RETURN @@ -386,10 +410,13 @@ CONTAINS MAX_DIFF=MAXVAL(TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)/MAX_VAL) TAB_INTERIOR_ll=> TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll) ! + IMI = GET_CURRENT_MODEL_INDEX() IF (MAX_DIFF > PRECISION ) THEN - write(6, '(" MPPDB_CHECK3D :: PB MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL + write(6, '(" MPPDB_CHECK3D :: PB MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8," IMI=",I3.3)' ) & + MESSAGE,MAX_DIFF , MAX_VAL, IMI ELSE - write(6, '(" MPPDB_CHECK3D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL + write(6, '(" MPPDB_CHECK3D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8," IMI=",I3.3)' ) & + MESSAGE,MAX_DIFF , MAX_VAL, IMI END IF flush(unit=OUTPUT_UNIT) ! @@ -475,7 +502,8 @@ CONTAINS USE MODD_MPIF , ONLY : MPI_STATUS_IGNORE, MPI_SUM use modd_precision, only: MNHINT_MPI, MNHREAL_MPI - USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD + USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD + USE MODE_MODELN_HANDLER, ONLY : GET_CURRENT_MODEL_INDEX IMPLICIT NONE @@ -504,12 +532,13 @@ CONTAINS INTEGER :: IIU_SON_ll,IJU_SON_ll INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll INTEGER :: IHEXT_SON_ll , IDIFF_HEXT + INTEGER :: IMI #ifdef MNH_SP4 !pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ... RETURN #else - IF ( ( .NOT. MPPDB_INITIALIZED ) ) RETURN + IF ( ( .NOT. MPPDB_INITIALIZED ) .OR. ( .NOT. MPPDB_ACTIVED ) ) RETURN CALL MPI_ALLREDUCE(SIZE(PTAB), IGLBSIZEPTAB, 1,MNHINT_MPI, MPI_SUM, MPPDB_INTRA_COMM, IINFO_ll) IF ( IGLBSIZEPTAB == 0 ) RETURN @@ -573,10 +602,14 @@ CONTAINS IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0 MAX_DIFF = MAXVAL( TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IIB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT) / MAX_VAL ) TAB_INTERIOR_ll => TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IIB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT) + ! + IMI = GET_CURRENT_MODEL_INDEX() IF (MAX_DIFF > PRECISION ) THEN - write(6, '(" MPPDB_CHECK2D :: PB MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL + write(6, '(" MPPDB_CHECK2D :: PB MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8," IMI=",I3.3)' ) & + MESSAGE,MAX_DIFF , MAX_VAL , IMI ELSE - write(6, '(" MPPDB_CHECK2D :: OK MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL + write(6, '(" MPPDB_CHECK2D :: OK MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8," IMI=",I3.3)' ) & + MESSAGE,MAX_DIFF , MAX_VAL , IMI END IF flush(unit=OUTPUT_UNIT) ! @@ -619,14 +652,16 @@ CONTAINS SUBROUTINE MPPDB_CHECKLB(PLB,MESSAGE,PRECISION,HLBTYPE,KRIM) - USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, L2D, LPACK - USE MODD_MPIF, ONLY: MPI_STATUS_IGNORE - USE MODD_PARAMETERS_ll, ONLY: JPHEXT - USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD - use modd_precision, only: MNHINT_MPI, MNHREAL_MPI + USE MODD_PARAMETERS_ll, ONLY : JPHEXT + USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD + USE MODD_IO , ONLY : ISP,ISNPROC,GSMONOPROC,LPACK,L2D + USE MODD_MPIF , ONLY : MPI_STATUS_IGNORE, MPI_SUM USE MODE_DISTRIB_LB - + USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll + USE MODE_MODELN_HANDLER, ONLY : GET_CURRENT_MODEL_INDEX + use modd_precision, only: MNHINT_MPI, MNHREAL_MPI + IMPLICIT NONE REAL, DIMENSION(:,:,:) , TARGET :: PLB @@ -657,14 +692,18 @@ CONTAINS INTEGER :: IIU_SON_ll,IJU_SON_ll,IKU_SON_ll INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll INTEGER :: IHEXT_SON_ll , IDIFF_HEXT , IRIM_ll , IRIM_SON_ll + INTEGER :: IMI , IGLBSIZEPTAB #ifdef MNH_SP4 !pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ... RETURN #else - IF ( .NOT. MPPDB_INITIALIZED ) RETURN + IF ( ( .NOT. MPPDB_INITIALIZED ) .OR. ( .NOT. MPPDB_ACTIVED ) ) RETURN + !get the global size of PLB + CALL MPI_ALLREDUCE(SIZE(PLB), IGLBSIZEPTAB, 1,MNHINT_MPI, MPI_SUM, MPPDB_INTER_COMM, IINFO_ll) + IF ( IGLBSIZEPTAB == 0 ) RETURN ! - CALL MPPDB_BARRIER() + CALL MPPDB_BARRIER() ! IF(MPPDB_FATHER_WORLD) THEN ! @@ -674,26 +713,30 @@ CONTAINS IIU_ll = IIMAX_ll+2*JPHEXT IJU_ll = IJMAX_ll+2*JPHEXT IKU_ll = SIZE(PLB,3) - IRIM_ll = (KRIM+JPHEXT)*2 - - IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN - IIU_ll = IRIM_ll - ELSE - IJU_ll = IRIM_ll + IRIM_ll = MAX(1,KRIM) + + IF (HLBTYPE == 'LBX' ) THEN + IIU_ll = JPHEXT*2 + ELSE IF ( HLBTYPE == 'LBXU') THEN + IIU_ll = (IRIM_ll+JPHEXT)*2 + ELSE IF ( HLBTYPE == 'LBY') THEN + IJU_ll = JPHEXT*2 + ELSE IF ( HLBTYPE == 'LBYV') THEN + IJU_ll = (IRIM_ll+JPHEXT)*2 END IF IF (MPPDB_IRANK_WORLD.EQ.0) THEN ! I/O proc case ALLOCATE(Z3D(IIU_ll,IJU_ll,SIZE(PLB,3))) DO JI = 1,ISNPROC - CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','WRITE',KRIM,IIB,IIE,IJB,IJE) + CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','WRITE',IRIM_ll,IIB,IIE,IJB,IJE) IF (IIB /= 0) THEN TX3DP=>Z3D(IIB:IIE,IJB:IJE,:) IF (ISP /= JI) THEN CALL MPI_RECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1 & ,99,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll) ELSE - CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE) + CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',IRIM_ll,IIB,IIE,IJB,IJE) TX3DP = PLB(IIB:IIE,IJB:IJE,:) END IF END IF @@ -703,7 +746,7 @@ CONTAINS ELSE ! Other processors - CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE) + CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','WRITE',IRIM_ll,IIB,IIE,IJB,IJE) IF (IIB /= 0) THEN TX3DP=>PLB(IIB:IIE,IJB:IJE,:) CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,0,99,NMNH_COMM_WORLD,IINFO_ll) @@ -727,12 +770,16 @@ CONTAINS IIU_SON_ll = IIMAX_ll+2*IHEXT_SON_ll IJU_SON_ll = IJMAX_ll+2*IHEXT_SON_ll IKU_SON_ll = SIZE(PLB,3) - IRIM_SON_ll = (KRIM+IHEXT_SON_ll)*2 + IRIM_SON_ll = MAX(1,KRIM) ! - IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN - IIU_SON_ll = IRIM_SON_ll - ELSE - IJU_SON_ll = IRIM_SON_ll + IF (HLBTYPE == 'LBX' ) THEN + IIU_SON_ll = IHEXT_SON_ll*2 + ELSE IF ( HLBTYPE == 'LBXU') THEN + IIU_SON_ll = (IRIM_SON_ll+IHEXT_SON_ll)*2 + ELSE IF ( HLBTYPE == 'LBY') THEN + IJU_SON_ll = IHEXT_SON_ll*2 + ELSE IF ( HLBTYPE == 'LBYV') THEN + IJU_SON_ll = (IRIM_SON_ll+IHEXT_SON_ll)*2 END IF ! ALLOCATE(TAB_SON_ll(IIU_SON_ll,IJU_SON_ll,IKU_SON_ll)) @@ -765,13 +812,16 @@ CONTAINS IJB_SON_ll-IDIFF_HEXT:IJE_SON_ll+IDIFF_HEXT,1:IKU_SON_ll) ) ) IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0 ! + IMI = GET_CURRENT_MODEL_INDEX() MAX_DIFF=MAXVAL(Z3D(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)/MAX_VAL) TAB_INTERIOR_ll=> Z3D(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll) ! IF (MAX_DIFF > PRECISION ) THEN - print*," MPPDB_CHECKLB :: PB MPPDB_CHECKLB =", MESSAGE ," ERROR=",MAX_DIFF , MAX_VAL + write(6, '(" MPPDB_CHECKLB :: PB MPPDB_CHECKLB =",A40," ERROR=",e15.8," MAXVAL=",e15.8," IMI=",I3.3)' ) & + MESSAGE ,MAX_DIFF , MAX_VAL , IMI ELSE - print*," MPPDB_CHECKLB :: OK MPPDB_CHECKLB =", MESSAGE ," ERROR=",MAX_DIFF , MAX_VAL + write(6, '(" MPPDB_CHECKLB :: OK MPPDB_CHECKLB =",A40," ERROR=",e15.8," MAXVAL=",e15.8," IMI=",I3.3)' ) & + MESSAGE ,MAX_DIFF , MAX_VAL , IMI END IF flush(unit=OUTPUT_UNIT) ! @@ -831,7 +881,7 @@ CONTAINS INTEGER :: KSIZE INTEGER :: KSIZE_FULL ! - IF ( ( .NOT. MPPDB_INITIALIZED ) ) RETURN + IF ( ( .NOT. MPPDB_INITIALIZED ) .OR. ( .NOT. MPPDB_ACTIVED ) ) RETURN ! ! IF ( SIZE(PTAB) == 0 ) THEN ! ALLOCATE(ZFIELD2D(0,0)) @@ -935,7 +985,7 @@ CONTAINS INTEGER :: IINFO_ll INTEGER :: IKSIZE_ll ! - IF ( ( .NOT. MPPDB_INITIALIZED ) ) RETURN + IF ( ( .NOT. MPPDB_INITIALIZED ) .OR. ( .NOT. MPPDB_ACTIVED ) ) RETURN CALL MPI_ALLREDUCE(SIZE(PTAB), IGLBSIZEPTAB, 1,MNHINT_MPI, MPI_SUM, MPPDB_INTRA_COMM, IINFO_ll) IF ( IGLBSIZEPTAB == 0 ) RETURN CALL MPI_ALLREDUCE(SIZE(PTAB,2),IKSIZE_ll, 1, MNHINT_MPI, MPI_MAX, MPPDB_INTRA_COMM, IINFO_ll) diff --git a/src/MNH/aircraft_balloon_evol.f90 b/src/MNH/aircraft_balloon_evol.f90 index 9642bcc4e8de8a731373a2db1fc3b94934abb8ce..aa0a13bf2ffc514375f355960a1fe6d750e5d481 100644 --- a/src/MNH/aircraft_balloon_evol.f90 +++ b/src/MNH/aircraft_balloon_evol.f90 @@ -144,15 +144,17 @@ USE MODD_NSV, ONLY : NSV_LIMA_NI,NSV_LIMA_NR,NSV_LIMA_NC USE MODD_PARAMETERS USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,& XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,& - XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC + XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC,LSNOW_T_L=>LSNOW_T USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,& XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,& - XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS + XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS, & + XLBDAS_MAX,XLBDAS_MIN USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,& XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XAR_L=>XAR,& XBC_L=>XBC,XAC_L=>XAC USE MODD_PARAM_n, ONLY: CCLOUD, CSURF +USE MODD_PARAM_ICE, ONLY: LSNOW_T_I=>LSNOW_T USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEXR,& XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XAR_I=>XAR,& XALPHAC_I=>XALPHAC,XNUC_I=>XNUC,& @@ -318,6 +320,7 @@ REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! tem REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays INTEGER :: JPTS_GAULAG=7 ! number of points for Gauss-Laguerre quadrature REAL :: ZLBDA ! slope distribution parameter +REAL :: ZN ! number concentration REAL :: ZFRAC_ICE ! ice water fraction REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point REAL :: ZFW ! liquid fraction @@ -1177,7 +1180,18 @@ IF ( TPFLYER%FLY) THEN ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ENDIF END SELECT - ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX + IF (JLOOP.EQ.5 .AND. ( (CCLOUD=='LIMA'.AND.LSNOW_T_L).OR. & + (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) ) THEN + IF (ZTEMPZ(JK)>-10.) THEN + ZLBDA = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*(ZTEMPZ(JK)+273.15))),XLBDAS_MIN) + ELSE + ZLBDA = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*(ZTEMPZ(JK)+273.15))),XLBDAS_MIN) + END IF + ZN=XLBS_L*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB + ELSE + ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX + ZN=ZCC*ZLBDA**ZCX + END IF ZREFLOC=0. ZAETMP=0. DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature @@ -1209,8 +1223,8 @@ IF ( TPFLYER%FLY) THEN ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ) ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ) END DO - ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZCC*ZLBDA**ZCX/(4.*GAMMA(ZNU)*.93) - ZAETMP=ZAETMP * XPI *ZCC*ZLBDA**ZCX/(4.*GAMMA(ZNU)) + ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93) + ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU)) TPFLYER%CRARE(IN,JK)=TPFLYER%CRARE(IN,JK)+ZREFLOC ZAELOC(JK)=ZAELOC(JK)+ZAETMP END IF diff --git a/src/MNH/ares.f b/src/MNH/ares.fx90 similarity index 98% rename from src/MNH/ares.f rename to src/MNH/ares.fx90 index 3fd41e2b9bac4782d0b53f6df1eb606206cf6c31..88f5e5d29428bce1433119715c84ce0bc7ff8e58 100644 --- a/src/MNH/ares.f +++ b/src/MNH/ares.fx90 @@ -1,4 +1,4 @@ -!MNH_LIC Copyright 1987-2019 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 1987-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 for details. version 1. @@ -833,11 +833,8 @@ C.................................................................... C...........PARAMETERS and their descriptions: - INTEGER NCAT ! number of cations - PARAMETER ( NCAT = 2 ) - - INTEGER NAN ! number of anions - PARAMETER ( NAN = 3 ) + INTEGER, PARAMETER :: NCAT = 2 ! number of cations + INTEGER, PARAMETER :: NAN = 3 ! number of anions C...........ARGUMENTS and their descriptions @@ -1071,12 +1068,14 @@ C /////////////////////////////////// C *** C234567 subroutine cubic(a2,a1,a0,nr,crutes) + use modd_precision, only: MNHREAL64 implicit none integer nr real a2,a1,a0,crutes(3) - real*8 qq,rr,a2sq,theta, sqrt3, one3rd - real*8 dum1,dum2,part1,part2,part3,rrsq,phi,yy1,yy2,yy3 - real*8 costh, sinth + real(kind=MNHREAL64) qq,rr,a2sq,theta, sqrt3, one3rd + real(kind=MNHREAL64) dum1,dum2,part1,part2,part3,rrsq,phi + real(kind=MNHREAL64) yy1,yy2,yy3 + real(kind=MNHREAL64) costh, sinth data sqrt3/1.732050808/, one3rd/0.333333333/ a2sq=a2*a2 qq=(a2sq-3.*a1)/9. @@ -1372,16 +1371,32 @@ c and the excess ammonium forms ammonum nitrate end if c return - end + end subroutine awater c23456789012345678901234567890123456789012345678901234567890123456789012 + MODULE MODI_poly4 + INTERFACE + function poly4(A,X) + real A(4), X + end function poly4 + END INTERFACE + END MODULE MODI_poly4 + function poly4(A,X) real poly4 real A(4), X poly4 = A(1) + X * ( A(2) + X * ( A(3) + X * ( A(4) ))) - return - end + return + end function poly4 + + MODULE MODI_poly6 + INTERFACE + function poly6(A,X) + real A(6), X + end function poly6 + END INTERFACE + END MODULE MODI_poly6 function poly6(A,X) real poly6 @@ -1389,5 +1404,5 @@ c23456789012345678901234567890123456789012345678901234567890123456789012 poly6 = A(1) + X * ( A(2) + X * ( A(3) + X * ( A(4) + & X * ( A(5) + X * (A(6) ))))) return - end ! awater + end function poly6 c ////////////////////////////////////////////////////////////////// diff --git a/src/MNH/boundaries.f90 b/src/MNH/boundaries.f90 index 046a28af303cc6401540b799ad74289b7794fb3d..1b73df6c2d508cc3eb67c3af1c1ea3f1314660b8 100644 --- a/src/MNH/boundaries.f90 +++ b/src/MNH/boundaries.f90 @@ -199,6 +199,7 @@ USE MODD_PARAMETERS USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, LBOUND, LWARM, LCOLD USE MODD_PARAM_n, ONLY : CELEC,CCLOUD USE MODD_PASPOL, ONLY : LPASPOL +USE MODD_PRECISION, ONLY: MNHREAL32 USE MODD_REF_n USE MODD_SALT, ONLY : LSALT @@ -420,6 +421,24 @@ ELSE ! END IF ! +! ============================================================ +! +! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result +! +ZLBXVT(:,:,:) = real(ZLBXVT(:,:,:),kind=MNHREAL32) +ZLBXWT(:,:,:) = real(ZLBXWT(:,:,:),kind=MNHREAL32) +ZLBXTHT(:,:,:) = real(ZLBXTHT(:,:,:),kind=MNHREAL32) +IF ( SIZE(PTKET,1) /= 0 ) THEN + ZLBXTKET(:,:,:) = real(ZLBXTKET(:,:,:),kind=MNHREAL32) +END IF +IF ( KRR > 0) THEN + ZLBXRT(:,:,:,:) = real(ZLBXRT(:,:,:,:),kind=MNHREAL32) +END IF +IF ( KSV > 0) THEN + ZLBXSVT(:,:,:,:) = real(ZLBXSVT(:,:,:,:),kind=MNHREAL32) +END IF +! ============================================================ +! IF ( SIZE(PLBYTHS,1) /= 0 .AND. & ( HLBCY(1)=='OPEN' .OR. HLBCY(2)=='OPEN' )) THEN ZLBYUT(:,:,:) = PLBYUM(:,:,:) + ZTSTEP * PLBYUS(:,:,:) @@ -453,6 +472,24 @@ ELSE END IF ! ! +! ============================================================ +! +! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result +! +ZLBYUT(:,:,:) = real(ZLBYUT(:,:,:),kind=MNHREAL32) +ZLBYWT(:,:,:) = real(ZLBYWT(:,:,:),kind=MNHREAL32) +ZLBYTHT(:,:,:) = real(ZLBYTHT(:,:,:),kind=MNHREAL32) +IF ( SIZE(PTKET,1) /= 0 ) THEN + ZLBYTKET(:,:,:) = real(ZLBYTKET(:,:,:),kind=MNHREAL32) +END IF +IF ( KRR > 0) THEN + ZLBYRT(:,:,:,:) = real(ZLBYRT(:,:,:,:),kind=MNHREAL32) +END IF +IF ( KSV > 0) THEN + ZLBYSVT(:,:,:,:) = real(ZLBYSVT(:,:,:,:),kind=MNHREAL32) +END IF +! ============================================================ +! !------------------------------------------------------------------------------- ! PONDERATION COEFF for Non-Normal velocities and pot temperature ! diff --git a/src/MNH/budget.f90 b/src/MNH/budget.f90 index 13c746c4344cd996220e6905df3e2020bbf2fab9..5e7dd0809c8f6296aca79452016cafe437950254 100644 --- a/src/MNH/budget.f90 +++ b/src/MNH/budget.f90 @@ -7,6 +7,7 @@ ! P. Wautelet 28/01/2020: new subroutines: Budget_store_init, Budget_store_end and Budget_source_id_find in new module mode_budget ! P. Wautelet 17/08/2020: treat LES budgets correctly ! P. Wautelet 05/03/2021: measure cpu_time for budgets +! J.Escobar : 06/10/2021 :for bit reproductiblity use MPPDB_CHECK if LCHECK=T !----------------------------------------------------------------- !################# @@ -36,6 +37,8 @@ contains subroutine Budget_store_init( tpbudget, hsource, pvars ) use modd_les, only: lles_call + USE MODE_MPPDB + USE MODD_CONF, ONLY : LCHECK type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure character(len=*), intent(in) :: hsource ! Name of the source term @@ -43,7 +46,15 @@ subroutine Budget_store_init( tpbudget, hsource, pvars ) integer :: iid ! Reference number of the current source term - call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_init', trim( tpbudget%cname )//':'//trim( hsource ) ) + character(len=:),allocatable :: hbudget + + hbudget = trim( tpbudget%cname )//':'//trim( hsource ) + + IF (LCHECK) THEN + CALL MPPDB_CHECK3D(PVARS,'BUD_INI::'//hbudget,PRECISION) + END IF + + call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_init', hbudget ) if ( lles_call ) then call Second_mnh( ztime1 ) @@ -112,6 +123,8 @@ subroutine Budget_store_init( tpbudget, hsource, pvars ) subroutine Budget_store_end( tpbudget, hsource, pvars ) use modd_les, only: lles_call + USE MODE_MPPDB + USE MODD_CONF, ONLY : LCHECK use modi_les_budget, only: Les_budget @@ -123,7 +136,14 @@ subroutine Budget_store_end( tpbudget, hsource, pvars ) integer :: igroup ! Number of the group where to store the source term real, dimension(:,:,:), allocatable :: zvars_add - call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_end', trim( tpbudget%cname )//':'//trim( hsource ) ) + character(len=:),allocatable :: hbudget + + hbudget = trim( tpbudget%cname )//':'//trim( hsource ) + + IF (LCHECK) THEN + CALL MPPDB_CHECK3D(PVARS,'BUD_END::'//hbudget,PRECISION) + END IF + call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_end', hbudget ) if ( lles_call ) then if ( hsource /= tpbudget%clessource ) & diff --git a/src/MNH/compute_bl89_ml.f90 b/src/MNH/compute_bl89_ml.f90 index 20c9a078db5e550dbf3bb03cd2fcc6b13ddc89a5..b2df24bd9b4d00d0e37550e347af3dcef9fc3abf 100644 --- a/src/MNH/compute_bl89_ml.f90 +++ b/src/MNH/compute_bl89_ml.f90 @@ -1,4 +1,4 @@ -!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 2006-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 for details. version 1. @@ -57,6 +57,7 @@ END MODULE MODI_COMPUTE_BL89_ML !! R.Honnert Oct 2016 : Update with AROME !! Q.Rodier 01/2019 : support RM17 mixing length as in bl89.f90 ! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg +! P. Wautelet 17/12/2021: bugfix: KK instead of JKK !! !------------------------------------------------------------------------------- ! @@ -162,9 +163,9 @@ IF (OUPORDN.EQV..TRUE.) THEN ! Lenght travelled by parcel to nullify energy ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * & ( ZHLVPT(J1D,KK) - ZVPT_DEP(J1D) ) & - - XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) & + - XRM17*PSHEAR(J1D,KK)*sqrt(abs(PTKEM_DEP(J1D))) & + SQRT (ABS( & - (XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + & + (XRM17*PSHEAR(J1D,KK)*sqrt(abs(PTKEM_DEP(J1D))) + & PG_O_THVREF(J1D) * (ZHLVPT(J1D,KK) - ZVPT_DEP(J1D)) )**2 & + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) & * ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )) ) / & diff --git a/src/MNH/compute_entr_detr.f90 b/src/MNH/compute_entr_detr.f90 index 80a9d68db57ef58f31574c47e144887ab441ce7a..004f706a183ee10d37a85b4fcd79fa78d801209f 100644 --- a/src/MNH/compute_entr_detr.f90 +++ b/src/MNH/compute_entr_detr.f90 @@ -122,6 +122,7 @@ END MODULE MODI_COMPUTE_ENTR_DETR !! R.Honnert Oct 2016 : Update with AROME ! P. Wautelet 08/02/2019: bugfix: compute ZEPSI_CLOUD only once and only when it is needed ! P. Wautelet 10/02/2021: bugfix: initialized PPART_DRY everywhere +! M. Mandement 24/01/2022:bugfix: init of theta_l in mixtures was too low (0.1K) !! -------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -232,7 +233,7 @@ INTEGER :: JI,JLOOP ZFRAC_ICE(:)=PFRAC_ICE(:) ! to not modify fraction of ice ZPRE(:)=PPRE_MINUS_HALF(:) - ZMIXTHL(:)=0.1 + ZMIXTHL(:)=300.0 ZMIXRT(:)=0.1 !Initialize PPART_DRY everywhere to prevent access to non-initialized values diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90 index 3b0b4673893c19604b474aa94d5979f9d97c7b50..f73c628c8730c1f457010036351ef1b7263477b3 100644 --- a/src/MNH/deallocate_model1.f90 +++ b/src/MNH/deallocate_model1.f90 @@ -198,6 +198,10 @@ IF ( ASSOCIATED(XCLDFR) .AND. KCALL==2 ) THEN DEALLOCATE(XCLDFR) END IF ! +IF ( ASSOCIATED(XICEFR) .AND. KCALL==2 ) THEN + DEALLOCATE(XICEFR) +END IF +! IF ( ASSOCIATED(XRAINFR) .AND. KCALL==2 ) THEN DEALLOCATE(XRAINFR) END IF diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90 index 8324b19c679c3742d0f6e031920810107f840163..f11672ace69e60ffc7f4acb39b5655b6081e5a47 100644 --- a/src/MNH/default_desfmn.f90 +++ b/src/MNH/default_desfmn.f90 @@ -220,6 +220,7 @@ END MODULE MODI_DEFAULT_DESFM_n ! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC ! Q. Rodier 07/2021: modify XPOND=1 ! C. Barthe 03/2022: add CIBU and RDSF options in LIMA +! Delbeke/Vie 03/2022 : KHKO option in LIMA !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -275,12 +276,12 @@ USE MODD_ALLSTATION_n ! ! USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS, & - NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, & + NMOD_IFN, NMOM_I, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, & CINT_MIXING, NMOD_IMM, NIND_SPECIE, & - CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, & + YSNOW_T=>LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, & XFACTNUC_DEP, XFACTNUC_CON, & OWARM=>LWARM, LACTI, ORAIN=>LRAIN, OSEDC=>LSEDC, & - OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, & + OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, LKHKO, & NMOD_CCN, XCCN_CONC, & LCCN_HOM, CCCN_MODES, & YALPHAR=>XALPHAR, YNUR=>XNUR, & @@ -873,7 +874,8 @@ IF (KMI == 1) THEN CFRAC_ICE_SHALLOW_MF = 'S' LSEDIM_AFTER = .FALSE. LDEPOSC = .FALSE. - XVDEPOSC= 0.02 ! 2 cm/s + XVDEPOSC= 0.02 ! 2 cm/s + LSNOW_T=.FALSE. END IF ! !------------------------------------------------------------------------------- @@ -974,13 +976,13 @@ ENDIF !* 19.BIS SET DEFAULT VALUES FOR MODD_PARAM_LIMA : ! ---------------------------------------- ! -LPTSPLIT = .FALSE. -L_LFEEDBACKT = .TRUE. -L_NMAXITER = 1 -L_XMRSTEP = 0. -L_XTSTEP_TS = 0. -! IF (KMI == 1) THEN + LPTSPLIT = .FALSE. + L_LFEEDBACKT = .TRUE. + L_NMAXITER = 1 + L_XMRSTEP = 0. + L_XTSTEP_TS = 0. +! YNUC = 1.0 YALPHAC = 3.0 YNUR = 2.0 @@ -993,6 +995,7 @@ IF (KMI == 1) THEN OACTIT = .FALSE. LADJ = .TRUE. LSPRO = .FALSE. + LKHKO = .FALSE. ODEPOC = .FALSE. LBOUND = .FALSE. OACTTKE = .TRUE. @@ -1019,19 +1022,19 @@ IF (KMI == 1) THEN LCCN_HOM = .TRUE. CCCN_MODES = 'COPT' XCCN_CONC(:)=300. -ENDIF -! -IF (KMI == 1) THEN + LHHONI = .FALSE. LCOLD = .TRUE. LNUCL = .TRUE. LSEDI = .TRUE. LSNOW = .TRUE. LHAIL = .FALSE. + YSNOW_T = .TRUE. CPRISTINE_ICE_LIMA = 'PLAT' CHEVRIMED_ICE_LIMA = 'GRAU' XFACTNUC_DEP = 1.0 XFACTNUC_CON = 1.0 + NMOM_I = 2 NMOD_IFN = 1 NIND_SPECIE = 1 LMEYERS = .FALSE. diff --git a/src/MNH/endstep_budget.f90 b/src/MNH/endstep_budget.f90 index eef2796be9394b7317e9bd82c6a46ff3d417a344..947c0770403adadd9a59248a206102c50046cca6 100644 --- a/src/MNH/endstep_budget.f90 +++ b/src/MNH/endstep_budget.f90 @@ -105,7 +105,6 @@ integer :: jbu, jgrp ! call Print_msg( NVERB_DEBUG, 'BUD', 'Endstep_budget', 'called' ) -!Do not call Write_budget at the beginning of the simulation (this is necessary in the case were xbulen = xtstep) IF ( KTCOUNT == 1 ) RETURN SELECT CASE(CBUTYPE) diff --git a/src/MNH/eol_alm.f90 b/src/MNH/eol_alm.f90 index 6dc910246b490c4ad23ad58b3233bb75e4fe07f9..ab533254e9d4fb65551a4d269e29cef05f3eae1e 100644 --- a/src/MNH/eol_alm.f90 +++ b/src/MNH/eol_alm.f90 @@ -74,7 +74,7 @@ END MODULE MODI_EOL_ALM !! ------------- !! Original 24/01/17 !! Modification 14/10/20 (PA. Joulin) Updated for a main version -!! +! P. Wautelet 23/07/2021: replace non-standard FLOAT function by REAL function !!--------------------------------------------------------------- ! ! @@ -408,22 +408,22 @@ DO KTSUBCOUNT=1,INBSUBCOUNT ZFAERO_RG(:) = MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:), ZFAERO_RE(:)) ! !* 4.11 Adding it to the cell of Meso-NH - PFX_RG(JI,JJ,JK) = PFX_RG(JI,JJ,JK) + ZFAERO_RG(1) / FLOAT(INBSUBCOUNT) - PFY_RG(JI,JJ,JK) = PFY_RG(JI,JJ,JK) + ZFAERO_RG(2) / FLOAT(INBSUBCOUNT) - PFZ_RG(JI,JJ,JK) = PFZ_RG(JI,JJ,JK) + ZFAERO_RG(3) / FLOAT(INBSUBCOUNT) + PFX_RG(JI,JJ,JK) = PFX_RG(JI,JJ,JK) + ZFAERO_RG(1) / REAL(INBSUBCOUNT) + PFY_RG(JI,JJ,JK) = PFY_RG(JI,JJ,JK) + ZFAERO_RG(2) / REAL(INBSUBCOUNT) + PFZ_RG(JI,JJ,JK) = PFZ_RG(JI,JJ,JK) + ZFAERO_RG(3) / REAL(INBSUBCOUNT) ! !* 4.12 Storing mean values over one full MNH timestep ! (all the sub-timesteps values are averaged) ZAOA_ATS(JROT,JBLA,JBELT) = ZAOA_ATS(JROT,JBLA,JBELT) & - + ZAOA / FLOAT(INBSUBCOUNT) + + ZAOA / REAL(INBSUBCOUNT) ZFLIFT_ATS(JROT,JBLA,JBELT) = ZFLIFT_ATS(JROT,JBLA,JBELT) & - + ZFLIFT / FLOAT(INBSUBCOUNT) + + ZFLIFT / REAL(INBSUBCOUNT) ZFDRAG_ATS(JROT,JBLA,JBELT) = ZFDRAG_ATS(JROT,JBLA,JBELT) & - + ZFDRAG / FLOAT(INBSUBCOUNT) + + ZFDRAG / REAL(INBSUBCOUNT) ZFAERO_RE_ATS(JROT,JBLA,JBELT,:)= ZFAERO_RE_ATS(JROT,JBLA,JBELT,:) & - + ZFAERO_RE(:) / FLOAT(INBSUBCOUNT) + + ZFAERO_RE(:) / REAL(INBSUBCOUNT) ZFAERO_RG_ATS(JROT,JBLA,JBELT,:)= ZFAERO_RG_ATS(JROT,JBLA,JBELT,:) & - + ZFAERO_RG(:) / FLOAT(INBSUBCOUNT) + + ZFAERO_RG(:) / REAL(INBSUBCOUNT) ! ! End of position tests END IF diff --git a/src/MNH/ibm_prep_ls.f90 b/src/MNH/ibm_prep_ls.f90 index bb3ae049b3716b925ea93dbcaca6877ab669290b..f4929d7c343c647a33c965e837459e7cf3cbb72b 100644 --- a/src/MNH/ibm_prep_ls.f90 +++ b/src/MNH/ibm_prep_ls.f90 @@ -81,7 +81,7 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI) ! MODIFICATIONS ! ------------- ! Original 01/06/2021 - ! + ! P. Wautelet 23/07/2021: replace non-standard FLOAT function by REAL function !------------------------------------------------------------------------------ ! !**** 0. DECLARATIONS @@ -367,7 +367,7 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI) DO JN=1,IIBM_NUMB_TYPE_SURF ! READ(UNIT=ILUIBMIDEA,FMT=*) IIBM_TYPE_SURF, IIBM_NUMB_SURF - ZIBM_TYPE_SURF= float(IIBM_TYPE_SURF) + ZIBM_TYPE_SURF= REAL(IIBM_TYPE_SURF) ! DO JM=1,IIBM_NUMB_SURF ! diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90 index b84dda857e7a679561f062eabbe0570f7fc22408..0f7dea2179ad05277f16065f54b35c893dbb4deb 100644 --- a/src/MNH/ice4_fast_rg.f90 +++ b/src/MNH/ice4_fast_rg.f90 @@ -94,6 +94,7 @@ SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, & !! ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function ! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support) +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! ! !* 0. DECLARATIONS @@ -337,10 +338,10 @@ ELSE WHERE(GDRY(:)) PRG_TEND(:, IRSWETG)=XFSDRYG*ZZW(:) & ! RSDRYG / XCOLSG & - *(PLBDAS(:)**(XCXS-XBS))*( PLBDAG(:)**XCXG ) & - *(PRHODREF(:)**(-XCEXVT-1.)) & - *( XLBSDRYG1/( PLBDAG(:)**2 ) + & - XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + & + *(PRST(:))*( PLBDAG(:)**XCXG ) & + *(PRHODREF(:)**(-XCEXVT)) & + *( XLBSDRYG1/( PLBDAG(:)**2 ) + & ! Il s'agit de moments (?) + XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + & XLBSDRYG3/( PLBDAS(:)**2)) PRG_TEND(:, IRSDRYG)=PRG_TEND(:, IRSWETG)*XCOLSG*EXP(XCOLEXSG*(PT(:)-XTT)) END WHERE diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90 index fcac937485414ba29fd691cb0774a32cb3ea4a3c..a21c85f19308cffede426f7b2510f52ef5cd447a 100644 --- a/src/MNH/ice4_fast_rh.f90 +++ b/src/MNH/ice4_fast_rh.f90 @@ -84,6 +84,7 @@ SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, & !! ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function ! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support) +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! ! !* 0. DECLARATIONS @@ -269,9 +270,9 @@ ELSE END DO ! WHERE(GWET(:)) - PRH_TEND(:, IRSWETH)=XFSWETH*ZZW(:) & ! RSWETH - *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) & - *( PRHODREF(:)**(-XCEXVT-1.) ) & + PRH_TEND(:, IRSWETH)=XFSWETH*ZZW(:) & + *( PRST(:))*( PLBDAH(:)**XCXH ) & + *( PRHODREF(:)**(-XCEXVT) ) & *( XLBSWETH1/( PLBDAH(:)**2 ) + & XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + & XLBSWETH3/( PLBDAS(:)**2) ) diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90 index 6d71c7b61b8188969aa488a3b22d65ad15d7cc26..11dbd67f50ac67a9fc97f9d7f145ba85541a6e4c 100644 --- a/src/MNH/ice4_fast_rs.f90 +++ b/src/MNH/ice4_fast_rs.f90 @@ -77,6 +77,7 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, & !! ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function ! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support) +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! ! !* 0. DECLARATIONS @@ -85,7 +86,7 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, & USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT, & XEPSILO USE MODD_PARAM_ICE, ONLY: LEVLIMIT, CSNOWRIMING -USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXS,XRTMIN +USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXS,XRTMIN,XALPHAS,XNUS,XFVELOS USE MODD_RAIN_ICE_PARAM, ONLY: NACCLBDAR,NACCLBDAS,NGAMINC,X0DEPS,X1DEPS,XACCINTP1R,XACCINTP1S,XACCINTP2R,XACCINTP2S, & XCRIMSG,XCRIMSS,XEX0DEPS,XEX1DEPS,XEXCRIMSG,XEXCRIMSS,XEXSRIMCG,XEXSRIMCG2,XFRACCSS, & XFSACCRG,XFSCVMG,XGAMINC_RIM1,XGAMINC_RIM1,XGAMINC_RIM2,XGAMINC_RIM4,XKER_RACCS, & @@ -170,9 +171,10 @@ ELSE PRS_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + & (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) & *(XESTT-PRS_TEND(:, IFREEZ1))/(XRV*PT(:)) ) - PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* ( X0DEPS* PLBDAS(:)**XEX0DEPS + & - X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )/ & - ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) + PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* PRST(:) * ( X0DEPS* PLBDAS(:)**XEX0DEPS + & + X1DEPS*PCJ(:)*PLBDAS(:) **(XBS+XEX1DEPS)* & + (1+(XFVELOS/(2*PLBDAS(:)))**XALPHAS)**(-XNUS+XEX1DEPS/XALPHAS))/ & + ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) PRS_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / & ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) END WHERE @@ -218,7 +220,7 @@ ELSE ! 5.1.1 select the PLBDAS ! DO JJ = 1, IGRIM - ZVEC1(JJ) = PLBDAS(I1(JJ)) + ZVEC1(JJ) = (PLBDAS(I1(JJ))**XALPHAS + XFVELOS**XALPHAS)**(1./XALPHAS) END DO ! ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical @@ -244,8 +246,9 @@ ELSE ! WHERE (GRIM(:)) PRS_TEND(:, IRCRIMSS) = XCRIMSS * ZZW(:) * PRCT(:) & ! RCRIMSS - * PLBDAS(:)**XEXCRIMSS & - * PRHODREF(:)**(-XCEXVT) + * PRST(:)*(1+(XFVELOS/PLBDAS(:))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) & + * PRHODREF(:)**(-XCEXVT+1.) & + * (PLBDAS(:)) ** (XEXCRIMSS+XBS) END WHERE ! ! 5.1.5 perform the linear interpolation of the normalized @@ -270,19 +273,21 @@ ELSE ! ! WHERE(GRIM(:)) - PRS_TEND(:, IRCRIMS)=XCRIMSG * PRCT(:) & ! RCRIMS - * PLBDAS(:)**XEXCRIMSG & - * PRHODREF(:)**(-XCEXVT) + PRS_TEND(:, IRCRIMS) = XCRIMSG * PRCT(:) & ! RCRIMS + * PRST(:)*(1+(XFVELOS/PLBDAS(:))**(XALPHAS))**(-XNUS+XEXCRIMSG/XALPHAS) & + * PRHODREF(:)**(-XCEXVT+1.) & + * PLBDAS(:)**(XBS+XEXCRIMSG) ZZW6(:) = PRS_TEND(:, IRCRIMS) - PRS_TEND(:, IRCRIMSS) ! RCRIMSG END WHERE IF(CSNOWRIMING=='M90 ')THEN !Murakami 1990 WHERE(GRIM(:)) - PRS_TEND(:, IRSRIMCG)=XSRIMCG * PLBDAS(:)**XEXSRIMCG*(1.0-ZZW(:)) + PRS_TEND(:, IRSRIMCG)=XSRIMCG * PRST(:)*PRHODREF(:)*PLBDAS(:)**(XEXSRIMCG+XBS)*(1.0-ZZW(:)) + PRS_TEND(:, IRSRIMCG)=ZZW6(:)*PRS_TEND(:, IRSRIMCG)/ & MAX(1.E-20, & - XSRIMCG3*XSRIMCG2*PLBDAS(:)**XEXSRIMCG2*(1.-ZZW2(:)) - & + XSRIMCG3*XSRIMCG2*PRST(:)*PRHODREF(:)*PLBDAS(:)**XEXSRIMCG2*(1.-ZZW2(:)) - & XSRIMCG3*PRS_TEND(:, IRSRIMCG)) END WHERE ELSE @@ -384,7 +389,7 @@ ELSE ! WHERE(GACC(:)) ZZW6(:) = & !! coef of RRACCS - XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) & + XFRACCSS*( PRST(:)*PLBDAS(:)**XBS )*( PRHODREF(:)**(-XCEXVT) ) & *( XLBRACCS1/((PLBDAS(:)**2) ) + & XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + & XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**4 @@ -430,7 +435,7 @@ ELSE ! WHERE(GACC(:)) PRS_TEND(:, IRSACCRG) = XFSACCRG*ZZW(:)* & ! RSACCRG - ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) & + ( PRST(:))*( PRHODREF(:)**(-XCEXVT) ) & *( XLBSACCR1/((PLBDAR(:)**2) ) + & XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + & XLBSACCR3/( (PLBDAS(:)**2)) )/PLBDAR(:) @@ -496,11 +501,16 @@ ELSE ! compute RSMLT ! PRSMLTG(:) = XFSCVMG*MAX( 0.0,( -PRSMLTG(:) * & - ( X0DEPS* PLBDAS(:)**XEX0DEPS + & - X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - & - ( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS) ) * & - ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / & - ( PRHODREF(:)*XLMTT ) ) + PRST(:)*PRHODREF(:) * & + ( X0DEPS *PLBDAS(:)**XEX0DEPS + & + X1DEPS*PCJ(:)*(1+(XFVELOS/(2*PLBDAS(:))**XALPHAS))**(XNUS+XEX1DEPS/XALPHAS)*((PLBDAS(:))**(XBS+XEX1DEPS))) - & + ( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS)) * & + ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / & + ( PRHODREF(:)*XLMTT ) ) + ! + ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT) + ! because the graupeln produced by this process are still icy!!! + ! ! When T < XTT, rc is collected by snow (riming) to produce snow and graupel ! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting) ! To insure consistency when crossing T=XTT, rc collected with T>XTT must be transformed in rain. diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90 index cf88792b1b42827bdce381c4e2ad5644b3fed376..d250ddc0e38953cbec90d1615655ba1eb291b313 100644 --- a/src/MNH/ice4_rsrimcg_old.f90 +++ b/src/MNH/ice4_rsrimcg_old.f90 @@ -44,6 +44,7 @@ SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, & !! ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function ! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support) +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! ! !* 0. DECLARATIONS @@ -132,7 +133,7 @@ IF(.NOT. ODSOFT) THEN ! WHERE(GRIM(:)) PRSRIMCG_MR(:) = XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG - * (1.0 - ZZW(:) )/PRHODREF(:) + * (1.0 - ZZW(:) )*PRST(:) PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:)) END WHERE END IF diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90 index cb0a147d070b865e8e9391bacf7ef143c3727311..f9369a8783af23ad117f46ab51489a44afad0436 100644 --- a/src/MNH/ice4_sedimentation_split.f90 +++ b/src/MNH/ice4_sedimentation_split.f90 @@ -6,11 +6,12 @@ MODULE MODI_ICE4_SEDIMENTATION_SPLIT INTERFACE SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & - &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & - &PRHODREF, PPABST, PTHT, PRHODJ, & - &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& - &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & - &PSEA, PTOWN, & + &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + & PLBDAS, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT, & + &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & + &PSEA, PTOWN, & &PINPRH, PRHT, PRHS, PFPR) IMPLICIT NONE INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT @@ -25,6 +26,7 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference den REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source @@ -51,11 +53,12 @@ END SUBROUTINE ICE4_SEDIMENTATION_SPLIT END INTERFACE END MODULE MODI_ICE4_SEDIMENTATION_SPLIT SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & - &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & - &PRHODREF, PPABST, PTHT, PRHODJ, & - &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& - &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & - &PSEA, PTOWN, & + &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + & PLBDAS, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT, & + &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & + &PSEA, PTOWN, & &PINPRH, PRHT, PRHS, PFPR) !! !!** PURPOSE @@ -72,6 +75,7 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB !! ! P. Wautelet 11/02/2019: dimensions of PINPRC and PINDEP not necessarily KIT,KJT ! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! ! !* 0. DECLARATIONS @@ -102,6 +106,7 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference den REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source @@ -239,6 +244,7 @@ IF (GSEDIC) THEN &XSPLIT_MAXCFL, & &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & &2, & + &PLBDAS, & &ZRCT, PRCS, PINPRC, ZPRCS, & &ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR) ENDIF @@ -265,8 +271,9 @@ END IF &XSPLIT_MAXCFL, & &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & &3, & + &PLBDAS, & &ZRRT, PRRS, PINPRR, ZPRRS, & - PFPR=PFPR) + &PFPR=PFPR) ! !* 2.3 for pristine ice ! @@ -274,6 +281,7 @@ END IF &XSPLIT_MAXCFL, & &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & &4, & + &PLBDAS, & &ZRIT, PRIS, PINPRI, ZPRIS, & PFPR=PFPR) ! @@ -283,6 +291,7 @@ END IF &XSPLIT_MAXCFL, & &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & &5, & + &PLBDAS, & &ZRST, PRSS, PINPRS, ZPRSS, & PFPR=PFPR) ! @@ -292,6 +301,7 @@ END IF &XSPLIT_MAXCFL, & &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & &6, & + &PLBDAS, & &ZRGT, PRGS, PINPRG, ZPRGS, & PFPR=PFPR) ! @@ -302,6 +312,7 @@ IF (IRR==7) THEN &XSPLIT_MAXCFL, & &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & &7, & + &PLBDAS, & &ZRHT, PRHS, PINPRH, ZPRHS, & PFPR=PFPR) ENDIF @@ -315,15 +326,16 @@ CONTAINS ! SUBROUTINE INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT,KKB,KKTB,KKTE,KKT,KKL,KRR, & &PMAXCFL,PRHODREF,POORHODZ,PDZZ,PPABST,PTHT,PTSTEP, & - &KSPE,PRXT,PRXS,PINPRX,PPRXS, & + &KSPE,PLBDAS,PRXT,PRXS,PINPRX,PPRXS, & &PRAY,PLBC,PFSEDC,PCONC3D,PFPR) ! !* 0. DECLARATIONS ! ------------ ! USE MODD_CST, ONLY: XCPD,XP00,XRD -USE MODD_RAIN_ICE_DESCR, ONLY: XCC,XCEXVT,XDC,XLBEXC,XRTMIN +USE MODD_RAIN_ICE_DESCR, ONLY: XCC,XCEXVT,XDC,XLBEXC,XRTMIN,XALPHAS,XNUS,XBS,XFVELOS USE MODD_RAIN_ICE_PARAM, ONLY: XEXCSEDI,XEXSEDG,XEXSEDH,XEXSEDR,XEXSEDS,XFSEDG,XFSEDH,XFSEDI,XFSEDR,XFSEDS + ! IMPLICIT NONE ! @@ -344,6 +356,7 @@ REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRX ! instant precip REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPRXS ! external tendencie REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D REAL, DIMENSION(KIT,KJT,KKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air precipitation fluxes + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow ! Modif Wurtz ! !* 0.2 declaration of local variables ! @@ -433,15 +446,30 @@ DO WHILE (ANY(ZREMAINT>0.)) & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI ENDIF ENDDO + ELSEIF(KSPE==5) THEN + ! ******* for snow + ZWSED(:,:,:) = 0. + DO JL=1, ISEDIM + JI=I1(JL) + JJ=I2(JL) + JK=I3(JL) + IF(PRXT(JI,JJ,JK)> XRTMIN(KSPE)) THEN + + ZWSED(JI, JJ, JK) = XFSEDS * & + & PRXT(JI,JJ,JK)* & + & PRHODREF(JI,JJ,JK)**(1-XCEXVT) * & + & (1 + (XFVELOS/PLBDAS(JI, JJ, JK))**XALPHAS)** (-XNUS+XEXSEDS/XALPHAS) * & + & PLBDAS(JI, JJ, JK) ** (XBS+XEXSEDS) + ! GAMMAGEN_LH_EXTENDED + + ENDIF + ENDDO ELSE ! ******* for other species SELECT CASE(KSPE) CASE(3) ZFSED=XFSEDR ZEXSED=XEXSEDR - CASE(5) - ZFSED=XFSEDS - ZEXSED=XEXSEDS CASE(6) ZFSED=XFSEDG ZEXSED=XEXSEDG diff --git a/src/MNH/ice4_sedimentation_stat.f90 b/src/MNH/ice4_sedimentation_stat.f90 index 3cbb31493eac8295e718f2e1438e4e3a269520e7..891223920fd73ea2bbbeed059ce1669aeebd2d51 100644 --- a/src/MNH/ice4_sedimentation_stat.f90 +++ b/src/MNH/ice4_sedimentation_stat.f90 @@ -8,6 +8,7 @@ INTERFACE SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + & PLBDAS, & &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT,& &PRSS, PRST, PRGS, PRGT,& &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & @@ -26,6 +27,7 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference den REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source @@ -54,6 +56,7 @@ END MODULE MODI_ICE4_SEDIMENTATION_STAT SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + & PLBDAS, & &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, & &PRSS, PRST, PRGS, PRGT,& &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & @@ -75,6 +78,7 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, ! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg ! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90 ! P. Wautelet 21/01/2021: initialize untouched part of PFPR +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! ! !* 0. DECLARATIONS @@ -83,7 +87,8 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, USE MODD_CST USE MODE_MSG - +USE MODD_RAIN_ICE_DESCR +! IMPLICIT NONE ! !* 0.1 Declarations of dummy arguments : @@ -100,6 +105,7 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference den REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source @@ -160,6 +166,7 @@ IF (OSEDIC) THEN CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & &2, & + &PLBDAS, &!Modif Wurtz &PRCT, PRCS, ZWSED, PSEA, PTOWN) IF (PRESENT(PFPR)) THEN DO JK = KKTB , KKTE @@ -187,6 +194,7 @@ END IF CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & &3, & + &PLBDAS, & &PRRT, PRRS, ZWSED) IF (PRESENT(PFPR)) THEN DO JK = KKTB , KKTE @@ -200,6 +208,7 @@ PINPRR(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & &4, & + &PLBDAS, & &PRIT, PRIS, ZWSED) IF (PRESENT(PFPR)) THEN DO JK = KKTB , KKTE @@ -213,6 +222,7 @@ PINPRI(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & &5, & + &PLBDAS, & &PRST, PRSS, ZWSED) IF (PRESENT(PFPR)) THEN DO JK = KKTB , KKTE @@ -226,6 +236,7 @@ PINPRS(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & &6, & + &PLBDAS, & &PRGT, PRGS, ZWSED) IF (PRESENT(PFPR)) THEN DO JK = KKTB , KKTE @@ -240,6 +251,7 @@ IF ( KRR == 7 ) THEN CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & &7, & + &PLBDAS, & &PRHT, PRHS, ZWSED) IF (PRESENT(PFPR)) THEN DO JK = KKTB , KKTE @@ -254,6 +266,7 @@ CONTAINS SUBROUTINE INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & &PRHODREF, PDZZ, PTSORHODZ, PPABST, PTHT, PTSTEP, & &KSPE, & + &PLBDAS, & &PRXT, PRXS, PWSED, PSEA, PTOWN) ! !* 0. DECLARATIONS @@ -272,6 +285,7 @@ CONTAINS ! INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKT, KKE, KKTB, KKTE, KKL REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTSORHODZ ! TimeStep Over (Rhodref times delta Z) REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST @@ -386,14 +400,34 @@ CONTAINS & ALOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) )**XEXCSEDI ENDIF ENDDO + + ELSEIF(KSPE==5) THEN + ! ******* for snow + DO JL=1, JCOUNT + JI=I1(JL) + JJ=I2(JL) + !calculation of w + + IF(PRXT(JI,JJ,JK) > XRTMIN(KSPE)) THEN + ZWSEDW1(JI,JJ,JK)= XFSEDS * & + & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & + & (1+(XFVELOS/PLBDAS(JI,JJ,JK))**XALPHAS)**(-XNUS+XEXSEDS/XALPHAS) * & + & PLBDAS(JI,JJ,JK)**(XBS+XEXSEDS) + ENDIF + IF ( ZQP(JI,JJ) > XRTMIN(KSPE)) THEN + ZWSEDW2(JI,JJ,JK)= XFSEDS * & + & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & + & (1+(XFVELOS/PLBDAS(JI,JJ,JK))**XALPHAS)**(-XNUS+XEXSEDS/XALPHAS) * & + & PLBDAS(JI,JJ,JK)**(XBS+XEXSEDS) + + ENDIF + ENDDO + ELSE ! ******* for other species IF(KSPE==3) THEN ZFSED=XFSEDR ZEXSED=XEXSEDR - ELSEIF(KSPE==5) THEN - ZFSED=XFSEDS - ZEXSED=XEXSEDS ELSEIF(KSPE==6) THEN ZFSED=XFSEDG ZEXSED=XEXSEDG diff --git a/src/MNH/ice4_slow.f90 b/src/MNH/ice4_slow.f90 index 15d0cd78e495cb255015fb6ed29fbfdb5361c748..e08dd1e77adff5823c7c2cb6404cfc1162d39af4 100644 --- a/src/MNH/ice4_slow.f90 +++ b/src/MNH/ice4_slow.f90 @@ -65,13 +65,14 @@ SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, & !! MODIFICATIONS !! ------------- !! +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! ! !* 0. DECLARATIONS ! ------------ ! USE MODD_CST, ONLY: XTT -USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN +USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN,XALPHAS,XNUS,XBS,XFVELOS USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPG,X0DEPS,X1DEPG,X1DEPS,XACRIAUTI,XALPHA3,XBCRIAUTI,XBETA3,XCOLEXIS,XCRIAUTI, & XEX0DEPG,XEX0DEPS,XEX1DEPG,XEX1DEPS,XEXIAGGS,XFIAGGS,XHON,XTEXAUTI,XTIMAUTI ! @@ -173,8 +174,9 @@ IF(LDSOFT) THEN ELSE PRVDEPS(:) = 0. WHERE(ZMASK(:)==1.) - PRVDEPS(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * & - ( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) + PRVDEPS(:) = ( PRST(:)*PSSI(:)/PAI(:)) * & + ( X0DEPS*PLBDAS(:)**XEX0DEPS + (X1DEPS*PCJ(:)*(1+(PLBDAS(:)/(2*XFVELOS)**XALPHAS))**(-XNUS+XEX1DEPS) & + *(PLBDAS(:))**(XBS+XEX1DEPS))) END WHERE ENDIF DO JL=1, KSIZE @@ -197,10 +199,11 @@ IF(LDSOFT) THEN ELSE PRIAGGS(:) = 0. WHERE(ZMASK(:)==1) - PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) & + PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) & * PRIT(:) & - * PLBDAS(:)**XEXIAGGS & - * PRHODREF(:)**(-XCEXVT) + * PRST(:) * (1+(XFVELOS/PLBDAS(:))**XALPHAS)**(-XNUS+XEXIAGGS/XALPHAS) & + * PRHODREF(:)**(-XCEXVT+1.) & + * ((PLBDAS(:))**(XBS+XEXIAGGS)) END WHERE ENDIF DO JL=1, KSIZE diff --git a/src/MNH/ice4_tendencies.f90 b/src/MNH/ice4_tendencies.f90 index 49cd599235d8a67c664bd2710e7864adc0a82123..ec33e100cfc60bec6ad576d781283372e52c165f 100644 --- a/src/MNH/ice4_tendencies.f90 +++ b/src/MNH/ice4_tendencies.f90 @@ -174,14 +174,16 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K !! ------------- ! ! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support) +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! ! !* 0. DECLARATIONS ! ------------ ! USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XEPSILO,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT -USE MODD_PARAM_ICE, ONLY: CSNOWRIMING -USE MODD_RAIN_ICE_DESCR, ONLY: XLBDAS_MAX,XLBEXG,XLBEXH,XLBEXR,XLBEXS,XLBG,XLBH,XLBR,XLBS,XRTMIN +USE MODD_PARAM_ICE, ONLY: CSNOWRIMING,LSNOW_T +USE MODD_RAIN_ICE_DESCR, ONLY: XLBDAS_MIN,XLBDAS_MAX,XLBEXG,XLBEXH,XLBEXR,XLBEXS,& + XLBG,XLBH,XLBR,XLBS,XRTMIN,XTRANS_MP_GAMMAS USE MODD_RAIN_ICE_PARAM, ONLY: XSCFAC ! USE MODI_ICE4_COMPUTE_PDF @@ -400,21 +402,28 @@ ELSE ! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation) ! IF(CSNOWRIMING=='OLD ') THEN - ZLBDAS(:)=0. - WHERE(ZRST(:)>0.) - ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS) - END WHERE - CALL ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, PCOMPUTE==1., & - &PRHODREF, & - &ZLBDAS, & - &ZT, ZRCT, ZRST, & - &PRSRIMCG_MR, PB_RS, PB_RG) - DO JL=1, KSIZE - ZRST(JL) = ZRST(JL) - PRSRIMCG_MR(JL) - ZRGT(JL) = ZRGT(JL) + PRSRIMCG_MR(JL) - ENDDO + ZLBDAS(:)=0. + IF (LSNOW_T) THEN + WHERE (ZRST(:)>XRTMIN(5) .AND. ZT(:)>263.15) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZT(:))),XLBDAS_MIN)*XTRANS_MP_GAMMAS + END WHERE + WHERE (ZRST(:)>XRTMIN(5) .AND. ZT(:)<=263.15) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZT(:))),XLBDAS_MIN)*XTRANS_MP_GAMMAS + END WHERE + ELSE + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX,XLBS*(PRHODREF(:)*ZRST(:))**XLBEXS),XLBDAS_MIN) + END IF + CALL ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, PCOMPUTE==1., & + &PRHODREF, & + &ZLBDAS, & + &ZT, ZRCT, ZRST, & + &PRSRIMCG_MR, PB_RS, PB_RG) + DO JL=1, KSIZE + ZRST(JL) = ZRST(JL) - PRSRIMCG_MR(JL) + ZRGT(JL) = ZRGT(JL) + PRSRIMCG_MR(JL) + ENDDO ELSE - PRSRIMCG_MR(:) = 0. + PRSRIMCG_MR(:) = 0. ENDIF ENDIF ! @@ -470,9 +479,16 @@ IF(KSIZE>0) THEN !* compute the slope parameters ! ZLBDAS(:)=0. - WHERE(ZRST(:)>0.) - ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS) - END WHERE + IF (LSNOW_T) THEN + WHERE (ZRST(:)>XRTMIN(5) .AND. ZT(:)>263.15) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZT(:))),XLBDAS_MIN)*XTRANS_MP_GAMMAS + END WHERE + WHERE (ZRST(:)>XRTMIN(5) .AND. ZT(:)<=263.15) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZT(:))),XLBDAS_MIN)*XTRANS_MP_GAMMAS + END WHERE + ELSE + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX,XLBS*(PRHODREF(:)*ZRST(:))**XLBEXS),XLBDAS_MIN) + END IF ZLBDAG(:)=0. WHERE(ZRGT(:)>0.) ZLBDAG(:) = XLBG*(PRHODREF(:)*MAX(ZRGT(:), XRTMIN(6)))**XLBEXG diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90 index 20cdbb4a448a63d2de3d2e65f37efd5c87973d16..569ef6392258a2132feab0797bef1fbe2decde71 100644 --- a/src/MNH/ini_budget.f90 +++ b/src/MNH/ini_budget.f90 @@ -525,7 +525,6 @@ if ( lbu_rth .or. lbu_rtke .or. lbu_rrv .or. lbu_rrc .or. lbu_rrr .or. & tburhodj%xdata(:, :, :) = 0. end if - tzsource%ntype = TYPEREAL tzsource%ndims = 3 @@ -4099,31 +4098,6 @@ SV_BUDGETS: do jsv = 1, ksv end if end do SV_BUDGETS -IF (CBUTYPE=='CART') THEN - WRITE(UNIT=KLUOUT, FMT= '(2/,"DESCRIPTION OF THE BUDGET BOX")' ) - WRITE(UNIT=KLUOUT, FMT= '("BUIL = ",I4.4)' ) NBUIL - WRITE(UNIT=KLUOUT, FMT= '("BUIH = ",I4.4)' ) NBUIH - WRITE(UNIT=KLUOUT, FMT= '("BUJL = ",I4.4)' ) NBUJL - WRITE(UNIT=KLUOUT, FMT= '("BUJH = ",I4.4)' ) NBUJH - WRITE(UNIT=KLUOUT, FMT= '("BUKL = ",I4.4)' ) NBUKL - WRITE(UNIT=KLUOUT, FMT= '("BUKH = ",I4.4)' ) NBUKH - WRITE(UNIT=KLUOUT, FMT= '("BUIMAX = ",I4.4)' ) NBUIMAX - WRITE(UNIT=KLUOUT, FMT= '("BUJMAX = ",I4.4)' ) NBUJMAX - WRITE(UNIT=KLUOUT, FMT= '("BUKMAX = ",I4.4)' ) NBUKMAX -END IF -IF (CBUTYPE=='MASK') THEN - WRITE(UNIT=KLUOUT, FMT= '(2/,"DESCRIPTION OF THE BUDGET MASK")' ) - WRITE(UNIT=KLUOUT, FMT= '("BUIL = ",I4.4)' ) NBUIL - WRITE(UNIT=KLUOUT, FMT= '("BUIH = ",I4.4)' ) NBUIH - WRITE(UNIT=KLUOUT, FMT= '("BUJL = ",I4.4)' ) NBUJL - WRITE(UNIT=KLUOUT, FMT= '("BUJH = ",I4.4)' ) NBUJH - WRITE(UNIT=KLUOUT, FMT= '("BUKL = ",I4.4)' ) NBUKL - WRITE(UNIT=KLUOUT, FMT= '("BUKH = ",I4.4)' ) NBUKH - WRITE(UNIT=KLUOUT, FMT= '("BUKMAX = ",I4.4)' ) NBUKMAX - WRITE(UNIT=KLUOUT, FMT= '("BUSUBWRITE = ",I4.4)' ) NBUSUBWRITE - WRITE(UNIT=KLUOUT, FMT= '("BUMASK = ",I4.4)' ) NBUMASK -END IF - call Ini_budget_groups( tbudgets, ibudim1, ibudim2, ibudim3 ) if ( tbudgets(NBUDGET_U) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_U), cbulist_ru ) diff --git a/src/MNH/ini_ice_c1r3.f90 b/src/MNH/ini_ice_c1r3.f90 index b0a35554a88837b36dc5ae44119426abe6a482a6..d04e1335813234391e13b0504dda31e1a8abeac8 100644 --- a/src/MNH/ini_ice_c1r3.f90 +++ b/src/MNH/ini_ice_c1r3.f90 @@ -90,6 +90,7 @@ END MODULE MODI_INI_ICE_C1R3 !! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O ! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -109,6 +110,8 @@ USE MODD_REF ! use mode_msg ! +USE MODD_RAIN_ICE_DESCR, ONLY : XFVELOS +! USE MODI_GAMMA USE MODI_GAMMA_INC USE MODI_READ_XKER_RACCS @@ -725,15 +728,15 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. & (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & + ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS ) CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & + ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, 0., & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_RACCS ) CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBS, XCS, XDS, XCR, XDR, & + ZESR, XBS, XCS, XDS, XFVELOS, XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS ) WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') @@ -938,7 +941,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. & (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, & - ZEGS, XBS, XCG, XDG, XCS, XDS, & + ZEGS, XBS, XCG, XDG, 0., XCS, XDS, XFVELOS, & XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, & ZFDINFTY, XKER_SDRYG ) WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') @@ -1004,7 +1007,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. & (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, & - ZEGR, XBR, XCG, XDG, XCR, XDR, & + ZEGR, XBR, XCG, XDG, 0., XCR, XDR, 0., & XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, & ZFDINFTY, XKER_RDRYG ) WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') diff --git a/src/MNH/ini_lb.f90 b/src/MNH/ini_lb.f90 index e72201af013cf0a26cdca9a75b012bce38f9dfb4..054d5f50f820b58ba72a593a6c0b91591a6eda3b 100644 --- a/src/MNH/ini_lb.f90 +++ b/src/MNH/ini_lb.f90 @@ -685,7 +685,6 @@ IF (CCLOUD=='LIMA' ) THEN TZFIELD%LTIMEDEP = .TRUE. ! DO JSV = NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 - SELECT CASE(HGETSVM(JSV)) CASE ('READ') WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1) @@ -694,7 +693,6 @@ IF (CCLOUD=='LIMA' ) THEN .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN - !TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE ELSE TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE @@ -715,15 +713,12 @@ IF (CCLOUD=='LIMA' ) THEN END IF END IF END IF - - ! IF (KSIZELBYSV_ll /= 0 ) THEN IF ( TPINIFILE%NMNHVERSION(1) < 5 & .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN - ! TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE ELSE TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE @@ -769,7 +764,6 @@ IF (CCLOUD=='LIMA' ) THEN .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN - !TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE ELSE TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE @@ -796,7 +790,6 @@ IF (CCLOUD=='LIMA' ) THEN .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN - !TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE ELSE TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE @@ -1667,6 +1660,5 @@ IF (OLSOURCE) THEN END DO ! ENDIF - ! END SUBROUTINE INI_LB diff --git a/src/MNH/ini_lesn.f90 b/src/MNH/ini_lesn.f90 index 45d7b9f9ac85e947fda34a09e56fe335c79d1d1c..406ee30a2feac649f7b708aa132f538ed52288b0 100644 --- a/src/MNH/ini_lesn.f90 +++ b/src/MNH/ini_lesn.f90 @@ -543,8 +543,10 @@ ELSE END IF IF (LUSERI ) THEN ALLOCATE(XLES_MEAN_Ri (NLES_K,NLES_TIMES,NLES_MASKS)) + ALLOCATE(XLES_MEAN_If (NLES_K,NLES_TIMES,NLES_MASKS)) ELSE ALLOCATE(XLES_MEAN_Ri (0,0,0)) + ALLOCATE(XLES_MEAN_If (0,0,0)) END IF IF (LUSERS ) THEN ALLOCATE(XLES_MEAN_Rs (NLES_K,NLES_TIMES,NLES_MASKS)) @@ -650,6 +652,7 @@ IF (LUSERC ) XLES_MEAN_INDCf = XUNDEF IF (LUSERC ) XLES_MEAN_INDCf2 = XUNDEF IF (LUSERR ) XLES_MEAN_Rr = XUNDEF IF (LUSERI ) XLES_MEAN_Ri = XUNDEF +IF (LUSERI ) XLES_MEAN_If = XUNDEF IF (LUSERS ) XLES_MEAN_Rs = XUNDEF IF (LUSERG ) XLES_MEAN_Rg = XUNDEF IF (LUSERH ) XLES_MEAN_Rh = XUNDEF diff --git a/src/MNH/ini_lima_cold_mixed.f90 b/src/MNH/ini_lima_cold_mixed.f90 index bd43aa295823c10b581ef8be3be4ce60cf820525..23b533c92556247cc4d6279b1412762d152acd47 100644 --- a/src/MNH/ini_lima_cold_mixed.f90 +++ b/src/MNH/ini_lima_cold_mixed.f90 @@ -42,6 +42,7 @@ END MODULE MODI_INI_LIMA_COLD_MIXED ! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function ! C. Barthe 14/03/2022: add CIBU and RDSF +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -186,12 +187,27 @@ XF1IS = 0.28 ! XAS = 0.02 XBS = 1.9 + +IF (LSNOW_T) THEN +!Cas Gamma generalisee +XCS = 11.52 +XDS = 0.39 +XFVELOS =0.097 +!Cas MP +!XCS = 13.2 +!XDS = 0.423 +!XFVELOS = 25.14 +ELSE XCS = 5. XDS = 0.27 -! -XCCS = 5.0 -XCXS = 1.0 -! +XFVELOS = 0. +END IF + +IF (.NOT. LSNOW_T) THEN + XCCS = 5.0 + XCXS = 1.0 +END IF + XF0S = 0.86 XF1S = 0.28 ! @@ -249,8 +265,17 @@ XC1H = 1./2. XALPHAI = 3.0 ! Gamma law for the ice crystal volume XNUI = 3.0 ! Gamma law with little dispersion ! -XALPHAS = 1.0 ! Exponential law -XNUS = 1.0 ! Exponential law +IF (LSNOW_T) THEN +!Cas GAMMAGEN + XALPHAS = .214 ! Generalized gamma law + XNUS = 43.7 ! Generalized gamma law + XTRANS_MP_GAMMAS = SQRT( ( GAMMA(XNUS + 2./XALPHAS)*GAMMA(XNUS + 4./XALPHAS) ) / & + ( 8.* GAMMA(XNUS + 1./XALPHAS)*GAMMA(XNUS + 3./XALPHAS) ) ) +ELSE + XALPHAS = 1.0 ! Exponential law + XNUS = 1.0 ! Exponential law + XTRANS_MP_GAMMAS = 1. +END IF ! XALPHAG = 1.0 ! Exponential law XNUG = 1.0 ! Exponential law @@ -263,8 +288,13 @@ XNUH = 8.0 ! Gamma law with little dispersion XLBEXI = 1.0/XBI XLBI = XAI*MOMG(XALPHAI,XNUI,XBI) ! -XLBEXS = 1.0/(XCXS-XBS) -XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS) +IF (LSNOW_T) THEN + XLBEXS = 0. ! Not used + XLBS = 1.0/(XAS*MOMG(XALPHAS,XNUS,XBS)) +ELSE + XLBEXS = 1.0/(XCXS-XBS) + XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS) +END IF ! XLBEXG = 1.0/(XCXG-XBG) XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG) @@ -281,7 +311,8 @@ IF (GFLAG) THEN WRITE(UNIT=ILUOUT0,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH END IF ! -XLBDAS_MAX = 500000 +XLBDAS_MAX = 500000. ! LBDAS_MAX doit être compare avec LBDAS avec une forme de Marshall-Palmer +XLBDAS_MIN = 1000. XLBDAG_MAX = 100000.0 ! ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc @@ -327,9 +358,20 @@ XFSEDRI = XC_I*GAMMA_X0D(XNUI+(XDI+XBI)/XALPHAI)/GAMMA_X0D(XNUI+XBI/XALPHAI)* XFSEDCI = XC_I*GAMMA_X0D(XNUI+XDI/XALPHAI)/GAMMA_X0D(XNUI)* & (ZRHO00)**XCEXVT ! -XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS) -XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* & +IF (LSNOW_T) THEN +!HOUZE/HAIC + !XEXSEDS = -XDS !(2*XBS+XDS) + !XFSEDS = XCS*MOMG(XALPHAS,XNUS,XBS+XDS)/(MOMG(XALPHAS,XNUS,XBS)) & + ! *(ZRHO00)**XCEXVT +!LH_EXTENDED + XEXSEDS = -XDS-XBS + XFSEDS = XCS*MOMG(XALPHAS,XNUS,XBS+XDS)/(MOMG(XALPHAS,XNUS,XBS)) & + *(ZRHO00)**XCEXVT +ELSE + XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS) + XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* & (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT +END IF ! XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG) XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* & @@ -339,8 +381,6 @@ XEXSEDH = (XBH+XDH-XCXH)/(XBH-XCXH) XFSEDH = XCH*XAH*XCCH*MOMG(XALPHAH,XNUH,XBH+XDH)* & (XAH*XCCH*MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH)*(ZRHO00)**XCEXVT ! -! -! XLB(4) = XLBI XLBEX(4) = XLBEXI XD(4) = XDI @@ -576,7 +616,7 @@ XR1DEPIS = XC1DEPIS *(XAI*XDICNVS_LIM**XBI) ! ! Harrington parameterization for snow to ice conversion ! -XLBDASCNVI_MAX = 6000. ! lbdas max after Field (1999) +XLBDASCNVI_MAX = 6000.*XTRANS_MP_GAMMAS ! lbdas max after Field (1999) ! XDSCNVI_LIM = 125.E-6 ! size in microns XLBDASCNVI_LIM = (50.0**(1.0/(XALPHAS)))/XDSCNVI_LIM ! ZLBDAS Limitation @@ -589,10 +629,10 @@ XR1DEPSI = XC1DEPSI *(XAS*XDSCNVI_LIM**XBS) ! ! Vapor deposition on snow and graupel and hail ! -X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.) -X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5) -XEX0DEPS = XCXS-1.0 -XEX1DEPS = XCXS-0.5*(XDS+3.0) +X0DEPS = XLBS*(4.0*XPI)*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.) +X1DEPS = XLBS*(4.0*XPI)*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5) +XEX0DEPS = XBS-1.0 +XEX1DEPS = -0.5*(XDS+3.0) ! X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.) X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5) @@ -662,6 +702,7 @@ XITAUTS_THRESHOLD = 7.5 !* 6.4 Constants for snow aggregation ! XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency +XFIAGGS = (XPI/4.0)*0.25*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) XAGGS_CLARGE1 = XKER_ZRNIC_A2*ZGAMI(2) XAGGS_CLARGE2 = XKER_ZRNIC_A2*ZGAMS(2) XAGGS_RLARGE1 = XKER_ZRNIC_A2*ZGAMI(6)*XAI @@ -684,11 +725,12 @@ END IF ! XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989) XCOLCS = 1.0 -XEXCRIMSS= XCXS-XDS-2.0 -XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) +XEXCRIMSS = -XDS-2.0 +XCRIMSS = XLBS * (XPI/4.0)*XCOLCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) + XEXCRIMSG= XEXCRIMSS XCRIMSG = XCRIMSS -XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS) +XSRIMCG = XAS*MOMG(XALPHAS,XNUS,XBS) XEXSRIMCG= XCXS-XBS ! GFLAG = .TRUE. @@ -699,9 +741,9 @@ IF (GFLAG) THEN END IF ! NGAMINC = 80 -XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha -XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha -ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1)) +XGAMINC_BOUND_MIN = (1000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha +XGAMINC_BOUND_MAX = (50000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha +ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/FLOAT(NGAMINC-1)) ! ALLOCATE( XGAMINC_RIM1(NGAMINC) ) ALLOCATE( XGAMINC_RIM2(NGAMINC) ) @@ -747,13 +789,13 @@ XHMLINTP2 = 1.0 + XHMLINTP1*LOG( 25.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) ) ! !* 7.2 Constants for the accretion of raindrops onto aggregates ! -XFRACCSS = ((XPI**2)/24.0)*XCCS*XRHOLW*(ZRHO00**XCEXVT) +XFRACCSS = XLBS*((XPI**2)/24.0)*XCCR*XRHOLW*(ZRHO00**XCEXVT) ! XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.) XLBRACCS2 = 2.*MOMG(XALPHAS,XNUS,1.)*MOMG(XALPHAR,XNUR,4.) XLBRACCS3 = MOMG(XALPHAR,XNUR,5.) ! -XFSACCRG = (XPI/4.0)*XAS*XCCS*(ZRHO00**XCEXVT) +XFSACCRG = XLBS*(XPI/4.0)*XAS*XCCR*(ZRHO00**XCEXVT) ! XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS) XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.) @@ -765,9 +807,9 @@ XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.) ! Notice: One magnitude of lambda discretized over 10 points for snow ! NACCLBDAS = 40 -XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS -XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS -ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/REAL(NACCLBDAS-1) +XACCLBDAS_MIN = 5.0E2*XTRANS_MP_GAMMAS !5.0E1*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_RACCS +XACCLBDAS_MAX = 1.0E5*XTRANS_MP_GAMMAS !5.0E5*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_RACCS +ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/FLOAT(NACCLBDAS-1) XACCINTP1S = 1.0 / ZRATE XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE NACCLBDAR = 40 @@ -800,15 +842,15 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. & (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & + ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS ) CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & + ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, 0., & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_RACCS ) CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBS, XCS, XDS, XCR, XDR, & + ZESR, XBS, XCS, XDS, XFVELOS, XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS ) WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') @@ -1052,7 +1094,7 @@ XCOLSG = 0.01 ! Collection efficiency of S+G XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln' WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG -XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT) +XFSDRYG = XLBS*(XPI/4.0)*XCOLSG*XCCG*XAS*(ZRHO00**XCEXVT) ! XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS) XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.) @@ -1082,8 +1124,8 @@ ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/REAL(NDRYLBDAR-1) XDRYINTP1R = 1.0 / ZRATE XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE NDRYLBDAS = 80 -XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG -XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG +XDRYLBDAS_MIN = 5.0E2*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_SDRYG +XDRYLBDAS_MAX = 1.0E5*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_SDRYG ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/REAL(NDRYLBDAS-1) XDRYINTP1S = 1.0 / ZRATE XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE @@ -1115,7 +1157,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. & (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, & - ZEGS, XBS, XCG, XDG, XCS, XDS, & + ZEGS, XBS, XCG, XDG, 0., XCS, XDS, XFVELOS, & XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, & ZFDINFTY, XKER_SDRYG ) WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') @@ -1181,7 +1223,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. & (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, & - ZEGR, XBR, XCG, XDG, XCR, XDR, & + ZEGR, XBR, XCG, XDG,0., XCR, XDR, 0., & XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, & ZFDINFTY, XKER_RDRYG ) WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') @@ -1242,7 +1284,8 @@ XFWETH = (XPI/4.0)*XCCH*XCH*(ZRHO00**XCEXVT)*MOMG(XALPHAH,XNUH,XDH+2.0) ! !* 9.2.2 Constants for the aggregate collection by the hailstones ! -XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT) +!XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT) +XFSWETH = XLBS*(XPI/4.0)*XCCH*XAS*(ZRHO00**XCEXVT) ! Wurtz ! XLBSWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAS,XNUS,XBS) XLBSWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAS,XNUS,XBS+1.) @@ -1259,8 +1302,8 @@ XLBGWETH3 = MOMG(XALPHAG,XNUG,XBG+2.) ! Notice: One magnitude of lambda discretized over 10 points ! NWETLBDAS = 80 -XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH -XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH +XWETLBDAS_MIN = 5.0E2*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_SWETH +XWETLBDAS_MAX = 1.0E5*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_SWETH ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/REAL(NWETLBDAS-1) XWETINTP1S = 1.0 / ZRATE XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE @@ -1298,7 +1341,7 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. & (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, & - ZEHS, XBS, XCH, XDH, XCS, XDS, & + ZEHS, XBS, XCH, XDH,0., XCS, XDS, XFVELOS, & XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, & ZFDINFTY, XKER_SWETH ) WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') @@ -1364,7 +1407,7 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. & (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, & - ZEHG, XBG, XCH, XDH, XCG, XDG, & + ZEHG, XBG, XCH, XDH,0., XCG, XDG, 0., & XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, & ZFDINFTY, XKER_GWETH ) WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') diff --git a/src/MNH/ini_lima_warm.f90 b/src/MNH/ini_lima_warm.f90 index 3fac15aaefe54e303ddb025473017407a5a60b6d..842552d8131dbe99f954f8c1aeaae70b8ea8f353 100644 --- a/src/MNH/ini_lima_warm.f90 +++ b/src/MNH/ini_lima_warm.f90 @@ -334,6 +334,7 @@ XLAUTR_THRESHOLD = 0.4 XITAUTR= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7 XITAUTR_THRESHOLD = 7.5 XCAUTR = 3.5E9 +XR0 = 25.0E-6 ! ! Cst for the accretion process ! @@ -405,6 +406,7 @@ X0EVAR = (12.0)*XF0R*GAMMA_X0D(XNUR+1./XALPHAR)/GAMMA_X0D(XNUR+3./XALPHAR) X1EVAR = (12.0)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* & GAMMA_X0D(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA_X0D(XNUR+3./XALPHAR) ! +XCEVAP = 0.86 ! !------------------------------------------------------------------------------ ! diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90 index d7f99b15dbb8867cae6293b0461ba1a0aa2b9096..911e543fc9d4be37e4f44207574d2b64831cd270 100644 --- a/src/MNH/ini_modeln.f90 +++ b/src/MNH/ini_modeln.f90 @@ -958,9 +958,11 @@ END IF ! IF (NRR>1) THEN ALLOCATE(XCLDFR(IIU,IJU,IKU)); XCLDFR (:, :, :) = 0. + ALLOCATE(XICEFR(IIU,IJU,IKU)); XICEFR (:, :, :) = 0. ALLOCATE(XRAINFR(IIU,IJU,IKU)); XRAINFR(:, :, :) = 0. ELSE ALLOCATE(XCLDFR(0,0,0)) + ALLOCATE(XICEFR(0,0,0)) ALLOCATE(XRAINFR(0,0,0)) END IF ! @@ -1797,7 +1799,7 @@ gles = lles_mean .or. lles_resolved .or. lles_subgrid .or. lles_updraft & .or. lles_downdraft .or. lles_spectra !Called if budgets are enabled via NAM_BUDGET !or if LES budgets are enabled via NAM_LES (condition on kmi==1 to call it max once) -if ( ( cbutype /= "NONE" .and. nbumod == kmi ) .or. ( gles .and. kmi == 1 ) ) THEN +if ( ( cbutype /= "NONE" .and. nbumod == kmi ) .or. ( gles .and. kmi == 1 ) .or. LCHECK ) THEN call Budget_preallocate() end if @@ -1905,16 +1907,16 @@ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before read_field::XUT",PRECISION) CALL READ_FIELD(KMI,TPINIFILE,IIU,IJU,IKU, & CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT,CGETZWS, & CGETRST,CGETRGT,CGETRHT,CGETSVT,CGETSRCT,CGETSIGS,CGETCLDFR, & - CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR, & + CGETICEFR, CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR, & CUVW_ADV_SCHEME, CTEMP_SCHEME, & NSIZELBX_ll, NSIZELBXU_ll, NSIZELBY_ll, NSIZELBYV_ll, & NSIZELBXTKE_ll,NSIZELBYTKE_ll, & NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, & XUM,XVM,XWM,XDUM,XDVM,XDWM, & XUT,XVT,XWT,XTHT,XPABST,XTKET,XRTKEMS, & - XRT,XSVT,XZWS,XCIT,XDRYMASST, XDRYMASSS, & - XSIGS,XSRCT,XCLDFR,XBL_DEPTH,XSBL_DEPTH,XWTHVMF,XPHC,XPHR, & - XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, & + XRT,XSVT,XZWS,XCIT,XDRYMASST,XDRYMASSS, & + XSIGS,XSRCT,XCLDFR,XICEFR, XBL_DEPTH,XSBL_DEPTH,XWTHVMF, & + XPHC,XPHR, XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, & XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM, & XLBXRM,XLBXSVM, & XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM, & @@ -1967,8 +1969,8 @@ CALL INI_LES_n !* 11. INITIALIZE THE SOURCE OF TOTAL DRY MASS Md ! ------------------------------------------ ! -IF((KMI==1).AND.LSTEADYLS) THEN - XDRYMASSS = 0. +IF((KMI==1).AND.LSTEADYLS .AND. (CCONF=='START') ) THEN + XDRYMASSS = 0. END IF ! !------------------------------------------------------------------------------- @@ -2162,20 +2164,22 @@ IF ( KMI > 1) THEN DPTR_XLBYRM=>XLBYRM DPTR_XLBXSVM=>XLBXSVM DPTR_XLBYSVM=>XLBYSVM - CALL INI_ONE_WAY_n(NDAD(KMI),KMI, & - DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, & - DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, & - NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), & - DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, & - DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, & - DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, & - DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, & - DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, & - CCLOUD, LUSECHAQ, LUSECHIC, & - DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, & - DPTR_XLBXTHM,DPTR_XLBYTHM, & - DPTR_XLBXTKEM,DPTR_XLBYTKEM, & - DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM ) + IF (CCONF=='START') THEN + CALL INI_ONE_WAY_n(NDAD(KMI),KMI, & + DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, & + DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, & + NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), & + DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, & + DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, & + DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, & + DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, & + DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, & + CCLOUD, LUSECHAQ, LUSECHIC, & + DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, & + DPTR_XLBXTHM,DPTR_XLBYTHM, & + DPTR_XLBXTKEM,DPTR_XLBYTKEM, & + DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM ) + ENDIF END IF ! ! diff --git a/src/MNH/ini_param_elec.f90 b/src/MNH/ini_param_elec.f90 index bdbd3c6d90293a6d4fde0fd28e4d9187e4712642..02a8b1578cfe2608304c04ccd8d8ebff6fd9025d 100644 --- a/src/MNH/ini_param_elec.f90 +++ b/src/MNH/ini_param_elec.f90 @@ -85,6 +85,7 @@ END MODULE MODI_INI_PARAM_ELEC !! J. Escobar 8/01/2016 bug , missing YDIR='XY' in READ !! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -846,17 +847,17 @@ XLBQSACCRG3 = MOMG(XALPHAS,XNUS,XFS) * MOMG(XALPHAR,XNUR,2.) ZESR = 1.0 ! CALL RRCOLSS (KND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XFR, XCS, XDS, XCR, XDR, & + ZESR, XFR, XCS, XDS, 0., XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & PFDINFTY, XKER_Q_RACCSS, XAG, XBS, XAS ) ! CALL RZCOLX (KND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XFR, XCS, XDS, XCR, XDR, & + ZESR, XFR, XCS, XDS, 0., XCR, XDR, 0., & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & PFDINFTY, XKER_Q_RACCS ) ! CALL RSCOLRG (KND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XFS, XCS, XDS, XCR, XDR, & + ZESR, XFS, XCS, XDS, 0., XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & PFDINFTY, XKER_Q_SACCRG, XAG, XBS, XAS ) ! @@ -878,7 +879,7 @@ XLBQSDRYG3 = MOMG(XALPHAS,XNUS,XFS) * MOMG(XALPHAG,XNUG,2.) ZEGS = 1. ! also initialized in ini_rain_ice_elec ! CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, & - ZEGS, XFS, XCG, XDG, XCS, XDS, & + ZEGS, XFS, XCG, XDG, 0., XCS, XDS, 0., & XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, & PFDINFTY, XKER_Q_SDRYG ) ! @@ -897,7 +898,7 @@ IF (CNI_CHARGING == 'HELFA') THEN ! IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(NDRYLBDAG,NDRYLBDAS) ) CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, & - ZEGS, 0., XCG, XDG, XCS, XDS, & + ZEGS, 0., XCG, XDG, 0., XCS, XDS, 0., & XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, & PFDINFTY, XKER_Q_SDRYGB ) ! Delta vqb1_sg @@ -999,7 +1000,7 @@ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAP98' .OR. & XAUX_LIM3 = MOMG(XALPHAG,XNUG,2.) IF( .NOT.ALLOCATED(XKER_Q_LIMSG)) ALLOCATE( XKER_Q_LIMSG(NDRYLBDAG,NDRYLBDAS) ) CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, & - ZEGS, 0., XCG, XDG, XCS, XDS, & + ZEGS, 0., XCG, XDG, 0., XCS, XDS, 0., & XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, & PFDINFTY, XKER_Q_LIMSG) ENDIF @@ -1021,7 +1022,7 @@ XLBQRDRYG3 = MOMG(XALPHAR,XNUR,XFR) * MOMG(XALPHAG,XNUG,2.) ZEGR = 1.0 ! CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAR, XNUR, & - ZEGR, XFR, XCG, XDG, XCR, XDR, & + ZEGR, XFR, XCG, XDG, 0., XCR, XDR, 0., & XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, & PFDINFTY, XKER_Q_RDRYG ) ! diff --git a/src/MNH/ini_rain_ice.f90 b/src/MNH/ini_rain_ice.f90 index 62cabad5b587f48a6cd6d443c088c8c7cea8c2ca..2c1ef440e54c4ed484d2b8547521293641d7a1ad 100644 --- a/src/MNH/ini_rain_ice.f90 +++ b/src/MNH/ini_rain_ice.f90 @@ -102,6 +102,7 @@ END MODULE MODI_INI_RAIN_ICE !! S. Riette 2016-11: new ICE3/ICE4 options !! P. Wautelet 22/01/2019 bug correction: incorrect write ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! !------------------------------------------------------------------------------- ! @@ -297,11 +298,25 @@ XF2I = 0.14 ! XAS = 0.02 XBS = 1.9 -XCS = 5.1 +IF (LSNOW_T) THEN +!Cas Gamma generalisee +XCS = 11.52 +XDS = 0.39 +XFVELOS =0.097 +!Cas MP +!XCS = 13.2 +!XDS = 0.423 +!XFVELOS = 25.14 +ELSE +XCS = 5. XDS = 0.27 +XFVELOS = 0. +END IF ! +IF (.NOT. LSNOW_T) THEN XCCS = 5.0 XCXS = 1.0 +END IF ! XF0S = 0.86 XF1S = 0.28 @@ -377,8 +392,17 @@ XNUR = 1.0 ! Exponential law XALPHAI = 3.0 ! Gamma law for the ice crystal volume XNUI = 3.0 ! Gamma law with little dispersion ! -XALPHAS = 1.0 ! Exponential law -XNUS = 1.0 ! Exponential law +IF (LSNOW_T) THEN +!Cas GAMMAGEN + XALPHAS = .214 ! Generalized gamma law + XNUS = 43.7 ! Generalized gamma law + XTRANS_MP_GAMMAS = SQRT( ( GAMMA(XNUS + 2./XALPHAS)*GAMMA(XNUS + 4./XALPHAS) ) / & + ( 8.* GAMMA(XNUS + 1./XALPHAS)*GAMMA(XNUS + 3./XALPHAS) ) ) +ELSE + XALPHAS = 1.0 ! Exponential law + XNUS = 1.0 ! Exponential law + XTRANS_MP_GAMMAS = 1. +END IF ! XALPHAG = 1.0 ! Exponential law XNUG = 1.0 ! Exponential law @@ -400,8 +424,13 @@ XLBR = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR) XLBEXI = 1.0/(-XBI) XLBI = ( XAI*MOMG(XALPHAI,XNUI,XBI) )**(-XLBEXI) ! -XLBEXS = 1.0/(XCXS-XBS) -XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS) +IF (LSNOW_T) THEN + XLBEXS = 0. ! Not used + XLBS = 1.0/(XAS*MOMG(XALPHAS,XNUS,XBS)) +ELSE + XLBEXS = 1.0/(XCXS-XBS) + XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS) +END IF ! XLBEXG = 1.0/(XCXG-XBG) XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG) )**(-XLBEXG) @@ -414,7 +443,8 @@ XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH) XLBDAS_MAX = 100000.0 ! ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc -XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS) +XLBDAS_MAX = 1.E6 +XLBDAS_MIN = 1000. ! IF (HCLOUD == 'ICE4') THEN ALLOCATE( XRTMIN(7) ) @@ -481,9 +511,20 @@ XEXCSEDI =-0.9324*3.0 WRITE (KLUOUT,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI =',XFSEDI ! ! -XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS) -XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* & +IF (LSNOW_T) THEN +!HOUZE/HAIC + !XEXSEDS = -XDS !(2*XBS+XDS) + !XFSEDS = XCS*MOMG(XALPHAS,XNUS,XBS+XDS)/(MOMG(XALPHAS,XNUS,XBS)) & + ! *(ZRHO00)**XCEXVT +!LH_EXTENDED + XEXSEDS = -XDS-XBS + XFSEDS = XCS*MOMG(XALPHAS,XNUS,XBS+XDS)/(MOMG(XALPHAS,XNUS,XBS)) & + *(ZRHO00)**XCEXVT +ELSE + XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS) + XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* & (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT +END IF ! XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG) XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* & @@ -556,10 +597,10 @@ XSCFAC = (0.63**(1./3.))*SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63 X0DEPI = (4.0*XPI)*XC1I*XF0I*MOMG(XALPHAI,XNUI,1.) X2DEPI = (4.0*XPI)*XC1I*XF2I*XC_I*MOMG(XALPHAI,XNUI,XDI+2.0) ! -X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.) -X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5) -XEX0DEPS = XCXS-1.0 -XEX1DEPS = XCXS-0.5*(XDS+3.0) +X0DEPS = XLBS*(4.0*XPI)*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.) +X1DEPS = XLBS*(4.0*XPI)*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5) +XEX0DEPS = XBS-1.0 +XEX1DEPS = -0.5*(XDS+3.0) ! X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.) X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5) @@ -599,8 +640,8 @@ END IF ! XCOLIS = 0.25 ! Collection efficiency of I+S XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency -XFIAGGS = (XPI/4.0)*XCOLIS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) -XEXIAGGS = XCXS-XDS-2.0 +XFIAGGS = XLBS*(XPI/4.0)*XCOLIS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) +XEXIAGGS = -XDS - 2.0 ! GAMMGEN LH_EXTENDED ! GFLAG = .TRUE. IF (GFLAG) THEN @@ -651,15 +692,15 @@ XEX1EVAR = -1.0-0.5*(XDR+3.0) ! XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989) XCOLCS = 1.0 -XEXCRIMSS= XCXS-XDS-2.0 -XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) +XEXCRIMSS= -XDS-2.0 +XCRIMSS = XLBS * (XPI/4.0)*XCOLCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) XEXCRIMSG= XEXCRIMSS XCRIMSG = XCRIMSS -XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS) -XEXSRIMCG= XCXS-XBS -XSRIMCG2 = XCCS*XAG*MOMG(XALPHAS,XNUS,XBG) +XSRIMCG = XLBS*XAS*MOMG(XALPHAS,XNUS,XBS) +XEXSRIMCG = -XBS +XSRIMCG2 = XLBS*XAG*MOMG(XALPHAS,XNUS,XBG) XSRIMCG3 = XFRACM90 -XEXSRIMCG2=XCXS-XBG +XEXSRIMCG2=XBS-XBG ! GFLAG = .TRUE. IF (GFLAG) THEN @@ -689,13 +730,13 @@ XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) ) ! !* 7.2 Constants for the accretion of raindrops onto aggregates ! -XFRACCSS = ((XPI**2)/24.0)*XCCS*XCCR*XRHOLW*(ZRHO00**XCEXVT) +XFRACCSS = XLBS*((XPI**2)/24.0)*XCCR*XRHOLW*(ZRHO00**XCEXVT) ! XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.) XLBRACCS2 = 2.*MOMG(XALPHAS,XNUS,1.)*MOMG(XALPHAR,XNUR,4.) XLBRACCS3 = MOMG(XALPHAR,XNUR,5.) ! -XFSACCRG = (XPI/4.0)*XAS*XCCS*XCCR*(ZRHO00**XCEXVT) +XFSACCRG = XLBS*(XPI/4.0)*XAS*XCCR*(ZRHO00**XCEXVT) ! XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS) XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.) @@ -742,15 +783,15 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. & (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & + ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS ) CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & + ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, 0., & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_RACCS ) CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBS, XCS, XDS, XCR, XDR, & + ZESR, XBS, XCS, XDS, XFVELOS, XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_SACCRG, XAG, XBS, XAS ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -887,7 +928,7 @@ XCOLSG = 0.01 ! Collection efficiency of S+G XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency WRITE (KLUOUT, FMT=*) ' NEW Constants for the aggregate collection by the graupeln' WRITE (KLUOUT, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG -XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT) +XFSDRYG = XLBS*(XPI/4.0)*XCOLSG*XCCG*XAS*(ZRHO00**XCEXVT) ! XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS) XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.) @@ -950,7 +991,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. & (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, & - ZEGS, XBS, XCG, XDG, XCS, XDS, & + ZEGS, XBS, XCG, XDG, 0., XCS, XDS, XFVELOS, & XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, & ZFDINFTY, XKER_SDRYG ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -1016,7 +1057,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. & (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, & - ZEGR, XBR, XCG, XDG, XCR, XDR, & + ZEGR, XBR, XCG, XDG, 0., XCR, XDR, 0., & XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, & ZFDINFTY, XKER_RDRYG ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -1082,7 +1123,8 @@ XFWETH = (XPI/4.0)*XCCH*XCH*(ZRHO00**XCEXVT)*MOMG(XALPHAH,XNUH,XDH+2.0) ! XCOLSH = 0.01 ! Collection efficiency of S+H XCOLEXSH = 0.1 ! Temperature factor of the S+H collection efficiency -XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT) +!XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT) +XFSWETH = XLBS*(XPI/4.0)*XCCH*XAS*(ZRHO00**XCEXVT) ! Wurtz ! XLBSWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAS,XNUS,XBS) XLBSWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAS,XNUS,XBS+1.) @@ -1154,7 +1196,7 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. & (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, & - ZEHS, XBS, XCH, XDH, XCS, XDS, & + ZEHS, XBS, XCH, XDH, 0., XCS, XDS, XFVELOS, & XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, & ZFDINFTY, XKER_SWETH ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -1220,7 +1262,7 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. & (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, & - ZEHG, XBG, XCH, XDH, XCG, XDG, & + ZEHG, XBG, XCH, XDH, 0., XCG, XDG, 0., & XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, & ZFDINFTY, XKER_GWETH ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -1286,7 +1328,7 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAR/=NWETLBDAR) .OR. (KND/=IND) .OR. & (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAR_MIN/=XWETLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAR, XNUR, & - ZEHR, XBR, XCH, XDH, XCR, XDR, & + ZEHR, XBR, XCH, XDH, 0., XCR, XDR, 0., & XWETLBDAH_MAX, XWETLBDAR_MAX, XWETLBDAH_MIN, XWETLBDAR_MIN, & ZFDINFTY, XKER_RWETH ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') diff --git a/src/MNH/ini_rain_ice_elec.f90 b/src/MNH/ini_rain_ice_elec.f90 index 940caeaeefc96dcda0800b7678b8be775815c116..978674f6912b966165a165116f9abe35eafb2b0f 100644 --- a/src/MNH/ini_rain_ice_elec.f90 +++ b/src/MNH/ini_rain_ice_elec.f90 @@ -87,6 +87,7 @@ END MODULE MODI_INI_RAIN_ICE_ELEC !! Modifications: !! C. Barthe 20/11/09 update to version 4.8.1 ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T ! !------------------------------------------------------------------------------- ! @@ -271,11 +272,25 @@ XF2I = 0.14 ! XAS = 0.02 XBS = 1.9 -XCS = 5.1 +IF (LSNOW_T) THEN +!Cas Gamma generalisee +XCS = 11.52 +XDS = 0.39 +XFVELOS =0.097 +!Cas MP +!XCS = 13.2 +!XDS = 0.423 +!XFVELOS = 25.14 +ELSE +XCS = 5. XDS = 0.27 +XFVELOS = 0. +END IF ! +IF (.NOT. LSNOW_T) THEN XCCS = 5.0 XCXS = 1.0 +END IF ! XF0S = 0.86 XF1S = 0.28 @@ -342,8 +357,17 @@ XNUR = 1.0 ! Exponential law XALPHAI = 3.0 ! Gamma law for the ice crystal volume XNUI = 3.0 ! Gamma law with little dispersion ! -XALPHAS = 1.0 ! Exponential law -XNUS = 1.0 ! Exponential law +IF (LSNOW_T) THEN +!Cas GAMMAGEN + XALPHAS = .214 ! Generalized gamma law + XNUS = 43.7 ! Generalized gamma law + XTRANS_MP_GAMMAS = SQRT( ( GAMMA(XNUS + 2./XALPHAS)*GAMMA(XNUS + 4./XALPHAS) ) / & + ( 8.* GAMMA(XNUS + 1./XALPHAS)*GAMMA(XNUS + 3./XALPHAS) ) ) +ELSE + XALPHAS = 1.0 ! Exponential law + XNUS = 1.0 ! Exponential law + XTRANS_MP_GAMMAS = 1. +END IF ! XALPHAG = 1.0 ! Exponential law XNUG = 1.0 ! Exponential law @@ -365,8 +389,13 @@ XLBR = (XAR * XCCR * MOMG(XALPHAR,XNUR,XBR))**(-XLBEXR) XLBEXI = 1.0 / (-XBI) XLBI = (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XLBEXI) ! -XLBEXS = 1.0 / (XCXS - XBS) -XLBS = (XAS * XCCS * MOMG(XALPHAS,XNUS,XBS))**(-XLBEXS) +IF (LSNOW_T) THEN + XLBEXS = 0. ! Not used + XLBS = 1.0/(XAS*MOMG(XALPHAS,XNUS,XBS)) +ELSE + XLBEXS = 1.0/(XCXS-XBS) + XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS) +END IF ! XLBEXG = 1.0 / (XCXG - XBG) XLBG = (XAG * XCCG * MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG) @@ -381,7 +410,8 @@ XLBDAS_MAX = 100000.0 XLBDAG_MAX = 100000.0 ! ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc -XLBDAS_MAX = (ZCONC_MAX / XCCS)**(1./XCXS) +XLBDAS_MAX = 1.E6 +XLBDAS_MIN = 1000. ! IF (HCLOUD == 'ICE4') THEN ALLOCATE( XRTMIN(7) ) @@ -441,17 +471,29 @@ XFSEDI = 3.89745E11 * MOMG(XALPHAI,XNUI,3.285) * & XEXCSEDI =-0.9324 * 3.0 WRITE (KLUOUT,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI =',XFSEDI ! -XEXSEDS = (XBS + XDS - XCXS) / (XBS - XCXS) -XFSEDS = XCS * XAS * XCCS * MOMG(XALPHAS,XNUS,XBS+XDS) * & - (XAS * XCCS * MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS) * (ZRHO00)**XCEXVT ! -XEXSEDG = (XBG + XDG - XCXG) / (XBG - XCXG) -XFSEDG = XCG * XAG * XCCG * MOMG(XALPHAG,XNUG,XBG+XDG) * & - (XAG * XCCG * MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG) * (ZRHO00)**XCEXVT +IF (LSNOW_T) THEN +!HOUZE/HAIC + !XEXSEDS = -XDS !(2*XBS+XDS) + !XFSEDS = XCS*MOMG(XALPHAS,XNUS,XBS+XDS)/(MOMG(XALPHAS,XNUS,XBS)) & + ! *(ZRHO00)**XCEXVT +!LH_EXTENDED + XEXSEDS = -XDS-XBS + XFSEDS = XCS*MOMG(XALPHAS,XNUS,XBS+XDS)/(MOMG(XALPHAS,XNUS,XBS)) & + *(ZRHO00)**XCEXVT +ELSE + XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS) + XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* & + (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT +END IF +! +XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG) +XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* & + (XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG)*(ZRHO00)**XCEXVT ! -XEXSEDH = (XBH + XDH - XCXH) / (XBH - XCXH) -XFSEDH = XCH * XAH * XCCH * MOMG(XALPHAH,XNUH,XBH+XDH) * & - (XAH * XCCH * MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH) * (ZRHO00)**XCEXVT +XEXSEDH = (XBH+XDH-XCXH)/(XBH-XCXH) +XFSEDH = XCH*XAH*XCCH*MOMG(XALPHAH,XNUH,XBH+XDH)* & + (XAH*XCCH*MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH)*(ZRHO00)**XCEXVT ! ! !------------------------------------------------------------------------------- @@ -516,10 +558,10 @@ XSCFAC = (0.63**(1./3.)) * SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63 X0DEPI = (4.0 * XPI) * XC1I * XF0I * MOMG(XALPHAI,XNUI,1.) X2DEPI = (4.0 * XPI) * XC1I * XF2I * XC_I * MOMG(XALPHAI,XNUI,XDI+2.0) ! -X0DEPS = (4.0 * XPI) * XCCS * XC1S * XF0S * MOMG(XALPHAS,XNUS,1.) -X1DEPS = (4.0 * XPI) * XCCS * XC1S * XF1S * SQRT(XCS) * MOMG(XALPHAS,XNUS,0.5*XDS+1.5) -XEX0DEPS = XCXS - 1.0 -XEX1DEPS = XCXS - 0.5 * (XDS + 3.0) +X0DEPS = XLBS*(4.0*XPI)*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.) +X1DEPS = XLBS*(4.0*XPI)*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5) +XEX0DEPS = XBS-1.0 +XEX1DEPS = -0.5*(XDS+3.0) ! X0DEPG = (4.0 * XPI) * XCCG * XC1G * XF0G * MOMG(XALPHAG,XNUG,1.) X1DEPG = (4.0 * XPI) * XCCG * XC1G * XF1G * SQRT(XCG) * MOMG(XALPHAG,XNUG,0.5*XDG+1.5) @@ -552,9 +594,8 @@ END IF ! XCOLIS = 0.25 ! Collection efficiency of I+S XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency -XFIAGGS = (XPI / 4.0) * XCOLIS * XCCS * XCS * (ZRHO00**XCEXVT) * & - MOMG(XALPHAS,XNUS,XDS+2.0) -XEXIAGGS = XCXS - XDS - 2.0 +XFIAGGS = XLBS*(XPI/4.0)*XCOLIS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) +XEXIAGGS = -XDS - 2.0 ! GAMMGEN LH_EXTENDED ! GFLAG = .TRUE. IF (GFLAG) THEN @@ -604,12 +645,15 @@ XEX1EVAR = -1.0 - 0.5 * (XDR + 3.0) ! XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989) XCOLCS = 1.0 -XEXCRIMSS= XCXS - XDS - 2.0 -XCRIMSS = (XPI / 4.0) * XCOLCS * XCCS * XCS * (ZRHO00**XCEXVT) * MOMG(XALPHAS,XNUS,XDS+2.0) +XEXCRIMSS= -XDS-2.0 +XCRIMSS = XLBS * (XPI/4.0)*XCOLCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) XEXCRIMSG= XEXCRIMSS XCRIMSG = XCRIMSS -XSRIMCG = XCCS * XAS * MOMG(XALPHAS,XNUS,XBS) -XEXSRIMCG= XCXS - XBS +XSRIMCG = XLBS*XAS*MOMG(XALPHAS,XNUS,XBS) +XEXSRIMCG = -XBS +XSRIMCG2 = XLBS*XAG*MOMG(XALPHAS,XNUS,XBG) +XSRIMCG3 = XFRACM90 +XEXSRIMCG2=XBS-XBG ! GFLAG = .TRUE. IF (GFLAG) THEN @@ -640,13 +684,13 @@ XRIMINTP2 = 1.0 + XRIMINTP1 * LOG(XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS)) ! !* 7.2 Constants for the accretion of raindrops onto aggregates ! -XFRACCSS = ((XPI**2) / 24.0) * XCCS * XCCR * XRHOLW * (ZRHO00**XCEXVT) +XFRACCSS = XLBS*((XPI**2)/24.0)*XCCR*XRHOLW*(ZRHO00**XCEXVT) ! XLBRACCS1 = MOMG(XALPHAS,XNUS,2.) * MOMG(XALPHAR,XNUR,3.) XLBRACCS2 = 2. * MOMG(XALPHAS,XNUS,1.) * MOMG(XALPHAR,XNUR,4.) XLBRACCS3 = MOMG(XALPHAR,XNUR,5.) ! -XFSACCRG = (XPI / 4.0) * XAS * XCCS * XCCR * (ZRHO00**XCEXVT) +XFSACCRG = XLBS*(XPI/4.0)*XAS*XCCR*(ZRHO00**XCEXVT) ! XLBSACCR1 = MOMG(XALPHAR,XNUR,2.) * MOMG(XALPHAS,XNUS,XBS) XLBSACCR2 = 2. * MOMG(XALPHAR,XNUR,1.) * MOMG(XALPHAS,XNUS,XBS+1.) @@ -694,15 +738,15 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. & (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & + ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS ) CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & + ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, 0., & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_RACCS ) CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBS, XCS, XDS, XCR, XDR, & + ZESR, XBS, XCS, XDS, XFVELOS, XCR, XDR, & XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & ZFDINFTY, XKER_SACCRG, XAG, XBS, XAS ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -820,9 +864,9 @@ XCOLIG = 0.01 ! Collection efficiency of I+G XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency WRITE (KLUOUT, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln' WRITE (KLUOUT, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG -! -XFIDRYG = (XPI / 4.0) * XCOLIG * XCCG * XCG * (ZRHO00**XCEXVT) * & - MOMG(XALPHAG,XNUG,XDG+2.0) +XFIDRYG = (XPI/4.0)*XCOLIG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0) +XEXFIDRYG=(XCXG-XDG-2.)/(XCXG-XBG) +XFIDRYG2=XFIDRYG/XCOLIG*(XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXFIDRYG) ! GFLAG = .TRUE. IF (GFLAG) THEN @@ -839,8 +883,7 @@ XCOLSG = 0.01 ! Collection efficiency of S+G XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency WRITE (KLUOUT, FMT=*) ' NEW Constants for the aggregate collection by the graupeln' WRITE (KLUOUT, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG -! -XFSDRYG = (XPI / 4.0) * XCOLSG * XCCG * XCCS * XAS * (ZRHO00**XCEXVT) +XFSDRYG = XLBS*(XPI/4.0)*XCOLSG*XCCG*XAS*(ZRHO00**XCEXVT) ! XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS,XNUS,XBS) XLBSDRYG2 = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS,XNUS,XBS+1.) @@ -905,7 +948,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. & (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, & - ZEGS, XBS, XCG, XDG, XCS, XDS, & + ZEGS, XBS, XCG, XDG,0., XCS, XDS, XFVELOS, & XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, & ZFDINFTY, XKER_SDRYG ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -971,7 +1014,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. & (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, & - ZEGR, XBR, XCG, XDG, XCR, XDR, & + ZEGR, XBR, XCG, XDG, 0., XCR, XDR, 0., & XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, & ZFDINFTY, XKER_RDRYG ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -1033,7 +1076,10 @@ XFWETH = (XPI / 4.0) * XCCH * XCH * (ZRHO00**XCEXVT) * MOMG(XALPHAH,XNUH,XDH+2.0 ! !* 9.2.2 Constants for the aggregate collection by the hailstones ! -XFSWETH = (XPI/4.0) * XCCH * XCCS * XAS * (ZRHO00**XCEXVT) +XCOLSH = 0.01 ! Collection efficiency of S+H +XCOLEXSH = 0.1 ! Temperature factor of the S+H collection efficiency +!XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT) +XFSWETH = XLBS*(XPI/4.0)*XCCH*XAS*(ZRHO00**XCEXVT) ! Wurtz ! XLBSWETH1 = MOMG(XALPHAH,XNUH,2.) * MOMG(XALPHAS,XNUS,XBS) XLBSWETH2 = 2. * MOMG(XALPHAH,XNUH,1.) * MOMG(XALPHAS,XNUS,XBS+1.) @@ -1089,7 +1135,7 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. & (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, & - ZEHS, XBS, XCH, XDH, XCS, XDS, & + ZEHS, XBS, XCH, XDH,0., XCS, XDS, XFVELOS, & XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, & ZFDINFTY, XKER_SWETH ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') @@ -1155,7 +1201,7 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. & (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. & (PFDINFTY/=ZFDINFTY) ) THEN CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, & - ZEHG, XBG, XCH, XDH, XCG, XDG, & + ZEHG, XBG, XCH, XDH, 0., XCG, XDG, 0., & XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, & ZFDINFTY, XKER_GWETH ) WRITE(UNIT=KLUOUT,FMT='("*****************************************")') diff --git a/src/MNH/init_aerosol_concentration.f90 b/src/MNH/init_aerosol_concentration.f90 index e86998c4b18e3a4f712a57c016ea1cbb7e9c14d0..32494739c32a42c280773d7510b518e518d2089b 100644 --- a/src/MNH/init_aerosol_concentration.f90 +++ b/src/MNH/init_aerosol_concentration.f90 @@ -54,7 +54,7 @@ END MODULE MODI_INIT_AEROSOL_CONCENTRATION USE MODD_NSV USE MODD_PARAM_n, ONLY : CCLOUD USE MODD_PARAM_LIMA, ONLY : LWARM, LACTI, NMOD_CCN, LSCAV, LAERO_MASS, & - XCCN_CONC, LCCN_HOM, & + XCCN_CONC, LCCN_HOM, & LCOLD, LNUCL, NMOD_IFN, LMEYERS, & XIFN_CONC, LIFN_HOM USE MODD_PARAMETERS, ONLY : JPVEXT @@ -79,7 +79,7 @@ INTEGER :: IKB, IKE ! ! IF ( LWARM .AND. LACTI ) THEN - DO JSV = NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI+NMOD_CCN-1 + DO JSV = NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI+NMOD_CCN-1 PSVT(:,:,:,JSV) = 0.0 ENDDO IKB = 1+JPVEXT @@ -112,7 +112,7 @@ END IF ! LWARM AND LACTI ! Initialisation des concentrations en IFN ! IF ( LCOLD .AND. LNUCL .AND. (.NOT. LMEYERS) ) THEN - DO JSV = NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL+NMOD_IFN-1 + DO JSV = NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL+NMOD_IFN-1 PSVT(:,:,:,JSV) = 0.0 ENDDO IKB = 1+JPVEXT @@ -127,7 +127,7 @@ IF ( LCOLD .AND. LNUCL .AND. (.NOT. LMEYERS) ) THEN ELSE ! concentration décroissante selon z DO JSV = 1, NMOD_IFN - WHERE (PZZ(:,:,:) .LE. 1000.) + WHERE (PZZ(:,:,:) .LE. 1000.) PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,:) ELSEWHERE (PZZ(:,:,:) .LE. 10000.) PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 & diff --git a/src/MNH/isocom.f b/src/MNH/isocom.f index f2e6503e663a2f39655c053f185dd64501f7421c..d92460fe1ac19f237be0ac2bd6c7a9fa2c79deab 100644 --- a/src/MNH/isocom.f +++ b/src/MNH/isocom.f @@ -1,8 +1,15 @@ -CMNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier +CMNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier CMNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence CMNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt CMNH_LIC for details. version 1. C======================================================================= +C Modifications: +C P. Wautelet 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q +C P. Wautelet 22/01/2019: replace obsolete SNGL intrinsics by REAL intrinsics +C P. Wautelet 19/04/2019: use kind(0.0d0) instead of kind=8 +C P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +C P. Wautelet 17/12/2021: add missing definitions of parameter ONE (in POLY3 and POLY3B) +C======================================================================= C C *** ISORROPIA CODE C *** SUBROUTINE ISOROPIA @@ -123,11 +130,6 @@ C C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY C *** WRITTEN BY ATHANASIOS NENES C -C Modifications: -C P. Wautelet 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q -C P. Wautelet 22/01/2019: replace obsolete SNGL intrinsics by REAL intrinsics -C P. Wautelet 19/04/2019: use kind(0.0d0) instead of kind=8 -C P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function C======================================================================= C SUBROUTINE ISOROPIA (WI, RHI, TEMPI, CNTRL, @@ -3782,7 +3784,8 @@ C C IMPLICIT REAL(kind(0.0d0)) (A-H, O-Z) PARAMETER (EXPON=1.D0/3.D0, ZERO=0.D0, THET1=120.D0/180.D0, - & THET2=240.D0/180.D0, PI=3.14159265358932, EPS=1D-50) + & THET2=240.D0/180.D0, PI=3.14159265358932, EPS=1D-50, + & ONE=1.D0 ) REAL(kind(0.0d0)) X(3) C C *** SPECIAL CASE : QUADRATIC*X EQUATION ***************************** @@ -3881,7 +3884,7 @@ C SUBROUTINE POLY3B (A1, A2, A3, RTLW, RTHI, ROOT, ISLV) C IMPLICIT REAL(kind(0.0d0)) (A-H, O-Z) - PARAMETER (ZERO=0.D0, EPS=1D-15, MAXIT=100, NDIV=5) + PARAMETER (ZERO=0.D0, ONE=1.D0, EPS=1D-15, MAXIT=100, NDIV=5) C FUNC(X) = X**3.d0 + A1*X**2.0 + A2*X + A3 C diff --git a/src/MNH/lesn.f90 b/src/MNH/lesn.f90 index 129929246495bee84d57526e482a17fc9b4e52b7..c23dc91b3ec93bfe41659dd8e9a69c8ee54cbd53 100644 --- a/src/MNH/lesn.f90 +++ b/src/MNH/lesn.f90 @@ -107,6 +107,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEW REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINDCLD !indice cloud si rc>0 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINDCLD2 !indice cloud rc>1E-5 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCLDFR_LES! CLDFR on LES vertical grid +REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZICEFR_LES! ICEFR on LES vertical grid REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRAINFR_LES! RAINFR on LES vertical grid REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMASSF ! massflux=rho*w REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZREHU ! relative humidity @@ -345,9 +346,11 @@ END IF IF (LUSERI) THEN ALLOCATE(ZRI_LES (IIU,IJU,NLES_K)) ALLOCATE(ZIWP_LES(IIU,IJU)) + ALLOCATE(ZICEFR_LES(IIU,IJU,NLES_K)) ELSE ALLOCATE(ZRI_LES (0,0,0)) ALLOCATE(ZIWP_LES(0,0)) + ALLOCATE(ZICEFR_LES(0,0,0)) END IF IF (LUSERS) THEN ALLOCATE(ZRS_LES (IIU,IJU,NLES_K)) @@ -598,6 +601,7 @@ IF (LUSERI) THEN END DO CALL LES_MEAN_ll ( ZIWP_LES, LLES_CURRENT_CART_MASK(:,:,1), & XLES_IWP(NLES_CURRENT_TCOUNT) ) + CALL LES_VER_INT( XICEFR(:,:,:) ,ZICEFR_LES ) END IF IF (LUSERS) THEN IRR = IRR + 1 @@ -812,6 +816,8 @@ END IF IF (LUSERI) & CALL LES_MEAN_ll ( ZRI_LES, LLES_CURRENT_CART_MASK, & XLES_MEAN_Ri(:,NLES_CURRENT_TCOUNT,1) ) + CALL LES_MEAN_ll ( ZICEFR_LES, LLES_CURRENT_CART_MASK, & + XLES_MEAN_If(:,NLES_CURRENT_TCOUNT,1) ) ! IF (LUSERS) & CALL LES_MEAN_ll ( ZRS_LES, LLES_CURRENT_CART_MASK, & @@ -1046,6 +1052,7 @@ DEALLOCATE(ZINDCLD2 ) DEALLOCATE(ZINDCLD2D ) DEALLOCATE(ZINDCLD2D2) DEALLOCATE(ZCLDFR_LES) +DEALLOCATE(ZICEFR_LES) DEALLOCATE(ZRAINFR_LES) DEALLOCATE(ZMASSF ) DEALLOCATE(ZTEMP ) diff --git a/src/MNH/lidar.f90 b/src/MNH/lidar.f90 index 4a3d987e8873486c7ce58e984cf78dc6b21a49da..a7b0bf94d598c56b4f72a3acd6480f51138a99fe 100644 --- a/src/MNH/lidar.f90 +++ b/src/MNH/lidar.f90 @@ -8,7 +8,7 @@ ! ################# ! INTERFACE - SUBROUTINE LIDAR(HCLOUD,HVIEW,PALT,PWVL,PZZ,PRHO,PCLDFR,PRT, & + SUBROUTINE LIDAR(HCLOUD,HVIEW,PALT,PWVL,PZZ,PRHO,PT,PCLDFR,PRT, & PLIDAROUT,PLIPAROUT,PCT,PDSTC,PDSTD,PDSTS) ! CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! Name of the cloud scheme @@ -17,6 +17,7 @@ REAL, INTENT(IN) :: PALT ! Altitude of the lidar source REAL, INTENT(IN) :: PWVL ! Wavelength of the lidar source REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! Air density +REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Air temperature (C) REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at t REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIDAROUT ! Lidar output @@ -36,7 +37,7 @@ END INTERFACE ! END MODULE MODI_LIDAR ! ######################################################### - SUBROUTINE LIDAR(HCLOUD,HVIEW,PALT,PWVL,PZZ,PRHO,PCLDFR,PRT, & + SUBROUTINE LIDAR(HCLOUD,HVIEW,PALT,PWVL,PZZ,PRHO,PT,PCLDFR,PRT, & PLIDAROUT,PLIPAROUT,PCT,PDSTC,PDSTD,PDSTS) ! ######################################################### ! @@ -98,6 +99,7 @@ USE MODD_RAIN_C2R2_DESCR, ONLY : XLBEXC, XLBEXR, & XRTMIN, XCTMIN USE MODD_PARAM_C2R2, ONLY : YALPHAC=>XALPHAC,YNUC=>XNUC, & YALPHAR=>XALPHAR,YNUR=>XNUR +USE MODD_PARAM_ICE, ONLY: WSNOW_T=>LSNOW_T USE MODD_RAIN_ICE_DESCR, ONLY : XCCR, WLBEXR=>XLBEXR, XLBR, & XCCS, XCXS, XLBEXS, XLBS, & XCCG, XCXG, XLBEXG, XLBG, & @@ -109,9 +111,11 @@ USE MODD_ICE_C1R3_DESCR, ONLY : XLBEXI, & USE MODD_PARAM_LIMA, ONLY : URTMIN=>XRTMIN, UCTMIN=>XCTMIN, & UALPHAC=>XALPHAC,UNUC=>XNUC, & UALPHAR=>XALPHAR,UNUR=>XNUR, & - UALPHAI=>XALPHAI,UNUI=>XNUI + UALPHAI=>XALPHAI,UNUI=>XNUI, & + USNOW_T=>LSNOW_T USE MODD_PARAM_LIMA_COLD, ONLY : UCCS=>XCCS, UCXS=>XCXS, ULBEXS=>XLBEXS, & - ULBS=>XLBS + ULBS=>XLBS, & + XLBDAS_MAX,XLBDAS_MIN, UBS=>XBS USE MODD_PARAM_LIMA_MIXED,ONLY : UCCG=>XCCG, UCXG=>XCXG, ULBEXG=>XLBEXG, & ULBG=>XLBG @@ -130,6 +134,7 @@ REAL, INTENT(IN) :: PALT ! Altitude of the lidar source REAL, INTENT(IN) :: PWVL ! Wavelength of the lidar source REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! Air density +REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Air temperature (C) REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at t REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIDAROUT ! Lidar output @@ -523,9 +528,19 @@ SELECT CASE ( HCLOUD ) ! YDSD = 'MONOD' ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,5) - ZLBDAS = ZLBS*(ZIWC)**ZLBEXS + IF ( (HCLOUD=='LIMA' .AND. USNOW_T) .OR. & + (HCLOUD=='ICE3' .AND. WSNOW_T) ) THEN + IF (PT(JI,JJ,JK)>-10.) THEN + ZLBDAS = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*(PT(JI,JJ,JK)+273.15))),XLBDAS_MIN) + ELSE + ZLBDAS = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*(PT(JI,JJ,JK)+273.15))),XLBDAS_MIN) + END IF + ZCONC=ZLBS*ZIWC*ZLBDAS**UBS + ELSE + ZLBDAS = ZLBS*(ZIWC)**ZLBEXS + ZCONC = ZCCS*(ZLBDAS)**ZCXS + END IF IF (ZLBDAS .GT. 0) THEN - ZCONC = ZCCS*(ZLBDAS)**ZCXS ZRADIUS = 0.5*(3.0/ZLBDAS) ! Assume Marshall-Palmer law for Reff IANGLE = 11 CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, & diff --git a/src/MNH/lima.f90 b/src/MNH/lima.f90 index c248f1acf5366d8bea72fab2055770f2562e5cc4..02b7a5b9c5af4a998838d9852595262b12454272 100644 --- a/src/MNH/lima.f90 +++ b/src/MNH/lima.f90 @@ -233,7 +233,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: & Z_RC_ACCR, Z_CC_ACCR, & ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr Z_CR_SCBU, & ! self collectio break up of drops (SCBU) : Nr ! Z_TH_EVAP, Z_RC_EVAP, Z_CC_EVAP, Z_RR_EVAP, Z_CR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th - Z_TH_EVAP, Z_RR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th + Z_TH_EVAP, Z_RR_EVAP, Z_CR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th Z_RI_CNVI, Z_CI_CNVI, & ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri Z_TH_DEPS, Z_RS_DEPS, & ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th Z_TH_DEPI, Z_RI_DEPI, & ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th @@ -284,7 +284,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: & ZTOT_RC_ACCR, ZTOT_CC_ACCR, & ! accretion of droplets by rain drops (ACCR) ZTOT_CR_SCBU, & ! self collectio break up of drops (SCBU) ! ZTOT_TH_EVAP, ZTOT_RC_EVAP, ZTOT_CC_EVAP, ZTOT_RR_EVAP, ZTOT_CR_EVAP, & ! evaporation of rain drops (EVAP) - ZTOT_TH_EVAP, ZTOT_RR_EVAP, & ! evaporation of rain drops (EVAP) + ZTOT_TH_EVAP, ZTOT_RR_EVAP, ZTOT_CR_EVAP, & ! evaporation of rain drops (EVAP) ZTOT_RI_CNVI, ZTOT_CI_CNVI, & ! conversion snow -> ice (CNVI) ZTOT_TH_DEPS, ZTOT_RS_DEPS, & ! deposition of vapor on snow (DEPS) ZTOT_TH_DEPI, ZTOT_RI_DEPI, & ! deposition of vapor on ice (DEPI) @@ -428,7 +428,7 @@ if ( lbu_enable ) then ! allocate( ZTOT_RC_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_EVAP(:,:,:) = 0. ! allocate( ZTOT_CC_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_EVAP(:,:,:) = 0. allocate( ZTOT_RR_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_EVAP(:,:,:) = 0. -! allocate( ZTOT_CR_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_EVAP(:,:,:) = 0. + allocate( ZTOT_CR_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_EVAP(:,:,:) = 0. allocate( ZTOT_RI_CNVI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CNVI(:,:,:) = 0. allocate( ZTOT_CI_CNVI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CNVI(:,:,:) = 0. allocate( ZTOT_TH_DEPS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DEPS(:,:,:) = 0. @@ -768,18 +768,12 @@ IF ( LCOLD ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP !* 2. Compute cloud, ice and precipitation fractions ! ---------------------------------------------- ! -IF (LSUBG_COND) THEN - CALL LIMA_COMPUTE_CLOUD_FRACTIONS (IIB, IIE, IJB, IJE, IKB, IKE, KKL, & - ZCCT, ZRCT, & - ZCRT, ZRRT, & - ZCIT, ZRIT, & - ZRST, ZRGT, ZRHT, & - PCLDFR, PICEFR, PPRCFR ) -ELSE - PCLDFR(:,:,:)=1. - PICEFR(:,:,:)=1. - PPRCFR(:,:,:)=1. -END IF +CALL LIMA_COMPUTE_CLOUD_FRACTIONS (IIB, IIE, IJB, IJE, IKB, IKE, KKL, & + ZCCT, ZRCT, & + ZCRT, ZRRT, & + ZCIT, ZRIT, & + ZRST, ZRGT, ZRHT, & + PCLDFR, PICEFR, PPRCFR ) ! !------------------------------------------------------------------------------- ! @@ -994,6 +988,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP)) ALLOCATE(Z_CR_SCBU(IPACK)) ; Z_CR_SCBU(:) = 0. ALLOCATE(Z_TH_EVAP(IPACK)) ; Z_TH_EVAP(:) = 0. ALLOCATE(Z_RR_EVAP(IPACK)) ; Z_RR_EVAP(:) = 0. + ALLOCATE(Z_CR_EVAP(IPACK)) ; Z_CR_EVAP(:) = 0. ALLOCATE(Z_RI_CNVI(IPACK)) ; Z_RI_CNVI(:) = 0. ALLOCATE(Z_CI_CNVI(IPACK)) ; Z_CI_CNVI(:) = 0. ALLOCATE(Z_TH_DEPS(IPACK)) ; Z_TH_DEPS(:) = 0. @@ -1086,7 +1081,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP)) Z_RC_AUTO, Z_CC_AUTO, Z_CR_AUTO, & Z_RC_ACCR, Z_CC_ACCR, & Z_CR_SCBU, & - Z_TH_EVAP, Z_RR_EVAP, & + Z_TH_EVAP, Z_RR_EVAP, Z_CR_EVAP, & Z_RI_CNVI, Z_CI_CNVI, & Z_TH_DEPS, Z_RS_DEPS, & Z_TH_DEPI, Z_RI_DEPI, & @@ -1370,7 +1365,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP)) !!$ ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) + Z_RC_EVAP(II) * ZMAXTIME(II) !!$ ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) + Z_CC_EVAP(II) * ZMAXTIME(II) ZTOT_RR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RR_EVAP(I1(II),I2(II),I3(II)) + Z_RR_EVAP(II) * ZMAXTIME(II) -!!$ ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) + Z_CR_EVAP(II) * ZMAXTIME(II) + ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) + Z_CR_EVAP(II) * ZMAXTIME(II) ZTOT_RI_CNVI(I1(II),I2(II),I3(II)) = ZTOT_RI_CNVI(I1(II),I2(II),I3(II)) + Z_RI_CNVI(II) * ZMAXTIME(II) ZTOT_CI_CNVI(I1(II),I2(II),I3(II)) = ZTOT_CI_CNVI(I1(II),I2(II),I3(II)) + Z_CI_CNVI(II) * ZMAXTIME(II) ZTOT_TH_DEPS(I1(II),I2(II),I3(II)) = ZTOT_TH_DEPS(I1(II),I2(II),I3(II)) + Z_TH_DEPS(II) * ZMAXTIME(II) @@ -1537,6 +1532,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP)) DEALLOCATE(Z_CR_SCBU) DEALLOCATE(Z_TH_EVAP) DEALLOCATE(Z_RR_EVAP) + DEALLOCATE(Z_CR_EVAP) DEALLOCATE(Z_RI_CNVI) DEALLOCATE(Z_CI_CNVI) DEALLOCATE(Z_TH_DEPS) @@ -1765,7 +1761,7 @@ if ( lbu_enable ) then idx = NBUDGET_SV1 - 1 + nsv_lima_nr call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cr_auto(:, :, :) * zrhodjontstep(:, :, :) ) call Budget_store_add( tbudgets(idx), 'SCBU', ztot_cr_scbu(:, :, :) * zrhodjontstep(:, :, :) ) - !call Budget_store_add( tbudgets(idx), 'REVA', 0. ) + call Budget_store_add( tbudgets(idx), 'REVA', ztot_cr_evap(:, :, :) * zrhodjontstep(:, :, :) ) call Budget_store_add( tbudgets(idx), 'BRKU', ztot_cr_brku(:, :, :) * zrhodjontstep(:, :, :) ) call Budget_store_add( tbudgets(idx), 'HONR', ztot_cr_honr(:, :, :) * zrhodjontstep(:, :, :) ) call Budget_store_add( tbudgets(idx), 'ACC', ztot_cr_acc (:, :, :) * zrhodjontstep(:, :, :) ) diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90 index 949fabf42b62e7240d2806dc6eaada110ff037f0..410c9a92043c33866f2c5b8205598815e12bae59 100644 --- a/src/MNH/lima_adjust.f90 +++ b/src/MNH/lima_adjust.f90 @@ -9,12 +9,12 @@ ! INTERFACE ! - SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, & - OSUBG_COND, PTSTEP, & - PRHODREF, PRHODJ, PEXNREF, PPABSM, & - PPABST, & - PRT, PRS, PSVT, PSVS, & - PTHS, PSRCS, PCLDFR ) + SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, & + OSUBG_COND, PTSTEP, & + PRHODREF, PRHODJ, PEXNREF, PPABSM, & + PPABST, & + PRT, PRS, PSVT, PSVS, & + PTHS, PSRCS, PCLDFR, PICEFR, PRAINFR ) ! USE MODD_IO, ONLY: TFILEDATA USE MODD_NSV, only: NSV_LIMA_BEG @@ -47,6 +47,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux ! s'rc'/2Sigma_s2 at time t+1 ! multiplied by Lambda_3 REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRAINFR ! Cloud fraction ! END SUBROUTINE LIMA_ADJUST ! @@ -54,14 +56,14 @@ END INTERFACE ! END MODULE MODI_LIMA_ADJUST ! -! ########################################################### - SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, & - OSUBG_COND, PTSTEP, & - PRHODREF, PRHODJ, PEXNREF, PPABSM, & - PPABST, & - PRT, PRS, PSVT, PSVS, & - PTHS, PSRCS, PCLDFR ) -! ########################################################### +! ############################################################# + SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, & + OSUBG_COND, PTSTEP, & + PRHODREF, PRHODJ, PEXNREF, PPABSM, & + PPABST, & + PRT, PRS, PSVT, PSVS, & + PTHS, PSRCS, PCLDFR, PICEFR, PRAINFR ) +! ############################################################# ! !!**** *MIMA_ADJUST* - compute the fast microphysical sources !! @@ -137,6 +139,7 @@ END MODULE MODI_LIMA_ADJUST ! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS ! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets ! B. Vie 06/2020: fix PSRCS +! P. Wautelet 23/07/2021: replace non-standard FLOAT function by REAL function !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -201,6 +204,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux ! s'rc'/2Sigma_s2 at time t+1 ! multiplied by Lambda_3 REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRAINFR ! Cloud fraction ! ! !* 0.2 Declarations of local variables : @@ -694,9 +699,9 @@ IF( IMICRO >= 1 ) THEN ALLOCATE(ZZW2(IMICRO)) ALLOCATE(ZVEC1(IMICRO)) ALLOCATE(IVEC1(IMICRO)) - ZVEC1(:) = MAX( 1.0001, MIN( FLOAT(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) ) + ZVEC1(:) = MAX( 1.0001, MIN( REAL(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) ) IVEC1(:) = INT( ZVEC1(:) ) - ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) ) + ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) ) ZS(:) = ZRVS(:)*PTSTEP / ZRVSATW(:) - 1. ZZW(:) = ZCCS(:)*PTSTEP/(XLBC*ZCCS(:)/ZRCS(:))**XLBEXC ZZW2(:) = XAHENG3(IVEC1(:)+1)*ZVEC1(:)-XAHENG3(IVEC1(:))*(ZVEC1(:)-1.) @@ -1170,11 +1175,21 @@ END DO !* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!) ! IF ( .NOT. OSUBG_COND ) THEN - WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT) + WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT) PCLDFR(:,:,:) = 1. ELSEWHERE PCLDFR(:,:,:) = 0. ENDWHERE + WHERE (PRIS(:,:,:) > 1.E-12 / ZDT) + PICEFR(:,:,:) = 1. + ELSEWHERE + PICEFR(:,:,:) = 0. + ENDWHERE + WHERE (PRRS(:,:,:)+PRSS(:,:,:)+PRGS(:,:,:) > 1.E-12 / ZDT) + PRAINFR(:,:,:) = 1. + ELSEWHERE + PRAINFR(:,:,:) = 0. + ENDWHERE END IF ! IF ( SIZE(PSRCS,3) /= 0 ) THEN diff --git a/src/MNH/lima_adjust_split.f90 b/src/MNH/lima_adjust_split.f90 index edaeec82007c9f14ed51c77c8aa092ad3bbc1d7b..8baf17668657c028818b1bc75665b6d712b53f15 100644 --- a/src/MNH/lima_adjust_split.f90 +++ b/src/MNH/lima_adjust_split.f90 @@ -14,7 +14,7 @@ INTERFACE PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PMFCONV, & PPABST, PZZ, PDTHRAD, PW_NU, & PRT, PRS, PSVT, PSVS, & - PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF ) + PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF) ! USE MODD_IO, ONLY: TFILEDATA USE MODD_NSV, only: NSV_LIMA_BEG @@ -58,7 +58,9 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux ! s'rc'/2Sigma_s2 at time t+1 ! multiplied by Lambda_3 REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio +REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction ! END SUBROUTINE LIMA_ADJUST_SPLIT @@ -73,7 +75,7 @@ END MODULE MODI_LIMA_ADJUST_SPLIT PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PMFCONV, & PPABST, PZZ, PDTHRAD, PW_NU, & PRT, PRS, PSVT, PSVS, & - PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF ) + PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF) ! ########################################################################### ! !!**** *MIMA_ADJUST* - compute the fast microphysical sources @@ -141,6 +143,8 @@ END MODULE MODI_LIMA_ADJUST_SPLIT !! MODIFICATIONS !! ------------- !! Original 06/2021 forked from lima_adjust.f90 +! P. Wautelet 23/07/2021: replace non-standard FLOAT function by REAL function +! B. Vie 03/2022: Add option for 1-moment pristine ice !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -216,7 +220,9 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux ! s'rc'/2Sigma_s2 at time t+1 ! multiplied by Lambda_3 REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio +REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction ! ! @@ -272,7 +278,7 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) & ZRV, ZRV2, & ZRC, ZRC2, & ZRI, & - ZSIGS, & + Z_SIGS, Z_SRCS, & ZW_MF LOGICAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) & :: GMICRO ! Test where to compute cond/dep proc. @@ -309,6 +315,8 @@ INTEGER :: JMOD, JMOD_IFN, JMOD_IMM ! INTEGER , DIMENSION(3) :: BV TYPE(TFIELDDATA) :: TZFIELD +LOGICAL :: G_SIGMAS, GUSERI +REAL :: Z_SIGQSAT ! !------------------------------------------------------------------------------- ! @@ -496,234 +504,154 @@ DO JITER =1,ITERMAX !* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME ! --------------------------------------- ! - IF ( OSUBG_COND ) THEN - ! - ZRV=PRVS*PTSTEP - ZRC=PRCS*PTSTEP - ZRV2=PRVT - ZRC2=PRCT + ZRV=PRVS*PTSTEP + ZRC=PRCS*PTSTEP + ZRV2=PRVT + ZRC2=PRCT + IF (NMOM_I.EQ.1) THEN + ZRI=PRIS*PTSTEP + GUSERI=.TRUE. + ELSE ZRI=0. - ZSIGS=PSIGS - CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'S', & - HCONDENS, HLAMBDA3, & - PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRSS*PTSTEP, PRGS*PTSTEP, & - ZSIGS, PMFCONV, PCLDFR, PSRCS, .FALSE., OSIGMAS, & - PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH ) - PCLDFR(:,:,:) = MIN(PCLDFR(:,:,:) + PCF_MF(:,:,:) , 1.) - ZRV(:,:,:) = ZRV(:,:,:) - MAX(MIN(PRC_MF(:,:,:), ZRV(:,:,:)),0.) - ZRC(:,:,:) = ZRC(:,:,:) + MAX(MIN(PRC_MF(:,:,:), ZRV(:,:,:)),0.) + GUSERI=.FALSE. + END IF + IF (OSUBG_COND) THEN + Z_SIGS=PSIGS + G_SIGMAS=OSIGMAS + Z_SIGQSAT=PSIGQSAT + ELSE + Z_SIGS=0. + G_SIGMAS=.TRUE. + Z_SIGQSAT=0. + END IF + + CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'S', & + HCONDENS, HLAMBDA3, & + PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRSS*PTSTEP, PRGS*PTSTEP, & + Z_SIGS, PMFCONV, PCLDFR, Z_SRCS, GUSERI, G_SIGMAS, & + Z_SIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH ) + + IF (OSUBG_COND) THEN + PSRCS=Z_SRCS ZW_MF=0. - CALL LIMA_CCN_ACTIVATION (TPFILE, & + CALL LIMA_CCN_ACTIVATION (TPFILE, & PRHODREF, PEXNREF, PPABST, ZT2, PDTHRAD, PW_NU+ZW_MF, & - PTHT, ZRV2, ZRC2, PCCT, PRRT, PNFT, PNAT, & - PCLDFR ) -! - ELSE -! -!------------------------------------------------------------------------------- -! + PTHT, ZRV2, ZRC2, PCCT, PRRT, PNFT, PNAT, & + PCLDFR ) + END IF + +END DO ! +!* 5.1 compute the sources ! -!* FULLY IMPLICIT CONDENSATION SCHEME -! --------------------------------- -! -!* select cases where r_c>0 -! + ! Rc - Rc* +ZW1(:,:,:) = (ZRC(:,:,:) - PRCS(:,:,:)*PTSTEP) / PTSTEP ! Pcon = ---------- + ! 2 Delta t +WHERE( ZW1(:,:,:) < 0.0 ) + ZW1(:,:,:) = MAX ( ZW1(:,:,:), -PRCS(:,:,:) ) +ELSEWHERE + ZW1(:,:,:) = MIN ( ZW1(:,:,:), PRVS(:,:,:) ) +END WHERE +PRVS(:,:,:) = PRVS(:,:,:) - ZW1(:,:,:) +PRCS(:,:,:) = PRCS(:,:,:) + ZW1(:,:,:) +PTHS(:,:,:) = PTHS(:,:,:) + & + ZW1(:,:,:) * ZLV(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:)) ! - GMICRO(:,:,:) = .FALSE. - GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) =( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. .AND. & - PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. ) - IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:)) - IF( IMICRO >= 1 ) THEN - ALLOCATE(ZRVT(IMICRO)) - ALLOCATE(ZRCT(IMICRO)) -! - ALLOCATE(ZRVS(IMICRO)) - ALLOCATE(ZRCS(IMICRO)) - ALLOCATE(ZCCS(IMICRO)) - ALLOCATE(ZTHS(IMICRO)) -! - ALLOCATE(ZRHODREF(IMICRO)) - ALLOCATE(ZZT(IMICRO)) - ALLOCATE(ZPRES(IMICRO)) - ALLOCATE(ZEXNREF(IMICRO)) - ALLOCATE(ZZCPH(IMICRO)) - DO JL=1,IMICRO - ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL)) - ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL)) - ! - ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL)) - ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL)) - ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL)) - ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL)) - ! - ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL)) - ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL)) - ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL)) - ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL)) - ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL)) - ENDDO - ALLOCATE(ZZW(IMICRO)) - ALLOCATE(ZLVFACT(IMICRO)) - ALLOCATE(ZRVSATW(IMICRO)) - ALLOCATE(ZCND(IMICRO)) - ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph - ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w - ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw - - IF (LADJ) THEN - ALLOCATE(ZRVSATW_PRIME(IMICRO)) - ALLOCATE(ZAWW(IMICRO)) - ALLOCATE(ZDELT1(IMICRO)) - ALLOCATE(ZDELT2(IMICRO)) - ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw - * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS ) - ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:) - ZDELT2(:) = (ZRVSATW_PRIME(:)*ZLVFACT(:)/ZAWW(:)) * & - ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) & - + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) ) - ZDELT1(:) = (ZLVFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT ) - ZCND(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZLVFACT(:)*ZDT) - DEALLOCATE(ZRVSATW_PRIME) - DEALLOCATE(ZAWW) - DEALLOCATE(ZDELT1) - DEALLOCATE(ZDELT2) - ELSE - ALLOCATE(ZS(IMICRO)) - ALLOCATE(ZZW2(IMICRO)) - ALLOCATE(ZVEC1(IMICRO)) - ALLOCATE(IVEC1(IMICRO)) - ZVEC1(:) = MAX( 1.0001, MIN( FLOAT(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) ) - IVEC1(:) = INT( ZVEC1(:) ) - ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) ) - ZS(:) = ZRVS(:)*PTSTEP / ZRVSATW(:) - 1. - ZZW(:) = ZCCS(:)*PTSTEP/(XLBC*ZCCS(:)/ZRCS(:))**XLBEXC - ZZW2(:) = XAHENG3(IVEC1(:)+1)*ZVEC1(:)-XAHENG3(IVEC1(:))*(ZVEC1(:)-1.) - ZCND(:) = 2.*3.14*1000.*ZZW2(:)*ZS(:)*ZZW(:) - DEALLOCATE(ZS) - DEALLOCATE(ZZW2) - DEALLOCATE(ZVEC1) - DEALLOCATE(IVEC1) - END IF -! -! -! Integration -! - WHERE( ZCND(:) < 0.0 ) - ZCND(:) = MAX ( ZCND(:), -ZRCS(:) ) - ELSEWHERE - ZCND(:) = MIN ( ZCND(:), ZRVS(:) ) - END WHERE - ZRVS(:) = ZRVS(:) - ZCND(:) - ZRCS(:) = ZRCS(:) + ZCND(:) - ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:) -! - ZW(:,:,:) = PRVS(:,:,:) - PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) ) - ZW(:,:,:) = PRCS(:,:,:) - PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) ) - ZW(:,:,:) = PTHS(:,:,:) - PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) ) -! - DEALLOCATE(ZRVT) - DEALLOCATE(ZRCT) - DEALLOCATE(ZRVS) - DEALLOCATE(ZRCS) - DEALLOCATE(ZTHS) - DEALLOCATE(ZRHODREF) - DEALLOCATE(ZZT) - DEALLOCATE(ZPRES) - DEALLOCATE(ZEXNREF) - DEALLOCATE(ZZCPH) - DEALLOCATE(ZZW) - DEALLOCATE(ZLVFACT) - DEALLOCATE(ZRVSATW) - DEALLOCATE(ZCND) - END IF ! IMICRO -! - END IF ! end of adjustment procedure (test on OSUBG_COND) +IF (NMOM_I.EQ.1) THEN + ZW2(:,:,:) = (ZRI(:,:,:) - PRIS(:,:,:)*PTSTEP) / PTSTEP ! idem ZW1 but for Ri ! -! Remove cloud droplets if there are few - - ZMASK(:,:,:) = 0.0 - ZW(:,:,:) = 0. - WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2)) - PRVS(:,:,:) = PRVS(:,:,:) + PRCS(:,:,:) - PTHS(:,:,:) = PTHS(:,:,:) - PRCS(:,:,:)*ZLV(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:)) - PRCS(:,:,:) = 0.0 - ZW(:,:,:) = MAX(PCCS(:,:,:),0.) - PCCS(:,:,:) = 0.0 + WHERE( ZW2(:,:,:) < 0.0 ) + ZW2(:,:,:) = MAX ( ZW2(:,:,:), -PRIS(:,:,:) ) + ELSEWHERE + ZW2(:,:,:) = MIN ( ZW2(:,:,:), PRVS(:,:,:) ) END WHERE + PRVS(:,:,:) = PRVS(:,:,:) - ZW2(:,:,:) + PRIS(:,:,:) = PRIS(:,:,:) + ZW2(:,:,:) + PTHS(:,:,:) = PTHS(:,:,:) + & + ZW2(:,:,:) * ZLS(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:)) +END IF ! - ZW1(:,:,:) = 0. - IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4) - ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) ) - ZW2(:,:,:) = 0. - WHERE ( ZW(:,:,:) > 0. ) - ZMASK(:,:,:) = 1.0 - ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:) - ENDWHERE +!* 5.2 compute the cloud fraction PCLDFR ! - IF (LWARM .AND. NMOD_CCN.GE.1) THEN - DO JMOD = 1, NMOD_CCN - PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + & - ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:) - PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) - & - ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:) - PNAS(:,:,:,JMOD) = MAX( 0.0 , PNAS(:,:,:,JMOD) ) - ENDDO +IF ( .NOT. OSUBG_COND ) THEN + WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / PTSTEP) + PCLDFR(:,:,:) = 1. + ELSEWHERE + PCLDFR(:,:,:) = 0. + ENDWHERE + IF ( SIZE(PSRCS,3) /= 0 ) THEN + WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT) + PSRCS(:,:,:) = 1. + ELSEWHERE + PSRCS(:,:,:) = 0. + ENDWHERE + END IF +ELSE +! We limit PRC_MF+PRI_MF to PRVS*PTSTEP to avoid negative humidity + ZW1(:,:,:)=PRC_MF(:,:,:)/PTSTEP + IF (NMOM_I.EQ.1) THEN + ZW2(:,:,:)=PRI_MF(:,:,:)/PTSTEP + ELSE + ZW2(:,:,:)=0. END IF + WHERE(ZW1(:,:,:)+ZW2(:,:,:)>PRVS(:,:,:)) + ZW1(:,:,:)=ZW1(:,:,:)*PRVS(:,:,:)/(ZW1(:,:,:)+ZW2(:,:,:)) + ZW2(:,:,:)=PRVS(:,:,:)-ZW1(:,:,:) + ENDWHERE +! Compute CF and update rc, ri from MF scheme + PRVS(:,:,:) = PRVS(:,:,:) - ZW1(:,:,:) -ZW2(:,:,:) + PRCS(:,:,:) = PRCS(:,:,:) + ZW1(:,:,:) + PRIS(:,:,:) = PRIS(:,:,:) + ZW2(:,:,:) + PCCS(:,:,:) = PCCT(:,:,:) / PTSTEP + PNFS(:,:,:,:) = PNFT(:,:,:,:) / PTSTEP + PNAS(:,:,:,:) = PNAT(:,:,:,:) / PTSTEP + PTHS(:,:,:) = PTHS(:,:,:) + & + (ZW1(:,:,:) * ZLV(:,:,:) + ZW2 * ZLS(:,:,:)) / ZCPH(:,:,:) & + / PEXNREF(:,:,:) +END IF ! - IF (LSCAV .AND. LAERO_MASS) PMAS(:,:,:) = PMAS(:,:,:) * (1-ZMASK(:,:,:)) +! Remove cloud droplets if there are few ! +ZMASK(:,:,:) = 0.0 +ZW(:,:,:) = 0. +WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2)) + PRVS(:,:,:) = PRVS(:,:,:) + PRCS(:,:,:) + PTHS(:,:,:) = PTHS(:,:,:) - PRCS(:,:,:)*ZLV(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:)) + PRCS(:,:,:) = 0.0 + ZW(:,:,:) = MAX(PCCS(:,:,:),0.) + PCCS(:,:,:) = 0.0 +END WHERE ! -END DO ! end of the iterative loop +ZW1(:,:,:) = 0. +IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4) +ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) ) +ZW2(:,:,:) = 0. +WHERE ( ZW(:,:,:) > 0. ) + ZMASK(:,:,:) = 1.0 + ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:) +ENDWHERE +! +IF (LWARM .AND. NMOD_CCN.GE.1) THEN + DO JMOD = 1, NMOD_CCN + PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + & + ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:) + PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) - & + ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:) + PNAS(:,:,:,JMOD) = MAX( 0.0 , PNAS(:,:,:,JMOD) ) + ENDDO +END IF ! +IF (LSCAV .AND. LAERO_MASS) PMAS(:,:,:) = PMAS(:,:,:) * (1-ZMASK(:,:,:)) ! -!* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!) ! -IF ( .NOT. OSUBG_COND ) THEN - WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT) - PCLDFR(:,:,:) = 1. - ELSEWHERE - PCLDFR(:,:,:) = 0. - ENDWHERE -END IF ! -IF ( SIZE(PSRCS,3) /= 0 ) THEN - WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT) - PSRCS(:,:,:) = 1. - ELSEWHERE - PSRCS(:,:,:) = 0. - ENDWHERE +PICEFR(:,:,:)=0. +IF (NMOM_I.EQ.1) THEN + WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=PCLDFR(:,:,:) +ELSE + WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1. END IF ! -IF ( OSUBG_COND ) THEN - ! - ! Mixing ratio change (cloud liquid water) - ! - ZW1(:,:,:) = (ZRC(:,:,:) - PRCS(:,:,:)*PTSTEP) / PTSTEP - WHERE( ZW1(:,:,:) < 0.0 ) - ZW1(:,:,:) = MAX ( ZW1(:,:,:), -PRCS(:,:,:) ) - ELSEWHERE - ZW1(:,:,:) = MIN ( ZW1(:,:,:), PRVS(:,:,:) ) - END WHERE - - WHERE (PCCT(:,:,:) < PCLDFR(:,:,:)*XCTMIN(2) .OR. ZRC(:,:,:)<PCLDFR(:,:,:)*XRTMIN(2)) - ZW1=-PRCS - PCCS=0. - PCLDFR=0. - END WHERE - - PRVS(:,:,:) = PRVS(:,:,:) - ZW1(:,:,:) - PRCS(:,:,:) = PRCS(:,:,:) + ZW1(:,:,:) - PCCS(:,:,:) = PCCT(:,:,:) / PTSTEP - PNFS(:,:,:,:) = PNFT(:,:,:,:) / PTSTEP - PNAS(:,:,:,:) = PNAT(:,:,:,:) / PTSTEP - PTHS(:,:,:) = PTHS(:,:,:) + & - ZW1(:,:,:) * ZLV(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:)) -END IF ! fin test OSUBG_COND - IF ( tpfile%lopened ) THEN TZFIELD%CMNHNAME = 'NEB' TZFIELD%CSTDNAME = '' @@ -742,7 +670,6 @@ END IF !* 6. SAVE CHANGES IN PRS AND PSVS ! ---------------------------- ! -! ! Prepare 3D water mixing ratios PRS(:,:,:,1) = PRVS(:,:,:) IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:) @@ -801,7 +728,6 @@ if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) ) if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) ) - !Remark: PRIS is not modified but source term kept for better coherence with lima_adjust and lima_notadjust if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) ) if ( lbudget_sv ) then if ( lwarm ) & diff --git a/src/MNH/lima_bergeron.f90 b/src/MNH/lima_bergeron.f90 index 9105c78d6f07be74f84fce86c33fe2c3a240f6e5..7a4967708e09ec8b49e850a2583fd47a7c04ee6d 100644 --- a/src/MNH/lima_bergeron.f90 +++ b/src/MNH/lima_bergeron.f90 @@ -10,8 +10,7 @@ INTERFACE SUBROUTINE LIMA_BERGERON (LDCOMPUTE, & PRCT, PRIT, PCIT, PLBDI, & PSSIW, PAI, PCJ, PLVFACT, PLSFACT, & - P_TH_BERFI, P_RC_BERFI, & - PA_TH, PA_RC, PA_RI ) + P_TH_BERFI, P_RC_BERFI ) ! LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE ! @@ -28,10 +27,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! ! REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI -! -REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH -REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC -REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI !! END SUBROUTINE LIMA_BERGERON END INTERFACE @@ -41,8 +36,7 @@ END MODULE MODI_LIMA_BERGERON SUBROUTINE LIMA_BERGERON( LDCOMPUTE, & PRCT, PRIT, PCIT, PLBDI, & PSSIW, PAI, PCJ, PLVFACT, PLSFACT, & - P_TH_BERFI, P_RC_BERFI, & - PA_TH, PA_RC, PA_RI ) + P_TH_BERFI, P_RC_BERFI ) ! ############################################################# ! !! PURPOSE @@ -89,18 +83,9 @@ REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! -REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH -REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC -REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI -! -!* 0.2 Declarations of local variables : -! -! !------------------------------------------------------------------------------- ! -! -!* 1. Bergeron-Findeisen process -! -------------------------- +! Bergeron-Findeisen process ! P_TH_BERFI(:) = 0.0 P_RC_BERFI(:) = 0.0 @@ -111,11 +96,6 @@ WHERE( (PRCT(:)>XRTMIN(2)) .AND. (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>XCTMIN(4)) . P_TH_BERFI(:) = - P_RC_BERFI(:)*(PLSFACT(:)-PLVFACT(:)) END WHERE ! -PA_RC(:) = PA_RC(:) + P_RC_BERFI(:) -PA_RI(:) = PA_RI(:) - P_RC_BERFI(:) -PA_TH(:) = PA_TH(:) + P_TH_BERFI(:) -! -! !------------------------------------------------------------------------------- ! END SUBROUTINE LIMA_BERGERON diff --git a/src/MNH/lima_ccn_activation.f90 b/src/MNH/lima_ccn_activation.f90 index b7786ea4f056c16c1f632f33e51df67f572c71d1..78d9e7c1430316ffad866e1830efb81bfc2e5304 100644 --- a/src/MNH/lima_ccn_activation.f90 +++ b/src/MNH/lima_ccn_activation.f90 @@ -167,7 +167,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, & REAL, DIMENSION(:,:), ALLOCATABLE :: ZTMP, ZCHEN_MULTI ! REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) & - :: ZTDT, ZDRC, ZRVSAT, ZW, ZW2 + :: ZTDT, ZDRC, ZRVSAT, ZW, ZW2, ZCLDFR REAL, DIMENSION(SIZE(PNFT,1),SIZE(PNFT,2),SIZE(PNFT,3)) & :: ZCONC_TOT ! total CCN C. available ! @@ -230,6 +230,11 @@ IF (.NOT. LSUBG_COND) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB .AND. PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ! +IF (.NOT. LSUBG_COND) THEN + ZCLDFR(:,:,:) = 1. +ELSE + ZCLDFR(:,:,:) = PCLDFR(:,:,:) +END IF INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:)) ! @@ -255,8 +260,8 @@ IF( INUCT >= 1 ) THEN ALLOCATE(ZRHODREF(INUCT)) ALLOCATE(ZEXNREF(INUCT)) DO JL=1,INUCT - ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))/PCLDFR(I1(JL),I2(JL),I3(JL)) - ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))/PCLDFR(I1(JL),I2(JL),I3(JL)) + ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))/ZCLDFR(I1(JL),I2(JL),I3(JL)) + ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))/ZCLDFR(I1(JL),I2(JL),I3(JL)) ZZT(JL) = PT(I1(JL),I2(JL),I3(JL)) ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL)) ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL)) diff --git a/src/MNH/lima_cold_slow_processes.f90 b/src/MNH/lima_cold_slow_processes.f90 index 9fcacdd5a39b10fc469e99ffba04621f848456a7..a95f91d462b981b9dec4184de9d767cddeecf288 100644 --- a/src/MNH/lima_cold_slow_processes.f90 +++ b/src/MNH/lima_cold_slow_processes.f90 @@ -80,6 +80,7 @@ END MODULE MODI_LIMA_COLD_SLOW_PROCESSES ! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O ! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90 ! P. Wautelet 03/2020: use the new data structures and subroutines for budgets +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -94,8 +95,8 @@ USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, & XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI USE MODD_NSV, ONLY: NSV_LIMA_NI USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT -USE MODD_PARAM_LIMA, ONLY: LSNOW, XRTMIN, XCTMIN, XALPHAI, XALPHAS, & - XNUI +USE MODD_PARAM_LIMA, ONLY: LSNOW, LSNOW_T, XRTMIN, XCTMIN, & + XALPHAI, XALPHAS, XNUI, XNUS USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, & XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, & XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, & @@ -103,7 +104,8 @@ USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, & XDICNVS_LIM, XLBDAICNVS_LIM, & XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, & XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, & - XAGGS_RLARGE1, XAGGS_RLARGE2 + XAGGS_RLARGE1, XAGGS_RLARGE2, XBS, & + XLBDAS_MIN,XFVELOS,XTRANS_MP_GAMMAS use mode_budget, only: Budget_store_init, Budget_store_end use mode_tools, only: Countjv @@ -316,9 +318,19 @@ IF( IMICRO >= 1 ) THEN ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI END WHERE ZLBDAS(:) = 1.E10 - WHERE (ZRST(:)>XRTMIN(5) ) - ZLBDAS(:) = XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS - END WHERE + IF (LSNOW_T) THEN + WHERE(ZZT(:)>263.15 .AND. ZRST(:)>XRTMIN(5)) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZZT(:))),XLBDAS_MIN) + END WHERE + WHERE(ZZT(:)<=263.15 .AND. ZRST(:)>XRTMIN(5)) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZZT(:))),XLBDAS_MIN) + END WHERE + ZLBDAS(:) = ZLBDAS(:) * XTRANS_MP_GAMMAS + ELSE + WHERE (ZRST(:)>XRTMIN(5) ) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX,XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS),XLBDAS_MIN) + END WHERE + END IF ! ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v @@ -342,16 +354,11 @@ IF( IMICRO >= 1 ) THEN call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVI', pcis(:, :, :) * prhodj(:, :, :) ) end if - WHERE ( ZRST(:)>XRTMIN(5) ) - ZLBDAS(:) = MIN( XLBDAS_MAX, & - XLBS*( ZRHODREF(:)*MAX( ZRST(:),XRTMIN(5) ) )**XLBEXS ) - END WHERE ZZW(:) = 0.0 WHERE ( ZLBDAS(:)<XLBDASCNVI_MAX .AND. (ZRST(:)>XRTMIN(5)) & .AND. (ZSSI(:)<0.0) ) ZZW(:) = (ZLBDAS(:)*XDSCNVI_LIM)**(XALPHAS) - ZZX(:) = ( -ZSSI(:)/ZAI(:) ) * (XCCS*ZLBDAS(:)**XCXS)/ZRHODREF(:) * (ZZW(:)**XNUI) & - * EXP(-ZZW(:)) + ZZX(:) = ( -ZSSI(:)/ZAI(:) ) * (XLBS*ZRST(:)*ZLBDAS(:)**XBS) * (ZZW(:)**XNUI) * EXP(-ZZW(:)) ! ZZW(:) = MIN( ( XR0DEPSI+XR1DEPSI*ZCJ(:) )*ZZX(:),ZRSS(:) ) ZRIS(:) = ZRIS(:) + ZZW(:) @@ -384,8 +391,11 @@ IF( IMICRO >= 1 ) THEN ZZW(:) = 0.0 WHERE ( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>ZRTMIN(5)) ) - ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * & - ( X0DEPS*ZLBDAS(:)**XEX0DEPS + X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS ) + ZZW(:) = ( ZRST(:)*ZSSI(:)/(ZAI(:)) ) * & + ( X0DEPS*ZLBDAS(:)**XEX0DEPS + & + (X1DEPS*ZCJ(:)*(1+(XFVELOS/(2.*ZLBDAS))**XALPHAS)**(-XNUS+XEX1DEPS/XALPHAS) * & + (ZLBDAS(:))**(XEX1DEPS+XBS))) + ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) & - MIN( ZRSS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:))) ZRSS(:) = ZRSS(:) + ZZW(:) @@ -420,8 +430,6 @@ IF( IMICRO >= 1 ) THEN ZZW(:) = (ZLBDAI(:)*XDICNVS_LIM)**(XALPHAI) ZZX(:) = ( ZSSI(:)/ZAI(:) )*ZCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:)) ! -! Correction BVIE -! ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:)/ZRHODREF(:) & ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:) & ,ZRIS(:) ) + ZRTMIN(5), ZRTMIN(5) ) - ZRTMIN(5) ZRIS(:) = ZRIS(:) - ZZW(:) @@ -458,7 +466,7 @@ IF( IMICRO >= 1 ) THEN WHERE ( (ZRIT(:)>XRTMIN(4)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRIS(:)>ZRTMIN(4)) & .AND. (ZCIS(:)>ZCTMIN(4)) ) ZZW1(:,3) = (ZLBDAI(:) / ZLBDAS(:))**3 - ZZW1(:,1) = (ZCIT(:)*(XCCS*ZLBDAS(:)**XCXS)/ZRHODREF(:)*EXP( XCOLEXIS*(ZZT(:)-XTT) )) & + ZZW1(:,1) = (ZCIT(:)*(XLBS*ZRST(:)*ZLBDAS(:)**XBS)*EXP(XCOLEXIS*(ZZT(:)-XTT) )) & / (ZLBDAI(:)**3) ZZW1(:,2) = MIN( ZZW1(:,1)*(XAGGS_CLARGE1+XAGGS_CLARGE2*ZZW1(:,3)),ZCIS(:) ) ZCIS(:) = ZCIS(:) - ZZW1(:,2) diff --git a/src/MNH/lima_conversion_melting_snow.f90 b/src/MNH/lima_conversion_melting_snow.f90 index ff5a691461b7a5de36d44febb6c320ce909eee12..307db0255eed1136811b4b159c846dcbfa692c6a 100644 --- a/src/MNH/lima_conversion_melting_snow.f90 +++ b/src/MNH/lima_conversion_melting_snow.f90 @@ -55,15 +55,16 @@ END MODULE MODI_LIMA_CONVERSION_MELTING_SNOW !! ------------- !! Original 15/03/2018 !! +! J. Wurtz 03/2022: new snow characteristics !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! USE MODD_CST, ONLY : XTT, XMV, XMD, XLVTT, XCPV, XCL, XESTT, XRV -USE MODD_PARAM_LIMA, ONLY : XRTMIN +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XNUS, XALPHAS USE MODD_PARAM_LIMA_MIXED, ONLY : XFSCVMG -USE MODD_PARAM_LIMA_COLD, ONLY : X0DEPS, XEX0DEPS, X1DEPS, XEX1DEPS +USE MODD_PARAM_LIMA_COLD, ONLY : X0DEPS, XEX0DEPS, X1DEPS, XEX1DEPS, XBS, XFVELOS ! IMPLICIT NONE ! @@ -106,9 +107,10 @@ WHERE( (PRST(:)>XRTMIN(5)) .AND. (PT(:)>XTT) .AND. LDCOMPUTE(:) ) ! ! compute RSMLT ! - ZW(:) = XFSCVMG*MAX( 0.0,( -ZW(:) * & - ( X0DEPS* PLBDS(:)**XEX0DEPS + & - X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS ) ))!- & + ZW(:) = XFSCVMG*MAX( 0.0,( -ZW(:) * PRHODREF(:) * PRST(:) * & + ( X0DEPS*PLBDS(:)**XEX0DEPS + & + X1DEPS*PCJ(:)*PLBDS(:)**(XEX1DEPS+XBS)* & + (1+(XFVELOS/(2.*PLBDS(:)))**XALPHAS)**(-XNUS+XEX1DEPS/XALPHAS)) )) ! On ne tient pas compte de la collection de pluie et gouttelettes par la neige si T>0 !!!! ! Note that no heat is exchanged because the graupeln produced are still icy!!! P_RS_CMEL(:) = - ZW(:) diff --git a/src/MNH/lima_droplets_accretion.f90 b/src/MNH/lima_droplets_accretion.f90 index 8996b5425b8282ae43f1676dd6b09e55661b8787..d97d99d3ed0e10522453e5d3043f15d819a102f8 100644 --- a/src/MNH/lima_droplets_accretion.f90 +++ b/src/MNH/lima_droplets_accretion.f90 @@ -58,12 +58,13 @@ END MODULE MODI_LIMA_DROPLETS_ACCRETION !! ------------- !! Original 15/03/2018 !! +! Delbeke/Vie 03/2022 : KHKO option !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LKHKO USE MODD_PARAM_LIMA_WARM, ONLY : XLAUTR, XAUTO1, XLAUTR_THRESHOLD, & XACCR4, XACCR5, XACCR3, XACCR2, XACCR1, & XACCR_CLARGE1, XACCR_CLARGE2, XACCR_RLARGE1, XACCR_RLARGE2, & @@ -109,50 +110,71 @@ ZW2(:) = 0.0 ZW3(:) = 0.0 ZW4(:) = 0.0 ! -WHERE( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:) ) - ZW2(:) = MAX( 0.0,XLAUTR*PRHODREF(:)*PRCT(:)*(XAUTO1/PLBDC(:)**4-XLAUTR_THRESHOLD) ) ! L - ZW4(:) = XACCR1/PLBDR(:) -END WHERE -! -GACCR(:) = LDCOMPUTE(:) .AND. & - PRRT(:)>XRTMIN(3) .AND. & - PCRT(:)>XCTMIN(3) .AND. & - PRCT(:)>XRTMIN(2) .AND. & - PCCT(:)>XCTMIN(2) .AND. & - (PRRT(:)>1.2*ZW2(:)/PRHODREF(:) .OR. & +! +! +IF ( LKHKO ) THEN +! + GACCR(:) = PRRT(:)>XRTMIN(3) .AND. & + PRCT(:)>XRTMIN(2) .AND. & + PCCT(:)>XCTMIN(2) +! + WHERE ( GACCR(:) ) +! + ZW1(:) = 67.0 * ( PRCT(:) * PRRT(:) )**1.15 + P_RC_ACCR(:) = - ZW1(:) +! + ZW2(:) = ZW1(:) * PCCT(:) / PRCT(:) + P_CC_ACCR(:) = - ZW2(:) +! + END WHERE +! +ELSE +! + WHERE( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:) ) + ZW2(:) = MAX( 0.0,XLAUTR*PRHODREF(:)*PRCT(:)*(XAUTO1/PLBDC(:)**4-XLAUTR_THRESHOLD) ) ! L + ZW4(:) = XACCR1/PLBDR(:) + END WHERE +! + GACCR(:) = LDCOMPUTE(:) .AND. & + PRRT(:)>XRTMIN(3) .AND. & + PCRT(:)>XCTMIN(3) .AND. & + PRCT(:)>XRTMIN(2) .AND. & + PCCT(:)>XCTMIN(2) .AND. & + (PRRT(:)>1.2*ZW2(:)/PRHODREF(:) .OR. & ZW4(:)>=MAX(XACCR2,XACCR3/(XACCR4/PLBDC(:)-XACCR5)) ) ! ! Accretion for D>100 10-6 m -WHERE( GACCR(:).AND.(ZW4(:)>1.E-4) ) - ZW3(:) = MIN(PLBDC3(:) / PLBDR3(:),1.E15) - ZW1(:) = ( PCCT(:)*PCRT(:) / PLBDC3(:) )*PRHODREF(:) - ZW2(:) = ZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZW3(:)) + WHERE( GACCR(:).AND.(ZW4(:)>1.E-4) ) + ZW3(:) = MIN(PLBDC3(:) / PLBDR3(:),1.E15) + ZW1(:) = ( PCCT(:)*PCRT(:) / PLBDC3(:) )*PRHODREF(:) + ZW2(:) = ZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZW3(:)) ! - P_CC_ACCR(:) = - ZW2(:) + P_CC_ACCR(:) = - ZW2(:) ! - ZW1(:) = ( ZW1(:) / PLBDC3(:) ) - ZW2(:) = ZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZW3(:)) + ZW1(:) = ( ZW1(:) / PLBDC3(:) ) + ZW2(:) = ZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZW3(:)) ! - P_RC_ACCR(:) = - ZW2(:) -END WHERE + P_RC_ACCR(:) = - ZW2(:) + END WHERE ! ! Accretion for D<100 10-6 m -WHERE( GACCR(:).AND.(ZW4(:)<=1.E-4) ) - ZW3(:) = MIN(PLBDC3(:) / PLBDR3(:), 1.E8) - ZW1(:) = ( PCCT(:)*PCRT(:) / PLBDC3(:) )*PRHODREF(:) - ZW1(:) = ZW1(:)/PLBDC3(:) + WHERE( GACCR(:).AND.(ZW4(:)<=1.E-4) ) + ZW3(:) = MIN(PLBDC3(:) / PLBDR3(:), 1.E8) + ZW1(:) = ( PCCT(:)*PCRT(:) / PLBDC3(:) )*PRHODREF(:) + ZW1(:) = ZW1(:)/PLBDC3(:) - ZW3(:) = ZW3(:)**2 - ZW2(:) = ZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZW3(:)) + ZW3(:) = ZW3(:)**2 + ZW2(:) = ZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZW3(:)) ! - P_CC_ACCR(:) = - ZW2(:) + P_CC_ACCR(:) = - ZW2(:) ! - ZW1(:) = ZW1(:) / PLBDC3(:) - ZW2(:) = ZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZW3(:)) + ZW1(:) = ZW1(:) / PLBDC3(:) + ZW2(:) = ZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZW3(:)) ! - P_RC_ACCR(:) = - ZW2(:) -END WHERE + P_RC_ACCR(:) = - ZW2(:) + END WHERE ! +END IF ! ! !------------------------------------------------------------------------------- diff --git a/src/MNH/lima_droplets_autoconversion.f90 b/src/MNH/lima_droplets_autoconversion.f90 index 044030f792dd2b64affa03bd8407470d8486691b..27090666289087303630e97d95b1c7836fd33d07 100644 --- a/src/MNH/lima_droplets_autoconversion.f90 +++ b/src/MNH/lima_droplets_autoconversion.f90 @@ -53,15 +53,17 @@ END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION !! ------------- !! Original 15/03/2018 !! B. Vie 02/03/2020 : missing CC process +! Delbeke/Vie 03/2022 : KHKO option !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LKHKO USE MODD_PARAM_LIMA_WARM, ONLY : XLAUTR, XAUTO1, XLAUTR_THRESHOLD, & XITAUTR, XAUTO2, XITAUTR_THRESHOLD, & - XACCR4, XACCR5, XACCR3, XACCR1, XAC + XACCR4, XACCR5, XACCR3, XACCR1, XAC, XR0 +USE MODD_CST, ONLY : XPI, XRHOLW ! IMPLICIT NONE ! @@ -86,13 +88,6 @@ REAL, DIMENSION(SIZE(PRCT)) :: ZW1, ZW2, ZW3 ! work arrays ! !------------------------------------------------------------------------------- ! -! -! -!* 1. Autoconversion of cloud droplets (Berry-Reinhardt parameterization) -! ---------------------------------------------------------------------- -! -! -! P_RC_AUTO(:) = 0.0 P_CC_AUTO(:) = 0.0 P_CR_AUTO(:) = 0.0 @@ -100,27 +95,53 @@ P_CR_AUTO(:) = 0.0 ZW3(:) = 0.0 ZW2(:) = 0.0 ZW1(:) = 0.0 -WHERE( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. PLBDC(:)>0. .AND. LDCOMPUTE(:) ) - ZW2(:) = MAX( 0.0, & +! +IF (LKHKO) THEN +! +! 1. Autoconversion of cloud droplets (Berry-Reinhardt parameterization) +! ---------------------------------------------------------------------- +! + WHERE ( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. LDCOMPUTE(:) ) +! + ZW1(:)= 1350.0 * PRCT(:)**(2.47) * (PCCT(:)* PRHODREF(:)/1.0E6)**(-1.79) ! ZCCT in cm-3 +! + P_RC_AUTO(:) = - ZW1(:) +! + ZW2(:) = ZW1(:) * 3./(4.*XPI*XRHOLW*(XR0)**(3.)) + P_CR_AUTO(:) = ZW2(:) +! + ZW3(:) = - ZW1(:) * PCCT(:) / PRCT(:) + P_CC_AUTO(:) = ZW3(:) +! + END WHERE +! +ELSE +! +! 2. Autoconversion of cloud droplets (Berry-Reinhardt parameterization) +! ---------------------------------------------------------------------- +! + WHERE( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. PLBDC(:)>0. .AND. LDCOMPUTE(:) ) + ZW2(:) = MAX( 0.0, & XLAUTR*PRHODREF(:)*PRCT(:)*(XAUTO1/min(PLBDC(:),1.e9)**4-XLAUTR_THRESHOLD) ) ! L ! - ZW3(:) = MAX( 0.0, & + ZW3(:) = MAX( 0.0, & XITAUTR*ZW2(:)*PRCT(:)*(XAUTO2/PLBDC(:)-XITAUTR_THRESHOLD) ) ! L/tau ! - P_RC_AUTO(:) = - ZW3(:) + P_RC_AUTO(:) = - ZW3(:) ! - ZW1(:) = MIN( MIN( 1.2E4, & - (XACCR4/PLBDC(:)-XACCR5)/XACCR3 ), & - PLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for - ! switching the autoconversion regimes - ! min (80 microns, D_h, D_r) - ZW3(:) = ZW3(:) * MAX( 0.0,ZW1(:) )**3 / XAC + ZW1(:) = MIN( MIN( 1.2E4, & + (XACCR4/PLBDC(:)-XACCR5)/XACCR3 ), & + PLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for + ! switching the autoconversion regimes + ! min (80 microns, D_h, D_r) + ZW3(:) = ZW3(:) * MAX( 0.0,ZW1(:) )**3 / XAC ! - P_CC_AUTO(:) = -ZW3(:) - P_CR_AUTO(:) = ZW3(:) + P_CC_AUTO(:) = -ZW3(:) + P_CR_AUTO(:) = ZW3(:) ! -END WHERE + END WHERE ! +END IF ! !------------------------------------------------------------------------------- ! diff --git a/src/MNH/lima_droplets_riming_snow.f90 b/src/MNH/lima_droplets_riming_snow.f90 index 6bef29df3bfac250078b40d9c8f45d2d00cc4dfa..b1c4a8007bddd182015e9aac542bec4c3e0d1c73 100644 --- a/src/MNH/lima_droplets_riming_snow.f90 +++ b/src/MNH/lima_droplets_riming_snow.f90 @@ -66,6 +66,7 @@ END MODULE MODI_LIMA_DROPLETS_RIMING_SNOW !! ------------- !! Original 15/03/2018 ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -73,11 +74,11 @@ END MODULE MODI_LIMA_DROPLETS_RIMING_SNOW ! ------------ ! USE MODD_CST, ONLY : XTT -USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT, XNUS, XALPHAS USE MODD_PARAM_LIMA_MIXED, ONLY : NGAMINC, XRIMINTP1, XRIMINTP2, XGAMINC_RIM1, XGAMINC_RIM2, & - XCRIMSS, XEXCRIMSS, XSRIMCG, XEXSRIMCG, & + XCRIMSS, XEXCRIMSS, XSRIMCG, XEXSRIMCG, XSRIMCG2, XSRIMCG3, XEXSRIMCG2, & XHMLINTP1, XHMLINTP2, XGAMINC_HMC, XHM_FACTS, XHMTMIN, XHMTMAX -USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0 +USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0, XBS, XFVELOS ! IMPLICIT NONE ! @@ -171,7 +172,9 @@ WHERE( GRIM ) ! 4. riming ! ! Cloud droplets collected - P_RC_RIM(:) = - XCRIMSS * PRCT(:) * PLBDS(:)**XEXCRIMSS * PRHODREF(:)**(-XCEXVT) + P_RC_RIM(:) = - XCRIMSS * PRCT(:) * PRST(:)*(1+(XFVELOS/PLBDS(:))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) & + * PRHODREF(:)**(-XCEXVT+1) & + * (PLBDS(:)) ** (XEXCRIMSS+XBS) P_CC_RIM(:) = P_RC_RIM(:) *(PCCT(:)/PRCT(:)) ! Lambda_c**3 ! ! Cloud droplets collected on small aggregates add to snow @@ -181,7 +184,7 @@ WHERE( GRIM ) P_RG_RIM(:) = - P_RC_RIM(:) - P_RS_RIM(:) ! ! Large aggregates collecting droplets add to graupel (instant process ???) - ZZW3(:) = XSRIMCG * PLBDS(:)**XEXSRIMCG * (1.0 - ZZW2(:))/(PTSTEP*PRHODREF(:)) + ZZW3(:) = PRST(:)*(1.0 - ZZW2(:))/PTSTEP P_RS_RIM(:) = P_RS_RIM(:) - ZZW3(:) P_RG_RIM(:) = P_RG_RIM(:) + ZZW3(:) ! diff --git a/src/MNH/lima_graupel.f90 b/src/MNH/lima_graupel.f90 index ad114da363f6c1616ce45ee6534f929d64845e2f..578f22bbf93fb04be12fb7e1c7edd9f1957cbe53 100644 --- a/src/MNH/lima_graupel.f90 +++ b/src/MNH/lima_graupel.f90 @@ -129,6 +129,7 @@ END MODULE MODI_LIMA_GRAUPEL !! ------------- !! Original 15/03/2018 ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -330,12 +331,12 @@ WHERE( GDRY ) * (ZVEC1(:) - 1.0) ZZW(:) = ZVEC3(:) ! - ZZW3(:) = XFSDRYG * ZZW(:) * EXP( XCOLEXSG*(PT(:)-XTT) ) & ! RSDRYG - rs collected by graupel in dry mode - *( PLBDS(:)**(XCXS-XBS) )*( PLBDG(:)**XCXG ) & - *( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSDRYG1/( PLBDG(:)**2 ) + & - XLBSDRYG2/( PLBDG(:) * PLBDS(:) ) + & - XLBSDRYG3/( PLBDS(:)**2) ) + ZZW3(:) = XFSDRYG * ZZW(:) * EXP( XCOLEXSG*(PT(:)-XTT) ) & ! RSDRYG - rs collected by graupel in dry mode + *( PRST(:))*( PLBDG(:)**XCXG ) & + *( PRHODREF(:)**(-XCEXVT) ) & + *( XLBSDRYG1/( PLBDG(:)**2 ) + & + XLBSDRYG2/( PLBDG(:) * PLBDS(:) ) + & + XLBSDRYG3/( PLBDS(:)**2) ) END WHERE ! !* 1.c Collection of rr in the dry mode diff --git a/src/MNH/lima_ice_aggregation_snow.f90 b/src/MNH/lima_ice_aggregation_snow.f90 index 15e01ec84b33a508d8b30285ea944540185b1015..2979bee5b31a944057a7b78360a6505ab58302ee 100644 --- a/src/MNH/lima_ice_aggregation_snow.f90 +++ b/src/MNH/lima_ice_aggregation_snow.f90 @@ -52,16 +52,18 @@ END MODULE MODI_LIMA_ICE_AGGREGATION_SNOW !! MODIFICATIONS !! ------------- !! Original 15/03/2018 -!! +! J. Wurtz 03/2022: new snow characteristics +! B. Vie 03/2022: Add option for 1-moment pristine ice +! !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! USE MODD_CST, ONLY : XTT -USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, NMOM_I USE MODD_PARAM_LIMA_COLD, ONLY : XBI, XCCS, XCXS, XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, & - XAGGS_RLARGE1, XAGGS_RLARGE2 + XAGGS_RLARGE1, XAGGS_RLARGE2, XFIAGGS, XBS, XLBS ! IMPLICIT NONE ! @@ -99,19 +101,30 @@ P_RI_AGGS(:) = 0. P_CI_AGGS(:) = 0. ! ! -WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. LDCOMPUTE(:) ) - ZZW1(:) = (PLBDI(:) / PLBDS(:))**3 - ZZW2(:) = (PCIT(:)*(XCCS*PLBDS(:)**XCXS)/PRHODREF(:)*EXP( XCOLEXIS*(PT(:)-XTT) )) & - / (PLBDI(:)**3) - ZZW3(:) = ZZW2(:)*(XAGGS_CLARGE1+XAGGS_CLARGE2*ZZW1(:)) +IF (NMOM_I.EQ.1) THEN + WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. LDCOMPUTE(:) ) + ZZW1(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) & + * PRIT(:) & + * PLBDS(:)**(1.-0.27-2.) & + * PRHODREF(:)**(-XCEXVT) +! + P_RI_AGGS(:) = - ZZW1(:) + END WHERE +ELSE + WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. LDCOMPUTE(:) ) + ZZW1(:) = (PLBDI(:) / PLBDS(:))**3 + ZZW2(:) = (PCIT(:)*(XLBS*PRST(:)*PLBDS(:)**XBS)*EXP(XCOLEXIS*(PT(:)-XTT) )) & + / (PLBDI(:)**3) + ZZW3(:) = ZZW2(:)*(XAGGS_CLARGE1+XAGGS_CLARGE2*ZZW1(:)) ! - P_CI_AGGS(:) = - ZZW3(:) + P_CI_AGGS(:) = - ZZW3(:) ! - ZZW2(:) = ZZW2(:) / PLBDI(:)**XBI - ZZW2(:) = ZZW2(:)*(XAGGS_RLARGE1+XAGGS_RLARGE2*ZZW1(:)) + ZZW2(:) = ZZW2(:) / PLBDI(:)**XBI + ZZW2(:) = ZZW2(:)*(XAGGS_RLARGE1+XAGGS_RLARGE2*ZZW1(:)) ! - P_RI_AGGS(:) = - ZZW2(:) -END WHERE + P_RI_AGGS(:) = - ZZW2(:) + END WHERE +END IF ! ! !------------------------------------------------------------------------------- diff --git a/src/MNH/lima_ice_deposition.f90 b/src/MNH/lima_ice_deposition.f90 index 8c7c57e4091305b31d8906cec050cd18427f63cb..2b46227b80ded9618b03c77b75eb75ce0a90a458 100644 --- a/src/MNH/lima_ice_deposition.f90 +++ b/src/MNH/lima_ice_deposition.f90 @@ -8,16 +8,17 @@ ! ##################### ! INTERFACE - SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, & - PRHODREF, PSSI, PAI, PCJ, PLSFACT, & - PRIT, PCIT, PLBDI, & - P_TH_DEPI, P_RI_DEPI, & - P_RI_CNVS, P_CI_CNVS ) + SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, & + PRHODREF, PT, PSSI, PAI, PCJ, PLSFACT, & + PRIT, PCIT, PLBDI, & + P_TH_DEPI, P_RI_DEPI, & + P_RI_CNVS, P_CI_CNVS ) ! REAL, INTENT(IN) :: PTSTEP LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE ! REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(:), INTENT(IN) :: PT ! abs. pressure at time t REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t @@ -40,7 +41,7 @@ END MODULE MODI_LIMA_ICE_DEPOSITION ! ! ########################################################################## SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, & - PRHODREF, PSSI, PAI, PCJ, PLSFACT, & + PRHODREF, PT, PSSI, PAI, PCJ, PLSFACT, & PRIT, PCIT, PLBDI, & P_TH_DEPI, P_RI_DEPI, & P_RI_CNVS, P_CI_CNVS ) @@ -65,14 +66,16 @@ SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, & !! MODIFICATIONS !! ------------- !! Original 15/03/2018 -!! +!! B. Vié 30/08/2021 Disable CNVS if LSNOW=F +!! B. Vie 03/2022 Add option for 1-moment pristine ice !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS -USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, & +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS,& + LSNOW, NMOM_I +USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, & XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, & XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, & XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, & @@ -81,7 +84,7 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, & XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, & XAGGS_RLARGE1, XAGGS_RLARGE2, & XDI, X0DEPI, X2DEPI - +USE MODD_CST, ONLY : XTT ! IMPLICIT NONE ! @@ -91,6 +94,7 @@ REAL, INTENT(IN) :: PTSTEP LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE ! REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(:), INTENT(IN) :: PT ! abs. pressure at time t REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t @@ -110,7 +114,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVS !* 0.2 Declarations of local variables : ! LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMICRO ! Computations only where necessary -REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX ! Work array +REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX, ZCRIAUTI ! Work array ! ! !------------------------------------------------------------------------------- @@ -128,48 +132,55 @@ P_CI_CNVS(:) = 0. GMICRO(:) = LDCOMPUTE(:) .AND. PRIT(:)>XRTMIN(4) ! ! -WHERE( GMICRO ) -! +IF (NMOM_I.EQ.1) THEN + WHERE( GMICRO ) ! -!* 2.2 Deposition of water vapor on r_i: RVDEPI -! ----------------------------------------------- +!* Conversion of pristine ice to r_s: RICNVS +! ----------------------------------------- ! + ZCRIAUTI(:)=MIN(0.2E-4,10**(0.06*(PT(:)-XTT)-3.5)) + ZZW(:) = 0.0 + WHERE ( (PRIT(:)>XRTMIN(4))) + ZZW(:) = 1.E-3 * EXP( 0.015*(PT(:)-XTT) ) * MAX( PRIT(:)-ZCRIAUTI(:),0.0 ) + END WHERE ! - ZZW(:) = 0.0 - WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>XCTMIN(4)) ) - ZZW(:) = ( PSSI(:) / PAI(:) ) * PCIT(:) * & - ( X0DEPI/PLBDI(:)+X2DEPI*PCJ(:)*PCJ(:)/PLBDI(:)**(XDI+2.0) ) + P_RI_CNVS(:) = - ZZW(:) END WHERE -! - P_RI_DEPI(:) = ZZW(:) -!!$ P_TH_DEPI(:) = P_RI_DEPI(:) * PLSFACT(:) -! -!!$ PA_TH(:) = PA_TH(:) + P_TH_DEPI(:) -!!$ PA_RV(:) = PA_RV(:) - P_RI_DEPI(:) -!!$ PA_RI(:) = PA_RI(:) + P_RI_DEPI(:) -! -! -!* 2.3 Conversion of pristine ice to r_s: RICNVS -! ------------------------------------------------ -! -! - ZZW(:) = 0.0 - ZZW2(:) = 0.0 - WHERE ( (PLBDI(:)<XLBDAICNVS_LIM) .AND. (PCIT(:)>XCTMIN(4)) & - .AND. (PSSI(:)>0.0) ) - ZZW(:) = (PLBDI(:)*XDICNVS_LIM)**(XALPHAI) - ZZX(:) = ( PSSI(:)/PAI(:) )*PCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:)) -! - ZZW(:) = ( XR0DEPIS + XR1DEPIS*PCJ(:) )*ZZX(:) -! - ZZW2(:) = ZZW(:) * (XC0DEPIS+XC1DEPIS*PCJ(:)) / (XR0DEPIS+XR1DEPIS*PCJ(:)) +ELSE + WHERE( GMICRO ) +! +!* Deposition of water vapor on r_i: RVDEPI +! ---------------------------------------- +! + ZZW(:) = 0.0 + WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>XCTMIN(4)) ) + ZZW(:) = ( PSSI(:) / PAI(:) ) * PCIT(:) * & + ( X0DEPI/PLBDI(:)+X2DEPI*PCJ(:)*PCJ(:)/PLBDI(:)**(XDI+2.0) ) + END WHERE + P_RI_DEPI(:) = ZZW(:) +! +!* Conversion of pristine ice to r_s: RICNVS +! ----------------------------------------- +! + ZZW(:) = 0.0 + ZZW2(:) = 0.0 + WHERE ( (PLBDI(:)<XLBDAICNVS_LIM) .AND. (PCIT(:)>XCTMIN(4)) & + .AND. (PSSI(:)>0.0) ) + ZZW(:) = (PLBDI(:)*XDICNVS_LIM)**(XALPHAI) + ZZX(:) = (PSSI(:)/PAI(:))*PCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:)) +! + ZZW(:) = (XR0DEPIS + XR1DEPIS*PCJ(:))*ZZX(:) +! + ZZW2(:) = ZZW(:) * (XC0DEPIS+XC1DEPIS*PCJ(:)) / (XR0DEPIS+XR1DEPIS*PCJ(:)) + END WHERE + P_RI_CNVS(:) = - ZZW(:) + P_CI_CNVS(:) = - ZZW2(:) END WHERE +END IF ! -P_RI_CNVS(:) = - ZZW(:) -P_CI_CNVS(:) = - ZZW2(:) -! -! -END WHERE -! +IF (.NOT.LSNOW) THEN + P_RI_CNVS(:) = 0. + P_CI_CNVS(:) = 0. +END IF ! END SUBROUTINE LIMA_ICE_DEPOSITION diff --git a/src/MNH/lima_ice_snow_deposition.f90 b/src/MNH/lima_ice_snow_deposition.f90 index 4d92b528ac9aabb0224e61ae9de0c23a5b50f0fb..f31d3175d58108eecb631b515567ca27e669d202 100644 --- a/src/MNH/lima_ice_snow_deposition.f90 +++ b/src/MNH/lima_ice_snow_deposition.f90 @@ -78,21 +78,22 @@ SUBROUTINE LIMA_ICE_SNOW_DEPOSITION (PTSTEP, LDCOMPUTE, & !! MODIFICATIONS !! ------------- !! Original 15/03/2018 +! J. Wurtz 03/2022: new snow characteristics !! !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS -USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, & +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS +USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, XLBS, XBS, & XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, & XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, & XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, & XDICNVS_LIM, XLBDAICNVS_LIM, & XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, & XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, & - XAGGS_RLARGE1, XAGGS_RLARGE2 + XAGGS_RLARGE1, XAGGS_RLARGE2, XFVELOS ! IMPLICIT NONE @@ -166,7 +167,7 @@ WHERE( GMICRO ) WHERE ( PLBDS(:)<XLBDASCNVI_MAX .AND. (PRST(:)>XRTMIN(5)) & .AND. (PSSI(:)<0.0) ) ZZW(:) = (PLBDS(:)*XDSCNVI_LIM)**(XALPHAS) - ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XCCS*PLBDS(:)**XCXS)/PRHODREF(:) * (ZZW(:)**XNUS) * EXP(-ZZW(:)) + ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XLBS*PRST(:)*PLBDS(:)**XBS) * (ZZW(:)**XNUS) * EXP(-ZZW(:)) ! ZZW(:) = ( XR0DEPSI+XR1DEPSI*PCJ(:) )*ZZX(:) ! @@ -187,8 +188,10 @@ WHERE( GMICRO ) ! ZZW(:) = 0.0 WHERE ( (PRST(:)>XRTMIN(5)) ) - ZZW(:) = ( PSSI(:)/(PAI(:))/PRHODREF(:) ) * & - ( X0DEPS*PLBDS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS ) + ZZW(:) =( PRST(:)*PSSI(:)/PAI(:) ) * & + ( X0DEPS*PLBDS(:)**XEX0DEPS + & + ( X1DEPS*PCJ(:)*(PLBDS(:))**(XBS+XEX1DEPS) * & + (1+(XFVELOS/(2.*PLBDS(:)))**XALPHAS)**(-XNUS+XEX1DEPS/XALPHAS))) ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:))) END WHERE ! diff --git a/src/MNH/lima_mixed.f90 b/src/MNH/lima_mixed.f90 index 49024b7b518893f1b9b101175676fb8a5d18f558..4d558eb1da83e2eb5d500c0ee18dbce977d80c42 100644 --- a/src/MNH/lima_mixed.f90 +++ b/src/MNH/lima_mixed.f90 @@ -96,6 +96,7 @@ END MODULE MODI_LIMA_MIXED ! P. Wautelet 03/2020: use the new data structures and subroutines for budgets (no more call to budget in this subroutine) ! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS ! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA +! J. Wurtz 03/2022: new snow characteristics !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -108,9 +109,9 @@ USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, & USE MODD_NSV USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, XRTMIN, XCTMIN, LWARM, LCOLD, & - NMOD_CCN, NMOD_IMM, LRAIN, LSNOW, LHAIL + NMOD_CCN, NMOD_IMM, LRAIN, LSNOW, LHAIL, LSNOW_T USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XLBR, XLBEXR -USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XSCFAC +USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XSCFAC, XLBDAS_MAX, XLBDAS_MIN, XTRANS_MP_GAMMAS USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG, XLBEXG, XLBH, XLBEXH use mode_tools, only: Countjv @@ -467,9 +468,19 @@ IF( IMICRO >= 1 ) THEN ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI END WHERE ZLBDAS(:) = 1.E10 - WHERE (ZRST(:)>XRTMIN(5) ) - ZLBDAS(:) = XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS - END WHERE + IF (LSNOW_T) THEN + WHERE(ZZT(:)>263.15 .AND. ZRST(:)>XRTMIN(5)) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZZT(:))),XLBDAS_MIN) + END WHERE + WHERE(ZZT(:)<=263.15 .AND. ZRST(:)>XRTMIN(5)) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZZT(:))),XLBDAS_MIN) + END WHERE + ZLBDAS(:) = ZLBDAS(:)*XTRANS_MP_GAMMAS + ELSE + WHERE (ZRST(:)>XRTMIN(5)) + ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS),XLBDAS_MIN) + END WHERE + END IF ZLBDAG(:) = 1.E10 WHERE (ZRGT(:)>XRTMIN(6) ) ZLBDAG(:) = XLBG*( ZRHODREF(:)*ZRGT(:) )**XLBEXG diff --git a/src/MNH/lima_mixed_fast_processes.f90 b/src/MNH/lima_mixed_fast_processes.f90 index 525ea3dfba7257955559379942b9b3413257ef81..662eecdd980a20f07ac222b70b1c673a2d362763 100644 --- a/src/MNH/lima_mixed_fast_processes.f90 +++ b/src/MNH/lima_mixed_fast_processes.f90 @@ -145,7 +145,7 @@ END MODULE MODI_LIMA_MIXED_FAST_PROCESSES ! C. Barthe 14/03/2022: - add CIBU (from T. Hoarau's work) and RDSF (from J.P. Pinty's work) ! - change the name of some arguments to match the DOCTOR norm ! - change conditions for HMG to occur -! +! J. Wurtz 03/2022: new snow characteristics !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -347,8 +347,9 @@ IF( IGRIM>0 ) THEN WHERE ( GRIM(:) ) ZZW1(:,1) = MIN( PRCS1D(:), & XCRIMSS * ZZW(:) * PRCT1D(:) & ! RCRIMSS - * PLBDAS(:)**XEXCRIMSS & - * PRHODREF(:)**(-XCEXVT) ) + * PRST1D(:)*(1+(XFVELOS/PLBDAS(:))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) & + * PRHODREF(:)**(-XCEXVT+1) & + * (PLBDAS(:)) ** (XEXCRIMSS+XBS) ) PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) PRSS1D(:) = PRSS1D(:) + ZZW1(:,1) PTHS1D(:) = PTHS1D(:) + ZZW1(:,1) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RCRIMSS)) @@ -367,13 +368,12 @@ IF( IGRIM>0 ) THEN ! WHERE ( GRIM(:) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) ) ZZW1(:,2) = MIN( PRCS1D(:), & - XCRIMSG * PRCT1D(:) & ! RCRIMSG - * PLBDAS(:)**XEXCRIMSG & - * PRHODREF(:)**(-XCEXVT) & - - ZZW1(:,1) ) + XCRIMSG * PRCT1D(:)* PRST1D(:) & ! RCRIMSG + *(1+(XFVELOS/PLBDAS(:))**XALPHAS)**(-XNUS+XEXCRIMSG/XALPHAS)*PLBDAS(:)**(XBS+XEXCRIMSG) & + * PRHODREF(:)**(-XCEXVT+1) & + - ZZW1(:,1) ) ZZW1(:,3) = MIN( PRSS1D(:), & - XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG - * (1.0 - ZZW(:) )/(PTSTEP*PRHODREF(:))) + XSRIMCG * XLBS * PRST1D(:) * (1.0 - ZZW(:))/PTSTEP ) PRCS1D(:) = PRCS1D(:) - ZZW1(:,2) PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) PRGS1D(:) = PRGS1D(:) + ZZW1(:,2) + ZZW1(:,3) @@ -824,10 +824,10 @@ IF( IGACC>0 .AND. LRAIN) THEN ! WHERE ( GACC(:) ) ZZW1(:,2) = PCRT1D(:) * & !! coef of RRACCS - XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBRACCS1/((PLBDAS(:)**2) ) + & - XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + & - XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**3 + XFRACCSS*( PRST1D(:)*PLBDAS(:)**XBS )*( PRHODREF(:)**(-XCEXVT) ) & + *( XLBRACCS1/((PLBDAS(:)**2) ) + & + XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + & + XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**3 ZZW1(:,4) = MIN( PRRS1D(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS PRRS1D(:) = PRRS1D(:) - ZZW1(:,4) PRSS1D(:) = PRSS1D(:) + ZZW1(:,4) @@ -868,10 +868,10 @@ IF( IGACC>0 .AND. LRAIN) THEN WHERE ( GACC(:) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) ) ZZW1(:,2) = MAX( MIN( PRRS1D(:),ZZW1(:,2)-ZZW1(:,4) ) , 0. ) ! RRACCSG ZZW1(:,3) = MIN( PRSS1D(:),XFSACCRG*ZZW(:)* & ! RSACCRG - ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSACCR1/((PLBDAR(:)**2) ) + & - XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + & - XLBSACCR3/( (PLBDAS(:)**2)) ) ) + ( PRST1D(:) )*( PRHODREF(:)**(-XCEXVT) ) & + *( XLBSACCR1/((PLBDAR(:)**2) ) + & + XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + & + XLBSACCR3/( (PLBDAS(:)**2)) ) ) PRRS1D(:) = PRRS1D(:) - ZZW1(:,2) PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) PRGS1D(:) = PRGS1D(:) + ZZW1(:,2) + ZZW1(:,3) @@ -920,12 +920,13 @@ WHERE( (PRST1D(:)>XRTMIN(5)) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) .AND. (PZT(:)>XT ! ! compute RSMLT ! - ZZW(:) = MIN( PRSS1D(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * & - ( X0DEPS* PLBDAS(:)**XEX0DEPS + & - X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - & - ( ZZW1(:,1)+ZZW1(:,4) ) * & - ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / & - ( PRHODREF(:)*XLMTT ) ) ) + ZZW(:) = MIN( PRSS1D(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * & + PRHODREF(:) * PRST1D(:)*( X0DEPS* PLBDAS(:)**XEX0DEPS + & + X1DEPS*PCJ(:)*(1+(XFVELOS/(2.*PLBDAS(:)))**XALPHAS) & + **(-XNUS+XEX1DEPS/XALPHAS)*(PLBDAS(:))**(XEX1DEPS+XBS))- & + ( ZZW1(:,1)+ZZW1(:,4) ) * & + ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / & + ( PRHODREF(:)*XLMTT ) ) ) ! ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT) ! because the graupeln produced by this process are still icy!!! @@ -1174,12 +1175,12 @@ IF( IGDRY>0 ) THEN ! WHERE( GDRY(:) ) ZZW1(:,3) = MIN( PRSS1D(:),XFSDRYG*ZZW(:) & ! RSDRYG - * EXP( XCOLEXSG*(PZT(:)-XTT) ) & - *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAG(:)**XCXG ) & - *( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSDRYG1/( PLBDAG(:)**2 ) + & - XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + & - XLBSDRYG3/( PLBDAS(:)**2) ) ) + * EXP( XCOLEXSG*(PZT(:)-XTT) ) & + *( PRST1D(:)) )*( PLBDAG(:)**XCXG ) & + *( PRHODREF(:)**(-XCEXVT) ) & + *( XLBSDRYG1/( PLBDAG(:)**2 ) + & + XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + & + XLBSDRYG3/( PLBDAS(:)**2) ) END WHERE DEALLOCATE(IVEC2) DEALLOCATE(IVEC1) @@ -1426,11 +1427,8 @@ if ( nbumod == kmi .and. lbu_enable ) then Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if -!GDRY(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))& -! .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCT1D(:)>XRTMIN(2)) GDRY(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZRWETG(:))& .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCT1D(:)>XRTMIN(2)) -! IGDRY = COUNT( GDRY(:) ) IF( IGDRY>0 ) THEN ALLOCATE(ZVEC1(IGDRY)) @@ -1620,11 +1618,11 @@ IF( IHAIL>0 ) THEN ! WHERE( GWET(:) ) ZZW1(:,3) = MIN( PRSS1D(:),XFSWETH*ZZW(:) & ! RSWETH - *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) & - *( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSWETH1/( PLBDAH(:)**2 ) + & - XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + & - XLBSWETH3/( PLBDAS(:)**2) ) ) + *( PRST1D(:))*( PLBDAH(:)**XCXH ) & + *( PRHODREF(:)**(-XCEXVT) ) & + *( XLBSWETH1/( PLBDAH(:)**2 ) + & + XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + & + XLBSWETH3/( PLBDAS(:)**2) ) ) END WHERE DEALLOCATE(IVEC2) DEALLOCATE(IVEC1) diff --git a/src/MNH/lima_notadjust.f90 b/src/MNH/lima_notadjust.f90 index 94ea1f4fdac0f3df7143f867cdd9e28740f8a5b6..48e97a2f32c15557758f71eddfe2c2f8517c9364 100644 --- a/src/MNH/lima_notadjust.f90 +++ b/src/MNH/lima_notadjust.f90 @@ -11,7 +11,7 @@ INTERFACE ! SUBROUTINE LIMA_NOTADJUST(KMI, TPFILE, HRAD, & PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, & - PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PSRCS ) + PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PICEFR, PRAINFR, PSRCS ) ! USE MODD_IO, ONLY: TFILEDATA ! @@ -38,6 +38,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux ! s'rc'/2Sigma_s2 at time t+1 ! multiplied by Lambda_3 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRAINFR ! Cloud fraction ! ! END SUBROUTINE LIMA_NOTADJUST @@ -49,7 +51,7 @@ END MODULE MODI_LIMA_NOTADJUST ! #################################################################################### SUBROUTINE LIMA_NOTADJUST(KMI, TPFILE, HRAD, & PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, & - PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PSRCS ) + PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PICEFR, PRAINFR, PSRCS ) ! #################################################################################### ! !!**** * - compute pseudo-prognostic of supersaturation according to Thouron @@ -126,6 +128,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux ! s'rc'/2Sigma_s2 at time t+1 ! multiplied by Lambda_3 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRAINFR ! Cloud fraction ! ! !* 0.2 Declarations of local variables : @@ -447,9 +451,10 @@ GNUCT(:,:,:) = .FALSE. !GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 .OR. & ! ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 !GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 -GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 .OR. & +GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>-1.0 .AND. & + ( ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 .OR. & ! ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>1.E+05 - ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2) + ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2) ) INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:)) !3D array to 1D array ! @@ -564,6 +569,23 @@ IF ( HRAD /= 'NONE' ) THEN PCLDFR(:,:,:) = ZW1(:,:,:) END IF ! +ZW1(:,:,:)=0. +IF (SIZE(PRS,4)>3) ZW1(:,:,:)=ZW1(:,:,:) + PRS(:,:,:,4) +WHERE (ZW1(:,:,:) > 1.E-15) + PICEFR(:,:,:) = 1. +ELSEWHERE + PICEFR(:,:,:) = 0. +ENDWHERE +ZW1(:,:,:)=0. +IF (SIZE(PRS,4)>2) ZW1(:,:,:)=ZW1(:,:,:) + PRS(:,:,:,3) +IF (SIZE(PRS,4)>4) ZW1(:,:,:)=ZW1(:,:,:) + PRS(:,:,:,5) +IF (SIZE(PRS,4)>5) ZW1(:,:,:)=ZW1(:,:,:) + PRS(:,:,:,6) +WHERE (ZW1(:,:,:) > 1.E-15) + PRAINFR(:,:,:) = 1. +ELSEWHERE + PRAINFR(:,:,:) = 0. +ENDWHERE +! IF ( tpfile%lopened ) THEN ZW(:,:,:)=SUM(ZNAS,4)-ZW(:,:,:) TZFIELD%CMNHNAME = 'NACT' diff --git a/src/MNH/lima_nucleation_procs.f90 b/src/MNH/lima_nucleation_procs.f90 index 122d4b3c867f2e98af5b9d6461a492df26a45e5e..f3f4e17fd057fde863f393e761a8f98265e1aae1 100644 --- a/src/MNH/lima_nucleation_procs.f90 +++ b/src/MNH/lima_nucleation_procs.f90 @@ -79,6 +79,7 @@ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, ! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets) ! P. Wautelet 02/2020: use the new data structures and subroutines for budgets ! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation +! B. Vie 03/2022: Add option for 1-moment pristine ice !------------------------------------------------------------------------------- ! use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, & @@ -86,10 +87,11 @@ use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudg NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, & tbudgets USE MODD_IO, ONLY: TFILEDATA +USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, & NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, & - NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO + NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO, NMOM_I USE MODD_TURB_n, ONLY : LSUBG_COND use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end @@ -98,6 +100,7 @@ USE MODI_LIMA_CCN_ACTIVATION USE MODI_LIMA_CCN_HOM_FREEZING USE MODI_LIMA_MEYERS_NUCLEATION USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION +USE MODE_RAIN_ICE_NUCLEATION ! !------------------------------------------------------------------------------- ! @@ -142,6 +145,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction !------------------------------------------------------------------------------- ! REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC +REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZTHS, ZRIS, ZRVS, ZRHT, ZCIT, ZT ! integer :: idx INTEGER :: JL @@ -193,7 +197,7 @@ END IF ! !------------------------------------------------------------------------------- ! -IF ( LCOLD .AND. LNUCL .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN +IF ( LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN if ( lbu_enable ) then if ( lbudget_sv ) then do jl = 1, nmod_ifn @@ -257,7 +261,7 @@ END IF ! !------------------------------------------------------------------------------- ! -IF (LCOLD .AND. LNUCL .AND. LMEYERS) THEN +IF (LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN CALL LIMA_MEYERS_NUCLEATION (PTSTEP, & PRHODREF, PEXNREF, PPABST, & PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & @@ -266,7 +270,56 @@ IF (LCOLD .AND. LNUCL .AND. LMEYERS) THEN Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, & PICEFR ) WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1. + ! + if ( lbu_enable ) then + if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep ) + if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep ) + if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep ) + if ( lbudget_sv ) then + call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep ) + if (nmod_ifn > 0 ) & + call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', & + z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep ) + end if + + if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep ) + if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep ) + if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep ) + if ( lbudget_sv ) then + call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep ) + call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep ) + if (nmod_ifn > 0 ) & + call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', & + -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep ) + end if + end if +END IF ! +!------------------------------------------------------------------------------- +! +IF (LCOLD .AND. LNUCL .AND. NMOM_I.EQ.1) THEN + WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1. + ! + ZTHS=PTHT/PTSTEP + ZRVS=PRVT/PTSTEP + ZRIS=PRIT/PTSTEP + ZRHT=0. + ZCIT=PCIT + ZT=PT + CALL RAIN_ICE_NUCLEATION(1+JPHEXT, SIZE(PT,1)-JPHEXT, 1+JPHEXT, SIZE(PT,2)-JPHEXT, 1+JPVEXT, SIZE(PT,3)-JPVEXT, 6, & + PTSTEP, PTHT, PPABST, PRHODJ, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & + ZCIT, PEXNREF, ZTHS, ZRVS, ZRIS, ZT, ZRHT) + ! + Z_TH_HIND=ZTHS*PTSTEP-PTHT + Z_RI_HIND=ZRIS*PTSTEP-PRIT + Z_CI_HIND=ZCIT-PCIT + PCIT=ZCIT + PRIT=ZRIS*PTSTEP + PTHT=ZTHS*PTSTEP + Z_TH_HINC=0. + Z_RC_HINC=0. + Z_CC_HINC=0. + ! if ( lbu_enable ) then if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep ) if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep ) diff --git a/src/MNH/lima_rain_accr_snow.f90 b/src/MNH/lima_rain_accr_snow.f90 index 01c31afbe3ff0152065142f33475281538a3c6ac..7c5c9bee51e37bc3c6d453f5a03b6fc07f3fa379 100644 --- a/src/MNH/lima_rain_accr_snow.f90 +++ b/src/MNH/lima_rain_accr_snow.f90 @@ -60,6 +60,7 @@ END MODULE MODI_LIMA_RAIN_ACCR_SNOW !! ------------- !! Original 15/03/2018 ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -68,7 +69,7 @@ END MODULE MODI_LIMA_RAIN_ACCR_SNOW ! USE MODD_CST, ONLY : XTT USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT -USE MODD_PARAM_LIMA_COLD, ONLY : XBS, XCXS +USE MODD_PARAM_LIMA_COLD, ONLY : XBS, XCXS, XTRANS_MP_GAMMAS USE MODD_PARAM_LIMA_MIXED, ONLY : NACCLBDAS, XACCINTP1S, XACCINTP2S, & NACCLBDAR, XACCINTP1R, XACCINTP2R, & XKER_RACCSS, XKER_RACCS, XKER_SACCRG, & @@ -141,7 +142,7 @@ WHERE( GACC ) ! ! 1.3.1 select the (ZLBDAS,ZLBDAR) couplet ! - ZVEC1(:) = MAX(MIN(PLBDS(:),5.E5),5.E1) + ZVEC1(:) = MAX(MIN(PLBDS(:),5.E5*XTRANS_MP_GAMMAS),5.E1*XTRANS_MP_GAMMAS) ZVEC2(:) = PLBDR(:) ! ! 1.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR @@ -212,42 +213,28 @@ WHERE( GACC ) ! ! BVIE manque PCRT ??????????????????????????????????? ! ZZW4(:) = & !! coef of RRACCS and RRACCS - ZZW4(:) = PCRT(:) & !! coef of RRACCS and RRACCS - * XFRACCSS *( PLBDS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBRACCS1/( PLBDS(:)**2 ) + & - XLBRACCS2/( PLBDS(:) * PLBDR(:) ) + & - XLBRACCS3/( PLBDR(:)**2 ) ) / PLBDR(:)**3 + ZZW4(:) = PCRT(:) & !! coef of RRACCS and RRACCS + * XFRACCSS *( PRST(:)*PLBDS(:)**XBS )*( PRHODREF(:)**(-XCEXVT) ) & + *( XLBRACCS1/( PLBDS(:)**2 ) + & + XLBRACCS2/( PLBDS(:) * PLBDR(:) ) + & + XLBRACCS3/( PLBDR(:)**2 ) ) / PLBDR(:)**3 -! ZRRS(:) = ZRRS(:) - ZZW1(:,4) -! ZRSS(:) = ZRSS(:) + ZZW1(:,4) -! ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS)) -! -! ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3 ! ! 1.3.6 raindrop accretion-conversion of the large sized aggregates ! into graupeln ! - ZZW5(:) = XFSACCRG*ZZW3(:) * & ! RSACCRG - ( PLBDS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSACCR1/((PLBDR(:)**2) ) + & - XLBSACCR2/( PLBDR(:) * PLBDS(:) ) + & - XLBSACCR3/( (PLBDS(:)**2)) ) - ! -! P_RR_ACC(:) = - ZZW4(:) * ZZW1(:) ! RRACCSS -! P_CR_ACC(:) = P_RR_ACC(:) * PCRT(:)/PRRT(:) ! Lambda_r**3 -! P_RS_ACC(:) = - P_RR_ACC(:) - ! -! P_RR_ACC(:) = P_RR_ACC(:) - ( ZZW2(:)-P_RS_ACC(:) ) -! P_CR_ACC(:) = P_CR_ACC(:) - ( ZZW2(:)-P_RS_ACC(:) ) * PCRT(:)/PRRT(:) ! Lambda_r**3 -! P_RS_ACC(:) = P_RS_ACC(:) - ZZW5(:) -! P_RG_ACC(:) = ( ZZW2(:)-P_RS_ACC(:) ) + ZZW5(:) - ! + ZZW5(:) = XFSACCRG*ZZW3(:) * & ! RSACCRG + ( PRST(:) )*( PRHODREF(:)**(-XCEXVT) ) & + *( XLBSACCR1/( PLBDR(:)**2 ) + & + XLBSACCR2/( PLBDR(:) * PLBDS(:) ) + & + XLBSACCR3/( PLBDS(:)**2 ) ) +! P_RR_ACC(:) = - ZZW4(:) * ZZW2(:) P_CR_ACC(:) = P_RR_ACC(:) * PCRT(:)/PRRT(:) P_RS_ACC(:) = ZZW4(:) * ZZW1(:) - ZZW5(:) P_RG_ACC(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) + ZZW5(:) P_TH_ACC(:) = - P_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:)) - ! +! END WHERE ! ! diff --git a/src/MNH/lima_rain_evaporation.f90 b/src/MNH/lima_rain_evaporation.f90 index 2970e027d0ae5d8b380a0c9348ddc7de249fe049..f4c0df7d033880a071937fc0c696bacc2899879a 100644 --- a/src/MNH/lima_rain_evaporation.f90 +++ b/src/MNH/lima_rain_evaporation.f90 @@ -10,8 +10,8 @@ INTERFACE SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, & - PRVT, PRCT, PRRT, PLBDR, & - P_TH_EVAP, P_RR_EVAP, & + PRVT, PRCT, PRRT, PCRT, PLBDR, & + P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, & PEVAP3D ) ! REAL, INTENT(IN) :: PTSTEP ! Time step @@ -27,10 +27,12 @@ REAL, DIMENSION(:), INTENT(IN) :: PRVSAT ! REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc at t REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain) ! REAL, DIMENSION(:), INTENT(OUT) :: P_TH_EVAP REAL, DIMENSION(:), INTENT(OUT) :: P_RR_EVAP +REAL, DIMENSION(:), INTENT(OUT) :: P_CR_EVAP ! REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile ! @@ -40,8 +42,8 @@ END MODULE MODI_LIMA_RAIN_EVAPORATION ! ############################################################################### SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, & - PRVT, PRCT, PRRT, PLBDR, & - P_TH_EVAP, P_RR_EVAP, & + PRVT, PRCT, PRRT, PCRT, PLBDR, & + P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, & PEVAP3D ) ! ############################################################################### ! @@ -63,14 +65,15 @@ END MODULE MODI_LIMA_RAIN_EVAPORATION !! ------------- !! Original 15/03/2018 !! +! Delbeke/Vie 03/2022 : KHKO option !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_CST, ONLY : XRHOLW, XRV -USE MODD_PARAM_LIMA, ONLY : XRTMIN -USE MODD_PARAM_LIMA_WARM, ONLY : X0EVAR, XEX0EVAR, X1EVAR, XEX2EVAR, XEX1EVAR, XTHCO, XDIVA +USE MODD_CST, ONLY : XRHOLW, XRV, XPI +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LKHKO +USE MODD_PARAM_LIMA_WARM, ONLY : X0EVAR, XEX0EVAR, X1EVAR, XEX2EVAR, XEX1EVAR, XTHCO, XDIVA, XCEVAP ! IMPLICIT NONE ! @@ -89,10 +92,12 @@ REAL, DIMENSION(:), INTENT(IN) :: PRVSAT ! REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain) +REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc at t +REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain) ! REAL, DIMENSION(:), INTENT(OUT) :: P_TH_EVAP REAL, DIMENSION(:), INTENT(OUT) :: P_RR_EVAP +REAL, DIMENSION(:), INTENT(OUT) :: P_CR_EVAP ! REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile ! @@ -110,40 +115,57 @@ REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW1, ZZW2 ! P_TH_EVAP(:) = 0. P_RR_EVAP(:) = 0. +P_CR_EVAP(:) = 0. +! +ZZW1(:) = 0. +ZZW2(:) = 0. ! GEVAP(:) = .FALSE. GEVAP(:) = LDCOMPUTE(:) .AND. & PRRT(:)>XRTMIN(3) .AND. & - PRVT(:)<PRVSAT(:) -! -WHERE ( GEVAP ) -! -!------------------------------------------------------------------------------- + PRVT(:)<PRVSAT(:) .AND. & + PCRT(:)>XCTMIN(3) ! ! -!* 2. compute the evaporation of rain drops -! ---------------------------------------- ! +IF (LKHKO) THEN + + ZZW1(:) = MAX((1.0 - PRVT(:)/ZZW1(:)),0.0) ! Subsaturation + + ZZW2(:) = 1. / ( XRHOLW*((((PLV(:)/PT(:))**2)/(XTHCO*XRV)) + & ! G + (XRV*PT(:))/(XDIVA*PEVSAT(:)))) + + ZZW2(:) = 3.0 * XCEVAP * ZZW2(:) * (4.*XPI*XRHOLW/(3.))**(2./3.) * & + (PRRT(:))**(1./3.) * (PCRT(:))**(2./3.) * ZZW1(:) + P_RR_EVAP(:) = - ZZW2(:) + + ZZW2(:) = ZZW2(:) * PCRT(:)/PRRT(:) + P_CR_EVAP = - ZZW2(:) + +ELSE + + WHERE ( GEVAP ) ! - ZZW1(:) = MAX((1.0 - PRVT(:)/PRVSAT(:)),0.0) ! Subsaturation + ZZW1(:) = MAX((1.0 - PRVT(:)/PRVSAT(:)),0.0) ! Subsaturation ! ! Compute the function G(T) ! - ZZW2(:) = 1. / ( XRHOLW*((((PLV(:)/PT(:))**2)/(XTHCO*XRV)) + & ! G - (XRV*PT(:))/(XDIVA*PEVSAT(:)))) + ZZW2(:) = 1. / ( XRHOLW*((((PLV(:)/PT(:))**2)/(XTHCO*XRV)) + & ! G + (XRV*PT(:))/(XDIVA*PEVSAT(:)))) ! ! Compute the evaporation tendency ! - ZZW2(:) = ZZW2(:) * ZZW1(:) * PRRT(:) * & - (X0EVAR * PLBDR(:)**XEX0EVAR + X1EVAR * PRHODREF(:)**XEX2EVAR * PLBDR(:)**XEX1EVAR) - ZZW2(:) = MAX(ZZW2(:),0.0) + ZZW2(:) = ZZW2(:) * ZZW1(:) * PRRT(:) * & + (X0EVAR * PLBDR(:)**XEX0EVAR + X1EVAR * PRHODREF(:)**XEX2EVAR * PLBDR(:)**XEX1EVAR) + ZZW2(:) = MAX(ZZW2(:),0.0) ! - P_RR_EVAP(:) = - ZZW2(:) + P_RR_EVAP(:) = - ZZW2(:) ! P_TH_EVAP(:) = P_RR_EVAP(:) * PLVFACT(:) ! PEVAP3D(:) = - P_RR_EVAP(:) ! -END WHERE + END WHERE ! +END IF !----------------------------------------------------------------------------- ! END SUBROUTINE LIMA_RAIN_EVAPORATION diff --git a/src/MNH/lima_sedimentation.f90 b/src/MNH/lima_sedimentation.f90 index 365ae0f23362e17a84e8f9ab1682d8dc165f38dd..8d48b776d8a46279ab4b6fd8268068faf0411f5e 100644 --- a/src/MNH/lima_sedimentation.f90 +++ b/src/MNH/lima_sedimentation.f90 @@ -66,6 +66,7 @@ END MODULE MODI_LIMA_SEDIMENTATION ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function ! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90 ! B. Vie 03/2020: disable temperature change of droplets by air temperature +! J. Wurtz 03/2022: new snow characteristics !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -73,10 +74,11 @@ END MODULE MODI_LIMA_SEDIMENTATION ! USE MODD_CST, ONLY: XRHOLW, XCL, XCI USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT -USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, & - XLB, XLBEX, XD, XFSEDR, XFSEDC, & - XALPHAC, XNUC -USE MODD_PARAM_LIMA_COLD, ONLY: XLBEXI, XLBI, XDI +USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, & + XLB, XLBEX, XD, XFSEDR, XFSEDC, & + XALPHAC, XNUC, XALPHAS, XNUS, LSNOW_T +USE MODD_PARAM_LIMA_COLD, ONLY: XLBEXI, XLBI, XDI, XLBDAS_MAX, XBS, XEXSEDS, & + XLBDAS_MIN, XTRANS_MP_GAMMAS, XFVELOS use mode_tools, only: Countjv @@ -183,11 +185,24 @@ DO JN = 1 , NSPLITSED(KID) IF (KMOMENTS==2) ZCS(JL) = PCS(I1(JL),I2(JL),I3(JL)) END DO ! - IF (KMOMENTS==1) ZLBDA(:) = XLB(KID) * ( ZRHODREF(:) * ZRS(:) )**XLBEX(KID) - IF (KMOMENTS==2) ZLBDA(:) = ( XLB(KID)*ZCS(:) / ZRS(:) )**XLBEX(KID) + IF (KID == 5 .AND. LSNOW_T) THEN + ZLBDA(:) = 1.E10 + WHERE(ZT(:)>263.15 .AND. ZRS(:)>XRTMIN(5)) + ZLBDA(:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZT(:))),XLBDAS_MIN) + END WHERE + WHERE(ZT(:)<=263.15 .AND. ZRS(:)>XRTMIN(5)) + ZLBDA(:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZT(:))),XLBDAS_MIN) + END WHERE + ZLBDA(:) = ZLBDA(:)*XTRANS_MP_GAMMAS + ZZW(:) = XFSEDR(KID) * ZRHODREF(:)**(1.-XCEXVT)*ZRS(:)* & + (1 + (XFVELOS/ZLBDA(:))**XALPHAS)**(-XNUS+XEXSEDS/XALPHAS) * ZLBDA(:)**(XBS+XEXSEDS) + ELSE + IF (KMOMENTS==1) ZLBDA(:) = XLB(KID) * ( ZRHODREF(:) * ZRS(:) )**XLBEX(KID) + IF (KMOMENTS==2) ZLBDA(:) = ( XLB(KID)*ZCS(:) / ZRS(:) )**XLBEX(KID) + ZZY(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDA(:)**(-XD(KID)) + ZZW(:) = XFSEDR(KID) * ZRS(:) * ZZY(:) * ZRHODREF(:) + END IF ! Wurtz ! - ZZY(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDA(:)**(-XD(KID)) - ZZW(:) = XFSEDR(KID) * ZRS(:) * ZZY(:) * ZRHODREF(:) IF (KMOMENTS==2) ZZX(:) = XFSEDC(KID) * ZCS(:) * ZZY(:) * ZRHODREF(:) IF (KID==2) THEN diff --git a/src/MNH/lima_snow_deposition.f90 b/src/MNH/lima_snow_deposition.f90 index 697f9ee74f5f9101579f9724421e76ee6f93d614..fa96aa705626479d4728dc83192533296bf470a9 100644 --- a/src/MNH/lima_snow_deposition.f90 +++ b/src/MNH/lima_snow_deposition.f90 @@ -63,20 +63,22 @@ SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, & !! ------------- !! Original 15/03/2018 !! +! J. Wurtz 03/2022: new snow characteristics +! B. Vie 03/2022: Add option for 1-moment pristine ice !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS -USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, & +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS, NMOM_I +USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS,XLBS,XBS, & XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, & XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, & XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, & XDICNVS_LIM, XLBDAICNVS_LIM, & XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, & XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, & - XAGGS_RLARGE1, XAGGS_RLARGE2 + XAGGS_RLARGE1, XAGGS_RLARGE2, XFVELOS ! IMPLICIT NONE @@ -113,51 +115,62 @@ P_CI_CNVI(:) = 0. P_TH_DEPS(:) = 0. P_RS_DEPS(:) = 0. ! -! Physical limitations -! -! ! Looking for regions where computations are necessary -! GMICRO(:) = LDCOMPUTE(:) .AND. PRST(:)>XRTMIN(5) ! +IF (NMOM_I.EQ.1) THEN + WHERE( GMICRO ) ! -WHERE( GMICRO ) +! Deposition of water vapor on r_s: RVDEPS +! + ZZW(:) = 0.0 + WHERE ( (PRST(:)>XRTMIN(5)) ) + ZZW(:) = ( PSSI(:)/(PAI(:)*PRHODREF(:)) ) * & + ( X0DEPS*PLBDS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS ) + ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:))) + END WHERE + P_RS_DEPS(:) = ZZW(:) + END WHERE +ELSE + WHERE( GMICRO ) ! !* 2.1 Conversion of snow to r_i: RSCNVI ! ---------------------------------------- ! ! - ZZW2(:) = 0.0 - ZZW(:) = 0.0 - WHERE ( PLBDS(:)<XLBDASCNVI_MAX .AND. (PRST(:)>XRTMIN(5)) & - .AND. (PSSI(:)<0.0) ) - ZZW(:) = (PLBDS(:)*XDSCNVI_LIM)**(XALPHAS) - ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XCCS*PLBDS(:)**XCXS) * (ZZW(:)**XNUS) * EXP(-ZZW(:)) + ZZW2(:) = 0.0 + ZZW(:) = 0.0 + WHERE ( PLBDS(:)<XLBDASCNVI_MAX .AND. (PRST(:)>XRTMIN(5)) & + .AND. (PSSI(:)<0.0) ) + ZZW(:) = (PLBDS(:)*XDSCNVI_LIM)**(XALPHAS) + ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XLBS*PRST(:)*PLBDS(:)**XBS) * (ZZW(:)**XNUS) * EXP(-ZZW(:)) ! - ZZW(:) = ( XR0DEPSI+XR1DEPSI*PCJ(:) )*ZZX(:) + ZZW(:) = ( XR0DEPSI+XR1DEPSI*PCJ(:) )*ZZX(:) ! - ZZW2(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*PCJ(:) )/( XR0DEPSI+XR1DEPSI*PCJ(:) ) - END WHERE + ZZW2(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*PCJ(:) )/( XR0DEPSI+XR1DEPSI*PCJ(:) ) + END WHERE ! - P_RI_CNVI(:) = ZZW(:) - P_CI_CNVI(:) = ZZW2(:) + P_RI_CNVI(:) = ZZW(:) + P_CI_CNVI(:) = ZZW2(:) ! ! !* 2.2 Deposition of water vapor on r_s: RVDEPS ! ----------------------------------------------- ! ! - ZZW(:) = 0.0 - WHERE ( (PRST(:)>XRTMIN(5)) ) - ZZW(:) = ( PSSI(:)/(PAI(:)) ) * & - ( X0DEPS*PLBDS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS ) - ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:))) - END WHERE + ZZW(:) = 0.0 + WHERE ( (PRST(:)>XRTMIN(5)) ) + ZZW(:) = ( PRST(:)*PSSI(:)/(PAI(:)) ) * & + ( X0DEPS*PLBDS(:)**XEX0DEPS + & + ( X1DEPS*PCJ(:)*(PLBDS(:))**(XBS+XEX1DEPS) * & + (1+(XFVELOS/(2.*PLBDS))**XALPHAS)**(-XNUS+XEX1DEPS/XALPHAS)) ) + ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:))) + END WHERE ! - P_RS_DEPS(:) = ZZW(:) + P_RS_DEPS(:) = ZZW(:) !!$ P_TH_DEPS(:) = P_RS_DEPS(:) * PLSFACT(:) ! -END WHERE -! + END WHERE +END IF ! END SUBROUTINE LIMA_SNOW_DEPOSITION diff --git a/src/MNH/lima_tendencies.f90 b/src/MNH/lima_tendencies.f90 index bd98d503c551fc74862ea85aeb1a80795beea2ce..0fce8cb11722c47e66789b940aa8d64127712cc8 100644 --- a/src/MNH/lima_tendencies.f90 +++ b/src/MNH/lima_tendencies.f90 @@ -16,7 +16,7 @@ MODULE MODI_LIMA_TENDENCIES P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, & P_RC_ACCR, P_CC_ACCR, & P_CR_SCBU, & - P_TH_EVAP, P_RR_EVAP, & + P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, & P_RI_CNVI, P_CI_CNVI, & P_TH_DEPS, P_RS_DEPS, & P_TH_DEPI, P_RI_DEPI, & @@ -80,7 +80,8 @@ REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR ! accretion of droplets by rain REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU ! self collectio break up of drops (SCBU) : Nr ! REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP -REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP ! evaporation of rain drops (EVAP) : rr, rv=-rr +REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP +REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_EVAP ! evaporation of rain drops (EVAP) : rr, Nr, rv=-rr ! REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri @@ -189,7 +190,7 @@ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, & P_RC_ACCR, P_CC_ACCR, & P_CR_SCBU, & - P_TH_EVAP, P_RR_EVAP, & + P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, & P_RI_CNVI, P_CI_CNVI, & P_TH_DEPS, P_RS_DEPS, & P_TH_DEPI, P_RI_DEPI, & @@ -231,6 +232,9 @@ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, !! ------------- !! Original 15/03/2018 !! +! Delbeke/Vie 03/2022 : KHKO option +! J. Wurtz 03/2022 : new snow characteristics +! B. Vie 03/2022: Add option for 1-moment pristine ice !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -238,11 +242,12 @@ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, ! USE MODD_CST, ONLY : XP00, XRD, XRV, XMD, XMV, XCPD, XCPV, XCL, XCI, XLVTT, XLSTT, XTT, & XALPW, XBETAW, XGAMW, XALPI, XBETAI, XGAMI -USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, & - LCOLD, LNUCL, LSNOW, LHAIL, LWARM, LACTI, LRAIN +USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XNUS, & + LCOLD, LNUCL, LSNOW, LHAIL, LWARM, LACTI, LRAIN, LKHKO, LSNOW_T, NMOM_I USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBH, XLBEXH, XLBDAG_MAX -USE MODD_PARAM_LIMA_COLD, ONLY : XSCFAC, XLBI, XLBEXI, XLBS, XLBEXS, XLBDAS_MAX +USE MODD_PARAM_LIMA_COLD, ONLY : XSCFAC, XLBI, XLBEXI, XLBS, XLBEXS, XLBDAS_MAX, XTRANS_MP_GAMMAS, & + XFVELOS, XLBDAS_MIN ! USE MODI_LIMA_DROPLETS_HOM_FREEZING USE MODI_LIMA_DROPLETS_SELF_COLLECTION @@ -260,6 +265,8 @@ USE MODI_LIMA_CONVERSION_MELTING_SNOW USE MODI_LIMA_RAIN_FREEZING USE MODI_LIMA_GRAUPEL ! +USE MODI_LIMA_BERGERON +! IMPLICIT NONE ! !* 0.1 Declarations of dummy arguments : @@ -300,7 +307,8 @@ REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR ! accretion of droplets by rain REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU ! self collectio break up of drops (SCBU) : Nr ! REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP -REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP ! evaporation of rain drops (EVAP) : rr, rv=-rr +REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP +REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_EVAP ! evaporation of rain drops (EVAP) : rr, Nr, rv=-rr ! REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri @@ -502,9 +510,21 @@ WHERE (PRIT(:)>XRTMIN(4) .AND. PCIT(:)>XCTMIN(4) .AND. LDCOMPUTE(:)) ZLBDI(:) = ( XLBI*PCIT(:) / PRIT(:) )**XLBEXI END WHERE ZLBDS(:) = 1.E10 -WHERE (PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) ) - ZLBDS(:) = XLBS*( PRHODREF(:)*PRST(:) )**XLBEXS -END WHERE +IF (LSNOW_T) THEN + WHERE (PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) ) + WHERE(ZT(:)>263.15) + ZLBDS(:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZT(:))),XLBDAS_MIN) + END WHERE + WHERE(ZT(:)<=263.15) + ZLBDS(:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZT(:))),XLBDAS_MIN) + END WHERE + END WHERE + ZLBDS(:) = ZLBDS(:) * XTRANS_MP_GAMMAS +ELSE + WHERE (PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) ) + ZLBDS(:) = XLBS*( PRHODREF(:)*PRST(:) )**XLBEXS + END WHERE +END IF ZLBDG(:) = 1.E10 WHERE (PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) ) ZLBDG(:) = XLBG*( PRHODREF(:)*PRGT(:) )**XLBEXG @@ -525,7 +545,7 @@ IF (LCOLD .AND. LWARM) THEN PA_TH, PA_RC, PA_CC, PA_RI, PA_CI ) END IF ! -IF (LWARM .AND. LRAIN) THEN +IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO)) THEN CALL LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, & ! depends on CF PRHODREF, & PCCT/ZCF1D, ZLBDC3, & @@ -564,7 +584,7 @@ IF (LWARM .AND. LRAIN) THEN PA_RR(:) = PA_RR(:) - P_RC_ACCR(:) END IF ! -IF (LWARM .AND. LRAIN) THEN +IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO)) THEN CALL LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, & ! depends on PF PRHODREF, & PCRT/ZPF1D(:), ZLBDR, ZLBDR3, & @@ -576,18 +596,20 @@ IF (LWARM .AND. LRAIN) THEN END IF ! IF (LWARM .AND. LRAIN) THEN - CALL LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & ! depends on PF > CF - PRHODREF, ZT, ZLV, ZLVFACT, ZEVSAT, ZRVSAT, & - PRVT, PRCT/ZPF1D, PRRT/ZPF1D, ZLBDR, & - P_TH_EVAP, P_RR_EVAP, & - PEVAP3D ) + CALL LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & ! depends on PF > CF + PRHODREF, ZT, ZLV, ZLVFACT, ZEVSAT, ZRVSAT, & + PRVT, PRCT/ZPF1D, PRRT/ZPF1D, PCRT/ZPF1D, ZLBDR, & + P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, & + PEVAP3D ) P_RR_EVAP(:) = P_RR_EVAP(:) * MAX((ZPF1D(:) - ZCF1D(:)),0.) + P_CR_EVAP(:) = P_RR_EVAP(:) * MAX((ZPF1D(:) - ZCF1D(:)),0.) P_TH_EVAP(:) = P_RR_EVAP(:) * ZLVFACT(:) PEVAP3D(:) = - P_RR_EVAP(:) ! PA_TH(:) = PA_TH(:) + P_TH_EVAP(:) PA_RV(:) = PA_RV(:) - P_RR_EVAP(:) PA_RR(:) = PA_RR(:) + P_RR_EVAP(:) + PA_CR(:) = PA_CR(:) + P_CR_EVAP(:) END IF ! IF (LCOLD) THEN @@ -595,7 +617,7 @@ IF (LCOLD) THEN ! Includes vapour deposition on ice, ice -> snow conversion ! CALL LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, & ! depends on IF, PF - PRHODREF, ZSSI, ZAI, ZCJ, ZLSFACT, & + PRHODREF, ZT, ZSSI, ZAI, ZCJ, ZLSFACT, & PRIT/ZIF1D, PCIT/ZIF1D, ZLBDI, & P_TH_DEPI, P_RI_DEPI, & P_RI_CNVS, P_CI_CNVS ) @@ -639,7 +661,7 @@ END IF ! Lambda_s limited for collection processes to prevent too high concentrations ! must be changed or removed if C and x modified ! -ZLBDS(:) = MIN( XLBDAS_MAX, ZLBDS(:)) +!ZLBDS(:) = MIN( XLBDAS_MAX, ZLBDS(:)) ! ! IF (LCOLD .AND. LSNOW) THEN @@ -667,16 +689,18 @@ IF (LWARM .AND. LCOLD) THEN PA_TH(:) = PA_TH(:) + P_TH_DEPG(:) END IF ! -!!$IF (LWARM .AND. LCOLD) THEN -!!$ CALL LIMA_BERGERON (LDCOMPUTE, & ! depends on CF, IF -!!$ PRCT, PRIT, PCIT, ZLBDI, & -!!$ ZSSIW, ZAI, ZCJ, ZLVFACT, ZLSFACT, & -!!$ P_TH_BERFI, P_RC_BERFI, & -!!$ PA_TH, PA_RC, PA_RI ) -!!$END IF -P_TH_BERFI(:) = 0. -P_RC_BERFI(:) = 0. -! +IF (LWARM .AND. LCOLD .AND. NMOM_I.EQ.1) THEN + CALL LIMA_BERGERON (LDCOMPUTE, & ! depends on CF, IF + PRCT/ZCF1D, PRIT/ZIF1D, PCIT/ZIF1D, ZLBDI, & + ZSSIW, ZAI, ZCJ, ZLVFACT, ZLSFACT, & + P_TH_BERFI, P_RC_BERFI ) + P_TH_BERFI(:) = P_TH_BERFI(:) * MIN(ZCF1D,ZIF1D) + P_RC_BERFI(:) = P_RC_BERFI(:) * MIN(ZCF1D,ZIF1D) +! + PA_RC(:) = PA_RC(:) + P_RC_BERFI(:) + PA_RI(:) = PA_RI(:) - P_RC_BERFI(:) + PA_TH(:) = PA_TH(:) + P_TH_BERFI(:) +END IF ! IF (LWARM .AND. LCOLD .AND. LSNOW) THEN ! diff --git a/src/MNH/lima_warm_coal.f90 b/src/MNH/lima_warm_coal.f90 index 4ec69ac5823e786c1dc06b9149d655e772db9e40..66c83de670a5fe35ad95e050c64363f9d6dff4c1 100644 --- a/src/MNH/lima_warm_coal.f90 +++ b/src/MNH/lima_warm_coal.f90 @@ -98,12 +98,14 @@ END MODULE MODI_LIMA_WARM_COAL ! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O ! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90 ! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine) +! Delbeke/Vie 03/2022 : KHKO option !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_sv, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, tbudgets +USE MODD_CST, ONLY: XPI, XRHOLW USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT USE MODD_PARAM_LIMA @@ -252,7 +254,7 @@ IF (LRAIN) THEN GSELF(:) = ZCCT(:)>XCTMIN(2) ISELF = COUNT(GSELF(:)) - IF( ISELF>0 ) THEN + IF( ISELF>0 .AND. .NOT.LKHKO) THEN ZZW1(:) = XSELFC*(ZCCT(:)/ZLBDC3(:))**2 * ZRHODREF(:) ! analytical integration WHERE( GSELF(:) ) ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) ) @@ -273,38 +275,54 @@ IF (LRAIN) THEN if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) ) if ( lbudget_sv ) then - !call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', pccs(:, :, :) * prhodj(:, :, :) ) + call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', pccs(:, :, :) * prhodj(:, :, :) ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) ) end if ZZW2(:) = 0.0 ZZW1(:) = 0.0 - WHERE( ZRCT(:)>XRTMIN(2) ) - ZZW2(:) = MAX( 0.0,XLAUTR*ZRHODREF(:)*ZRCT(:)* & + IF (LKHKO) THEN + WHERE ( ZRCT(:) .GT. XRTMIN(2) .AND. ZCCT(:) .GT. XCTMIN(2) & + .AND. (ZRCS(:) .GT. 0.0) .AND. (ZCCS(:) .GT. 0.0)) +! + ZZW1(:)= 1350.0 * ZRCT(:)**(2.47) * (ZCCT(:)/1.0E6)**(-1.79) ! ZCCT in cm-3 + ZZW1(:) = min (ZRCS(:), ZZW1(:)) + ZRCS(:) = ZRCS(:) - ZZW1(:) + ZRRS(:) = ZRRS(:) + ZZW1(:) +! + ZCRS(:) = ZCRS(:) + ZZW1(:) * 3. * ZRHODREF(:)/(4.*XPI*XRHOLW*(XR0)**(3.)) +! + ZZW1(:) = min ( ZCCS(:),ZZW1(:) * ZCCT(:) / ZRCT(:)) + ZCCS(:) = ZCCS(:) - ZZW1(:) +! + END WHERE + ELSE + WHERE( ZRCT(:)>XRTMIN(2) ) + ZZW2(:) = MAX( 0.0,XLAUTR*ZRHODREF(:)*ZRCT(:)* & (XAUTO1/min(ZLBDC(:),1.e9)**4-XLAUTR_THRESHOLD) ) ! L ! - ZZW3(:) = MIN( ZRCS(:), MAX( 0.0,XITAUTR*ZZW2(:)*ZRCT(:)* & + ZZW3(:) = MIN( ZRCS(:), MAX( 0.0,XITAUTR*ZZW2(:)*ZRCT(:)* & (XAUTO2/ZLBDC(:)-XITAUTR_THRESHOLD) ) ) ! L/tau ! - ZRCS(:) = ZRCS(:) - ZZW3(:) - ZRRS(:) = ZRRS(:) + ZZW3(:) + ZRCS(:) = ZRCS(:) - ZZW3(:) + ZRRS(:) = ZRRS(:) + ZZW3(:) ! - ZZW1(:) = MIN( MIN( 1.2E4,(XACCR4/ZLBDC(:)-XACCR5)/XACCR3), & + ZZW1(:) = MIN( MIN( 1.2E4,(XACCR4/ZLBDC(:)-XACCR5)/XACCR3), & ZLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for ! switching the autoconversion regimes ! min (80 microns, D_h, D_r) - ZZW3(:) = ZZW3(:) * MAX( 0.0,ZZW1(:) )**3 / XAC - ZCRS(:) = ZCRS(:) + ZZW3(:) - END WHERE - + ZZW3(:) = ZZW3(:) * MAX( 0.0,ZZW1(:) )**3 / XAC + ZCRS(:) = ZCRS(:) + ZZW3(:) + END WHERE + END IF if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', & Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', & Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) then !This budget is = 0 for nsv_lima_nc => not necessary to call it (ZCCS is not modified in this part) - !call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', & - ! Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', & + Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'AUTO', & Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) end if @@ -334,31 +352,45 @@ IF (LRAIN) THEN Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'ACCR', & Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - WHERE( GACCR(:).AND.(ZZW4(:)>1.E-4) ) ! Accretion for D>100 10-6 m - ZZW3(:) = ZLBDC3(:) / ZLBDR3(:) - ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:) - ZZW2(:) = MIN( ZZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZZW3(:)),ZCCS(:) ) - ZCCS(:) = ZCCS(:) - ZZW2(:) -! - ZZW1(:) = ( ZZW1(:) / ZLBDC3(:) ) - ZZW2(:) = MIN( ZZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW3(:)),ZRCS(:) ) - ZRCS(:) = ZRCS(:) - ZZW2(:) - ZRRS(:) = ZRRS(:) + ZZW2(:) - END WHERE - WHERE( GACCR(:).AND.(ZZW4(:)<=1.E-4) ) ! Accretion for D<100 10-6 m - ZZW3(:) = MIN(ZLBDC3(:) / ZLBDR3(:), 1.E8) - ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:) - ZZW1(:) = ZZW1(:) / ZLBDC3(:) - ZZW3(:) = ZZW3(:)**2 - ZZW2(:) = MIN( ZZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZZW3(:)),ZCCS(:) ) - ZCCS(:) = ZCCS(:) - ZZW2(:) -! - ZZW1(:) = ZZW1(:) / ZLBDC3(:) - ZZW2(:) = MIN( ZZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW3(:)) & + IF (LKHKO) THEN + WHERE ( (ZRCT(:) .GT. XRTMIN(2)) .AND. (ZRRT(:) .GT. XRTMIN(3)) & + .AND. (ZRCS(:) .GT. 0.0) .AND. (ZCCS(:) .GT. 0.0)) + ZZW1(:) = 67.0 * ( ZRCT(:) * ZRRT(:) )**1.15 + ZZW1(:) = MIN (ZRCS(:),ZZW1(:)) + ZRCS(:) = ZRCS(:) - ZZW1(:) + ZRRS(:) = ZRRS(:) + ZZW1(:) +! + ZZW1(:) = MIN (ZCCS(:),ZZW1(:) * ZCCT(:) / ZRCT(:)) + ZCCS(:) = ZCCS(:) - ZZW1(:) +! + END WHERE + ELSE + WHERE( GACCR(:).AND.(ZZW4(:)>1.E-4) ) ! Accretion for D>100 10-6 m + ZZW3(:) = ZLBDC3(:) / ZLBDR3(:) + ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:) + ZZW2(:) = MIN( ZZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZZW3(:)),ZCCS(:) ) + ZCCS(:) = ZCCS(:) - ZZW2(:) +! + ZZW1(:) = ( ZZW1(:) / ZLBDC3(:) ) + ZZW2(:) = MIN( ZZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW3(:)),ZRCS(:) ) + ZRCS(:) = ZRCS(:) - ZZW2(:) + ZRRS(:) = ZRRS(:) + ZZW2(:) + END WHERE + WHERE( GACCR(:).AND.(ZZW4(:)<=1.E-4) ) ! Accretion for D<100 10-6 m + ZZW3(:) = MIN(ZLBDC3(:) / ZLBDR3(:), 1.E8) + ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:) + ZZW1(:) = ZZW1(:) / ZLBDC3(:) + ZZW3(:) = ZZW3(:)**2 + ZZW2(:) = MIN( ZZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZZW3(:)),ZCCS(:) ) + ZCCS(:) = ZCCS(:) - ZZW2(:) +! + ZZW1(:) = ZZW1(:) / ZLBDC3(:) + ZZW2(:) = MIN( ZZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW3(:)) & ,ZRCS(:) ) - ZRCS(:) = ZRCS(:) - ZZW2(:) - ZRRS(:) = ZRRS(:) + ZZW2(:) - END WHERE + ZRCS(:) = ZRCS(:) - ZZW2(:) + ZRRS(:) = ZRRS(:) + ZZW2(:) + END WHERE + END IF if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', & Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) @@ -380,7 +412,7 @@ IF (LRAIN) THEN ELSE ISCBU = 0.0 END IF - IF( ISCBU>0 ) THEN + IF( ISCBU>0 .AND. .NOT.LKHKO) THEN if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', & Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) ! diff --git a/src/MNH/lima_warm_evap.f90 b/src/MNH/lima_warm_evap.f90 index 9a67a4b824bf150485226d9ad53037131418c1a9..e62660ecdb41c18ec7da4ac2c8d9110384f7bbbb 100644 --- a/src/MNH/lima_warm_evap.f90 +++ b/src/MNH/lima_warm_evap.f90 @@ -75,6 +75,7 @@ END MODULE MODI_LIMA_WARM_EVAP !! Original ??/??/13 !! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O ! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90 +! Delbeke/Vie 03/2022 : KHKO option ! !------------------------------------------------------------------------------- ! @@ -137,6 +138,7 @@ REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t ! REAL, DIMENSION(:) , ALLOCATABLE :: ZRVS ! Water vapor m.r. source REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source +REAL, DIMENSION(:) , ALLOCATABLE :: ZCRS ! Rain water m.r. source REAL, DIMENSION(:) , ALLOCATABLE :: ZTHS ! Theta source ! ! Other packed variables @@ -151,7 +153,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, & ZZLV ! Latent heat of vaporization at T ! REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) & - :: ZW, ZW2, ZRVSAT, ZDR + :: ZW, ZW2, ZRVSAT, ZDR, ZLV ! ! REAL :: ZEPS, ZFACT @@ -179,11 +181,14 @@ ZCTMIN(:) = XCTMIN(:) / PTSTEP ZEPS= XMV / XMD ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * & EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0) - +ZLV(:,:,:) = XLVTT + (XCPV-XCL)*(ZT(:,:,:)-XTT) ! GEVAP(:,:,:) = .FALSE. GEVAP(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) .AND. & + PRRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) .AND. & + PCRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(3) .AND. & + PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) .AND. & + PCRT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(3) .AND. & PRVT(IIB:IIE,IJB:IJE,IKB:IKE)<ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ! IEVAP = COUNTJV( GEVAP(:,:,:),I1(:),I2(:),I3(:)) @@ -196,6 +201,7 @@ IF( IEVAP >= 1 ) THEN ! ALLOCATE(ZRVS(IEVAP)) ALLOCATE(ZRRS(IEVAP)) + ALLOCATE(ZCRS(IEVAP)) ALLOCATE(ZTHS(IEVAP)) ! ALLOCATE(ZLBDR(IEVAP)) @@ -212,6 +218,7 @@ IF( IEVAP >= 1 ) THEN ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL)) ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL)) ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL)) + ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL)) ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL)) ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL)) ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL)) @@ -219,8 +226,8 @@ IF( IEVAP >= 1 ) THEN ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL)) ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL)) ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL)) + ZZLV(JL) = ZLV(I1(JL),I2(JL),I3(JL)) END DO - ZZLV(:) = XLVTT + (XCPV-XCL)*(ZZT(:)-XTT) ! ALLOCATE(ZZW2(IEVAP)) ALLOCATE(ZZW3(IEVAP)) @@ -242,10 +249,16 @@ IF( IEVAP >= 1 ) THEN ! ! Compute the evaporation tendency ! - ZZW2(:) = MIN( ZZW2(:) * ZZW3(:) * ZRRT(:) * & + IF (LKHKO) THEN + ZZW2(:) = 3.0 * XCEVAP * ZZW2(:) * (4.*XPI*XRHOLW/(3.*ZRHODREF(:)))**(2./3.) * & + (ZRRT(:))**(1./3.) * (ZCRT(:))**(2./3.) * ZZW3(:) + ZZW2(:) = MIN(ZZW2(:),ZRRS(:)) + ELSE + ZZW2(:) = MIN( ZZW2(:) * ZZW3(:) * ZRRT(:) * & (X0EVAR*ZLBDR(:)**XEX0EVAR + X1EVAR*ZRHODREF(:)**XEX2EVAR* & ZLBDR(:)**XEX1EVAR),ZRRS(:) ) - ZZW2(:) = MAX(ZZW2(:),0.0) + ZZW2(:) = MAX(ZZW2(:),0.0) + END IF ! ! Adjust sources ! @@ -271,12 +284,20 @@ IF( IEVAP >= 1 ) THEN ZW(:,:,:)= PEVAP3D(:,:,:) PEVAP3D(:,:,:) = UNPACK( ZZW2(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) ) ! + IF (LKHKO) THEN + ZZW2(:) = MIN(ZZW2(:) * ZCRT(:)/ZRRT(:),ZCRS(:)) + ZCRS(:) = ZCRS(:) - ZZW2(:) + ZW(:,:,:) = PCRS(:,:,:) + PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) ) + ENDIF + DEALLOCATE(ZRCT) DEALLOCATE(ZRRT) DEALLOCATE(ZRVT) DEALLOCATE(ZCRT) DEALLOCATE(ZRVS) DEALLOCATE(ZRRS) + DEALLOCATE(ZCRS) DEALLOCATE(ZTHS) DEALLOCATE(ZZLV) DEALLOCATE(ZZT) @@ -295,21 +316,40 @@ IF( IEVAP >= 1 ) THEN ! --------------------------------------- ! ! - GEVAP(:,:,:) = PRRS(:,:,:)>ZRTMIN(3) .AND. PCRS(:,:,:)>ZCTMIN(3) - ZDR(:,:,:) = 9999. - WHERE (GEVAP(:,:,:)) - ZDR(:,:,:)=(6.*PRRS(:,:,:)/XPI/XRHOLW/PCRS(:,:,:))**0.33 - ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:) - ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR - END WHERE + IF (LKHKO) THEN +!* correct negative values for rain +! -------------------------------- +! + WHERE (PRRS(:,:,:)<0.) + PRCS(:,:,:) = PRCS(:,:,:)+PRRS(:,:,:) + PRRS(:,:,:) = 0. + PCRS(:,:,:) = 0. + END WHERE +! +!* REMOVES NON-PHYSICAL LOW VALUES + GEVAP(:,:,:) = PRRS(:,:,:)<ZRTMIN(3) .AND. PCRS(:,:,:)< ZCTMIN(3) + WHERE (GEVAP(:,:,:)) + PRVS(:,:,:) = PRVS(:,:,:) + PRRS(:,:,:) + PTHS(:,:,:) = PTHS(:,:,:) - PRRS(:,:,:) * ZLV(:,:,:) / & + ( PEXNREF(:,:,:)*(XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:) + PRRT(:,:,:)) ) ) + PCRS(:,:,:) = 0.0 + PRRS(:,:,:) = 0.0 + END WHERE + ELSE + GEVAP(:,:,:) = PRRS(:,:,:)>ZRTMIN(3) .AND. PCRS(:,:,:)>ZCTMIN(3) + ZDR(:,:,:) = 9999. + WHERE (GEVAP(:,:,:)) + ZDR(:,:,:)=(6.*PRRS(:,:,:)/XPI/XRHOLW/PCRS(:,:,:))**0.33 + ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:) + ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR + END WHERE ! - WHERE (GEVAP(:,:,:) .AND. ZDR(:,:,:).LT.82.E-6) - PCCS(:,:,:) = PCCS(:,:,:)+PCRS(:,:,:) - PCRS(:,:,:) = 0. - PRCS(:,:,:) = PRCS(:,:,:)+PRRS(:,:,:) - PRRS(:,:,:) = 0. - END WHERE - + WHERE (GEVAP(:,:,:) .AND. ZDR(:,:,:).LT.82.E-6) + PCCS(:,:,:) = PCCS(:,:,:)+PCRS(:,:,:) + PCRS(:,:,:) = 0. + PRCS(:,:,:) = PRCS(:,:,:)+PRRS(:,:,:) + PRRS(:,:,:) = 0. + END WHERE !!$ GMICRO(:,:,:) = GEVAP(:,:,:) .AND. ZWLBDR(:,:,:)/XACCR1>ZWLBDC3(:,:,:) !!$ ! the raindrops are too small, that is lower than D_h !!$ ZFACT = 1.2E4*XACCR1 @@ -341,6 +381,8 @@ IF( IEVAP >= 1 ) THEN !!$ PRRS(:,:,:) = 0.0 !!$ END WHERE ! + END IF ! LKHKO + ! END IF ! IEVAP ! !++cb++ diff --git a/src/MNH/mesonh.f90 b/src/MNH/mesonh.f90 index 84017a6b994ac7be3f3681429bfd3a61771b67ed..ac5f3cdef04db6c7ffa837bbbd1f849b8974e9a8 100644 --- a/src/MNH/mesonh.f90 +++ b/src/MNH/mesonh.f90 @@ -134,6 +134,7 @@ INTEGER :: IINFO_ll ! return code of // routines ! Switch to model 1 variables #ifndef CPLOASIS CALL MPPDB_INIT() +CALL MPPDB_STOP_DEBUG() #endif ! CALL GOTO_MODEL(1,ONOFIELDLIST=.TRUE.) diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90 index 2e28feeae0e88d68dc7de3d6d189917ddcc66dfa..49cd8d3e5860b3a96468052aabae09bc6f79be44 100644 --- a/src/MNH/modd_fieldn.f90 +++ b/src/MNH/modd_fieldn.f90 @@ -165,6 +165,7 @@ REAL, DIMENSION(:,:,:), POINTER :: XHLI_HRI=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XHLI_HCF=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XSIGS=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XCLDFR=>NULL() +REAL, DIMENSION(:,:,:), POINTER :: XICEFR=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XRAINFR=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XCIT=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL() diff --git a/src/MNH/modd_getn.f90 b/src/MNH/modd_getn.f90 index f6531c4f82818662547b4332cfd7e6e2559a28f2..5978b7c2f6aafcf4f7a061d8938fab84360284f3 100644 --- a/src/MNH/modd_getn.f90 +++ b/src/MNH/modd_getn.f90 @@ -86,6 +86,8 @@ TYPE GET_t ! and SRC related to the subgrid condensation CHARACTER (LEN=4) :: CGETCLDFR ! Get indicator for the ! CLouD FRaction + CHARACTER (LEN=4) :: CGETICEFR ! Get indicator for the + ! CLouD FRaction CHARACTER (LEN=4) :: CGETSRCT ! Get indicator for SRCM ! and SRCT related to the subgrid condensation CHARACTER (LEN=4) :: CGETHL ! Get indicator for HighLow cloud @@ -123,6 +125,7 @@ CHARACTER (LEN=4), POINTER :: CGETLSUM=>NULL(), CGETLSVM=>NULL(), CGETLSWM=>NULL CHARACTER (LEN=4), POINTER :: CGETLSTHM=>NULL(), CGETLSRVM=>NULL() CHARACTER (LEN=4), POINTER :: CGETSIGS=>NULL(),CGETSRC=>NULL() CHARACTER (LEN=4), POINTER :: CGETCLDFR=>NULL() +CHARACTER (LEN=4), POINTER :: CGETICEFR=>NULL() CHARACTER (LEN=4), POINTER :: CGETSRCT=>NULL() CHARACTER (LEN=4), POINTER :: CGETHL=>NULL() CHARACTER (LEN=4), POINTER :: CGETCIT=>NULL() @@ -178,6 +181,7 @@ CGETLSRVM=>GET_MODEL(KTO)%CGETLSRVM CGETSIGS=>GET_MODEL(KTO)%CGETSIGS CGETSRC=>GET_MODEL(KTO)%CGETSRC CGETCLDFR=>GET_MODEL(KTO)%CGETCLDFR +CGETICEFR=>GET_MODEL(KTO)%CGETICEFR CGETSRCT=>GET_MODEL(KTO)%CGETSRCT CGETHL=>GET_MODEL(KTO)%CGETHL CGETCIT=>GET_MODEL(KTO)%CGETCIT diff --git a/src/MNH/modd_lesn.f90 b/src/MNH/modd_lesn.f90 index 28db43c4d13ba4f85754ace59ad988145b5f1c75..ac78ef503a2edbb805192fd505df5d174686b7ad 100644 --- a/src/MNH/modd_lesn.f90 +++ b/src/MNH/modd_lesn.f90 @@ -113,6 +113,7 @@ TYPE LES_t REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Qs=>NULL() ! saturated spec h REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Rc=>NULL() ! <Rc> REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Cf=>NULL() ! <CLDFR> + REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_If=>NULL() ! <CLDFR> REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_INDCf=>NULL() ! <Cf> tq rc>0 (0 OU 1) REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_INDCf2=>NULL() ! <Cf> tq rc>1E-5 (0 OU 1) REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_RF=>NULL() ! <RAINFR> @@ -686,6 +687,7 @@ REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Rehu=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Qs=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Rc=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Cf=>NULL() +REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_If=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_INDCf=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_INDCf2=>NULL() REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_RF=>NULL() @@ -1110,6 +1112,7 @@ LES_MODEL(KFROM)%XLES_MEAN_Rehu=>XLES_MEAN_Rehu LES_MODEL(KFROM)%XLES_MEAN_Qs=>XLES_MEAN_Qs LES_MODEL(KFROM)%XLES_MEAN_Rc=>XLES_MEAN_Rc LES_MODEL(KFROM)%XLES_MEAN_Cf=>XLES_MEAN_Cf +LES_MODEL(KFROM)%XLES_MEAN_If=>XLES_MEAN_If LES_MODEL(KFROM)%XLES_MEAN_INDCf=>XLES_MEAN_INDCf LES_MODEL(KFROM)%XLES_MEAN_INDCf2=>XLES_MEAN_INDCf2 LES_MODEL(KFROM)%XLES_MEAN_RF=>XLES_MEAN_RF @@ -1535,6 +1538,7 @@ XLES_MEAN_Rehu=>LES_MODEL(KTO)%XLES_MEAN_Rehu XLES_MEAN_Qs=>LES_MODEL(KTO)%XLES_MEAN_Qs XLES_MEAN_Rc=>LES_MODEL(KTO)%XLES_MEAN_Rc XLES_MEAN_Cf=>LES_MODEL(KTO)%XLES_MEAN_Cf +XLES_MEAN_If=>LES_MODEL(KTO)%XLES_MEAN_If XLES_MEAN_INDCf=>LES_MODEL(KTO)%XLES_MEAN_INDCf XLES_MEAN_INDCf2=>LES_MODEL(KTO)%XLES_MEAN_INDCf2 XLES_MEAN_RF=>LES_MODEL(KTO)%XLES_MEAN_RF diff --git a/src/MNH/modd_param_ice.f90 b/src/MNH/modd_param_ice.f90 index ddafd7516ed3313d0295d5c0b69fed2851f71783..ade107121eeb6c60d406147a6a09d104b67b59f6 100644 --- a/src/MNH/modd_param_ice.f90 +++ b/src/MNH/modd_param_ice.f90 @@ -78,6 +78,7 @@ LOGICAL, SAVE :: LSEDIM_AFTER ! sedimentation done before (.FALSE.) or after (.T ! REAL, SAVE :: XSPLIT_MAXCFL ! Maximum CFL number allowed for SPLIT scheme ! +LOGICAL,SAVE :: LSNOW_T ! Snow parameterization from Wurtz (2021) !------------------------------------------------------------------------------- ! END MODULE MODD_PARAM_ICE diff --git a/src/MNH/modd_param_lima.f90 b/src/MNH/modd_param_lima.f90 index 8e9c1c428786ca9f4e39039b0e902709dde3b2f0..3d6b4421e8b2dc1225896579b8b085c7925815bf 100644 --- a/src/MNH/modd_param_lima.f90 +++ b/src/MNH/modd_param_lima.f90 @@ -65,6 +65,7 @@ LOGICAL, SAVE :: LRDSF ! TRUE to use rain drop shattering by fr ! 1.2 IFN initialisation ! INTEGER, SAVE :: NMOD_IFN ! Number of IFN modes +INTEGER, SAVE :: NMOM_I ! Number of moments for pristine ice REAL, DIMENSION(JPLIMAIFNMAX), SAVE :: XIFN_CONC ! Ref. concentration of IFN(#/L) LOGICAL, SAVE :: LIFN_HOM ! True for z-homogeneous IFN concentrations CHARACTER(LEN=8), SAVE :: CIFN_SPECIES ! Internal mixing species definitions @@ -83,6 +84,7 @@ REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XFRAC_REF ! AP compostion in P ! ! 1.3 Ice characteristics ! +LOGICAL, SAVE :: LSNOW_T ! TRUE to enable snow param. after Wurtz 2021 CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE_LIMA ! Pristine type PLAT, COLU or BURO CHARACTER(LEN=4), SAVE :: CHEVRIMED_ICE_LIMA ! Heavily rimed type GRAU or HAIL REAL,SAVE :: XALPHAI,XNUI, & ! Pristine ice distribution parameters @@ -141,6 +143,7 @@ LOGICAL, SAVE :: LDEPOC ! Deposition of rc at 1st level above ground LOGICAL, SAVE :: LACTTKE ! TRUE to take into account TKE in W for activation LOGICAL, SAVE :: LADJ ! TRUE for adjustment procedure + Smax (false for diagnostic supersaturation) LOGICAL, SAVE :: LSPRO ! TRUE for prognostic supersaturation +LOGICAL, SAVE :: LKHKO ! TRUE for Scu simulation (replicates the previous KHKO scheme) ! ! 2.2 CCN initialisation ! diff --git a/src/MNH/modd_param_lima_cold.f90 b/src/MNH/modd_param_lima_cold.f90 index 9db92526b622f15f9722ca4d8eaff834f140e9cb..dde912b42185d6e34d5b5ac558b791ecf9d506de 100644 --- a/src/MNH/modd_param_lima_cold.f90 +++ b/src/MNH/modd_param_lima_cold.f90 @@ -20,6 +20,7 @@ !! ------------- !! Original ??/??/13 !! C. Barthe 14/03/2022 add CIBU and RDSF +! J. Wurtz 03/2022: new snow characteristics !! !------------------------------------------------------------------------------- USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX @@ -52,8 +53,9 @@ REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact. REAL,SAVE :: XF0IS,XF1IS ! (large Di vent. coef.) REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact. ! -REAL,SAVE :: XLBDAS_MAX ! Max values allowed for the shape - ! parameter of snow +REAL,SAVE :: XLBDAS_MIN, XLBDAS_MAX ! Max values allowed for the shape parameter of snow +REAL,SAVE :: XFVELOS ! Wurtz - snow fall speed parameterizaed after Thompson 2008 +REAL,SAVE :: XTRANS_MP_GAMMAS ! Wurtz - change between lambda value for MP and gen. gamma ! CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER & :: CLIMA_COLD_NAMES=(/'CICE ','CIFNFREE','CIFNNUCL', & @@ -106,8 +108,9 @@ REAL,SAVE :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice XR0DEPIS,XR1DEPIS ! snow : ICNVS ! REAL,SAVE :: XCOLEXIS, & ! Constants for snow - XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG - XAGGS_RLARGE1,XAGGS_RLARGE2 + XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG + XAGGS_RLARGE1,XAGGS_RLARGE2, & + XFIAGGS ! !?????????????????? REAL,SAVE :: XKER_ZRNIC_A1,XKER_ZRNIC_A2 ! Long-Zrnic Kernels (ini_ice_coma) diff --git a/src/MNH/modd_param_lima_mixed.f90 b/src/MNH/modd_param_lima_mixed.f90 index f13accfc669e88fca83566c2eb72f5c2cc6f4945..57ea4d1a559fcab6f202c4bafb3b6015119732f6 100644 --- a/src/MNH/modd_param_lima_mixed.f90 +++ b/src/MNH/modd_param_lima_mixed.f90 @@ -14,6 +14,7 @@ !! MODIFICATIONS !! ------------- !! Original ??/??/13 +! J. Wurtz 03/2022: new snow characteristics !! !------------------------------------------------------------------------------- ! @@ -67,6 +68,7 @@ REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM XEXCRIMSG,XCRIMSG, & ! XEXSRIMCG,XSRIMCG, & ! + XSRIMCG2, XSRIMCG3, XEXSRIMCG2, & ! Murakami 1990 XGAMINC_BOUND_MIN, & ! Min val. of Lbda_s for RIM XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of diff --git a/src/MNH/modd_param_lima_warm.f90 b/src/MNH/modd_param_lima_warm.f90 index 65a3d10279364cb382048f19ed657c7eca2d2c39..2c182b6e986a346fb9d61594316501cba7577cd9 100644 --- a/src/MNH/modd_param_lima_warm.f90 +++ b/src/MNH/modd_param_lima_warm.f90 @@ -90,8 +90,8 @@ REAL,SAVE :: XSELFC ! Constants for cloud droplet ! selfcollection : SELF ! REAL,SAVE :: XAUTO1, XAUTO2, XCAUTR, & ! Constants for cloud droplet - XLAUTR, XLAUTR_THRESHOLD, & ! autoconversion : AUT - XITAUTR, XITAUTR_THRESHOLD + XLAUTR, XLAUTR_THRESHOLD, & ! autoconversion : AUT + XITAUTR, XITAUTR_THRESHOLD, XR0 ! XR0 for KHKO autoconversion ! REAL,SAVE :: XACCR1, XACCR2, XACCR3, & ! Constants for the accretion XACCR4, XACCR5, XACCR6, & ! process @@ -105,7 +105,8 @@ REAL,SAVE :: XSPONBUD1,XSPONBUD2,XSPONBUD3, & ! Spontaneous Break-up XSPONCOEF2 ! (drop size limiter) ! REAL,SAVE :: X0EVAR, X1EVAR, & ! Constants for raindrop - XEX0EVAR, XEX1EVAR, XEX2EVAR ! evaporation: EVA + XEX0EVAR, XEX1EVAR, XEX2EVAR, & ! evaporation: EVA + XCEVAP ! for KHKO ! REAL,DIMENSION(:,:,:,:), SAVE, ALLOCATABLE :: XCONCC_INI REAL,SAVE :: XCONCR_PARAM_INI diff --git a/src/MNH/modd_rain_ice_descr.f90 b/src/MNH/modd_rain_ice_descr.f90 index 96295e4e7841c57028903c03f50731d03b9a9c6c..789a251c87e825c19bdcd08119d12b1ed97795b1 100644 --- a/src/MNH/modd_rain_ice_descr.f90 +++ b/src/MNH/modd_rain_ice_descr.f90 @@ -76,7 +76,10 @@ REAL,SAVE :: XALPHAS,XNUS,XLBEXS,XLBS ! Snow/agg. distribution parameters REAL,SAVE :: XALPHAG,XNUG,XLBEXG,XLBG ! Graupel distribution parameters REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters ! -REAL,SAVE :: XLBDAR_MAX,XLBDAS_MAX,XLBDAG_MAX ! Max values allowed for the shape +REAL,SAVE :: XFVELOS ! factor for snow fall speed after Thompson (2008) +REAL,SAVE :: XTRANS_MP_GAMMAS ! coefficient to convert lambdas for gamma function +! +REAL,SAVE :: XLBDAR_MAX,XLBDAS_MIN,XLBDAS_MAX,XLBDAG_MAX ! Max values allowed for the shape ! parameters (rain,snow,graupeln) ! REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values allowed for the mixing ratios diff --git a/src/MNH/modd_rain_ice_param.f90 b/src/MNH/modd_rain_ice_param.f90 index 7568e2a68efc91b9081f88ca55d426724038c3fc..434c4bc761d351bc6756fbdd6b5026d1a38141a3 100644 --- a/src/MNH/modd_rain_ice_param.f90 +++ b/src/MNH/modd_rain_ice_param.f90 @@ -39,7 +39,6 @@ ! ------------ ! IMPLICIT NONE -! REAL,DIMENSION(2),SAVE :: XFSEDC ! Constants for sedimentation fluxes of C REAL,SAVE :: XFSEDR,XEXSEDR, & ! Constants for sedimentation XFSEDI,XEXCSEDI,XEXRSEDI, & ! fluxes of R, I, S and G diff --git a/src/MNH/mode_RBK90_Integrator.f90 b/src/MNH/mode_RBK90_Integrator.f90 index ae11720e3cd8fdc1ce7ab60d602dd20a5e4ce0d5..536726def5d7ba4cca6db9fab1f67c5e867db171 100644 --- a/src/MNH/mode_RBK90_Integrator.f90 +++ b/src/MNH/mode_RBK90_Integrator.f90 @@ -1,10 +1,11 @@ -!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 1994-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. !----------------------------------------------------------------- ! Modifications: -! Philippe 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q +! P. Wautelet 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q +! P. Wautelet 17/12/2021: remove unused time variables (and remove use of non initialised time values) !----------------------------------------------------------------- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! @@ -1316,9 +1317,6 @@ USE MODI_CH_FCN REAL :: T, Y(N) !~~~> Output variables REAL :: Ydot(N) -!~~~> Local variables - REAL :: Told - REAL :: TIME ! INTEGER, INTENT(IN) :: KMI ! model number INTEGER, INTENT(IN) :: KVECNPT @@ -1330,8 +1328,6 @@ INTEGER, INTENT(IN) :: KVECNPT INTEGER :: ISPECIES ! Ancillary variable - Told = TIME - TIME = T !JPP CALL Update_SUN() !JPP CALL Update_RCONST() !JPP CALL Fun( Y, FIX, RCONST, Ydot ) @@ -1352,7 +1348,6 @@ INTEGER, INTENT(IN) :: KVECNPT Ydot(JLSHIFT+1:JLSHIFT+ISPECIES) = ZFCN(JL,1:ISPECIES) JLSHIFT = JLSHIFT + ISPECIES END DO - TIME = Told END SUBROUTINE FunTemplate @@ -1389,8 +1384,6 @@ INTEGER, INTENT(IN) :: KMI ! model number INTEGER, INTENT(IN) :: KVECNPT ! !~~~> Local variables - REAL :: Told - REAL :: TIME !#ifdef FULL_ALGEBRA !## INTEGER :: i, j !#endif @@ -1399,8 +1392,6 @@ INTEGER, INTENT(IN) :: KVECNPT INTEGER :: JL, JLL, JLSHIFT ! Loop indexes INTEGER :: ISPECIES ! Ancillary variable - Told = TIME - TIME = T !JPP CALL Update_SUN() !JPP CALL Update_RCONST() !#ifdef FULL_ALGEBRA @@ -1441,7 +1432,6 @@ INTEGER, INTENT(IN) :: KVECNPT JLSHIFT = JLSHIFT + NSPARSEDIM_NAQ END IF END DO - TIME = Told END SUBROUTINE JacTemplate diff --git a/src/MNH/mode_RBK90_linearalgebra.f90 b/src/MNH/mode_RBK90_linearalgebra.f90 index 8fd23aa139e89b8c906915ccda98c36e80e102e0..de787d50d3e04f7b43d59230b4f92f7d525bf730 100644 --- a/src/MNH/mode_RBK90_linearalgebra.f90 +++ b/src/MNH/mode_RBK90_linearalgebra.f90 @@ -1,10 +1,11 @@ -!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 1994-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. !----------------------------------------------------------------- ! Modifications: ! P. Wautelet 22/02/2019: DOUBLE COMPLEX -> COMPLEX(kind(0.0d0)) to respect Fortran standard +! P. Wautelet 17/12/2021: convert arithmetic if to classic if (deleted from Fortran 2018 standard) !----------------------------------------------------------------- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! @@ -1261,46 +1262,49 @@ END SUBROUTINE KppSolveTR WDOT = 0.0D0 IF (N .LE. 0) RETURN - IF (incX .EQ. incY) IF (incX-1) 5,20,60 + IF (incX .EQ. incY) THEN ! ! Code for unequal or nonpositive increments. ! - 5 IX = 1 - IY = 1 - IF (incX .LT. 0) IX = (-N+1)*incX + 1 - IF (incY .LT. 0) IY = (-N+1)*incY + 1 - DO i = 1,N - WDOT = WDOT + DX(IX)*DY(IY) - IX = IX + incX - IY = IY + incY - END DO - RETURN + IF ( incX < 1 ) THEN + IX = 1 + IY = 1 + IF (incX .LT. 0) IX = (-N+1)*incX + 1 + IF (incY .LT. 0) IY = (-N+1)*incY + 1 + DO i = 1,N + WDOT = WDOT + DX(IX)*DY(IY) + IX = IX + incX + IY = IY + incY + END DO + ELSE IF ( incX == 1 ) THEN ! ! Code for both increments equal to 1. ! ! Clean-up loop so remaining vector length is a multiple of 5. ! - 20 M = MOD(N,5) - IF (M .EQ. 0) GO TO 40 - DO i = 1,M - WDOT = WDOT + DX(i)*DY(i) - END DO - IF (N .LT. 5) RETURN - 40 MP1 = M + 1 - DO i = MP1,N,5 - WDOT = WDOT + DX(i)*DY(i) + DX(i+1)*DY(i+1) + DX(i+2)*DY(i+2) + & - DX(i+3)*DY(i+3) + DX(i+4)*DY(i+4) - END DO - RETURN + M = MOD(N,5) + IF (M .EQ. 0) GO TO 40 + DO i = 1,M + WDOT = WDOT + DX(i)*DY(i) + END DO + IF (N .LT. 5) RETURN + 40 MP1 = M + 1 + DO i = MP1,N,5 + WDOT = WDOT + DX(i)*DY(i) + DX(i+1)*DY(i+1) + DX(i+2)*DY(i+2) + & + DX(i+3)*DY(i+3) + DX(i+4)*DY(i+4) + END DO + ELSE ! ! Code for equal, positive, non-unit increments. ! - 60 NS = N*incX - DO i = 1,NS,incX - WDOT = WDOT + DX(i)*DY(i) - END DO + NS = N*incX + DO i = 1,NS,incX + WDOT = WDOT + DX(i)*DY(i) + END DO + END IF + END IF - END FUNCTION WDOT + END FUNCTION WDOT !-------------------------------------------------------------- diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90 index a7a507828f15b68d1b26aed7ec2df69b86fc039a..8672e488dd9daf956d657273bf10b4622df20f5a 100644 --- a/src/MNH/modeln.f90 +++ b/src/MNH/modeln.f90 @@ -945,6 +945,14 @@ CALL SECOND_MNH2(ZTIME2) ! XT_BOUND = XT_BOUND + ZTIME2 - ZTIME1 ! +! +! For START/RESTART MPPDB_CHECK use +!IF ( (IMI==1) .AND. (CCONF == "START") .AND. (KTCOUNT == 2) ) THEN +! CALL MPPDB_START_DEBUG() +!ENDIF +!IF ( (IMI==1) .AND. (CCONF == "RESTA") .AND. (KTCOUNT == 1) ) THEN +! CALL MPPDB_START_DEBUG() +!ENDIF !------------------------------------------------------------------------------- !* initializes surface number IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI) @@ -973,6 +981,10 @@ IF ( nfile_backup_current < NBAK_NUMB ) THEN TFILE_SURFEX => TZBAKFILE CALL GOTO_SURFEX(IMI) CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.) + IF ( KTCOUNT > 1) THEN + CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH') + CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL') + END IF NULLIFY(TFILE_SURFEX) END IF ! @@ -1427,17 +1439,6 @@ IF (CDCONV/='NONE') THEN END IF END IF ! -IF ( nfile_backup_current > 0 .AND. nfile_backup_current <= NBAK_NUMB ) THEN - IF ( KTCOUNT == TBACKUPN(nfile_backup_current)%NSTEP ) THEN - IF (CSURF=='EXTE') THEN - CALL GOTO_SURFEX(IMI) - CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH') - TFILE_SURFEX => TZBAKFILE - CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL') - NULLIFY(TFILE_SURFEX) - END IF - END IF -END IF ! CALL SECOND_MNH2(ZTIME2) ! @@ -1719,14 +1720,20 @@ CALL MPPDB_CHECK3DM("before RAD_BOUND :XRU/V/WS",PRECISION,XRUS,XRVS,XRWS) ZRUS=XRUS ZRVS=XRVS ZRWS=XRWS - +! if ( .not. l1d ) then if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus(:, :, :) ) if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', xrvs(:, :, :) ) if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', xrws(:, :, :) ) end if - -CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, & +! +CALL MPPDB_CHECK3DM("before RAD_BOUND : other var",PRECISION,XUT,XVT,XRHODJ,XTKET) +CALL MPPDB_CHECKLB(XLBXUM,"modeln XLBXUM",PRECISION,'LBXU',NRIMX) +CALL MPPDB_CHECKLB(XLBYVM,"modeln XLBYVM",PRECISION,'LBYV',NRIMY) +CALL MPPDB_CHECKLB(XLBXUS,"modeln XLBXUS",PRECISION,'LBXU',NRIMX) +CALL MPPDB_CHECKLB(XLBYVS,"modeln XLBYVS",PRECISION,'LBYV',NRIMY) +! + CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, & XTSTEP, & XDXHAT, XDYHAT, XZHAT, & XUT, XVT, & @@ -1772,6 +1779,7 @@ CALL MPPDB_CHECK3DM("before pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS) XRUS_PRES = XRUS - XRUS_PRES + ZRUS XRVS_PRES = XRVS - XRVS_PRES + ZRVS XRWS_PRES = XRWS - XRWS_PRES + ZRWS + CALL MPPDB_CHECK3DM("after pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS) ! END IF ! @@ -1800,7 +1808,7 @@ IF ((LDUST).OR.(LSALT)) THEN ! GCLD=.TRUE. IF (GCLD .AND. NRR.LE.3 ) THEN - IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN + IF( MAX(MAXVAL(XCLDFR(:,:,:)),MAXVAL(XICEFR(:,:,:))).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN GCLD = .FALSE. ! only the cloudy verticals would be ! refreshed but there is no clouds END IF @@ -1888,7 +1896,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, & XPABSM, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, & XSVT, XRSVS, & - XSRCT, XCLDFR,XCIT, & + XSRCT, XCLDFR,XICEFR, XCIT, & LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, & LCONVHG, XCF_MF,XRC_MF, XRI_MF, & XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, & @@ -1907,7 +1915,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, & XPABSM, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, & XSVT, XRSVS, & - XSRCT, XCLDFR,XCIT, & + XSRCT, XCLDFR, XICEFR, XCIT, & LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, & LCONVHG, XCF_MF,XRC_MF, XRI_MF, & XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, & @@ -2123,7 +2131,7 @@ IF (LPROFILER) & CALL PROFILER_n(XTSTEP, & XXHAT, XYHAT, XZZ,XRHODREF, & XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST, & - XAER, XCLDFR, XCIT,PSEA=ZSEA(:,:)) + XAER, MAX(XCLDFR,XICEFR), XCIT,PSEA=ZSEA(:,:)) ! IF (ALLOCATED(ZSEA)) DEALLOCATE (ZSEA) ! diff --git a/src/MNH/modn_blankn.f90 b/src/MNH/modn_blankn.f90 index 44845258a5bddb348b631ccd3052e30696c64fb6..2825372c2e01dbc839105c6391cb7e107d9a7ff8 100644 --- a/src/MNH/modn_blankn.f90 +++ b/src/MNH/modn_blankn.f90 @@ -78,7 +78,7 @@ USE MODD_BLANK_n, ONLY:& IMPLICIT NONE LOGICAL, SAVE :: LDUMMY1, LDUMMY2, LDUMMY3, LDUMMY4,& LDUMMY5, LDUMMY6, LDUMMY7, LDUMMY8 -CHARACTER*80, SAVE :: CDUMMY1, CDUMMY2, CDUMMY3, CDUMMY4,& +CHARACTER(LEN=80), SAVE :: CDUMMY1, CDUMMY2, CDUMMY3, CDUMMY4,& CDUMMY5, CDUMMY6, CDUMMY7, CDUMMY8 INTEGER, SAVE :: NDUMMY1, NDUMMY2, NDUMMY3, NDUMMY4,& NDUMMY5, NDUMMY6, NDUMMY7, NDUMMY8 diff --git a/src/MNH/modn_param_ice.f90 b/src/MNH/modn_param_ice.f90 index 0c7379b3b0f75b233ba679e0d2469ce3a759e0cd..085f74d7381939312012e03d5f1cf082779e233d 100644 --- a/src/MNH/modn_param_ice.f90 +++ b/src/MNH/modn_param_ice.f90 @@ -26,6 +26,6 @@ NAMELIST/NAM_PARAM_ICE/LWARM,LSEDIC,LCONVHG,CPRISTINE_ICE,CSEDIM,LDEPOSC,XVDEPOS LEVLIMIT,LNULLWETG,LWETGPOST,LNULLWETH,LWETHPOST, & CSNOWRIMING,XFRACM90,NMAXITER,XMRSTEP,XTSTEP_TS, & LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LCRFLIMIT, & - XSPLIT_MAXCFL, CFRAC_ICE_SHALLOW_MF, LSEDIM_AFTER + XSPLIT_MAXCFL, CFRAC_ICE_SHALLOW_MF, LSEDIM_AFTER, LSNOW_T ! END MODULE MODN_PARAM_ICE diff --git a/src/MNH/modn_param_lima.f90 b/src/MNH/modn_param_lima.f90 index c42f00675961d7b8b2c4f8d4ee7890074bfd4042..84a2d83e23282a1bc7c2dcc84f5f53d1a87a658d 100644 --- a/src/MNH/modn_param_lima.f90 +++ b/src/MNH/modn_param_lima.f90 @@ -18,14 +18,14 @@ IMPLICIT NONE ! ! NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,& - NMOD_IFN, XIFN_CONC, LIFN_HOM, & + NMOD_IFN, NMOM_I, XIFN_CONC, LIFN_HOM, & CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, & - CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, & + LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, & XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, & XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, & LCIBU, XNDEBRIS_CIBU, LRDSF, & LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, & - LADJ, & + LADJ, LKHKO, & NMOD_CCN, XCCN_CONC, & LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, & XALPHAC, XNUC, XALPHAR, XNUR, & diff --git a/src/MNH/nband_model.fx90 b/src/MNH/nband_model.fx90 index e0aface0e240a114c19048fbf5ddf99cb6c969f5..6005b838759cf188856ece7a479f72945cf033a2 100644 --- a/src/MNH/nband_model.fx90 +++ b/src/MNH/nband_model.fx90 @@ -1,4 +1,4 @@ -!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 1996-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 for details. version 1. @@ -13,6 +13,7 @@ * named nband_model.f90 and compiled with -Fixed * J.Escobar (1/12/2017) bug => intialized all ZV=0.0 in spectr * P. Wautelet 21/11/2019: replace several CONTINUE (workaround of problems with gfortran OpenACC) +* P. Wautelet 17/12/2021: comment ZBSUI variable (not used and was not initialized) * SUBROUTINE NBMVEC I ( KIDIA ,KFDIA ,KLON,KLEV,KGL,KCABS,KNG1,KUABS @@ -768,7 +769,7 @@ C DO 255 JL=KIDIA,KFDIA ZBLEV(JL,KLEV+1)=ZRES(JL) ZBINT(JL,KLEV+1)=ZBINT(JL,KLEV+1)+ZRES(JL) - ZBSUI(JL)=ZBSUI(JL)+ZBSUR(JL) +C ZBSUI(JL)=ZBSUI(JL)+ZBSUR(JL) 255 CONTINUE C IF (NIMP.EQ.0) THEN C JL=KIDIA diff --git a/src/MNH/nhoa_coupln.f90 b/src/MNH/nhoa_coupln.f90 index f8ea30639b021065de23652e151303524f0644f4..072dfbeb3ca7aa64c133a8d0b2855e4a3d1fdea8 100644 --- a/src/MNH/nhoa_coupln.f90 +++ b/src/MNH/nhoa_coupln.f90 @@ -49,6 +49,7 @@ SUBROUTINE NHOA_COUPL_n(KDAD,PTSTEP,KMI,KTCOUNT,KKU) !! JL Redelsperger 03/2021 Version 0 !! MODIFICATIONS !! ------------- +! P. Wautelet 17/12/2021: bugfix: set IIU and IJU values !!----------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -98,17 +99,20 @@ CHARACTER(LEN=4) :: ZINIT_TYPE !---Coupled OA MesoNH---------------------------------------------------------------------------- !* 0. INITIALISATION ! -------------- +IIU = SIZE(XRHODJ,1) +IJU = SIZE(XRHODJ,2) + ! allocate flux local array -ALLOCATE(ZCOUPTFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) -ALLOCATE(ZCOUPUFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) -ALLOCATE(ZCOUPVFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) +ALLOCATE(ZCOUPTFL(IIU,IJU)) +ALLOCATE(ZCOUPUFL(IIU,IJU)) +ALLOCATE(ZCOUPVFL(IIU,IJU)) ! allocate sfc variable local array -ALLOCATE(ZCOUPUA(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) -ALLOCATE(ZCOUPVA(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) -ALLOCATE(ZCOUPTA(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) -ALLOCATE(ZCOUPUO(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) -ALLOCATE(ZCOUPVO(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) -ALLOCATE(ZCOUPTO(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) +ALLOCATE(ZCOUPUA(IIU,IJU)) +ALLOCATE(ZCOUPVA(IIU,IJU)) +ALLOCATE(ZCOUPTA(IIU,IJU)) +ALLOCATE(ZCOUPUO(IIU,IJU)) +ALLOCATE(ZCOUPVO(IIU,IJU)) +ALLOCATE(ZCOUPTO(IIU,IJU)) ! values in ocean sfc IKE=KKU-JPVEXT ZCOUPUO(:,:)= XUT(:,:,IKE) diff --git a/src/MNH/num_diff.f90 b/src/MNH/num_diff.f90 index 65c221c739d179b1116501ac1ce8fe9700be733a..688304a1a2bce2db56e2bc8aadbe9774692ae689 100644 --- a/src/MNH/num_diff.f90 +++ b/src/MNH/num_diff.f90 @@ -1,4 +1,4 @@ -!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 1994-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 for details. version 1. @@ -227,6 +227,7 @@ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudg tbudgets USE MODD_CONF USE MODD_PARAMETERS +use modd_precision, only: MNHREAL32 use mode_budget, only: Budget_store_init, Budget_store_end USE MODE_ll @@ -1120,18 +1121,18 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2) TPHALO2%WEST(:,:) + PFIELDM(IW+1,:,:) & -4.*( PFIELDM(IW-2,:,:) + PFIELDM(IW,:,:) ) & +6.* PFIELDM(IW-1,:,:) & - - TPHALO2LS%WEST(:,:) - PLSFIELD(IW+1,:,:) & - +4.*( PLSFIELD(IW-2,:,:) + PLSFIELD(IW,:,:) ) & - -6.* PLSFIELD(IW-1,:,:) ) + - real(TPHALO2LS%WEST(:,:),kind=MNHREAL32) - real(PLSFIELD(IW+1,:,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(IW-2,:,:),kind=MNHREAL32) + real(PLSFIELD(IW,:,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(IW-1,:,:),kind=MNHREAL32) ) ! PRFIELDS(IE+1,:,:) = PRFIELDS(IE+1,:,:) - PRHODJ(IE+1,:,:) * & PDK4*( & PFIELDM(IE-1,:,:) + TPHALO2%EAST(:,:) & -4.*( PFIELDM(IE,:,:) + PFIELDM(IE+2,:,:) ) & +6.* PFIELDM(IE+1,:,:) & - - PLSFIELD(IE-1,:,:) - TPHALO2LS%EAST(:,:) & - +4.*( PLSFIELD(IE,:,:) + PLSFIELD(IE+2,:,:) ) & - -6.* PLSFIELD(IE+1,:,:) ) + - real(PLSFIELD(IE-1,:,:),kind=MNHREAL32) - real(TPHALO2LS%EAST(:,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(IE,:,:),kind=MNHREAL32) + real(PLSFIELD(IE+2,:,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(IE+1,:,:),kind=MNHREAL32) ) ! !!$ ENDIF ! @@ -1142,10 +1143,10 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2) PDK4*( & PFIELDM(IW-2:IE-2,:,:) + PFIELDM(IW+2:IE+2,:,:) & -4.*( PFIELDM(IW-1:IE-1,:,:) + PFIELDM(IW+1:IE+1,:,:) ) & - +6.* PFIELDM(IW:IE,:,:) & - - PLSFIELD(IW-2:IE-2,:,:) - PLSFIELD(IW+2:IE+2,:,:) & - +4.*( PLSFIELD(IW-1:IE-1,:,:) + PLSFIELD(IW+1:IE+1,:,:) ) & - -6.* PLSFIELD(IW:IE,:,:)) + +6.* PFIELDM(IW:IE,:,:) & + - real(PLSFIELD(IW-2:IE-2,:,:),kind=MNHREAL32) - real(PLSFIELD(IW+2:IE+2,:,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(IW-1:IE-1,:,:),kind=MNHREAL32) + real(PLSFIELD(IW+1:IE+1,:,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(IW:IE,:,:),kind=MNHREAL32) ) ! ELSE ! @@ -1215,7 +1216,8 @@ CASE ('OPEN','WALL','NEST') PRFIELDS(IW-1,:,:) = PRFIELDS(IW-1,:,:) + PRHODJ(IW-1,:,:) * & PDK2*( & PFIELDM(IW-2,:,:) -2.*PFIELDM(IW-1,:,:) + PFIELDM(IW,:,:) & - -PLSFIELD(IW-2,:,:) +2.*PLSFIELD(IW-1,:,:) - PLSFIELD(IW,:,:) ) + - real(PLSFIELD(IW-2,:,:),kind=MNHREAL32) +2.*real(PLSFIELD(IW-1,:,:),kind=MNHREAL32) & + - real(PLSFIELD(IW,:,:),kind=MNHREAL32) ) ! !!$ ELSEIF (NHALO == 1) THEN ELSE @@ -1225,9 +1227,9 @@ CASE ('OPEN','WALL','NEST') TPHALO2%WEST(:,:) + PFIELDM(IW+1,:,:) & -4.*( PFIELDM(IW-2,:,:) + PFIELDM(IW,:,:) ) & +6.* PFIELDM(IW-1,:,:) & - - TPHALO2LS%WEST(:,:) - PLSFIELD(IW+1,:,:) & - +4.*( PLSFIELD(IW-2,:,:) + PLSFIELD(IW,:,:) ) & - -6.* PLSFIELD(IW-1,:,:) ) + - real(TPHALO2LS%WEST(:,:),kind=MNHREAL32) - real(PLSFIELD(IW+1,:,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(IW-2,:,:),kind=MNHREAL32) + real(PLSFIELD(IW,:,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(IW-1,:,:),kind=MNHREAL32) ) ! ENDIF ! @@ -1236,7 +1238,8 @@ CASE ('OPEN','WALL','NEST') PRFIELDS(IE+1,:,:) = PRFIELDS(IE+1,:,:) + PRHODJ(IE+1,:,:) * & PDK2*( & PFIELDM(IE,:,:) -2.*PFIELDM(IE+1,:,:) + PFIELDM(IE+2,:,:) & - - PLSFIELD(IE,:,:) +2.*PLSFIELD(IE+1,:,:) - PLSFIELD(IE+2,:,:) ) + - real(PLSFIELD(IE,:,:),kind=MNHREAL32) +2.*real(PLSFIELD(IE+1,:,:),kind=MNHREAL32) & + - real(PLSFIELD(IE+2,:,:),kind=MNHREAL32) ) ! !!$ ELSEIF (NHALO == 1) THEN ELSE @@ -1246,9 +1249,9 @@ CASE ('OPEN','WALL','NEST') PFIELDM(IE-1,:,:) + TPHALO2%EAST(:,:) & -4.*( PFIELDM(IE ,:,:) + PFIELDM(IE+2,:,:) ) & +6.* PFIELDM(IE+1,:,:) & - - PLSFIELD(IE-1,:,:) - TPHALO2LS%EAST(:,:) & - +4.*( PLSFIELD(IE ,:,:) + PLSFIELD(IE+2,:,:)) & - -6.* PLSFIELD(IE+1,:,:)) + - real(PLSFIELD(IE-1,:,:),kind=MNHREAL32) - real(TPHALO2LS%EAST(:,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(IE ,:,:),kind=MNHREAL32) + real(PLSFIELD(IE+2,:,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(IE+1,:,:),kind=MNHREAL32) ) ! ENDIF @@ -1262,9 +1265,9 @@ CASE ('OPEN','WALL','NEST') PFIELDM(IW-2:IE-2,:,:) + PFIELDM(IW+2:IE+2,:,:) & -4.*( PFIELDM(IW-1:IE-1,:,:) + PFIELDM(IW+1:IE+1,:,:) ) & +6.* PFIELDM(IW:IE,:,:) & - - PLSFIELD(IW-2:IE-2,:,:) - PLSFIELD(IW+2:IE+2,:,:) & - +4.*( PLSFIELD(IW-1:IE-1,:,:) + PLSFIELD(IW+1:IE+1,:,:) ) & - -6.* PLSFIELD(IW:IE,:,:)) + - real(PLSFIELD(IW-2:IE-2,:,:),kind=MNHREAL32) - real(PLSFIELD(IW+2:IE+2,:,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(IW-1:IE-1,:,:),kind=MNHREAL32) + real(PLSFIELD(IW+1:IE+1,:,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(IW:IE,:,:),kind=MNHREAL32) ) ! ELSE ! @@ -1353,18 +1356,18 @@ IF ( .NOT. L2D ) THEN TPHALO2%SOUTH(:,:) + PFIELDM(:,IS+1,:) & -4.*( PFIELDM(:,IS-2,:) + PFIELDM(:,IS,:) ) & +6.* PFIELDM(:,IS-1,:) & - - TPHALO2LS%SOUTH(:,:) - PLSFIELD(:,IS+1,:) & - +4.*( PLSFIELD(:,IS-2,:) + PLSFIELD(:,IS,:) ) & - -6.* PLSFIELD(:,IS-1,:) ) + - real(TPHALO2LS%SOUTH(:,:),kind=MNHREAL32) - real(PLSFIELD(:,IS+1,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(:,IS-2,:),kind=MNHREAL32) + real(PLSFIELD(:,IS,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(:,IS-1,:),kind=MNHREAL32) ) ! PRFIELDS(:,IN+1,:) = PRFIELDS(:,IN+1,:) - PRHODJ(:,IN+1,:) * & PDK4*( & PFIELDM(:,IN-1,:) + TPHALO2%NORTH(:,:) & -4.*( PFIELDM(:,IN,:) + PFIELDM(:,IN+2,:) ) & +6.* PFIELDM(:,IN+1,:) & - - PLSFIELD(:,IN-1,:) - TPHALO2LS%NORTH(:,:) & - +4.*( PLSFIELD(:,IN,:) + PLSFIELD(:,IN+2,:) ) & - -6.* PLSFIELD(:,IN+1,:) ) + - real(PLSFIELD(:,IN-1,:),kind=MNHREAL32) - real(TPHALO2LS%NORTH(:,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(:,IN,:),kind=MNHREAL32) + real(PLSFIELD(:,IN+2,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(:,IN+1,:),kind=MNHREAL32) ) ! !!$ ENDIF ! @@ -1376,9 +1379,9 @@ IF ( .NOT. L2D ) THEN PFIELDM(:,IS-2:IN-2,:) + PFIELDM(:,IS+2:IN+2,:) & -4.*( PFIELDM(:,IS-1:IN-1,:) + PFIELDM(:,IS+1:IN+1,:) ) & +6.* PFIELDM(:,IS:IN,:) & - - PLSFIELD(:,IS-2:IN-2,:) - PLSFIELD(:,IS+2:IN+2,:) & - +4.*( PLSFIELD(:,IS-1:IN-1,:) + PLSFIELD(:,IS+1:IN+1,:) ) & - -6.* PLSFIELD(:,IS:IN,:) ) + - real(PLSFIELD(:,IS-2:IN-2,:),kind=MNHREAL32) - real(PLSFIELD(:,IS+2:IN+2,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(:,IS-1:IN-1,:),kind=MNHREAL32) + real(PLSFIELD(:,IS+1:IN+1,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(:,IS:IN,:),kind=MNHREAL32) ) ! ELSE ! @@ -1448,8 +1451,9 @@ IF ( .NOT. L2D ) THEN ! PRFIELDS(:,IS-1,:) = PRFIELDS(:,IS-1,:) + PRHODJ(:,IS-1,:) * & PDK2*( & - PFIELDM(:,IS-2,:) -2.*PFIELDM(:,IS-1,:) + PFIELDM(:,IS,:) & - -PLSFIELD(:,IS-2,:) +2.*PLSFIELD(:,IS-1,:) - PLSFIELD(:,IS,:) ) + PFIELDM(:,IS-2,:) -2.*PFIELDM(:,IS-1,:) + PFIELDM(:,IS,:) & + - real(PLSFIELD(:,IS-2,:),kind=MNHREAL32) +2.*real(PLSFIELD(:,IS-1,:),kind=MNHREAL32) & + - real(PLSFIELD(:,IS,:),kind=MNHREAL32) ) ! !!$ ELSEIF (NHALO == 1) THEN ELSE @@ -1459,9 +1463,9 @@ IF ( .NOT. L2D ) THEN TPHALO2%SOUTH(:,:) + PFIELDM(:,IS+1,:) & -4.*( PFIELDM(:,IS-2,:) + PFIELDM(:,IS,:) ) & +6.* PFIELDM(:,IS-1,:) & - - TPHALO2LS%SOUTH(:,:) - PLSFIELD(:,IS+1,:) & - +4.*( PLSFIELD(:,IS-2,:) + PLSFIELD(:,IS,:) ) & - -6.* PLSFIELD(:,IS-1,:) ) + - real(TPHALO2LS%SOUTH(:,:),kind=MNHREAL32) - real(PLSFIELD(:,IS+1,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(:,IS-2,:),kind=MNHREAL32) + real(PLSFIELD(:,IS,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(:,IS-1,:),kind=MNHREAL32) ) ! ENDIF ! @@ -1470,7 +1474,8 @@ IF ( .NOT. L2D ) THEN PRFIELDS(:,IN+1,:) = PRFIELDS(:,IN+1,:) + PRHODJ(:,IN+1,:) * & PDK2*( & PFIELDM(:,IN,:) -2.*PFIELDM(:,IN+1,:) + PFIELDM(:,IN+2,:) & - -PLSFIELD(:,IN,:) +2.*PLSFIELD(:,IN+1,:) - PLSFIELD(:,IN+2,:) ) + - real(PLSFIELD(:,IN,:),kind=MNHREAL32) +2.*real(PLSFIELD(:,IN+1,:),kind=MNHREAL32) & + - real(PLSFIELD(:,IN+2,:),kind=MNHREAL32) ) ! !!$ ELSEIF (NHALO == 1) THEN ELSE @@ -1480,9 +1485,9 @@ IF ( .NOT. L2D ) THEN PFIELDM(:,IN-1,:) + TPHALO2%NORTH(:,:) & -4.*( PFIELDM(:,IN,:) + PFIELDM(:,IN+2,:) ) & +6.* PFIELDM(:,IN+1,:) & - - PLSFIELD(:,IN-1,:) - TPHALO2LS%NORTH(:,:) & - +4.*( PLSFIELD(:,IN,:) + PLSFIELD(:,IN+2,:) ) & - -6.* PLSFIELD(:,IN+1,:) ) + - real(PLSFIELD(:,IN-1,:),kind=MNHREAL32) - real(TPHALO2LS%NORTH(:,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(:,IN,:),kind=MNHREAL32) + real(PLSFIELD(:,IN+2,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(:,IN+1,:),kind=MNHREAL32) ) ! ENDIF ! @@ -1496,9 +1501,9 @@ IF ( .NOT. L2D ) THEN PFIELDM(:,IS-2:IN-2,:) + PFIELDM(:,IS+2:IN+2,:) & -4.*( PFIELDM(:,IS-1:IN-1,:) + PFIELDM(:,IS+1:IN+1,:) ) & +6.* PFIELDM(:,IS:IN,:) & - - PLSFIELD(:,IS-2:IN-2,:) - PLSFIELD(:,IS+2:IN+2,:) & - +4.*( PLSFIELD(:,IS-1:IN-1,:) + PLSFIELD(:,IS+1:IN+1,:) ) & - -6.* PLSFIELD(:,IS:IN,:) ) + - real(PLSFIELD(:,IS-2:IN-2,:),kind=MNHREAL32) - real(PLSFIELD(:,IS+2:IN+2,:),kind=MNHREAL32) & + +4.*( real(PLSFIELD(:,IS-1:IN-1,:),kind=MNHREAL32) + real(PLSFIELD(:,IS+1:IN+1,:),kind=MNHREAL32) ) & + -6.* real(PLSFIELD(:,IS:IN,:),kind=MNHREAL32) ) ! ELSE diff --git a/src/MNH/one_wayn.f90 b/src/MNH/one_wayn.f90 index 035f9498615835453bd56cbdf1462d6dabeeeb5c..eac7238d63ed4e9ee1b641155964a222bdc1273e 100644 --- a/src/MNH/one_wayn.f90 +++ b/src/MNH/one_wayn.f90 @@ -126,7 +126,7 @@ SUBROUTINE ONE_WAY_n(KDAD,PTSTEP,KMI,KTCOUNT, & !* 0. DECLARATIONS ! ------------ USE MODD_CH_MNHC_n, only: LUSECHAQ, LUSECHIC -USE MODD_CONF, only: CEQNSYS +USE MODD_CONF, only: CEQNSYS,CCONF USE MODD_CST, only: XCPD, XP00, XRD, XRV, XTH00 USE MODD_DYN_n, ONLY: LOCEAN USE MODD_FIELD_n, only: XPABST, XRT, XSVT, XUT, XVT, XWT, XTHT, XTKET @@ -683,22 +683,8 @@ IF(.NOT. OSTEADY_DMASS) THEN ! !* 4.5 segment beginning (we have first to recover the dry mass at T-DT) ! - IF(SIZE(XRT,4) == 0) THEN - ! dry air case -! ------------ - ZRHOD(:,:,:) = XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**ZRD_O_CPD/(XRD*XTHT(:,:,:)) - ELSE ! moist air case -! -------------- - ZRHOD(:,:,:) = XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**ZRD_O_CPD/(XRD*XTHT(:,:,:) & - *(1.+ZRV_O_RD*XRT(:,:,:,1))) - ENDIF -! -! - ZDRYMASSM = SUM3D_ll (ZJ(:,:,:)*ZRHOD(:,:,:),IINFO_ll,NXOR_ALL(KMI)+JPHEXT,NYOR_ALL(KMI)+JPHEXT, & - 1+JPVEXT,NXEND_ALL(KMI)-JPHEXT,NYEND_ALL(KMI)-JPHEXT,SIZE(XRHODJ,3)-JPVEXT) -! - PDRYMASST = ZDRYMASST - PDRYMASSS = (PDRYMASST - ZDRYMASSM) / (PTSTEP*KDTRATIO) + PDRYMASST = ZDRYMASST + IF ( CCONF /= 'RESTA' ) PDRYMASSS = 0. ENDIF ! END IF diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90 index 327f252f01893ae368664c04eb59d6faffe9bb3c..ef08a0077d4ee244a144c6cf400e1545f9c71316 100644 --- a/src/MNH/phys_paramn.f90 +++ b/src/MNH/phys_paramn.f90 @@ -624,7 +624,7 @@ IF (CRAD /='NONE') THEN ! IF (CRAD =='ECMW' .OR. CRAD =='ECRA') THEN IF (GRAD .AND. NRR.LE.3 ) THEN - IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. OCLOUD_ONLY ) THEN + IF( MAX(MAXVAL(XCLDFR(:,:,:)),MAXVAL(XICEFR(:,:,:))).LE. 1.E-10 .AND. OCLOUD_ONLY ) THEN GRAD = .FALSE. ! only the cloudy verticals would be ! refreshed but there is no clouds END IF @@ -680,6 +680,7 @@ IF (.NOT. OCLOUD_ONLY .AND. KTCOUNT /= 1) THEN NDLON,NFLEV,CAER,NAER,NSTATM, & XSINDEL,XCOSDEL,XTSIDER,XCORSOL, & XSTATM,XOZON, XAER) + XAER_CLIM = XAER END IF END IF ! @@ -738,7 +739,7 @@ CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL ) COPWLW, COPILW, XFUDG, & NDLON, NFLEV, NRAD_DIAG, NFLUX, NRAD, NAER, NSWB_OLD, NSWB_MNH, NLWB_MNH, & NSTATM, NRAD_COLNBR, ZCOSZEN, XSEA, XCORSOL, & - XDIR_ALB, XSCA_ALB, XEMIS, XCLDFR, XCCO2, XTSRAD, XSTATM, XTHT, XRT, & + XDIR_ALB, XSCA_ALB, XEMIS, MAX(XCLDFR,XICEFR), XCCO2, XTSRAD, XSTATM, XTHT, XRT, & XPABST, XOZON, XAER,XDST_WL, XAER_CLIM, XSVT, & XDTHRAD, XFLALWD, XDIRFLASWD, XSCAFLASWD, XRHODREF, XZZ , & XRADEFF, XSWU, XSWD, XLWU, XLWD, XDTHRADSW, XDTHRADLW ) diff --git a/src/MNH/profilern.f90 b/src/MNH/profilern.f90 index 433a5c6ef02ae8a1630718f497b1f602b536f7a5..997562e4fca562d22a6875e636244257abfc050d 100644 --- a/src/MNH/profilern.f90 +++ b/src/MNH/profilern.f90 @@ -112,14 +112,16 @@ USE MODE_FGAU, ONLY : GAULAG USE MODE_FSCATTER, ONLY: QEPSW,QEPSI,BHMIE,MOMG,MG USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,& XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,& - XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC + XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC, LSNOW_T_L=>LSNOW_T USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,& XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,& - XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS + XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS, & + XLBDAS_MIN,XLBDAS_MAX USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,& XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XAR_L=>XAR,& XBC_L=>XBC,XAC_L=>XAC +USE MODD_PARAM_ICE, ONLY: LSNOW_T_I=>LSNOW_T USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEXR,& XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XAR_I=>XAR,& XALPHAC_I=>XALPHAC,XNUC_I=>XNUC,& @@ -242,6 +244,7 @@ REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! tem REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays INTEGER :: JPTS_GAULAG=9 ! number of points for Gauss-Laguerre quadrature REAL :: ZLBDA ! slope distribution parameter +REAL :: ZN ! number cocentration REAL :: ZFRAC_ICE ! ice water fraction REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point REAL :: ZFW ! liquid fraction @@ -724,7 +727,18 @@ IF (GSTORE) THEN ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ENDIF END SELECT - ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX + IF (JLOOP.EQ.5 .AND. ( (CCLOUD=='LIMA'.AND.LSNOW_T_L).OR. & + (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) ) THEN + IF (ZTEMPZ(JK)>-10.) THEN + ZLBDA = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*(ZTEMPZ(JK)+273.15))),XLBDAS_MIN) + ELSE + ZLBDA = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*(ZTEMPZ(JK)+273.15))),XLBDAS_MIN) + END IF + ZN=XLBS_L*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB + ELSE + ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX + ZN=ZCC*ZLBDA**ZCX + END IF ZREFLOC=0. ZAETMP=0. DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature @@ -754,8 +768,8 @@ IF (GSTORE) THEN ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ) ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ) END DO - ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZCC*ZLBDA**ZCX/(4.*GAMMA(ZNU)*.93) - ZAETMP=ZAETMP * XPI *ZCC*ZLBDA**ZCX/(4.*GAMMA(ZNU)) + ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93) + ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU)) TPROFILER%CRARE(IN,JK,I)=TPROFILER%CRARE(IN,JK,I)+ZREFLOC ZAELOC(JK)=ZAELOC(JK)+ZAETMP END IF diff --git a/src/MNH/rad_bound.f90 b/src/MNH/rad_bound.f90 index 296d476b44d32be4d2814e4614cfe0c7cfc1e1b2..22c423583eabe9d1a038f11cd51ef3fefd047ec0 100644 --- a/src/MNH/rad_bound.f90 +++ b/src/MNH/rad_bound.f90 @@ -159,9 +159,10 @@ END MODULE MODI_RAD_BOUND !* 0. DECLARATIONS ! ------------ ! -USE MODD_CONF +USE MODD_CONF USE MODD_CTURB USE MODD_PARAMETERS +USE MODD_PRECISION, ONLY: MNHREAL32 USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL, XRCOEFF ! USE MODE_ll @@ -317,6 +318,14 @@ SELECT CASE ( HLBCX(1) ) ! + ZKTSTEP*( ZLBXU(:,:) ) ) & ! ) * ZINVTSTEP / (1.+ ZCPHASX(:,:) +ZKTSTEP) ! +! ============================================================ +! +! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result +! + ZLBEU = real(ZLBEU,kind=MNHREAL32) + ZLBGU = real(ZLBGU,kind=MNHREAL32) + ZLBXU = real(ZLBXU,kind=MNHREAL32) +! ============================================================ PRUS (IIB,:,:) =(PRHODJ(IIB-1,:,:) + PRHODJ(IIB,:,:)) * 0.5 * & ZINVTSTEP / (1.+ ZKTSTEP * ZALPHA2 ) * & ( (1. - ZCPHASX(:,:) - ZKTSTEP * (1. - ZALPHA2)) * PUT(IIB,:,:) & @@ -374,7 +383,7 @@ SELECT CASE ( HLBCX(2) ) ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) END IF ELSE - ZLBEU (:,:) = PLBXUS(ILBX-JPHEXT+1,:,:) + ZLBEU (:,:) = PLBXUS(ILBX-JPHEXT+1,:,:) ZLBGU (:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) - PLBXUM(ILBX-JPHEXT,:,:) + & PTSTEP * (PLBXUS(ILBX-JPHEXT+1,:,:) - PLBXUS(ILBX-JPHEXT,:,:)) IF ( LRECYCL ) THEN @@ -393,7 +402,15 @@ SELECT CASE ( HLBCX(2) ) ! + ZLBGU (:,:) * ZCPHASX(:,:) & ! + ZKTSTEP*ZLBXU(:,:) ) & ! ) * ZINVTSTEP / (1.+ZCPHASX(:,:) +ZKTSTEP) -! +! +! ============================================================ +! +! Reproductibility for RSTART -> truncate ZLB to real(knd=4) +! + ZLBEU = real(ZLBEU,kind=MNHREAL32) + ZLBGU = real(ZLBGU,kind=MNHREAL32) + ZLBXU = real(ZLBXU,kind=MNHREAL32) +! ============================================================ PRUS (IIE+1,:,:) =(PRHODJ(IIE+1,:,:) + PRHODJ(IIE,:,:)) * 0.5 * & ZINVTSTEP / (1.+ ZKTSTEP * ZALPHA2 ) * & ( (1. - ZCPHASX(:,:) - ZKTSTEP * (1. - ZALPHA2) ) * PUT(IIE+1,:,:) & @@ -469,6 +486,15 @@ SELECT CASE ( HLBCY(1) ) ! - ZLBGV (:,:) * ZCPHASY(:,:) & ! + ZKTSTEP*ZLBYV(:,:) ) & ! ) * ZINVTSTEP / (1.+ ZCPHASY(:,:) +ZKTSTEP) +! +! ============================================================ +! +! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result +! + ZLBEV = real(ZLBEV,kind=MNHREAL32) + ZLBGV = real(ZLBGV,kind=MNHREAL32) + ZLBYV = real(ZLBYV,kind=MNHREAL32) +! ============================================================ PRVS (:,IJB,:) =(PRHODJ(:,IJB-1,:) + PRHODJ(:,IJB,:)) * 0.5 * & ZINVTSTEP / (1.+ ZKTSTEP * ZALPHA2 ) * & ( (1. - ZCPHASY(:,:) - ZKTSTEP * (1. - ZALPHA2) ) * PVT(:,IJB,:)& @@ -546,6 +572,14 @@ SELECT CASE ( HLBCY(2) ) ! + ZKTSTEP* ZLBYV(:,:) ) & ! ) * ZINVTSTEP / (1.+ ZCPHASY(:,:) +ZKTSTEP) ! +! ============================================================ +! +! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result +! + ZLBEV = real(ZLBEV,kind=MNHREAL32) + ZLBGV = real(ZLBGV,kind=MNHREAL32) + ZLBYV = real(ZLBYV,kind=MNHREAL32) +! ============================================================ PRVS (:,IJE+1,:) =(PRHODJ(:,IJE+1,:) + PRHODJ(:,IJE,:)) * 0.5 * & ZINVTSTEP / (1.+ ZKTSTEP * ZALPHA2 ) * & ( (1. - ZCPHASY(:,:) - ZKTSTEP * (1. - ZALPHA2) ) * PVT(:,IJE+1,:)& diff --git a/src/MNH/radar_rain_ice.f90 b/src/MNH/radar_rain_ice.f90 index eddac2294d8c62054116b7be77081b610e72aefb..bd892a45293a32fc6296d13677bf88c111230fa3 100644 --- a/src/MNH/radar_rain_ice.f90 +++ b/src/MNH/radar_rain_ice.f90 @@ -96,6 +96,7 @@ END MODULE MODI_RADAR_RAIN_ICE ! USE MODD_CST USE MODD_REF +USE MODD_PARAM_ICE, ONLY: LSNOW_T_I=>LSNOW_T USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEXR,& XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XAR_I=>XAR,& XALPHAC_I=>XALPHAC,XNUC_I=>XNUC,& @@ -114,7 +115,8 @@ USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XAR_L=> XBC_L=>XBC,XAC_L=>XAC,XCR_L=>XCR,XDR_L=>XDR USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,& XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,& - XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS,XCS_L=>XCS,XDS_L=>XDS + XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS,XCS_L=>XCS,XDS_L=>XDS,& + XLBDAS_MIN,XLBDAS_MAX USE MODD_PARAM_LIMA_MIXED, ONLY:XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,& XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG,& @@ -123,7 +125,7 @@ USE MODD_PARAM_LIMA_MIXED, ONLY:XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L= USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,& XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,& - XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC + XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC, LSNOW_T_L=>LSNOW_T USE MODD_PARAMETERS USE MODD_PARAM_n, ONLY : CCLOUD USE MODD_LUNIT @@ -169,6 +171,8 @@ REAL :: ZRHO00 ! Surface reference air density LOGICAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: GRAIN REAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: ZLBDA ! slope distribution parameter +REAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: ZN + ! number concentration REAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: ZW REAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: ZREFL_MELT_CONV INTEGER :: JLBDA @@ -325,7 +329,25 @@ END IF ! --------------- ! IF (SIZE(PRT,4) >= 5) THEN - IF (CCLOUD=='LIMA') THEN + IF ( (CCLOUD=='LIMA' .AND. LSNOW_T_L) .OR. & + (CCLOUD=='ICE3' .AND. LSNOW_T_I) ) THEN + ZDMELT_FACT = ( (6.0*XAS_L)/(XPI*XRHOLW) )**(2.0) + ZEXP = 2.0*XBS_L + WHERE(PTEMP(:,:,:)>-10. .AND. PRT(:,:,:,5).GT.XRTMIN_L(5)) + ZLBDA(:,:,:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*(PTEMP(:,:,:)+273.15))),XLBDAS_MIN) + END WHERE + WHERE(PTEMP(:,:,:)<=-10 .AND. PRT(:,:,:,5).GT.XRTMIN_L(5)) + ZLBDA(:,:,:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*(PTEMP(:,:,:)+273.15))),XLBDAS_MIN) + END WHERE + ZN(:,:,:)=XLBS_L*PRHODREF(:,:,:)*PRT(:,:,:,5)*ZLBDA(:,:,:)**XBS_L + WHERE( PRT(:,:,:,5).GT.XRTMIN_L(5) ) + ZW(:,:,:) = ZEQICE*ZDMELT_FACT & + *1.E18*ZN(:,:,:)*(ZLBDA(:,:,:)**(-ZEXP))*MOMG(XALPHAS_L,XNUS_L,ZEXP) + PVDOP(:,:,:) = PVDOP(:,:,:)+ZEQICE*ZDMELT_FACT*MOMG(XALPHAS_L,XNUS_L,ZEXP+XDS_L) & + *1.E18*ZN(:,:,:)*XCS_L*(ZLBDA(:,:,:)**(-ZEXP-XDS_L)) + PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:) + END WHERE + ELSEIF (CCLOUD=='LIMA') THEN ZDMELT_FACT = ( (6.0*XAS_L)/(XPI*XRHOLW) )**(2.0) ZEXP = 2.0*XBS_L WHERE( PRT(:,:,:,5).GT.XRTMIN_L(5) ) diff --git a/src/MNH/radar_scattering.f90 b/src/MNH/radar_scattering.f90 index dc3ddc1e5027eed57ce8610829eef632598ac9ac..4d6537af5ea199b904980a1ae2b8c694b40817c6 100644 --- a/src/MNH/radar_scattering.f90 +++ b/src/MNH/radar_scattering.f90 @@ -105,6 +105,7 @@ USE MODD_CST USE MODD_IO, ONLY: TFILEDATA USE MODD_LUNIT USE MODD_PARAMETERS +USE MODD_PARAM_ICE, ONLY: LSNOW_T_I=>LSNOW_T USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XDR_I=>XDR,XLBEXR_I=>XLBEXR,& XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XCR_I=>XCR,& XALPHAS_I=>XALPHAS,XNUS_I=>XNUS,XDS_I=>XDS,XLBEXS_I=>XLBEXS,& @@ -119,12 +120,13 @@ USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XDR_I=>XDR,XLBEXR !!LIMA USE MODD_PARAM_LIMA_WARM, ONLY: XDR_L=>XDR,XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XCR_L=>XCR USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,& - XDS_L=>XDS,XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS,XCS_L=>XCS + XDS_L=>XDS,XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,XAS_L=>XAS,XBS_L=>XBS,& + XCXS_L=>XCXS,XCS_L=>XCS,XLBDAS_MIN,XLBDAS_MAX USE MODD_PARAM_LIMA_MIXED, ONLY:XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,& XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,& - XRTMIN_L=>XRTMIN + XRTMIN_L=>XRTMIN, LSNOW_T_L=>LSNOW_T !!LIMA USE MODD_RADAR, ONLY:XLAM_RAD,XSTEP_RAD,NBELEV,NDIFF,LATT,NPTS_GAULAG,LQUAD,XVALGROUND,NDGS, & LFALL,LWBSCS,LWREFL,XREFLVDOPMIN,XREFLMIN,LSNRT,XSNRMIN @@ -192,6 +194,7 @@ REAL :: ZDMELT_FACT ! factor used to compute the equivalent melted diameter REAL :: ZEQICE=0.224! factor used to convert the ice crystals reflectivity into an equivalent liquid water reflectivity (from Smith, JCAM 84) REAL :: ZEXP ! anciliary parameter REAL :: ZLBDA ! slope distribution parameter +REAL :: ZN ! Number concentration REAL :: ZFRAC_ICE,ZD,ZDE ! auxiliary variables REAL :: ZQSCA REAL,DIMENSION(2) :: ZQEXT @@ -1282,28 +1285,37 @@ DO JI=1,INBRAD ZDMELT_FACT=6.*ZAS/(XPI*.92*XRHOLW) ZEXP=2.*ZBS !XBS = 1.9 in ini_radar.f90 (bj tab 2.1 p24) !dans ini_rain_ice.f90 : - ZLBDA= ZLBS*(ZM)**ZLBEXS - + IF ( (GLIMA .AND. LSNOW_T_L) .OR. (.NOT.GLIMA .AND. LSNOW_T_I) ) THEN + IF (PT_RAY(JI,JEL,JAZ,JL,JH,JV)>-10.) THEN + ZLBDA = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*(PT_RAY(JI,JEL,JAZ,JL,JH,JV)+273.15))),XLBDAS_MIN) + ELSE + ZLBDA = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*(PT_RAY(JI,JEL,JAZ,JL,JH,JV)+273.15))),XLBDAS_MIN) + END IF + ZN=ZLBS*ZM*ZLBDA**ZBS + ELSE + ZLBDA= ZLBS*(ZM)**ZLBEXS + ZN=ZCCS*ZLBDA**ZCXS + END IF ! Rayleigh or Rayleigh-Gans or Rayleigh with 6th order for attenuation IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN - ZREFLOC(1:2)=ZEQICE*.92**2*ZDMELT_FACT**2*1.E18*ZCCS*ZLBDA**(ZCXS-ZEXP)*MOMG(ZALPHAS,ZNUS,ZEXP) + ZREFLOC(1:2)=ZEQICE*.92**2*ZDMELT_FACT**2*1.E18*ZN*ZLBDA**(ZEXP)*MOMG(ZALPHAS,ZNUS,ZEXP) ZREFLOC(3)=0. IF(LWREFL) THEN ! weighting by reflectivities ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)& -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZEQICE*.92**2*ZDMELT_FACT**2& - *1.E18*ZCCS*ZLBDA**(ZCXS-ZEXP-ZDS)*MOMG(ZALPHAS,ZNUS,ZEXP+ZDS) + *1.E18*ZN*ZLBDA**(ZEXP-ZDS)*MOMG(ZALPHAS,ZNUS,ZEXP+ZDS) ELSE - ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)+ZCCS*ZLBDA**ZCXS + ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)+ZN ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)& -ZCS*SIN(PELEV(JI,JEL,JL,JV))& - *ZCCS*ZLBDA**(ZCXS-ZDS)*MOMG(ZALPHAS,ZNUS,ZDS) + *ZN*ZLBDA**(ZDS)*MOMG(ZALPHAS,ZNUS,ZDS) END IF IF(LATT) THEN IF(NDIFF==0.OR.NDIFF==3) THEN - ZAETMP(:)=ZCCS*ZLBDA**ZCXS*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)& + ZAETMP(:)=ZN*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)& *MOMG(ZALPHAS,ZNUS,ZBS)/ZLBDA**ZBS) ELSE - ZAETMP(:)=ZCCS*ZLBDA**ZCXS*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) & + ZAETMP(:)=ZN*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) & *MOMG(ZALPHAS,ZNUS,ZBS)/ZLBDA**ZBS & +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3 & *AIMAG(ZQK**2*(ZQMI**4+27.*ZQMI**2+38.) & @@ -1355,7 +1367,7 @@ DO JI=1,INBRAD ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) & -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) & - *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCS/4./ZLBDA**(3+ZDS) + *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*(ZN*ZLBDA**(-ZCXS))/4./ZLBDA**(3+ZDS) IF(LATT) THEN ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2 ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2 @@ -1374,15 +1386,15 @@ DO JI=1,INBRAD ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUS-1.+2.*ZBS/3./ZALPHAS+ZDS/ZALPHAS)*ZW(JJ) IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUS-1.+2.*ZBS/3./ZALPHAS)*ZW(JJ) END DO ! ****** end loop Gauss-Laguerre quadrature - ZREFLOC(1:2)=1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCS*ZLBDA**(ZCXS-2.*ZBS/3.)/& + ZREFLOC(1:2)=1.E18*(XLAM_RAD(JI)/XPI)**4*ZN*ZLBDA**(-2.*ZBS/3.)/& (4.*GAMMA(ZNUS)*.93)*ZDMELT_FACT**(2./3.)*ZREFLOC(1:2) ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)& +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) & -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) & - *1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCS & - *ZLBDA**(ZCXS-2.*ZBS/3.-ZDS)/ & + *1.E18*(XLAM_RAD(JI)/XPI)**4*ZN & + *ZLBDA**(2.*ZBS/3.-ZDS)/ & (4.*GAMMA(ZNUS)*.93)*ZDMELT_FACT**(2./3.) - IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZCCS*ZLBDA**(ZCXS-2.*ZBS/3.)/(4.*GAMMA(ZNUS))& + IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZN*ZLBDA**(-2.*ZBS/3.)/(4.*GAMMA(ZNUS))& *ZDMELT_FACT**(2./3.) ZRE_S22S11_S=0 ZIM_S22S11_S=0 diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90 index 2416326653944702f6e731bfda3d47c2f2f7d9d3..3ad44addbceccd40be33646a13bc83964a27e0b8 100644 --- a/src/MNH/rain_ice_red.f90 +++ b/src/MNH/rain_ice_red.f90 @@ -257,6 +257,7 @@ END MODULE MODI_RAIN_ICE_RED ! P. Wautelet 17/01/2020: move Quicksort to tools.f90 ! P. Wautelet 02/2020: use the new data structures and subroutines for budgets ! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG +! J. Wurtz 03/2022: New snow characteristics with LSNOW_T !----------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -272,8 +273,8 @@ use modd_budget, only: lbu_enable, USE MODD_CST, ONLY: XCI,XCL,XCPD,XCPV,XLSTT,XLVTT,XTT USE MODD_PARAMETERS, ONLY: JPVEXT,XUNDEF USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPOSC,LFEEDBACKT,LSEDIM_AFTER, & - NMAXITER,XMRSTEP,XTSTEP_TS,XVDEPOSC -USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN + NMAXITER,XMRSTEP,XTSTEP_TS,XVDEPOSC,LSNOW_T +USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN,XLBDAS_MIN,XLBDAS_MAX,XTRANS_MP_GAMMAS,XLBS,XLBEXS USE MODD_VAR_ll, ONLY: IP use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end @@ -356,6 +357,8 @@ REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air pre ! !* 0.2 Declarations of local variables : ! +REAL, DIMENSION(SIZE(PRST,1),SIZE(PRST,2),SIZE(PRST,3)) :: ZLBDAS ! Modif !lbda parameter snow + INTEGER :: IIB ! Define the domain where is INTEGER :: IIE ! the microphysical sources have to be computed INTEGER :: IJB ! @@ -571,6 +574,27 @@ ELSE ENDDO ENDDO ENDIF + +!Compute lambda_snow parameter +!ZT en KELVIN +ZLBDAS(:,:,:)=1000. +DO JK = 1, KKT + DO JJ = 1, KJT + DO JI = 1, KIT + IF (LSNOW_T) THEN + IF (PRST(JI,JJ,JK)>XRTMIN(5)) THEN + IF(ZT(JI,JJ,JK)>263.15) THEN + ZLBDAS(JI,JJ,JK) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZT(JI,JJ,JK))),XLBDAS_MIN)*XTRANS_MP_GAMMAS + ELSE + ZLBDAS(JI,JJ,JK) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZT(JI,JJ,JK))),XLBDAS_MIN)*XTRANS_MP_GAMMAS + END IF + END IF + ELSE + ZLBDAS(JI,JJ,JK) = MAX(MIN(XLBDAS_MAX,XLBS*(PRHODREF(JI,JK,JL)*PRST(JI,JK,JL))**XLBEXS),XLBDAS_MIN) + END IF + END DO + END DO +END DO ! !------------------------------------------------------------------------------- ! @@ -600,6 +624,7 @@ IF(.NOT. LSEDIM_AFTER) THEN CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + &ZLBDAS, & &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,& &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,& &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, & @@ -609,6 +634,7 @@ IF(.NOT. LSEDIM_AFTER) THEN CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + &ZLBDAS, & &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,& &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,& &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, & @@ -623,6 +649,7 @@ IF(.NOT. LSEDIM_AFTER) THEN CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + &ZLBDAS, & &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, & &PSEA=PSEA, PTOWN=PTOWN, & @@ -631,6 +658,7 @@ IF(.NOT. LSEDIM_AFTER) THEN CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + &ZLBDAS, & &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, & &PSEA=PSEA, PTOWN=PTOWN, & @@ -1684,6 +1712,7 @@ IF(LSEDIM_AFTER) THEN CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + &ZLBDAS, & &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,& &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,& &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, & @@ -1693,6 +1722,7 @@ IF(LSEDIM_AFTER) THEN CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ,& &PRHODREF, PPABST, PTHT, PRHODJ, & + &ZLBDAS, & &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,& &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,& &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, & @@ -1707,6 +1737,7 @@ IF(LSEDIM_AFTER) THEN CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + &ZLBDAS, & &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, & &PSEA=PSEA, PTOWN=PTOWN, & @@ -1715,6 +1746,7 @@ IF(LSEDIM_AFTER) THEN CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, & &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, & &PRHODREF, PPABST, PTHT, PRHODJ, & + &ZLBDAS, & &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, & &PSEA=PSEA, PTOWN=PTOWN, & diff --git a/src/MNH/read_all_data_grib_case.f90 b/src/MNH/read_all_data_grib_case.f90 index 84c13799185ffe6e85d837934b7348cf51c022f6..841ae62b0c834902a5fec42fcbbac2c947e6d8c3 100644 --- a/src/MNH/read_all_data_grib_case.f90 +++ b/src/MNH/read_all_data_grib_case.f90 @@ -136,6 +136,7 @@ END MODULE MODI_READ_ALL_DATA_GRIB_CASE ! Q. Rodier 21/04/2020: correction GFS u and v wind component written in the right vertical order ! Q. Rodier 02/09/2020: Read and interpol geopotential height for interpolation on isobaric surface Grid of NCEP ! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv +!JP Chaboureau 02/08/2021: add ERA5 reanlysis in pressure levels !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -202,10 +203,11 @@ REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolati ! ------------------------------ ! General purpose variables INTEGER :: ILUOUT0 ! Unit used for output msg. -INTEGER :: IRESP ! Return code of FM-routines +INTEGER :: IRESP ! Return code of FM-routines INTEGER :: IRET ! Return code from subroutines -INTEGER(KIND=kindOfInt) :: IRET_GRIB ! Return code from subroutines +INTEGER(KIND=kindOfInt) :: IRET_GRIB ! Return code from subroutines INTEGER, PARAMETER :: JP_GFS=31 ! number of pressure levels for GFS model +INTEGER, PARAMETER :: JP_ERA=37 ! number of pressure levels for ERA5 reanalysis REAL :: ZA,ZB,ZC ! Dummy variables REAL :: ZD,ZE,ZF ! | REAL :: ZTEMP ! | @@ -230,7 +232,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points ! Variable involved in the task of reading the grib file -INTEGER(KIND=kindOfInt) :: IUNIT ! unit of the grib file +INTEGER(KIND=kindOfInt) :: IUNIT ! unit of the grib file CHARACTER(LEN=50) :: HGRID ! type of grid INTEGER :: IPAR ! Parameter identifier INTEGER :: ITYP ! type of level (Grib code table 3) @@ -246,13 +248,13 @@ INTEGER :: IMODEL ! Type of Grib file : ! 10 -> NCEP - GFS INTEGER :: ICENTER ! number of center INTEGER :: ISIZE ! size of grib message -INTEGER(KIND=kindOfInt) :: ICOUNT ! number of messages in the file +INTEGER(KIND=kindOfInt) :: ICOUNT ! number of messages in the file INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: IGRIB ! number of the grib in memory INTEGER :: INUM ,INUM_ZS ! number of a grib message -REAL,DIMENSION(:),ALLOCATABLE :: ZPARAM ! parameter of girb grid +REAL,DIMENSION(:),ALLOCATABLE :: ZPARAM ! parameter of grib grid INTEGER,DIMENSION(:),ALLOCATABLE :: IINLO ! longitude of grib grid INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: IINLO_GRIB ! longitude of grib grid -REAL,DIMENSION(:),ALLOCATABLE :: ZPARAM_ZS ! parameter of girb grid for ZS +REAL,DIMENSION(:),ALLOCATABLE :: ZPARAM_ZS ! parameter of grib grid for ZS INTEGER,DIMENSION(:),ALLOCATABLE :: IINLO_ZS ! longitude of grib grid for ZS REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE ! Intermediate array REAL,DIMENSION(:),ALLOCATABLE :: ZOUT ! Intermediate arrays @@ -264,11 +266,11 @@ TYPE(DATE_TIME) :: TPTCUR ! Date & time of the grib fi INTEGER :: ITWOZS ! surface pressure REAL, DIMENSION(:), ALLOCATABLE :: ZPS_G ! Grib data : Ps -REAL, DIMENSION(:), ALLOCATABLE :: ZLNPS_G ! Grib data : ln(Ps) -REAL, DIMENSION(:), ALLOCATABLE :: ZWORK_LNPS ! Grib data on zs grid: ln(Ps) +REAL, DIMENSION(:), ALLOCATABLE :: ZLNPS_G ! Grib data : ln(Ps) +REAL, DIMENSION(:), ALLOCATABLE :: ZWORK_LNPS ! Grib data on zs grid: ln(Ps) INTEGER :: INJ,INJ_ZS ! orography -CHARACTER(LEN=50) :: HGRID_ZS ! type of grid +CHARACTER(LEN=50) :: HGRID_ZS ! type of grid ! ! Reading and projection of the wind vectors u, v REAL :: ZALPHA ! Angle of rotation @@ -330,14 +332,17 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEV_LS ! T V REAL, DIMENSION(:), ALLOCATABLE :: ZPV ! vertical level in grib file INTEGER :: IPVPRESENT ,IPV REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZR_DUM -INTEGER :: IMI +INTEGER :: IMI TYPE(TFILEDATA),POINTER :: TZFILE INTEGER, DIMENSION(JP_GFS) :: IP_GFS ! list of pressure levels for GFS model +INTEGER, DIMENSION(JP_ERA) :: IP_ERA ! list of pressure levels for ERA5 reanalysis INTEGER :: IVERSION,ILEVTYPE -LOGICAL :: GFIND ! to test if sea wave height is found +LOGICAL :: GFIND ! to test if sea wave height is found !--------------------------------------------------------------------------------------- IP_GFS=(/1000,975,950,925,900,850,800,750,700,650,600,550,500,450,400,350,300,& - 250,200,150,100,70,50,30,20,10,7,5,3,2,1/)! + 250,200,150,100,70,50,30,20,10,7,5,3,2,1/) +IP_ERA=(/1000,975,950,925,900,875,850,825,800,775,750,700,650,600,550,500,450,& + 400,350,300,250,225,200,175,150,125,100,70,50,30,20,10,7,5,3,2,1/) ! TZFILE => NULL() ! @@ -567,7 +572,6 @@ ELSE IF (HFILE=='CHEM') THEN END IF DEALLOCATE (ZOUT) ! -! *** BEGIN MODIF SB ADD HS *** !--------------------------------------------------------------------------------------- !* 2.3 bis Read and interpol Sea Wave significant height !--------------------------------------------------------------------------------------- @@ -593,7 +597,7 @@ SELECT CASE (IMODEL) GFIND=.TRUE. END IF ! - IF(GFIND) THEN + IF (GFIND) THEN !!!!!!!!!!! Faire en sorte de le faire que pour le CASE(0) ! Sea wave significant height disponible uniquement pour ECMWF ! recuperation du tableau de valeurs @@ -615,7 +619,6 @@ SELECT CASE (IMODEL) DEALLOCATE (ZOUT) END IF END SELECT - ! *** END MODIF SB ADD HS *** ! !--------------------------------------------------------------------------------------- !* 2.4 Interpolation surface pressure @@ -628,6 +631,12 @@ WRITE (ILUOUT0,'(A)') ' | Searching pressure' SELECT CASE (IMODEL) CASE(0) ! ECMWF CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=152) + IF( INUM < 0 ) THEN + WRITE (ILUOUT0,'(A)') ' | Logarithm of surface pressure is missing. It is then supposed that' + WRITE (ILUOUT0,'(A)') ' | this ECMWF file has atmospheric fields on pressure levels (e.g. ERA5)' + CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=134) + IMODEL = 11 + END IF CASE(1,2,3,4,5) ! arpege mocage aladin et aladin reunion CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=1) CASE(6,7) ! NEW AROME,ARPEGE @@ -647,7 +656,7 @@ SELECT CASE (IMODEL) ALLOCATE (ZLNPS_G(ISIZE)) ZLNPS_G(:) = ZVALUE(1:ISIZE) ZPS_G (:) = EXP(ZVALUE(1:ISIZE)) - CASE(1,2,3,4,5,10) ! arpege mocage aladin aladin-reunion NCEP + CASE(1,2,3,4,5,10,11) ! arpege mocage aladin aladin-reunion NCEP ERA5 ALLOCATE (ZPS_G (ISIZE)) ALLOCATE (ZLNPS_G(ISIZE)) ZPS_G (:) = ZVALUE(1:ISIZE) @@ -708,7 +717,7 @@ DEALLOCATE (ZLNPS_G) ! WRITE (ILUOUT0,'(A)') ' | Reading T and Q fields' ! -IF (IMODEL/=10) THEN +IF (IMODEL/=10.AND.IMODEL/=11) THEN SELECT CASE (IMODEL) CASE(0) ! ECMWF ISTARTLEVEL=1 @@ -732,7 +741,7 @@ IF (IMODEL/=10) THEN IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' ) CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL) IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' ) -ELSE ! NCEP +ELSEIF (IMODEL==10) THEN ! NCEP ISTARTLEVEL=1000 IT=130 IQ=157 @@ -740,20 +749,32 @@ ELSE ! NCEP IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' ) CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL) IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric relative humidity is missing' ) +ELSE ! ERA5 + ISTARTLEVEL=1000 + IT=130 + IQ=133 + CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL) + IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' ) + CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL) + IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' ) ENDIF ! -IF (IMODEL/=10) THEN ! others than NCEP +IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5 CALL GRIB_GET(IGRIB(INUM),'NV',INLEVEL) INLEVEL = NINT(INLEVEL / 2.) - 1 CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE) ELSE - INLEVEL=JP_GFS + IF (IMODEL==10) THEN + INLEVEL=JP_GFS + ELSE + INLEVEL=JP_ERA + END IF END IF ! ALLOCATE (ZT_G(ISIZE,INLEVEL)) ALLOCATE (ZQ_G(ISIZE,INLEVEL)) ! -IF (IMODEL/=10) THEN ! others than NCEP +IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5 DO JLOOP1=1, INLEVEL ILEV1 = JLOOP1-1+ISTARTLEVEL CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1) @@ -770,7 +791,7 @@ IF (IMODEL/=10) THEN ! others than NCEP CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,INLEVEL-JLOOP1+1)) CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB) END DO -ELSE ! NCEP +ELSEIF (IMODEL==10) THEN ! NCEP DO JLOOP1=1, INLEVEL ILEV1 = IP_GFS(JLOOP1) CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1) @@ -779,14 +800,29 @@ ELSE ! NCEP CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG) END IF CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,JLOOP1),IRET_GRIB) - WRITE (ILUOUT0,*) 'Q ',ILEV1,IRET_GRIB CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=0,KNUMBER=0,KLEV1=ILEV1,KTFFS=100) IF (INUM< 0) THEN WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing' CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG) END IF CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,JLOOP1),IRET_GRIB) - WRITE (ILUOUT0,*) 'T ',ILEV1,IRET_GRIB + CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB) + END DO +ELSE ! ERA5 + DO JLOOP1=1, INLEVEL + ILEV1 = IP_ERA(JLOOP1) + CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1) + IF (INUM< 0) THEN + WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing' + CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG) + END IF + CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,JLOOP1),IRET_GRIB) + CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1) + IF (INUM< 0) THEN + WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing' + CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG) + END IF + CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,JLOOP1),IRET_GRIB) CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB) END DO END IF @@ -797,7 +833,7 @@ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,& ! !* 2.5.2 Load level definition parameters A and B ! -IF (IMODEL/=10) THEN ! others than NCEP +IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5 IF (HFILE(1:3)=='ATM') THEN XP00_LS = 101325. @@ -853,14 +889,19 @@ IF (IMODEL/=10) THEN ! others than NCEP ELSE ALLOCATE (XA_LS(INLEVEL)) ALLOCATE (XB_LS(0)) - XA_LS = 100.*IP_GFS + IF (IMODEL==10) THEN + XA_LS = 100.*IP_GFS + ELSE + XA_LS = 100.*IP_ERA + END IF END IF ! !* 2.5.3 Compute atmospheric pressure on grib grid ! WRITE (ILUOUT0,'(A)') ' | Atmospheric pressure on Grib grid is being computed' + ALLOCATE (ZPF_G(INI,INLEVEL)) -IF (IMODEL/=10) THEN ! others than NCEP +IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5 IF (HFILE(1:3)=='ATM') THEN ZPF_G(:,:) = SPREAD(XA_LS,1,INI)*XP00_LS + & SPREAD(XB_LS,1,INI)*SPREAD(ZPS_G(1:INI),2,INLEVEL) @@ -869,7 +910,11 @@ IF (IMODEL/=10) THEN ! others than NCEP SPREAD(XB_SV_LS,1,INI)*SPREAD(ZPS_G(1:INI),2,INLEVEL) END IF ELSE - ZPF_G(:,:) = 100.*SPREAD(IP_GFS,1,INI) + IF (IMODEL==10) THEN + ZPF_G(:,:) = 100.*SPREAD(IP_GFS,1,INI) + ELSE + ZPF_G(:,:) = 100.*SPREAD(IP_ERA,1,INI) + END IF END IF DEALLOCATE (ZPS_G) ! @@ -965,6 +1010,8 @@ ALLOCATE (ZRV_G(INI)) ALLOCATE (ZOUT(INO)) IF (IMODEL/=10) THEN ! others than NCEP DO JLOOP1=1, INLEVEL + !WRITE (ILUOUT0,*) 'JLOOP1=',JLOOP1,MINVAL(ZPM_G(:,JLOOP1)),MINVAL(ZT_G(:,JLOOP1)),MINVAL(ZQ_G(:,JLOOP1)) + !WRITE (ILUOUT0,*) ' ',MAXVAL(ZPM_G(:,JLOOP1)),MAXVAL(ZT_G(:,JLOOP1)),MAXVAL(ZQ_G(:,JLOOP1)) ! ! Compute Theta V and relative humidity on grib grid ! @@ -994,15 +1041,15 @@ IF (IMODEL/=10) THEN ! others than NCEP END DO ELSE !NCEP DO JLOOP1=1, INLEVEL - WRITE (ILUOUT0,*) 'JLOOP1=',JLOOP1,MINVAL(ZPM_G(:,JLOOP1)),MINVAL(ZT_G(:,JLOOP1)),MINVAL(ZQ_G(:,JLOOP1)) - WRITE (ILUOUT0,*) ' ',MAXVAL(ZPM_G(:,JLOOP1)),MAXVAL(ZT_G(:,JLOOP1)),MAXVAL(ZQ_G(:,JLOOP1)) + !WRITE (ILUOUT0,*) 'JLOOP1=',JLOOP1,MINVAL(ZPM_G(:,JLOOP1)),MINVAL(ZT_G(:,JLOOP1)),MINVAL(ZQ_G(:,JLOOP1)) + !WRITE (ILUOUT0,*) ' ',MAXVAL(ZPM_G(:,JLOOP1)),MAXVAL(ZT_G(:,JLOOP1)),MAXVAL(ZQ_G(:,JLOOP1)) ZH_G(:) =ZQ_G(:,JLOOP1) ZRV_G(:) = (XRD/XRV)*SM_FOES(ZT_G(:,JLOOP1))*0.01*ZH_G(:) & /(ZPM_G(:,JLOOP1) -SM_FOES(ZT_G(:,JLOOP1))*0.01*ZH_G(:)) - WRITE (ILUOUT0,*) ' ',MINVAL(ZRV_G(:)),MAXVAL(ZRV_G(:)) + !WRITE (ILUOUT0,*) ' ',MINVAL(ZRV_G(:)),MAXVAL(ZRV_G(:)) ZTHV_G(:)=ZT_G(:,JLOOP1) * ((XP00/ZPM_G(:,JLOOP1))**(XRD/XCPD)) * & ((1. + XRV*ZRV_G(:)/XRD) / (1. + ZRV_G(:))) - WRITE (ILUOUT0,*) ' ',MINVAL(ZTHV_G(:)),MAXVAL(ZTHV_G(:)) + !WRITE (ILUOUT0,*) ' ',MINVAL(ZTHV_G(:)),MAXVAL(ZTHV_G(:)) ! ! Interpolation : H CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, & @@ -1027,20 +1074,29 @@ DEALLOCATE (ZOUT) ! ALLOCATE (ZGH_G(ISIZE,INLEVEL)) ! -IF(IMODEL==10) THEN !NCEP with pressure grid only +IF (IMODEL==10.OR.IMODEL==11) THEN !NCEP or ERA5 with pressure grid only DO JLOOP1=1, INLEVEL - ILEV1 = IP_GFS(JLOOP1) - WRITE (ILUOUT0,'(A)') ' | Searching geopotential height' - CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=5,KLEV1=ILEV1) + IF (IMODEL==10) THEN + ILEV1 = IP_GFS(JLOOP1) + CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=5,KLEV1=ILEV1) + ELSE + ILEV1 = IP_ERA(JLOOP1) + CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=129,KLEV1=ILEV1) + END IF IF (INUM< 0) THEN !callabortstop - WRITE(YMSG,*) 'Geopoential height level ',JLOOP1,' is missing' + WRITE(YMSG,*) 'Geopotential height level ',JLOOP1,' is missing' CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG) END IF ! CALL GRIB_GET(IGRIB(INUM),'values',ZGH_G(:,JLOOP1),IRET_GRIB) CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB) ! + IF (IMODEL/=10) THEN + ! Data given in archives are multiplied by the gravity acceleration + ZGH_G(:,JLOOP1) = ZGH_G(:,JLOOP1) / XG + END IF + ! END DO ! CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM_ZS),IIU,IJU,ZLONOUT,ZLATOUT,& @@ -1059,9 +1115,9 @@ END IF ! !* 2.5.5 Compute atmospheric pressure on MESO-NH grid ! -WRITE (ILUOUT0,'(A)') ' | Atmospheric pressure on MesoNH grid is being computed' +WRITE (ILUOUT0,'(A)') ' | Atmospheric pressure on the Meso-NH grid is being computed' ALLOCATE (ZPF_LS(IIU,IJU,INLEVEL)) -IF (IMODEL/=10) THEN ! others than NCEP +IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5 IF (HFILE(1:3)=='ATM') THEN ZPF_LS(:,:,:) = SPREAD(SPREAD(XA_LS,1,IIU),2,IJU)*XP00_LS + & SPREAD(SPREAD(XB_LS,1,IIU),2,IJU)*SPREAD(XPS_LS,3,INLEVEL) @@ -1070,7 +1126,11 @@ IF (IMODEL/=10) THEN ! others than NCEP SPREAD(SPREAD(XB_SV_LS,1,IIU),2,IJU)*SPREAD(XPS_SV_LS,3,INLEVEL) END IF ELSE - ZPF_LS(:,:,:) = 100.*SPREAD(SPREAD(IP_GFS,1,IIU),2,IJU) + IF(IMODEL==10) THEN + ZPF_LS(:,:,:) = 100.*SPREAD(SPREAD(IP_GFS,1,IIU),2,IJU) + ELSE + ZPF_LS(:,:,:) = 100.*SPREAD(SPREAD(IP_ERA,1,IIU),2,IJU) + END IF END IF ! ALLOCATE (ZEXNF_LS(IIU,IJU,INLEVEL)) @@ -1420,11 +1480,6 @@ END IF ! After this projection, the file is simil ! IF (HFILE(1:3)=='ATM') THEN -IF (IMODEL/=10) THEN ! others than NCEP - ISTARTLEVEL = 1 -ELSE - ISTARTLEVEL = 10 -END IF ALLOCATE (XU_LS(IIU,IJU,INLEVEL)) ALLOCATE (XV_LS(IIU,IJU,INLEVEL)) ALLOCATE (ZTU_LS(INO)) @@ -1445,16 +1500,20 @@ SELECT CASE (IMODEL) ISTARTLEVEL = 0 CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL) END IF - CASE (10) + CASE (10,11) IPAR = 131 ISTARTLEVEL = 1 END SELECT DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1 - IF (IMODEL/=10) THEN ! others than NCEP + IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5 ILEV1 = JLOOP1 ELSE - ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1) + IF(IMODEL==10) THEN + ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1) + ELSE + ILEV1 = IP_ERA(INLEVEL+ISTARTLEVEL-JLOOP1) + END IF END IF ! read component u CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1) @@ -1483,10 +1542,14 @@ DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1 END IF DEALLOCATE (ZVALUE) ! read component v and perform interpolation if not Arpege grid - IF (IMODEL/=10) THEN ! others than NCEP + IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5 ILEV1 = JLOOP1 ELSE - ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1) + IF(IMODEL==10) THEN + ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1) + ELSE + ILEV1 = IP_ERA(INLEVEL+ISTARTLEVEL-JLOOP1) + END IF END IF CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR+1,KLEV1=ILEV1) IF (INUM < 0) THEN @@ -1661,7 +1724,7 @@ TPTCUR%nmonth=INT((IDATE-TPTCUR%nyear*10000)/100) TPTCUR%nday=IDATE-TPTCUR%nyear*10000-TPTCUR%nmonth*100 CALL GRIB_GET(IGRIB(INUM),'startStep',ITIMESTEP,IRET_GRIB) CALL GRIB_GET(IGRIB(INUM),'stepUnits',CSTEPUNIT,IRET_GRIB) -IF (IMODEL==0) THEN +IF (IMODEL==0.OR.IMODEL==11) THEN ITWOZS=0 IF ((TPTCUR%nyear ==2000).AND.(TPTCUR%nmonth >11)) ITWOZS=1 IF ((TPTCUR%nyear ==2000).AND.(TPTCUR%nmonth ==11)) THEN @@ -2135,7 +2198,7 @@ ALLOCATE(INLO_GRIB(SIZE(KINLO))) INO= KNOLON*KNOLARG SELECT CASE (KMODEL) ! -CASE(0,5) ! CEP/MOCAGE +CASE(0,5,11) ! CEP/MOCAGE/ERA5 ! en theorie il faut ces 4 lignes ! CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZILA1) ! CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZILO1) diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90 index 623a7cd4e4730949dd07ecbccb571f737558bb0a..f1cb9ef1f6be28f28c87f8d7edf332c8a7f74e13 100644 --- a/src/MNH/read_exsegn.f90 +++ b/src/MNH/read_exsegn.f90 @@ -1608,6 +1608,20 @@ ELSE END IF END IF ! +IF (LUSERI.AND. (.NOT.OUSERI)) THEN + WRITE(UNIT=ILUOUT,FMT=9001) KMI + WRITE(UNIT=ILUOUT,FMT=*) 'THE ICE CLOUD FRACTION WILL BE INITIALIZED ACCORDING' + WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0' + CGETICEFR = 'INIT' +ELSE + IF ( LUSERI ) THEN + CGETICEFR = 'READ' + IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETICEFR='INIT' + ELSE + CGETICEFR = 'SKIP' + END IF +END IF +! IF(CTURBLEN=='RM17' .OR. CTURBLEN=='ADAP') THEN XCEDIS=0.34 ELSE @@ -2159,6 +2173,13 @@ IF ( CRAD /= 'NONE' .AND. CPROGRAM=='MESONH' ) THEN IF(CCONF=='START') THEN CGETRAD='INIT' END IF + IF(CCONF=='RESTA' .AND. (.NOT. LAERO_FT) .AND. (.NOT. LORILAM) & + .AND. (.NOT. LSALT) .AND. (.NOT. LDUST)) THEN + WRITE(UNIT=ILUOUT,FMT=9001) KMI + WRITE(UNIT=ILUOUT,FMT=*) '!!! WARNING !!! FOR REPRODUCTIBILITY BETWEEN START and START+RESTART,' + WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LAERO_FT=T WITH CAER=TEGE IF CCONF=RESTA IN ALL SEGMENTS' + WRITE(UNIT=ILUOUT,FMT=*) 'TO UPDATE THE OZONE AND AEROSOLS CLIMATOLOGY USED BY THE RADIATION CODE;' + END IF END IF ! ! 3.6 check the initialization of the deep convection scheme diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90 index f7ccb114e6c605c3aad6f3585688b88e4f2b6b8b..d83171513705eb2621407b89d55801859dcf9749 100644 --- a/src/MNH/read_field.f90 +++ b/src/MNH/read_field.f90 @@ -11,7 +11,7 @@ INTERFACE ! SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, & HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, & - HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, & + HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR,HGETICEFR, & HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, & HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, & KSIZELBXTKE_ll,KSIZELBYTKE_ll, & @@ -19,7 +19,7 @@ INTERFACE PUM,PVM,PWM,PDUM,PDVM,PDWM, & PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, & PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, & - PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, & + PSIGS,PSRCT,PCLDFR,PICEFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, & PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, PLSZWSM, & PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, & @@ -46,7 +46,7 @@ CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, & HGETRVT,HGETRCT,HGETRRT, & HGETRIT,HGETRST,HGETRGT,HGETRHT, & HGETCIT,HGETSRCT, HGETZWS, & - HGETSIGS,HGETCLDFR,HGETBL_DEPTH, & + HGETSIGS,HGETCLDFR,HGETICEFR,HGETBL_DEPTH, & HGETSBL_DEPTH,HGETPHC,HGETPHR CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT ! @@ -85,6 +85,7 @@ REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the ! Subgrid Condensation REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction +REAL, DIMENSION(:,:,:), INTENT(OUT) :: PICEFR ! cloud fraction REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHC ! pH value in cloud water REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwater ! Larger Scale fields @@ -135,7 +136,7 @@ END MODULE MODI_READ_FIELD ! ######################################################################## SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, & HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, & - HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, & + HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR,HGETICEFR, & HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, & HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, & KSIZELBXTKE_ll,KSIZELBYTKE_ll, & @@ -143,7 +144,7 @@ END MODULE MODI_READ_FIELD PUM,PVM,PWM,PDUM,PDVM,PDWM, & PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, & PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, & - PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, & + PSIGS,PSRCT,PCLDFR,PICEFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, & PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, & PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, & @@ -325,7 +326,7 @@ CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, & HGETRVT,HGETRCT,HGETRRT, & HGETRIT,HGETRST,HGETRGT,HGETRHT, & HGETCIT,HGETSRCT,HGETZWS, & - HGETSIGS,HGETCLDFR,HGETBL_DEPTH, & + HGETSIGS,HGETCLDFR,HGETICEFR,HGETBL_DEPTH, & HGETSBL_DEPTH,HGETPHC,HGETPHR CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT ! @@ -366,6 +367,7 @@ REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the ! Subgrid Condensation REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction +REAL, DIMENSION(:,:,:), INTENT(OUT) :: PICEFR ! cloud fraction REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHC ! pH value in cloud water REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwater ! @@ -1520,6 +1522,22 @@ IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN ENDIF ENDIF ! +IRESP=0 +IF(HGETICEFR=='READ') THEN ! cloud fraction + CALL IO_Field_read(TPINIFILE,'ICEFR',PICEFR,IRESP) +ENDIF +IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN + IF(SIZE(PRT,4) > 3) THEN + WHERE(PRT(:,:,:,4) > 1.E-30) + PICEFR(:,:,:) = 1. + ELSEWHERE + PICEFR(:,:,:) = 0. + ENDWHERE + ELSE + PICEFR(:,:,:) = 0. + ENDIF +ENDIF +! !* boundary layer depth ! IF (HGETBL_DEPTH=='READ') THEN diff --git a/src/MNH/recycling.f90 b/src/MNH/recycling.f90 index 9734eebc00e2f5bc16e8e923bfdc04cba2f120e7..18e0956cd05cb710e26718962a054e801d79636b 100644 --- a/src/MNH/recycling.f90 +++ b/src/MNH/recycling.f90 @@ -65,35 +65,17 @@ END MODULE MODI_RECYCLING !**** 0. DECLARATIONS ! --------------- ! -! module -USE MODE_POS -USE MODE_ll -USE MODE_IO -!USE MODI_SHUMAN -! -USE MODD_PARAMETERS -USE MODD_CONF -! -USE MODD_CST -! -USE MODD_DIM_n -USE MODD_CONF -USE MODD_CONF_n -USE MODD_GRID -USE MODD_GRID_n -USE MODD_METRICS_n -USE MODD_TIME -USE MODD_TIME_n -USE MODD_DYN_n -USE MODD_FIELD_n -USE MODD_CURVCOR_n -USE MODD_REF -! -USE MODD_VAR_ll, ONLY: IP, NPROC +USE MODD_CONF, ONLY: CCONF +USE MODD_FIELD_n, ONLY: XTHT, XUT, XVT, XWT +USE MODD_GRID_n, ONLY: XXHAT, XYHAT +USE MODD_METRICS_n, ONLY: XDZZ +USE MODD_PARAMETERS, ONLY: JPHEXT USE MODD_RECYCL_PARAM_n + +USE MODE_MSG + USE MODI_RECYCL_FLUC -USE MODD_LUNIT_n, ONLY : TLUOUT -! + IMPLICIT NONE ! !------------------------------------------------------------------------------ @@ -106,9 +88,6 @@ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTU !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables -INTEGER :: IIU,IJU,IKU,JCOUNT,ICOUNT,ILUOUT -INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE,IIP -INTEGER :: IIBG,IIEG,IJBG,IJEG,IIMAX,IJMAX INTEGER :: PMINW,PMINE,PMINN,PMINS INTEGER :: JIDIST,JJDIST REAL :: Z_DELTX,Z_DELTY @@ -116,24 +95,14 @@ REAL :: Z_DELTX,Z_DELTY !------------------------------------------------------------------------------ ! ! 0.3 allocation -CALL GET_DIM_EXT_ll('B',IIU,IJU) -IKU=NKMAX+2*JPVEXT PMINW=0 PMINN=0 PMINS=0 PMINE=0 -CALL GET_OR_ll('B',IIBG,IJBG) -IIBG = IIBG+IIB-1 -IJBG = IJBG+IJB-1 -CALL GET_GLOBALDIMS_ll( IIMAX,IJMAX) -IIEG=IIBG+IIE-IIB -IJEG=IJBG+IJE-IJB Z_DELTX = XXHAT(2)-XXHAT(1) Z_DELTY = XYHAT(2)-XYHAT(1) - -ILUOUT = TLUOUT%NLU !------------------------------------------------------------------------------ ! !**** 1. Recycling distance calculation diff --git a/src/MNH/relaxation.f90 b/src/MNH/relaxation.f90 index 7202c8ea13c44d2b708271e20e44fd158703750d..69e130288298efa89da7afaccb9fe70fd88fb11d 100644 --- a/src/MNH/relaxation.f90 +++ b/src/MNH/relaxation.f90 @@ -273,6 +273,7 @@ USE MODD_CONF, only: cconf USE MODD_ELEC_DESCR, ONLY: LRELAX2FW_ION USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND USE MODD_PARAMETERS, only: jphext, jpvext +USE MODD_PRECISION, ONLY: MNHREAL32 use mode_budget, only: Budget_store_init, Budget_store_end USE MODE_EXTRAPOL, only: Extrapol @@ -517,16 +518,16 @@ IF(OVE_RELAX) THEN ! DO JK = KALBOT, IKE+1 ! - PRUS(:,:,JK) = PRUS(:,:,JK) - ZKV(JK) *(PUT(:,:,JK) -PLSUM(:,:,JK) )& + PRUS(:,:,JK) = PRUS(:,:,JK) - ZKV(JK) *(PUT(:,:,JK) -real(PLSUM(:,:,JK),kind=MNHREAL32) )& * ZRHODJU(:,:,JK) ! - PRVS(:,:,JK) = PRVS(:,:,JK) - ZKV(JK) *(PVT(:,:,JK) -PLSVM(:,:,JK) )& + PRVS(:,:,JK) = PRVS(:,:,JK) - ZKV(JK) *(PVT(:,:,JK) -real(PLSVM(:,:,JK),kind=MNHREAL32) )& * ZRHODJV(:,:,JK) ! - PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVW(JK) *(PWT(:,:,JK) -PLSWM(:,:,JK) )& + PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVW(JK) *(PWT(:,:,JK) -real(PLSWM(:,:,JK),kind=MNHREAL32) )& * ZRHODJW(:,:,JK) ! - PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKV(JK) *(PTHT(:,:,JK) -PLSTHM(:,:,JK) )& + PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKV(JK) *(PTHT(:,:,JK) -real(PLSTHM(:,:,JK),kind=MNHREAL32) )& * PRHODJ(:,:,JK) ! END DO @@ -554,16 +555,16 @@ IF(OVE_RELAX_GRD) THEN ! DO JK = 1,KALBAS ! - PRUS(:,:,JK) = PRUS(:,:,JK) - ZKVBAS(JK) *(PUT(:,:,JK) -PLSUM(:,:,JK) )& + PRUS(:,:,JK) = PRUS(:,:,JK) - ZKVBAS(JK) *(PUT(:,:,JK) -real(PLSUM(:,:,JK),kind=MNHREAL32) )& * ZRHODJU(:,:,JK) ! - PRVS(:,:,JK) = PRVS(:,:,JK) - ZKVBAS(JK) *(PVT(:,:,JK) -PLSVM(:,:,JK) )& + PRVS(:,:,JK) = PRVS(:,:,JK) - ZKVBAS(JK) *(PVT(:,:,JK) -real(PLSVM(:,:,JK),kind=MNHREAL32) )& * ZRHODJV(:,:,JK) ! - PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVWBAS(JK) *(PWT(:,:,JK) -PLSWM(:,:,JK) )& + PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVWBAS(JK) *(PWT(:,:,JK) -real(PLSWM(:,:,JK),kind=MNHREAL32) )& * ZRHODJW(:,:,JK) ! - PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKVBAS(JK) *(PTHT(:,:,JK) -PLSTHM(:,:,JK) )& + PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKVBAS(JK) *(PTHT(:,:,JK) -real(PLSTHM(:,:,JK),kind=MNHREAL32) )& * PRHODJ(:,:,JK) ! END DO diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90 index dce56fa74237abeb9d1fe8d605136d84bac8c7c2..937990ac60b9f1ec2b644266849fbd9e917205d3 100644 --- a/src/MNH/resolved_cloud.f90 +++ b/src/MNH/resolved_cloud.f90 @@ -14,7 +14,7 @@ INTERFACE PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, & PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, & PTHM, PRCM, PPABSM, & - PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,& + PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR, PICEFR,& PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, & ORAIN, OWARM, OHHONI, OCONVHG, & PCF_MF,PRC_MF, PRI_MF, & @@ -83,6 +83,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux ! s'rc'/2Sigma_s2 at time t+1 ! multiplied by Lambda_3 REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number ! concentration at time t LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the @@ -152,7 +153,7 @@ END MODULE MODI_RESOLVED_CLOUD PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, & PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, & PTHM, PRCM, PPABSM, & - PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,& + PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,PICEFR,& PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, & ORAIN, OWARM, OHHONI, OCONVHG, & PCF_MF,PRC_MF, PRI_MF, & @@ -388,6 +389,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux ! s'rc'/2Sigma_s2 at time t+1 ! multiplied by Lambda_3 REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number ! concentration at time t LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the @@ -485,9 +487,6 @@ INTEGER :: JMOD, JMOD_IFN LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH ! BVIE work array waiting for PINPRI REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZICEFR -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZPRCFR -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZTM ! !------------------------------------------------------------------------------ ! @@ -1000,7 +999,7 @@ SELECT CASE ( HCLOUD ) PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, & PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, & - PEVAP3D, PCLDFR, ZICEFR, ZPRCFR ) + PEVAP3D, PCLDFR, PICEFR, PRAINFR ) ELSE IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, & @@ -1034,7 +1033,7 @@ SELECT CASE ( HCLOUD ) PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, & PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PCLDFR, PSRCS ) + PCLDFR, PICEFR, PRAINFR, PSRCS ) ELSE IF (LPTSPLIT) THEN CALL LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, CCONDENS, CLAMBDA3, & OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, & @@ -1042,14 +1041,14 @@ SELECT CASE ( HCLOUD ) PDTHRAD, PW_ACT, & PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF ) + PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF ) ELSE CALL LIMA_ADJUST(KRR, KMI, TPFILE, & OSUBG_COND, PTSTEP, & PRHODREF, PRHODJ, PEXNREF, PPABST, PPABST, & PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PTHS, PSRCS, PCLDFR ) + PTHS, PSRCS, PCLDFR, PICEFR, PRAINFR ) ENDIF ! END SELECT diff --git a/src/MNH/rrcolss.f90 b/src/MNH/rrcolss.f90 index 527165111ecf4d225ce5ec0117c09846d2116b9e..7be9a8af4b13f889e15c5592330ec49db74e0d6f 100644 --- a/src/MNH/rrcolss.f90 +++ b/src/MNH/rrcolss.f90 @@ -10,7 +10,7 @@ INTERFACE ! SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, & - PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLR, PEXFALLR, & + PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, & PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, & PDINFTY, PRRCOLSS, PAG, PBS, PAS ) ! @@ -28,6 +28,7 @@ REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates +REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008) REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates @@ -49,7 +50,7 @@ END INTERFACE END MODULE MODI_RRCOLSS ! ######################################################################## SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, & - PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLR, PEXFALLR, & + PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, & PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, & PDINFTY, PRRCOLSS, PAG, PBS, PAS ) ! ######################################################################## @@ -117,6 +118,7 @@ END INTERFACE !! Original 8/11/95 !! ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -151,6 +153,7 @@ REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates +REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008) REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates @@ -277,11 +280,11 @@ DO JLBDAS = 1,SIZE(PRRCOLSS(:,:),1) DO JDR = 1,INR-1 ZDR = ZDDCOLLR * REAL(JDR) ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 * ZDR**PEXMASSR & - * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDR**PEXFALLR) & + * PESR * ABS(PFALLS*ZDS**PEXFALLS * EXP(-(PFALLEXPS*XDS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) & * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) END DO ZCOLLDRMAX = (ZDS+ZDRMAX)**2 * ZDRMAX**PEXMASSR & - * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDRMAX**PEXFALLR) & + * PESR * ABS(PFALLS*ZDS**PEXFALLS* EXP(-(PFALLEXPS*XDS)**PALPHAS)-PFALLR*ZDRMAX**PEXFALLR) & * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX) ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR) ! diff --git a/src/MNH/rscolrg.f90 b/src/MNH/rscolrg.f90 index caa868e91d39cbe12010bfa2c265ffe35304dba4..210df03805b8189e969d1712d411b6f7540e07d8 100644 --- a/src/MNH/rscolrg.f90 +++ b/src/MNH/rscolrg.f90 @@ -10,7 +10,7 @@ INTERFACE ! SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, & - PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLR, PEXFALLR, & + PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, & PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, & PDINFTY, PRSCOLRG,PAG, PBS, PAS ) ! @@ -28,6 +28,7 @@ REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates +REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates @@ -49,7 +50,7 @@ END INTERFACE END MODULE MODI_RSCOLRG ! ######################################################################## SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, & - PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLR, PEXFALLR, & + PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, & PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, & PDINFTY, PRSCOLRG,PAG, PBS, PAS ) ! ######################################################################## @@ -117,6 +118,7 @@ END INTERFACE !! Original 8/11/95 !! ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -149,6 +151,7 @@ REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates +REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates @@ -271,12 +274,12 @@ DO JLBDAR = 1,SIZE(PRSCOLRG(:,:),1) ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 & * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) & - * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDR**PEXFALLR) + * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) END DO IF( ZDRMIN>0.0 ) THEN ZCOLLDRMIN = (ZDS+ZDRMIN)**2 & * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) & - * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDRMIN**PEXFALLR) + * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDRMIN**PEXFALLR) ELSE ZCOLLDRMIN = 0.0 END IF diff --git a/src/MNH/rzcolx.f90 b/src/MNH/rzcolx.f90 index 28658241cf1021a29de694cd5a99b85e9c3340d9..de0fc723a1598394e512fafa67b808ff469ad670 100644 --- a/src/MNH/rzcolx.f90 +++ b/src/MNH/rzcolx.f90 @@ -10,7 +10,8 @@ INTERFACE ! SUBROUTINE RZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, & - PEXZ, PEXMASSZ, PFALLX, PEXFALLX, PFALLZ, PEXFALLZ, & + PEXZ, PEXMASSZ, PFALLX, PEXFALLX, PFALLEXPX, & + PFALLZ, PEXFALLZ, PFALLEXPZ, & PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, & PDINFTY, PRZCOLX ) ! @@ -29,8 +30,10 @@ REAL, INTENT(IN) :: PEXZ ! Efficiency of specy X collecting specy Z REAL, INTENT(IN) :: PEXMASSZ ! Mass exponent of specy Z REAL, INTENT(IN) :: PFALLX ! Fall speed constant of specy X REAL, INTENT(IN) :: PEXFALLX ! Fall speed exponent of specy X +REAL, INTENT(IN) :: PFALLEXPX ! Fall speed exponential constant of specy X REAL, INTENT(IN) :: PFALLZ ! Fall speed constant of specy Z REAL, INTENT(IN) :: PEXFALLZ ! Fall speed exponent of specy Z +REAL, INTENT(IN) :: PFALLEXPZ ! Fall speed exponential constant of specy Z REAL, INTENT(IN) :: PLBDAXMAX ! Maximun slope of size distribution of specy X REAL, INTENT(IN) :: PLBDAZMAX ! Maximun slope of size distribution of specy Z REAL, INTENT(IN) :: PLBDAXMIN ! Minimun slope of size distribution of specy X @@ -49,7 +52,8 @@ END INTERFACE END MODULE MODI_RZCOLX ! ######################################################################## SUBROUTINE RZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, & - PEXZ, PEXMASSZ, PFALLX, PEXFALLX, PFALLZ, PEXFALLZ, & + PEXZ, PEXMASSZ, PFALLX, PEXFALLX, PFALLEXPX, & + PFALLZ, PEXFALLZ, PFALLEXPZ, & PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, & PDINFTY, PRZCOLX ) ! ######################################################################## @@ -121,6 +125,7 @@ END INTERFACE !! Original 8/11/95 !! ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! J. Wurtz 03/2022: new snow characteristics ! !------------------------------------------------------------------------------- ! @@ -152,8 +157,10 @@ REAL, INTENT(IN) :: PEXZ ! Efficiency of specy X collecting specy Z REAL, INTENT(IN) :: PEXMASSZ ! Mass exponent of specy Z REAL, INTENT(IN) :: PFALLX ! Fall speed constant of specy X REAL, INTENT(IN) :: PEXFALLX ! Fall speed exponent of specy X +REAL, INTENT(IN) :: PFALLEXPX ! Fall speed exponential constant of specy X REAL, INTENT(IN) :: PFALLZ ! Fall speed constant of specy Z REAL, INTENT(IN) :: PEXFALLZ ! Fall speed exponent of specy Z +REAL, INTENT(IN) :: PFALLEXPZ ! Fall speed exponential constant of specy Z REAL, INTENT(IN) :: PLBDAXMAX ! Maximun slope of size distribution of specy X REAL, INTENT(IN) :: PLBDAZMAX ! Maximun slope of size distribution of specy Z REAL, INTENT(IN) :: PLBDAXMIN ! Minimun slope of size distribution of specy X @@ -234,20 +241,20 @@ DO JLBDAX = 1,SIZE(PRZCOLX(:,:),1) ZSCALZ = 0.0 ZCOLLZ = 0.0 DO JDZ = 1,KND-1 - ZDZ = ZDDZ * REAL(JDZ) + ZDZ = ZDDZ * REAL(JDZ) ! !* 1.6 Compute the normalization factor by integration over the ! dimensional spectrum of specy Z ! - ZFUNC = (ZDX+ZDZ)**2 * ZDZ**PEXMASSZ & - * GENERAL_GAMMA(PALPHAZ,PNUZ,ZLBDAZ,ZDZ) - ZSCALZ = ZSCALZ + ZFUNC + ZFUNC = (ZDX+ZDZ)**2 * ZDZ**PEXMASSZ & + * GENERAL_GAMMA(PALPHAZ,PNUZ,ZLBDAZ,ZDZ) + ZSCALZ = ZSCALZ + ZFUNC ! !* 1.7 Compute the scaled fall speed difference by integration over ! the dimensional spectrum of specy Z ! - ZCOLLZ = ZCOLLZ + ZFUNC & - * PEXZ * ABS(PFALLX*ZDX**PEXFALLX-PFALLZ*ZDZ**PEXFALLZ) + ZCOLLZ = ZCOLLZ + ZFUNC * PEXZ * ABS( PFALLX*ZDX**PEXFALLX * EXP(-(ZDX*PFALLEXPX)**PALPHAX) & + - PFALLZ*ZDZ**PEXFALLZ * EXP(-(ZDZ*PFALLEXPZ)**PALPHAZ)) END DO ! !* 1.8 Compute the normalization factor by integration over the diff --git a/src/MNH/subl_blowsnow.f90 b/src/MNH/subl_blowsnow.f90 index ad0cf278fa86b1eeedaf7c0a2da1344d8d86024a..96c6b9be4432ef3ee07b4f7d79368c232ca113d7 100644 --- a/src/MNH/subl_blowsnow.f90 +++ b/src/MNH/subl_blowsnow.f90 @@ -696,6 +696,7 @@ ZFCRI = MAX(ZFCRI1,ZFCRI2) !* 2 Calculate variances of the horizontal and vertical velocity components ! ZS0 = ZFCRI*PZZ/PVMOD +STOP 'Bug in TURB_FLUC: ZUSTAR used but not set' ZSIGU = 4.77 *ZUSTAR**2/ (1+33*ZS0)**0.66666 ZSIGV = 2.76 *ZUSTAR**2/ (1+9.5*ZS0)**0.66666 ZSIGW = 1.31 *ZUSTAR**2/ (1+3.12*ZS0)**0.66666 diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90 index 228241e2ce6e40965f1766ef2b8396210a08c4c9..fa09f1e10771a1f1875aff1aa465065054b0c96c 100644 --- a/src/MNH/turb.f90 +++ b/src/MNH/turb.f90 @@ -618,7 +618,7 @@ ZRVORD= XRV / XRD ! ! !Copy data into ZTHLM and ZRM only if needed -IF (HTURBLEN=='BL89' .OR. HTURBLEN=='RM17' .OR. ORMC01) THEN +IF (HTURBLEN=='BL89' .OR. HTURBLEN=='RM17' .OR. HTURBLEN=='ADAP' .OR. ORMC01) THEN ZTHLM(:,:,:) = PTHLT(:,:,:) ZRM(:,:,:,:) = PRT(:,:,:,:) END IF diff --git a/src/MNH/version.f90 b/src/MNH/version.f90 index 8a7e340814d6a5fc2b25c3bc61afc8b5f477c999..5c98f1946a20fa439b85ac1ef532e771ecb90a4a 100644 --- a/src/MNH/version.f90 +++ b/src/MNH/version.f90 @@ -1,4 +1,4 @@ -!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 2002-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 for details. version 1. @@ -44,9 +44,9 @@ IMPLICIT NONE ! NMNHVERSION(1)=5 NMNHVERSION(2)=5 -NMNHVERSION(3)=0 +NMNHVERSION(3)=1 NMASDEV=55 -NBUGFIX=0 +NBUGFIX=1 CBIBUSER='' ! END SUBROUTINE VERSION diff --git a/src/MNH/write_desfmn.f90 b/src/MNH/write_desfmn.f90 index fb24c9bae47e3b7140e3a266768cffe9a5216841..8be686e6450155250e7d03c8712d67f659048a94 100644 --- a/src/MNH/write_desfmn.f90 +++ b/src/MNH/write_desfmn.f90 @@ -434,7 +434,6 @@ IF(LBU_RRH) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRH) IF(LBU_RSV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RSV) IF(LLES_MEAN .OR. LLES_RESOLVED .OR. LLES_SUBGRID .OR. LLES_UPDRAFT & .OR. LLES_DOWNDRAFT .OR. LLES_SPECTRA) WRITE(UNIT=ILUSEG,NML=NAM_LES) -WRITE(UNIT=ILUSEG,NML=NAM_BLANKn) IF(LFORCING .OR. LTRANS) WRITE(UNIT=ILUSEG,NML=NAM_FRC) IF(CCLOUD(1:3) == 'ICE') WRITE(UNIT=ILUSEG,NML=NAM_PARAM_ICE) IF(CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') & diff --git a/src/MNH/write_diachro.f90 b/src/MNH/write_diachro.f90 index 8ad7c453850bb1409087333d0c8ed12fcb1bfd0b..8175eb1d84072a822001f956ec6483e7b8551023 100644 --- a/src/MNH/write_diachro.f90 +++ b/src/MNH/write_diachro.f90 @@ -89,6 +89,7 @@ subroutine Write_diachro( tpdiafile, tpbudiachro, tpfields, & ! P. Wautelet 03/03/2021: add tbudiachrometadata type (useful to pass more information to Write_diachro) ! P. Wautelet 11/03/2021: remove ptrajx/y/z optional dummy arguments of Write_diachro ! + get the trajectory data for LFI files differently +! P. Wautelet 01/09/2021: allow NMNHDIM_LEVEL and NMNHDIM_LEVEL_W simultaneously !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -1035,7 +1036,10 @@ do jp = 2, Size( tpfields ) if ( tpfields(jp)%ndimlist(ji) /= tpfields(1)%ndimlist(ji) ) then !For SERIES: it is possible to have NMNHDIM_NI and NMNHDIM_NI_U in the different tpfields !For SERIES: it is possible to have NMNHDIM_SERIES_LEVEL and NMNHDIM_SERIES_LEVEL_W in the different tpfields - if ( tpfields(jp)%ndimlist(ji) /= NMNHDIM_NI .and. tpfields(jp)%ndimlist(ji) /= NMNHDIM_NI_U .and. & + !For profiles: it is possible to have NMNHDIM_LEVEL and NMNHDIM_LEVEL_W in the different tpfields + !This check is not perfect but should catch most problems + if ( tpfields(jp)%ndimlist(ji) /= NMNHDIM_NI .and. tpfields(jp)%ndimlist(ji) /= NMNHDIM_NI_U .and. & + tpfields(jp)%ndimlist(ji) /= NMNHDIM_LEVEL .and. tpfields(jp)%ndimlist(ji) /= NMNHDIM_LEVEL_W .and. & tpfields(jp)%ndimlist(ji) /= NMNHDIM_SERIES_LEVEL .and. tpfields(jp)%ndimlist(ji) /= NMNHDIM_SERIES_LEVEL_W ) then call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', & 'some dimensions are not the same for all tpfields entries for variable '//trim(tpfields(jp)%cmnhname) ) diff --git a/src/MNH/write_lesn.f90 b/src/MNH/write_lesn.f90 index e4adb2045bd0fc24bbcf5f685c34fd7051a53ba7..d1fedaada44a7c8cbbd0ce15dcc9358a6c038d15 100644 --- a/src/MNH/write_lesn.f90 +++ b/src/MNH/write_lesn.f90 @@ -87,6 +87,7 @@ use modd_grid_n, only: xdxhat, xdyhat use modd_nsv, only: nsv use modd_les use modd_les_n +use modd_param_n, only: ccloud use modd_param_c2r2, only: ldepoc use modd_param_ice, only: ldeposc use modd_parameters, only: XUNDEF @@ -126,6 +127,7 @@ INTEGER :: IMI ! Current model inde ! IF (.NOT. LLES) RETURN ! +! !* 1. Initializations ! --------------- ! @@ -355,6 +357,8 @@ if ( luserr ) & call Les_diachro_write( tpdiafile, XLES_MEAN_RF, 'MEAN_RF', 'Mean RF Profile', '1', ymasks ) if ( luseri ) & call Les_diachro_write( tpdiafile, XLES_MEAN_Ri, 'MEAN_RI', 'Mean Ri Profile', 'kg kg-1', ymasks ) +if ( luseri ) & +call Les_diachro_write( tpdiafile, XLES_MEAN_If, 'MEAN_IF', 'Mean If Profile', '1', ymasks ) if ( lusers ) & call Les_diachro_write( tpdiafile, XLES_MEAN_Rs, 'MEAN_RS', 'Mean Rs Profile', 'kg kg-1', ymasks ) if ( luserg ) & diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90 index 54c450494c019c6a7126122d6299d7151e0c7f50..d5245ba54d095d621d195ba13b24627dbd94927b 100644 --- a/src/MNH/write_lfifm1_for_diag.f90 +++ b/src/MNH/write_lfifm1_for_diag.f90 @@ -2689,9 +2689,10 @@ IF ( LMEAN_POVO ) THEN IWORK1(:,:)=0 ZWORK21(:,:)=0. IF (XMEAN_POVO(1)>XMEAN_POVO(2)) THEN - XMEAN_POVO(1) = ZX0D - XMEAN_POVO(2) = XMEAN_POVO(1) - ZX0D = XMEAN_POVO(2) + !Invert values (smallest must be first) + ZX0D = XMEAN_POVO(1) + XMEAN_POVO(1) = XMEAN_POVO(2) + XMEAN_POVO(2) = ZX0D END IF DO JK=IKB,IKE WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2))) @@ -3925,20 +3926,20 @@ IF (LLIDAR) THEN ZTMP3(:,:,:,1)=ZSIG_DST(:,:,:,IACCMODE) SELECT CASE ( CCLOUD ) CASE('KESS''ICE3','ICE4') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & + CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, & XRT, ZWORK31, ZWORK32, & PDSTC=ZTMP1, & PDSTD=ZTMP2, & PDSTS=ZTMP3) CASE('C2R2') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & + CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, & XRT, ZWORK31, ZWORK32, & PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C2R2END), & PDSTC=ZTMP1, & PDSTD=ZTMP2, & PDSTS=ZTMP3) CASE('C3R5') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & + CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, & XRT, ZWORK31, ZWORK32, & PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C1R3END-1), & PDSTC=ZTMP1, & @@ -3952,7 +3953,7 @@ IF (LLIDAR) THEN ZTMP4(:,:,:,3)=XSVT(:,:,:,NSV_LIMA_NR) ZTMP4(:,:,:,4)=XSVT(:,:,:,NSV_LIMA_NI) ! - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR,& + CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, MAX(XCLDFR,XICEFR),& XRT, ZWORK31, ZWORK32, & PCT=ZTMP4, & PDSTC=ZTMP1, & @@ -3963,14 +3964,14 @@ IF (LLIDAR) THEN ELSE SELECT CASE ( CCLOUD ) CASE('KESS','ICE3','ICE4') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & + CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, & XRT, ZWORK31, ZWORK32) CASE('C2R2') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & + CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, & XRT, ZWORK31, ZWORK32, & PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C2R2END)) CASE('C3R5') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & + CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, & XRT, ZWORK31, ZWORK32, & PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C1R3END-1)) CASE('LIMA') @@ -3981,7 +3982,7 @@ IF (LLIDAR) THEN ZTMP4(:,:,:,3)=XSVT(:,:,:,NSV_LIMA_NR) ZTMP4(:,:,:,4)=XSVT(:,:,:,NSV_LIMA_NI) ! - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR,& + CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, MAX(XCLDFR,XICEFR),& XRT, ZWORK31, ZWORK32, & PCT=ZTMP4) END SELECT diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90 index 1bb11e435afd44755eff957d81908fa904554cb6..0175e2c28a7b797264a2578763d00077218aadcd 100644 --- a/src/MNH/write_lfifm1_for_diag_supp.f90 +++ b/src/MNH/write_lfifm1_for_diag_supp.f90 @@ -519,6 +519,7 @@ IF (LCLD_COV .AND. LUSERC) THEN CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22) ! CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR) + CALL IO_Field_write(TPFILE,'ICEFR',XICEFR) ! ! Visibility ! @@ -808,7 +809,7 @@ IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. NRR /=0) THEN CALL RADTR_SATEL( TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, & NDLON, NFLEV, NSTATM, NRAD_COLNBR, XEMIS(:,:,1), & XCCO2, XTSRAD, XSTATM, XTHT, XRT, XPABST, XZZ, & - XSIGS, XMFCONV, XCLDFR, LUSERI, LSIGMAS, & + XSIGS, XMFCONV, MAX(XCLDFR,XICEFR), LUSERI, LSIGMAS, & LSUBG_COND, LRAD_SUBG_COND, ZIRBT, ZWVBT, & INDGEO(JI), VSIGQSAT ) ! @@ -848,15 +849,15 @@ IF (NRTTOVINFO(1,1) /= NUNDEF) THEN ! PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURE COMPUTED BY THE RTTOV CODE' #ifdef MNH_RTTOV_8 CALL CALL_RTTOV8(NDLON, NFLEV, NSTATM, XEMIS(:,:,1), XTSRAD, XSTATM, XTHT, XRT, & - XPABST, XZZ, XMFCONV, XCLDFR, XUT(:,:,IKB), XVT(:,:,IKB), & + XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), & LUSERI, NRTTOVINFO, TPFILE ) #elif MNH_RTTOV_11 CALL CALL_RTTOV11(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, & - XPABST, XZZ, XMFCONV, XCLDFR, XUT(:,:,IKB), XVT(:,:,IKB), & + XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), & LUSERI, NRTTOVINFO, TPFILE ) #elif MNH_RTTOV_13 CALL CALL_RTTOV13(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, & - XPABST, XZZ, XMFCONV, XCLDFR, XUT(:,:,IKB), XVT(:,:,IKB), & + XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), & LUSERI, NRTTOVINFO, TPFILE ) #else PRINT *, "RTTOV LIBRARY NOT AVAILABLE = ###CALL_RTTOV####" diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90 index 36d37ac65c7f3761ea5f179991fc9da8c0573df8..b7264511f1367d679341ab8df25eed39b70cd275 100644 --- a/src/MNH/write_lfin.f90 +++ b/src/MNH/write_lfin.f90 @@ -1568,6 +1568,11 @@ CALL WRITE_LB_n(TPFILE) ! ! CALL IO_Field_write(TPFILE,'DRYMASST',XDRYMASST) +IF (CPROGRAM == 'MESONH') THEN + CALL IO_Field_write(TPFILE,'DRYMASSS',XDRYMASSS) +ELSE + CALL IO_Field_write(TPFILE,'DRYMASSS',0.) +END IF ! IF( CTURB /= 'NONE' .AND. CTOM=='TM06') THEN CALL IO_Field_write(TPFILE,'BL_DEPTH',XBL_DEPTH) @@ -1684,6 +1689,7 @@ ENDIF ! IF (NRR > 1 .AND. CPROGRAM == 'MESONH') THEN CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR) + CALL IO_Field_write(TPFILE,'ICEFR',XICEFR) CALL IO_Field_write(TPFILE,'RAINFR',XRAINFR) END IF ! diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90 index 486978e1c2accda7b8125d056c48166d2a5f201c..fcef2068ce48ba4d93b79de00fde64d8ae6edad4 100644 --- a/src/MNH/write_profilern.f90 +++ b/src/MNH/write_profilern.f90 @@ -17,6 +17,8 @@ ! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL ! P. Wautelet 05/07/2021: reorganisation to store point values correctly (not in vertical profiles) ! M. Taufour 07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE +! P. Wautelet 01/09/2021: fix: correct vertical dimension for ALT and W +! P. Wautelet 19/11/2021: bugfix in units for LIMA variables !----------------------------------------------------------------- ! ########################### MODULE MODE_WRITE_PROFILER_n @@ -85,7 +87,7 @@ USE MODD_CH_AEROSOL, ONLY: CAERONAMES, LORILAM, JPMODE USE MODD_CH_M9_n, ONLY: CNAMES USE MODD_CST, ONLY: XRV USE MODD_ELEC_DESCR, ONLY: CELECNAMES -use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_PROFILER_TIME, NMNHDIM_PROFILER_PROC, NMNHDIM_UNUSED, & +use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, NMNHDIM_PROFILER_TIME, NMNHDIM_PROFILER_PROC, NMNHDIM_UNUSED, & tfield_metadata_base, TYPEREAL USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES USE MODD_IO, ONLY: TFILEDATA @@ -114,10 +116,12 @@ INTEGER, INTENT(IN) :: KI character(len=2) :: yidx character(len=100) :: ycomment character(len=100) :: yname +character(len=40) :: yunits CHARACTER(LEN=:), allocatable :: YGROUP ! group title INTEGER :: IKU INTEGER :: IPROC ! number of variables records INTEGER :: JPROC +integer :: jproc_alt, jproc_w INTEGER :: JRR ! loop counter INTEGER :: JSV ! loop counter integer :: ji @@ -161,11 +165,15 @@ call Add_profile( 'RARE', 'Radar reflectivity', 'dBZ', tprofil call Add_profile( 'RAREatt', 'Radar attenuated reflectivity', 'dBZ', tprofiler%crare_att ) call Add_profile( 'P', 'Pressure', 'Pa', tprofiler%p ) call Add_profile( 'ALT', 'Altitude', 'm', tprofiler%zz ) +!Store position of ALT in the field list. Useful because it is not computed on the same Arakawa-grid points +jproc_alt = jproc call Add_profile( 'ZON_WIND', 'Zonal wind', 'm s-1', tprofiler%zon ) call Add_profile( 'MER_WIND', 'Meridional wind', 'm s-1', tprofiler%mer ) call Add_profile( 'FF', 'Wind intensity', 'm s-1', tprofiler%ff ) call Add_profile( 'DD', 'Wind direction', 'degree', tprofiler%dd ) call Add_profile( 'W', 'Air vertical speed', 'm s-1', tprofiler%w ) +!Store position of W in the field list. Useful because it is not computed on the same Arakawa-grid points +jproc_w = jproc if ( ldiag_in_run ) & call Add_profile( 'TKE_DISS', 'TKE dissipation rate', 'm2 s-2', tprofiler% tke_diss ) @@ -207,6 +215,7 @@ if ( Size( tprofiler%sv, 4 ) > 0 ) then end do ! LIMA variables do jsv = nsv_lima_beg, nsv_lima_end + yunits = 'kg-1' if ( jsv == nsv_lima_nc ) then yname = Trim( clima_warm_names(1) ) // 'T' else if ( jsv == nsv_lima_nr ) then @@ -219,6 +228,7 @@ if ( Size( tprofiler%sv, 4 ) > 0 ) then yname = Trim( clima_warm_names(4) ) // yidx // 'T' else if ( jsv == nsv_lima_scavmass ) then yname = Trim( caero_mass(1) ) // 'T' + yunits = 'kg kg-1' else if ( jsv == nsv_lima_ni ) then yname = Trim( clima_cold_names(1) ) // 'T' else if ( jsv >= nsv_lima_ifn_free .and. jsv < nsv_lima_ifn_free + nmod_ifn ) then @@ -235,7 +245,7 @@ if ( Size( tprofiler%sv, 4 ) > 0 ) then else if ( jsv == nsv_lima_spro ) then yname = Trim( clima_warm_names(5) ) // 'T' end if - call Add_profile( yname, '', 'kg-1', tprofiler%sv(:,:,:,jsv) ) + call Add_profile( yname, '', yunits, tprofiler%sv(:,:,:,jsv) ) end do ! electrical scalar variables do jsv = nsv_elecbeg, nsv_elecend @@ -389,6 +399,8 @@ tzfields(:)%ndims = 3 tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED tzfields(:)%ndimlist(3) = NMNHDIM_LEVEL +tzfields(jproc_alt)%ndimlist(3) = NMNHDIM_LEVEL_W +tzfields(jproc_w)%ndimlist(3) = NMNHDIM_LEVEL_W tzfields(:)%ndimlist(4) = NMNHDIM_PROFILER_TIME tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED tzfields(:)%ndimlist(6) = NMNHDIM_PROFILER_PROC diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk index 74bd7d3a779b1a022f5ac4b58ef2482ba785f2da..7e99233a2fc6af6ae1e525a5da2cf25a390f4e88 100644 --- a/src/Makefile.MESONH.mk +++ b/src/Makefile.MESONH.mk @@ -337,7 +337,7 @@ INC_MPI = -I$(B)$(DIR_MPI) DIR_MASTER += $(DIR_MPI) OBJS_LISTE_MASTER += mpivide.o INC += $(INC_MPI) -mpivide.o : CPPFLAGS += -DFUJI -DMNH_INT=$(MNH_INT) -DMNH_REAL=$(MNH_REAL) \ +mpivide.o : CPPFLAGS += -DMNH_INT=$(MNH_INT) -DMNH_REAL=$(MNH_REAL) \ -I$(DIR_MPI)/include VPATH += $(DIR_MPI) endif diff --git a/src/SURFEX/init_megann.F90 b/src/SURFEX/init_megann.F90 index 6996a37b15eafb0f1c8f38424525ed3d90632a87..bc40cc3effedf9ce126f4f528be39d67a1e3cb3b 100644 --- a/src/SURFEX/init_megann.F90 +++ b/src/SURFEX/init_megann.F90 @@ -26,6 +26,7 @@ SUBROUTINE INIT_MEGAN_n(IO, S, K, NP, MSF, MGN, PLAT, HSV, PMEGAN_FIELDS) !! Original: 25/10/14 !! Modified: 06/2017, J. Pianezze, adaptation for SurfEx v8.0 !! Modified: 06/2018, P. Tulet, add PFT and LAI +!! Modified: 11/2021, P. Tulet, update PFT with Ecoclimap-SG !! !! !! EXTERNAL diff --git a/src/SURFEX/modn_isban.F90 b/src/SURFEX/modn_isban.F90 index 2ea5770de36f09326b5d2219eb5302efe3a8cf43..8ea9b57710e4a013a2375ad9e0975d24e016b5a1 100644 --- a/src/SURFEX/modn_isban.F90 +++ b/src/SURFEX/modn_isban.F90 @@ -108,7 +108,7 @@ LOGICAL :: LSNOWDRIFT_SUBLIM LOGICAL :: LSNOW_ABS_ZENITH CHARACTER(3) :: CSNOWMETAMO CHARACTER(3) :: CSNOWRAD - CHARACTER(LEN=6) :: CCH_DRY_DEP, CPARAMBVOC + CHARACTER(LEN=6) :: CCH_DRY_DEP, CPARAMBVOC='' CHARACTER(LEN=28) :: CCHEM_SURF_FILE ! NAMELIST/NAM_ISBAn/CC1DRY,CSCOND,CSOILFRZ,CDIFSFCOND,CSNOWRES,CCPSURF, & diff --git a/src/configure b/src/configure index c0845c0d5f5e52acd0d7cca1d31c9316e03c1c79..bf9ce3128cccb7730631c1ec4bb936abd15aeaf5 100755 --- a/src/configure +++ b/src/configure @@ -19,7 +19,7 @@ export VERSION_CDFCXX=${VERSION_CDFCXX:-"4.3.1"} export VERSION_CDFF=${VERSION_CDFF:-"4.5.3"} export VERSION_GRIBAPI=${VERSION_GRIBAPI:-"1.26.0-Source"} export VERSION_ECCODES=${VERSION_ECCODES:-"2.18.0"} -export ECCODES_DEFINITION_PATH=${ECCODES_DEFINITION_PATH:${SRC_MESONH}/src/LIB/eccodes-${VERSION_ECCODES}"/definitions/"} +export ECCODES_DEFINITION_PATH=${ECCODES_DEFINITION_PATH:-${SRC_MESONH}/src/LIB/eccodes-${VERSION_ECCODES}"/definitions/"} export MNH_INT=${MNH_INT:-"4"} export LFI_INT=${LFI_INT:-8} export MNH_REAL=${MNH_REAL:-"8"} @@ -347,7 +347,7 @@ export CC=gcc export OPTLEVEL=${OPTLEVEL:-DEBUG} export MVWORK=${MVWORK:-NO} export VER_CDF=${VER_CDF:-CDFCTI} - export NEED_NCARG=${NEED_NCARG:-NO} + export NEED_NCARG=${NEED_NCARG:-YES} export NEED_TOOLS=NO ;; 'Linux nuwa'*)