Changeset 5224 for LMDZ6/branches/Amaury_dev
- Timestamp:
- Sep 24, 2024, 10:47:17 AM (2 months ago)
- Location:
- LMDZ6/branches/Amaury_dev
- Files:
-
- 2 deleted
- 24 edited
- 2 copied
-
DefLists/field_def_lmdz.xml (modified) (3 diffs)
-
libf/dyn3d/lmdz_check_isotopes.f90 (modified) (1 diff)
-
libf/dyn3d/lmdz_dynetat0.f90 (modified) (1 diff)
-
libf/dyn3d_common/iso_verif_dyn.f90 (modified) (1 diff)
-
libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90 (modified) (4 diffs)
-
libf/phylmd/conf_phys_m.F90 (modified) (5 diffs)
-
libf/phylmd/create_etat0_unstruct_mod.F90 (modified) (2 diffs)
-
libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90 (modified) (2 diffs)
-
libf/phylmd/dyn1d/lmdz_scm.F90 (modified) (2 diffs)
-
libf/phylmd/ice_sursat_mod.F90 (deleted)
-
libf/phylmd/lmdz_clesphys.f90 (modified) (4 diffs)
-
libf/phylmd/lmdz_lscp.F90 (modified) (24 diffs)
-
libf/phylmd/lmdz_lscp_condensation.f90 (copied) (copied from LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_condensation.F90) (23 diffs, 1 prop)
-
libf/phylmd/lmdz_lscp_ini.F90 (modified) (13 diffs)
-
libf/phylmd/lmdz_lscp_poprecip.F90 (modified) (1 diff)
-
libf/phylmd/lmdz_lscp_tools.F90 (modified) (6 diffs)
-
libf/phylmd/phyetat0_mod.F90 (modified) (6 diffs)
-
libf/phylmd/phyredem.F90 (modified) (3 diffs)
-
libf/phylmd/phys_local_var_mod.F90 (modified) (11 diffs)
-
libf/phylmd/phys_output_ctrlout_mod.F90 (modified) (3 diffs)
-
libf/phylmd/phys_output_write_mod.F90 (modified) (9 diffs)
-
libf/phylmd/phys_state_var_mod.F90 (modified) (5 diffs)
-
libf/phylmd/physiq_mod.F90 (modified) (20 diffs)
-
libf/phylmdiso/ice_sursat_mod.F90 (deleted)
-
libf/phylmdiso/lmdz_lscp_condensation.f90 (copied) (copied from LMDZ6/branches/cirrus/libf/phylmdiso/lmdz_lscp_condensation.F90) (1 diff, 1 prop)
-
libf/phylmdiso/phyetat0_mod.F90 (modified) (6 diffs)
-
libf/phylmdiso/phyredem.F90 (modified) (2 diffs)
-
libf/phylmdiso/physiq_mod.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/DefLists/field_def_lmdz.xml
r5219 r5224 1 <!-- $Id$ -->2 1 <field_definition level="1" prec="4" operation="average" freq_op="1ts" enabled=".true." default_value="9.96921e+36"> 3 2 … … 156 155 <field id="LWupSFC" long_name="Upwd. IR rad. at surface" unit="W/m2" /> 157 156 <field id="LWupSFCclr" long_name="CS Upwd. IR rad. at surface" unit="W/m2" /> 157 <field id="LWupTOA" long_name="LWup at TOA" unit="W/m2" /> 158 <field id="LWupTOAclr" long_name="LWup clear sky at TOA" unit="W/m2" /> 158 159 <field id="LWupTOAcleanclr" long_name="CS clean (no aerosol) Upwd. IR rad. at TOA" unit="W/m2" /> 159 160 <field id="LWdnSFC" long_name="Down. IR rad. at surface" unit="W/m2" /> … … 879 880 <field id="dqch4" long_name="H2O due to CH4 oxidation and photolysis" unit="(kg/kg)/s" /> 880 881 <field id="pvap" long_name="pvap intermediary variable" unit="-">pres*ovap*461.5 / (287.04*(1.+ (10.9491/18.0153)*ovap)) </field> 881 <field id="oclr" long_name="Clear sky total water" unit="kg/kg" /> 882 <field id="ocld" long_name="Cloudy sky total water" unit="kg/kg" /> 883 <field id="oss" long_name="ISSR total water" unit="kg/kg" /> 884 <field id="ovc" long_name="In-cloud vapor" unit="kg/kg" /> 885 <field id="rnebclr" long_name="Clear sky fraction" unit="-" /> 886 <field id="rnebss" long_name="ISSR fraction" unit="-" /> 887 <field id="rnebseri" long_name="Cloud fraction" unit="-" /> 888 <field id="gammass" long_name="Supersaturation ratio" unit="-" /> 889 <field id="N1ss" long_name="N1ss" unit="-" /> 890 <field id="N2ss" long_name="N2ss" unit="-" /> 891 <field id="drnebsub" long_name="Cloud fraction change because of sublimation" unit="s-1" /> 892 <field id="drnebcon" long_name="Cloud fraction change because of condensation" unit="s-1" /> 893 <field id="drnebtur" long_name="Cloud fraction change because of turbulence" unit="s-1" /> 894 <field id="drnebavi" long_name="Cloud fraction change because of aviation" unit="s-1" /> 895 <field id="qsatl" long_name="Saturation with respect to liquid water" unit="-" /> 896 <field id="qsats" long_name="Saturation with respect to liquid ice" unit="-" /> 897 <field id="flightm" long_name="Aviation meters flown" unit="m/s" /> 898 <field id="flighth2o" long_name="Aviation H2O emitted" unit="kg H2O/s" /> 899 <field id="fcontrP" long_name="Gridbox fraction with potential persistent contrails" unit="-" /> 900 <field id="fcontrN" long_name="Gridbox fraction with potential non-persistent contrails" unit="-" /> 901 <field id="qcontr" long_name="Contrail qcontr" unit="Pa" /> 902 <field id="qcontr2" long_name="Contrail qcontr2" unit="kg/kg" /> 903 <field id="Tcontr" long_name="Contrail Tcontr" unit="K" /> 882 <field id="cfseri" long_name="Cloud fraction" unit="-" /> 883 <field id="dcfdyn" long_name="Dynamics cloud fraction tendency" unit="s-1" /> 884 <field id="rvcseri" long_name="Cloudy water vapor to total water vapor ratio" unit="-" /> 885 <field id="drvcdyn" long_name="Dynamics cloudy water vapor to total water vapor ratio tendency" unit="s-1" /> 886 <field id="qsub" long_name="Subsaturated clear sky total water" unit="kg/kg" /> 887 <field id="qissr" long_name="Supersaturated clear sky total water" unit="kg/kg" /> 888 <field id="qcld" long_name="Cloudy sky total water" unit="kg/kg" /> 889 <field id="subfra" long_name="Subsaturated clear sky fraction" unit="kg/kg" /> 890 <field id="issrfra" long_name="Supersaturated clear sky fraction" unit="kg/kg" /> 891 <field id="gammacond" long_name="Condensation threshold w.r.t. saturation" unit="-" /> 892 <field id="dcfsub" long_name="Sublimation cloud fraction tendency" unit="s-1" /> 893 <field id="dcfcon" long_name="Condensation cloud fraction tendency" unit="s-1" /> 894 <field id="dcfmix" long_name="Cloud mixing cloud fraction tendency" unit="s-1" /> 895 <field id="dqiadj" long_name="Temperature adjustment ice tendency" unit="kg/kg/s" /> 896 <field id="dqisub" long_name="Sublimation ice tendency" unit="kg/kg/s" /> 897 <field id="dqicon" long_name="Condensation ice tendency" unit="kg/kg/s" /> 898 <field id="dqimix" long_name="Cloud mixing ice tendency" unit="kg/kg/s" /> 899 <field id="dqvcadj" long_name="Temperature adjustment cloudy water vapor tendency" unit="kg/kg/s" /> 900 <field id="dqvcsub" long_name="Sublimation cloudy water vapor tendency" unit="kg/kg/s" /> 901 <field id="dqvccon" long_name="Condensation cloudy water vapor tendency" unit="kg/kg/s" /> 902 <field id="dqvcmix" long_name="Cloud mixing cloudy water vapor tendency" unit="kg/kg/s" /> 903 <field id="qsatl" long_name="Saturation with respect to liquid" unit="kg/kg" /> 904 <field id="qsati" long_name="Saturation with respect to ice" unit="kg/kg" /> 905 <field id="Tcontr" long_name="Temperature threshold for contrail formation" unit="K" /> 906 <field id="qcontr" long_name="Specific humidity threshold for contrail formation" unit="Pa" /> 907 <field id="qcontr2" long_name="Specific humidity threshold for contrail formation" unit="kg/kg" /> 908 <field id="fcontrN" long_name="Fraction with non-persistent contrail in clear-sky" unit="-" /> 909 <field id="fcontrP" long_name="Fraction with persistent contrail in ISSR" unit="-" /> 910 <field id="dcfavi" long_name="Aviation cloud fraction tendency" unit="s-1" /> 911 <field id="dqiavi" long_name="Aviation ice tendency" unit="kg/kg/s" /> 912 <field id="dqvcavi" long_name="Aviation cloudy water vapor tendency" unit="kg/kg/s" /> 913 <field id="flightdist" long_name="Aviation flown distance" unit="m/s/mesh" /> 914 <field id="flighth2o" long_name="Aviation H2O flight emission" unit="kg H2O/s/mesh" /> 904 915 <field id="fluxt" long_name="flux h" unit="W/m2" /> 905 916 <field id="fluxq" long_name="flux q" unit="-" /> -
LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_check_isotopes.f90
r5223 r5224 12 12 13 13 USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm 14 USE ioipsl, ONLY: getin 14 15 IMPLICIT NONE 15 16 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_dynetat0.f90
r5223 r5224 27 27 USE lmdz_comgeom2 28 28 USE lmdz_strings, ONLY: strIdx 29 USE ioipsl, ONLY: getin 29 30 30 31 USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90
r5223 r5224 65 65 (x, iso, q, err_msg) 66 66 USE lmdz_infotrac, ONLY: isoName, getKey 67 USE ioipsl, ONLY: getin 68 67 69 IMPLICIT NONE 68 70 -
LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90
r5159 r5224 48 48 prw_ancien, u10m, v10m, treedrg, u_ancien, v_ancien, wake_delta_pbl_TKE, wake_dens, & 49 49 ale_bl, ale_bl_trig, alp_bl, & 50 ale_wake, ale_bl_stat, AWAKE_S 50 ale_wake, ale_bl_stat, AWAKE_S, & 51 cf_ancien, rvc_ancien 51 52 52 53 USE comconst_mod, ONLY: pi, dtvr … … 94 95 USE init_ssrf_m, ONLY: start_init_subsurf 95 96 USE phys_state_var_mod, ONLY: beta_aridity, delta_tsurf, awake_dens, cv_gen, & 96 ratqs_inter_ , rneb_ancien97 ratqs_inter_ 97 98 USE lmdz_alpale 98 99 USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree … … 246 247 ale_bl_stat = 0. 247 248 249 cf_ancien = 0. 250 rvc_ancien = 0. 251 248 252 z0m(:, :) = 0 ! ym missing 5th subsurface initialization 249 253 … … 290 294 291 295 ratqs_inter_ = 0.002 292 rneb_ancien = 0.293 296 CALL phyredem("startphy.nc") 294 297 -
LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90
r5158 r5224 172 172 INTEGER, SAVE :: iflag_clw_omp 173 173 INTEGER, SAVE :: iflag_ice_thermo_omp 174 LOGICAL, SAVE :: ok_ice_su rsat_omp174 LOGICAL, SAVE :: ok_ice_supersat_omp 175 175 LOGICAL, SAVE :: ok_plane_h2o_omp, ok_plane_contrail_omp 176 176 REAL, SAVE :: rad_froid_omp, rad_chau1_omp, rad_chau2_omp … … 1305 1305 CALL getin('iflag_ice_thermo', iflag_ice_thermo_omp) 1306 1306 1307 !Config Key = ok_ice_su rsat1308 !Config Desc = 1309 !Config Def = 01310 !Config Help = 1311 1312 ok_ice_sursat_omp = .FALSE.1313 CALL getin('ok_ice_su rsat', ok_ice_sursat_omp)1307 !Config Key = ok_ice_supersat 1308 !Config Desc = include ice supersaturation for cold clouds 1309 !Config Def = .FALSE. 1310 !Config Help = 1311 1312 ok_ice_supersat_omp = .FALSE. 1313 CALL getin('ok_ice_supersat',ok_ice_supersat_omp) 1314 1314 1315 1315 !Config Key = ok_plane_h2o 1316 !Config Desc = 1317 !Config Def = 01316 !Config Desc = include H2O emissions from aviation 1317 !Config Def = .FALSE. 1318 1318 !Config Help = 1319 1319 … … 1322 1322 1323 1323 !Config Key = ok_plane_contrail 1324 !Config Desc = 1325 !Config Def = 01324 !Config Desc = include the formation of contrail cirrus clouds 1325 !Config Def = .FALSE. 1326 1326 !Config Help = 1327 1327 … … 2258 2258 rad_chau2 = rad_chau2_omp 2259 2259 iflag_ice_thermo = iflag_ice_thermo_omp 2260 ok_ice_su rsat = ok_ice_sursat_omp2260 ok_ice_supersat = ok_ice_supersat_omp 2261 2261 ok_plane_h2o = ok_plane_h2o_omp 2262 2262 ok_plane_contrail = ok_plane_contrail_omp … … 2683 2683 WRITE(lunout, *) ' rad_chau2 = ', rad_chau2 2684 2684 WRITE(lunout, *) ' iflag_ice_thermo = ', iflag_ice_thermo 2685 WRITE(lunout, *) ' ok_ice_sursat = ', ok_ice_sursat2685 WRITE(lunout,*) ' ok_ice_supersat = ',ok_ice_supersat 2686 2686 WRITE(lunout, *) ' ok_plane_h2o = ', ok_plane_h2o 2687 2687 WRITE(lunout, *) ' ok_plane_contrail = ', ok_plane_contrail -
LMDZ6/branches/Amaury_dev/libf/phylmd/create_etat0_unstruct_mod.F90
r5139 r5224 257 257 prw_ancien = 0. 258 258 agesno = 0. 259 260 ! LSCP condensation and ice supersaturation 261 cf_ancien = 0. 262 rvc_ancien = 0. 259 263 260 264 wake_delta_pbl_TKE(:,:,:)=0 … … 309 313 END IF 310 314 ratqs_inter_ = 0.002 311 rneb_ancien = 0.312 315 313 316 CALL gather_omp(cell_area,cell_area_mpi) -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90
r5186 r5224 19 19 ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, & 20 20 rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, & 21 solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, rneb_ancien,&21 solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, & 22 22 wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, & 23 23 wake_deltaq, wake_deltat, wake_s, awake_s, wake_dens, & … … 915 915 u_ancien(1, :) = u(:) 916 916 v_ancien(1, :) = v(:) 917 rneb_ancien(1, :) = 0.918 917 919 918 u10m = 0. -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90
r5186 r5224 12 12 ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, & 13 13 rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, & 14 solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, rneb_ancien,&14 solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, & 15 15 wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, & 16 16 wake_deltaq, wake_deltat, wake_s, awake_s, wake_dens, & … … 665 665 u_ancien(1, :)= u(:) 666 666 v_ancien(1, :)= v(:) 667 rneb_ancien(1, :)= 0.668 667 669 668 u10m = 0. -
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_clesphys.f90
r5137 r5224 1 ! $Id$2 1 ! Replaces clesphys.h 3 2 … … 45 44 , ok_lic_melt, ok_lic_cond, aer_type & 46 45 , iflag_rrtm, ok_strato, ok_hines, ok_qch4 & 47 , iflag_ice_thermo, ok_ice_su rsat &46 , iflag_ice_thermo, ok_ice_supersat & 48 47 , ok_plane_h2o, ok_plane_contrail & 49 48 , ok_gwd_rando, NSW, iflag_albedo & … … 142 141 LOGICAL :: ok_airs 143 142 INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo 144 LOGICAL :: ok_ice_su rsat, ok_plane_h2o, ok_plane_contrail143 LOGICAL :: ok_ice_supersat, ok_plane_h2o, ok_plane_contrail 145 144 LOGICAL :: ok_chlorophyll 146 145 LOGICAL :: ok_strato … … 202 201 !$OMP , ok_lic_melt, ok_lic_cond, aer_type & 203 202 !$OMP , iflag_rrtm, ok_strato, ok_hines, ok_qch4 & 204 !$OMP , iflag_ice_thermo, ok_ice_su rsat &203 !$OMP , iflag_ice_thermo, ok_ice_supersat & 205 204 !$OMP , ok_plane_h2o, ok_plane_contrail & 206 205 !$OMP , ok_gwd_rando, NSW, iflag_albedo & -
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp.F90
r5194 r5224 8 8 SUBROUTINE lscp(klon, klev, dtime, missing_val, & 9 9 paprs, pplay, temp, qt, qice_save, ptconv, ratqs, & 10 d_t, d_q, d_ql, d_qi, rneb, rneblsvol, rneb_seri,&10 d_t, d_q, d_ql, d_qi, rneb, rneblsvol, & 11 11 pfraclr, pfracld, & 12 12 cldfraliq, sigma2_icefracturb, mean_icefracturb, & … … 15 15 prfl, psfl, rhcl, qta, fraca, & 16 16 tv, pspsk, tla, thl, iflag_cld_th, & 17 iflag_ice_thermo, ok_ice_sursat, qsatl, qsats, & 18 distcltop, temp_cltop, tke, tke_dissip, & 19 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 20 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 17 iflag_ice_thermo, distcltop, temp_cltop, & 18 tke, tke_dissip, & 19 cell_area, & 20 cf_seri, rvc_seri, u_seri, v_seri, & 21 qsub, qissr, qcld, subfra, issrfra, gamma_cond, & 22 ratio_qi_qtot, dcf_sub, dcf_con, dcf_mix, & 23 dqi_adj, dqi_sub, dqi_con, dqi_mix, dqvc_adj, & 24 dqvc_sub, dqvc_con, dqvc_mix, qsatl, qsati, & 25 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, dcf_avi, & 26 dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 21 27 cloudth_sth, cloudth_senv, cloudth_sigmath, cloudth_sigmaenv, & 22 28 qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, & … … 99 105 USE lmdz_lscp_tools, ONLY: icefrac_lscp, icefrac_lscp_turb 100 106 USE lmdz_lscp_tools, ONLY: fallice_velocity, distance_to_cloud_top 101 USE ice_sursat_mod, ONLY: ice_sursat107 USE lmdz_lscp_condensation, ONLY: condensation_lognormal, condensation_ice_supersat 102 108 USE lmdz_lscp_poprecip, ONLY: poprecip_precld, poprecip_postcld 103 109 104 110 ! Use du module lmdz_lscp_ini contenant les constantes 105 USE lmdz_lscp_ini, ONLY: prt_level, lunout 111 USE lmdz_lscp_ini, ONLY: prt_level, lunout, eps 106 112 USE lmdz_lscp_ini, ONLY: seuil_neb, niter_lscp, iflag_evap_prec, t_coup, DDT0, ztfondue, rain_int_min 107 113 USE lmdz_lscp_ini, ONLY: ok_radocond_snow, a_tr_sca, cld_expo_con, cld_expo_lsc … … 112 118 USE lmdz_lscp_ini, ONLY: RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG 113 119 USE lmdz_lscp_ini, ONLY: ok_poprecip 114 USE lmdz_lscp_ini, ONLY: iflag_icefrac120 USE lmdz_lscp_ini, ONLY: ok_external_lognormal, ok_ice_supersat, ok_unadjusted_clouds, iflag_icefrac 115 121 USE lmdz_abort_physic, ONLY: abort_physic 116 122 IMPLICIT NONE … … 135 141 INTEGER, INTENT(IN) :: iflag_ice_thermo! flag to activate the ice thermodynamics 136 142 ! CR: if iflag_ice_thermo=2, ONLY convection is active 137 LOGICAL, INTENT(IN) :: ok_ice_sursat ! flag to determine if ice sursaturation is activated138 139 143 LOGICAL, DIMENSION(klon, klev), INTENT(IN) :: ptconv ! grid points where deep convection scheme is active 140 144 … … 146 150 REAL, DIMENSION(klon, klev), INTENT(IN) :: pspsk ! exner potential (p/100000)**(R/cp) 147 151 REAL, DIMENSION(klon, klev), INTENT(IN) :: tla ! liquid temperature within thermals [K] 148 REAL, DIMENSION(klon, klev ), INTENT(IN) :: tke !--turbulent kinetic energy [m2/s2]149 REAL, DIMENSION(klon, klev ), INTENT(IN) :: tke_dissip !--TKE dissipation [m2/s3]152 REAL, DIMENSION(klon, klev+1), INTENT(IN) :: tke !--turbulent kinetic energy [m2/s2] 153 REAL, DIMENSION(klon, klev+1), INTENT(IN) :: tke_dissip !--TKE dissipation [m2/s3] 150 154 151 155 ! INPUT/OUTPUT variables … … 155 159 REAL, DIMENSION(klon, klev), INTENT(INOUT) :: ratqs ! function of pressure that sets the large-scale 156 160 157 158 ! Input sursaturation en glace 159 REAL, DIMENSION(klon, klev), INTENT(INOUT) :: rneb_seri ! fraction nuageuse en memoire 161 ! INPUT/OUTPUT condensation and ice supersaturation 162 !-------------------------------------------------- 163 REAL, DIMENSION(klon, klev), INTENT(INOUT) :: cf_seri ! cloud fraction [-] 164 REAL, DIMENSION(klon, klev), INTENT(INOUT) :: ratio_qi_qtot ! solid specific water to total specific water ratio [-] 165 REAL, DIMENSION(klon, klev), INTENT(INOUT) :: rvc_seri ! cloudy water vapor to total water vapor ratio [-] 166 REAL, DIMENSION(klon, klev), INTENT(IN) :: u_seri ! eastward wind [m/s] 167 REAL, DIMENSION(klon, klev), INTENT(IN) :: v_seri ! northward wind [m/s] 168 REAL, DIMENSION(klon), INTENT(IN) :: cell_area ! area of each cell [m2] 169 170 ! INPUT/OUTPUT aviation 171 !-------------------------------------------------- 172 REAL, DIMENSION(klon, klev), INTENT(IN) :: flight_dist ! Aviation distance flown within the mesh [m/s/mesh] 173 REAL, DIMENSION(klon, klev), INTENT(IN) :: flight_h2o ! Aviation H2O emitted within the mesh [kg H2O/s/mesh] 160 174 161 175 ! OUTPUT variables 162 176 !----------------- 163 177 164 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t 165 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_q 166 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_ql 167 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_qi 168 REAL, DIMENSION(klon, klev), INTENT(OUT) :: rneb 169 REAL, DIMENSION(klon, klev), INTENT(OUT) :: rneblsvol 170 REAL, DIMENSION(klon, klev), INTENT(OUT) :: pfraclr 171 REAL, DIMENSION(klon, klev), INTENT(OUT) :: pfracld 178 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t ! temperature increment [K] 179 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_q ! specific humidity increment [kg/kg] 180 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_ql ! liquid water increment [kg/kg] 181 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_qi ! cloud ice mass increment [kg/kg] 182 REAL, DIMENSION(klon, klev), INTENT(OUT) :: rneb ! cloud fraction [-] 183 REAL, DIMENSION(klon, klev), INTENT(OUT) :: rneblsvol ! cloud fraction per unit volume [-] 184 REAL, DIMENSION(klon, klev), INTENT(OUT) :: pfraclr ! precip fraction clear-sky part [-] 185 REAL, DIMENSION(klon, klev), INTENT(OUT) :: pfracld ! precip fraction cloudy part [-] 172 186 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cldfraliq ! liquid fraction of cloud [-] 173 187 REAL, DIMENSION(klon, klev), INTENT(OUT) :: sigma2_icefracturb ! Variance of the diagnostic supersaturation distribution (icefrac_turb) [-] 174 188 REAL, DIMENSION(klon, klev), INTENT(OUT) :: mean_icefracturb ! Mean of the diagnostic supersaturation distribution (icefrac_turb) [-] 175 REAL, DIMENSION(klon, klev), INTENT(OUT) :: radocond ! condensed water used in the radiation scheme [kg/kg] 176 REAL, DIMENSION(klon, klev), INTENT(OUT) :: radicefrac ! ice fraction of condensed water for radiation scheme 177 REAL, DIMENSION(klon, klev), INTENT(OUT) :: rhcl ! clear-sky relative humidity [-] 178 REAL, DIMENSION(klon), INTENT(OUT) :: rain ! surface large-scale rainfall [kg/s/m2] 179 REAL, DIMENSION(klon), INTENT(OUT) :: snow ! surface large-scale snowfall [kg/s/m2] 180 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qsatl ! saturation specific humidity wrt liquid [kg/kg] 181 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qsats ! saturation specific humidity wrt ice [kg/kg] 182 REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: prfl ! large-scale rainfall flux in the column [kg/s/m2] 183 REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: psfl ! large-scale snowfall flux in the column [kg/s/m2] 184 REAL, DIMENSION(klon, klev), INTENT(OUT) :: distcltop ! distance to cloud top [m] 185 REAL, DIMENSION(klon, klev), INTENT(OUT) :: temp_cltop ! temperature of cloud top [K] 186 REAL, DIMENSION(klon, klev), INTENT(OUT) :: beta ! conversion rate of condensed water 189 REAL, DIMENSION(klon, klev), INTENT(OUT) :: radocond ! condensed water used in the radiation scheme [kg/kg] 190 REAL, DIMENSION(klon, klev), INTENT(OUT) :: radicefrac ! ice fraction of condensed water for radiation scheme 191 REAL, DIMENSION(klon, klev), INTENT(OUT) :: rhcl ! clear-sky relative humidity [-] 192 REAL, DIMENSION(klon), INTENT(OUT) :: rain ! surface large-scale rainfall [kg/s/m2] 193 REAL, DIMENSION(klon), INTENT(OUT) :: snow ! surface large-scale snowfall [kg/s/m2] 194 REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: prfl ! large-scale rainfall flux in the column [kg/s/m2] 195 REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: psfl ! large-scale snowfall flux in the column [kg/s/m2] 196 REAL, DIMENSION(klon, klev), INTENT(OUT) :: distcltop ! distance to cloud top [m] 197 REAL, DIMENSION(klon, klev), INTENT(OUT) :: temp_cltop ! temperature of cloud top [K] 198 REAL, DIMENSION(klon, klev), INTENT(OUT) :: beta ! conversion rate of condensed water 187 199 188 200 ! fraction of aerosol scavenging through impaction and nucleation (for on-line) … … 191 203 REAL, DIMENSION(klon, klev), INTENT(OUT) :: frac_nucl ! scavenging fraction due tu nucleation [-] 192 204 193 ! for supersaturation and contrails parameterisation 194 195 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qclr ! specific total water content in clear sky region [kg/kg] 196 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcld ! specific total water content in cloudy region [kg/kg] 197 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qss ! specific total water content in supersat region [kg/kg] 198 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qvc ! specific vapor content in clouds [kg/kg] 199 REAL, DIMENSION(klon, klev), INTENT(OUT) :: rnebclr ! mesh fraction of clear sky [-] 200 REAL, DIMENSION(klon, klev), INTENT(OUT) :: rnebss ! mesh fraction of ISSR [-] 201 REAL, DIMENSION(klon, klev), INTENT(OUT) :: gamma_ss ! coefficient governing the ice nucleation RHi threshold [-] 202 REAL, DIMENSION(klon, klev), INTENT(OUT) :: Tcontr ! threshold temperature for contrail formation [K] 203 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcontr ! threshold humidity for contrail formation [kg/kg] 204 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcontr2 ! // (2nd expression more consistent with LMDZ expression of q) 205 REAL, DIMENSION(klon, klev), INTENT(OUT) :: fcontrN ! fraction of grid favourable to non-persistent contrails 206 REAL, DIMENSION(klon, klev), INTENT(OUT) :: fcontrP ! fraction of grid favourable to persistent contrails 207 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cloudth_sth ! mean saturation deficit in thermals 208 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cloudth_senv ! mean saturation deficit in environment 209 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cloudth_sigmath ! std of saturation deficit in thermals 210 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cloudth_sigmaenv ! std of saturation deficit in environment 205 ! for condensation and ice supersaturation 206 207 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qsub !--specific total water content in sub-saturated clear sky region [kg/kg] 208 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qissr !--specific total water content in supersat region [kg/kg] 209 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcld !--specific total water content in cloudy region [kg/kg] 210 REAL, DIMENSION(klon, klev), INTENT(OUT) :: subfra !--mesh fraction of subsaturated clear sky [-] 211 REAL, DIMENSION(klon, klev), INTENT(OUT) :: issrfra !--mesh fraction of ISSR [-] 212 REAL, DIMENSION(klon, klev), INTENT(OUT) :: gamma_cond !--coefficient governing the ice nucleation RHi threshold [-] 213 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dcf_sub !--cloud fraction tendency because of sublimation [s-1] 214 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dcf_con !--cloud fraction tendency because of condensation [s-1] 215 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dcf_mix !--cloud fraction tendency because of cloud mixing [s-1] 216 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqi_adj !--specific ice content tendency because of temperature adjustment [kg/kg/s] 217 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqi_sub !--specific ice content tendency because of sublimation [kg/kg/s] 218 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqi_con !--specific ice content tendency because of condensation [kg/kg/s] 219 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqi_mix !--specific ice content tendency because of cloud mixing [kg/kg/s] 220 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqvc_adj !--specific cloud water vapor tendency because of temperature adjustment [kg/kg/s] 221 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqvc_sub !--specific cloud water vapor tendency because of sublimation [kg/kg/s] 222 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqvc_con !--specific cloud water vapor tendency because of condensation [kg/kg/s] 223 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqvc_mix !--specific cloud water vapor tendency because of cloud mixing [kg/kg/s] 224 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qsatl !--saturation specific humidity wrt liquid [kg/kg] 225 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qsati !--saturation specific humidity wrt ice [kg/kg] 226 227 ! for contrails and aviation 228 229 REAL, DIMENSION(klon, klev), INTENT(OUT) :: Tcontr !--threshold temperature for contrail formation [K] 230 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcontr !--threshold humidity for contrail formation [kg/kg] 231 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcontr2 !--// (2nd expression more consistent with LMDZ expression of q) 232 REAL, DIMENSION(klon, klev), INTENT(OUT) :: fcontrN !--fraction of grid favourable to non-persistent contrails 233 REAL, DIMENSION(klon, klev), INTENT(OUT) :: fcontrP !--fraction of grid favourable to persistent contrails 234 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dcf_avi !--cloud fraction tendency because of aviation [s-1] 235 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqi_avi !--specific ice content tendency because of aviation [kg/kg/s] 236 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqvc_avi !--specific cloud water vapor tendency because of aviation [kg/kg/s] 211 237 212 238 ! for POPRECIP … … 225 251 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqsfreez !--snow tendency due to freezing [kg/kg/s] 226 252 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dqrfreez !--rain tendency due to freezing [kg/kg/s] 253 254 ! for thermals 255 256 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cloudth_sth !--mean saturation deficit in thermals 257 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cloudth_senv !--mean saturation deficit in environment 258 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cloudth_sigmath !--std of saturation deficit in thermals 259 REAL, DIMENSION(klon, klev), INTENT(OUT) :: cloudth_sigmaenv !--std of saturation deficit in environment 227 260 228 261 … … 292 325 REAL, DIMENSION(klon) :: zqliq, zqice, zqvapcl ! for icefrac_lscp_turb 293 326 327 ! for condensation and ice supersaturation 328 REAL, DIMENSION(klon) :: qvc, shear 329 REAL :: delta_z 330 !--Added for ice supersaturation (ok_ice_supersat) and contrails (ok_plane_contrails) 331 ! Constants used for calculating ratios that are advected (using a parent-child 332 ! formalism). This is not done in the dynamical core because at this moment, 333 ! only isotopes can use this parent-child formalism. Note that the two constants 334 ! are the same as the one use in the dynamical core, being also defined in 335 ! dyn3d_common/infotrac.F90 336 REAL :: min_qParent, min_ratio 337 294 338 INTEGER i, k, n, kk, iter 295 339 INTEGER, DIMENSION(klon) :: n_i … … 375 419 ztemp_cltop(:) = 0.0 376 420 ztupnew(:) = 0.0 377 !--ice supersaturation 378 gamma_ss(:, :) = 1.0 379 qss(:, :) = 0.0 380 rnebss(:, :) = 0.0 421 422 distcltop(:, :) = 0. 423 temp_cltop(:, :) = 0. 424 425 !--Ice supersaturation 426 gamma_cond(:, :) = 1. 427 qissr(:, :) = 0. 428 issrfra(:, :) = 0. 429 dcf_sub(:, :) = 0. 430 dcf_con(:, :) = 0. 431 dcf_mix(:, :) = 0. 432 dqi_adj(:, :) = 0. 433 dqi_sub(:, :) = 0. 434 dqi_con(:, :) = 0. 435 dqi_mix(:, :) = 0. 436 dqvc_adj(:, :) = 0. 437 dqvc_sub(:, :) = 0. 438 dqvc_con(:, :) = 0. 439 dqvc_mix(:, :) = 0. 440 fcontrN(:, :) = 0. 441 fcontrP(:, :) = 0. 381 442 Tcontr(:, :) = missing_val 382 443 qcontr(:, :) = missing_val 383 444 qcontr2(:, :) = missing_val 384 fcontrN(:, :) = 0.0 385 fcontrP(:, :) = 0.0 386 distcltop(:, :) = 0. 387 temp_cltop(:, :) = 0. 445 dcf_avi(:, :) = 0. 446 dqi_avi(:, :) = 0. 447 dqvc_avi(:, :) = 0. 448 qvc(:) = 0. 449 shear(:) = 0. 450 min_qParent = 1.e-30 451 min_ratio = 1.e-16 388 452 389 453 !-- poprecip … … 772 836 rneblsvol(i, k) = ctot_vol(i, k) 773 837 zqn(i) = qcloud(i) 838 !--AB grid-mean vapor in the cloud - we assume saturation adjustment 839 qvc(i) = rneb(i, k) * zqs(i) 774 840 ENDDO 775 841 … … 807 873 DO iter = 1, iflag_fisrtilp_qsat + 1 808 874 875 keepgoing(:) = .FALSE. 876 809 877 DO i = 1, klon 810 878 811 879 ! keepgoing = .TRUE. while convergence is not satisfied 812 keepgoing(i) = ABS(DT(i))>DDT0 813 814 IF ((keepgoing(i) .OR. (n_i(i) == 0)) .AND. lognormale(i)) THEN 880 IF (((ABS(DT(i))>DDT0) .OR. (n_i(i) == 0)) .AND. lognormale(i)) THEN 881 815 882 816 883 ! if not convergence: 884 ! we calculate a new iteration 885 keepgoing(i) = .TRUE. 817 886 818 887 ! P2.2.1> cloud fraction and condensed water mass calculation … … 830 899 qtot(i) = zq(i) + zmqc(i) 831 900 832 END IF833 834 END DO901 END IF 902 903 END DO 835 904 836 905 ! Calculation of saturation specific humidity and ice fraction … … 843 912 ! For iflag_t_glace GE 4 the phase partition function dependends on temperature AND distance to cloud top 844 913 CALL distance_to_cloud_top(klon, klev, k, temp, pplay, paprs, rneb, zdistcltop, ztemp_cltop) 845 END IF914 END IF 846 915 847 916 CALL icefrac_lscp(klon, zt(:), iflag_ice_thermo, zdistcltop(:), ztemp_cltop(:), zfice(:), dzfice(:)) 848 917 849 DO i = 1, klon !todoan : check if loop in i is needed 850 851 IF ((keepgoing(i) .OR. (n_i(i) == 0)) .AND. lognormale(i)) THEN 852 853 zpdf_sig(i) = ratqs(i, k) * zq(i) 854 zpdf_k(i) = -sqrt(log(1. + (zpdf_sig(i) / zq(i))**2)) 855 zpdf_delta(i) = log(zq(i) / (gammasat(i) * zqs(i))) 856 zpdf_a(i) = zpdf_delta(i) / (zpdf_k(i) * sqrt(2.)) 857 zpdf_b(i) = zpdf_k(i) / (2. * sqrt(2.)) 858 zpdf_e1(i) = zpdf_a(i) - zpdf_b(i) 859 zpdf_e1(i) = sign(min(ABS(zpdf_e1(i)), 5.), zpdf_e1(i)) 860 zpdf_e1(i) = 1. - erf(zpdf_e1(i)) 861 zpdf_e2(i) = zpdf_a(i) + zpdf_b(i) 862 zpdf_e2(i) = sign(min(ABS(zpdf_e2(i)), 5.), zpdf_e2(i)) 863 zpdf_e2(i) = 1. - erf(zpdf_e2(i)) 864 865 IF ((.NOT.ok_ice_sursat).OR.(Tbef(i)>t_glace_min)) THEN 918 !--AB Activates a condensation scheme that allows for 919 !--ice supersaturation and contrails evolution from aviation 920 IF (ok_ice_supersat) THEN 921 922 !--Calculate the shear value (input for condensation and ice supersat) 923 DO i = 1, klon 924 !--Cell thickness [m] 925 delta_z = (paprs(i, k) - paprs(i, k + 1)) / RG / pplay(i, k) * Tbef(i) * RD 926 IF (iftop) THEN 927 ! top 928 shear(i) = SQRT(((u_seri(i, k) - u_seri(i, k - 1)) / delta_z)**2. & 929 + ((v_seri(i, k) - v_seri(i, k - 1)) / delta_z)**2.) 930 ELSE IF (k == 1) THEN 931 ! surface 932 shear(i) = SQRT(((u_seri(i, k + 1) - u_seri(i, k)) / delta_z)**2. & 933 + ((v_seri(i, k + 1) - v_seri(i, k)) / delta_z)**2.) 934 ELSE 935 ! other layers 936 shear(i) = SQRT((((u_seri(i, k + 1) + u_seri(i, k)) / 2. & 937 - (u_seri(i, k) + u_seri(i, k - 1)) / 2.) / delta_z)**2. & 938 + (((v_seri(i, k + 1) + v_seri(i, k)) / 2. & 939 - (v_seri(i, k) + v_seri(i, k - 1)) / 2.) / delta_z)**2.) 940 END IF 941 END DO 942 943 !--------------------------------------------- 944 !-- CONDENSATION AND ICE SUPERSATURATION -- 945 !--------------------------------------------- 946 947 CALL condensation_ice_supersat(& 948 klon, dtime, missing_val, & 949 pplay(:, k), paprs(:, k), paprs(:, k + 1), & 950 cf_seri(:, k), rvc_seri(:, k), ratio_qi_qtot(:, k), & 951 shear(:), tke_dissip(:, k), cell_area(:), & 952 Tbef(:), zq(:), zqs(:), gammasat(:), ratqs(:, k), keepgoing(:), & 953 rneb(:, k), zqn(:), qvc(:), issrfra(:, k), qissr(:, k), & 954 dcf_sub(:, k), dcf_con(:, k), dcf_mix(:, k), & 955 dqi_adj(:, k), dqi_sub(:, k), dqi_con(:, k), dqi_mix(:, k), & 956 dqvc_adj(:, k), dqvc_sub(:, k), dqvc_con(:, k), dqvc_mix(:, k), & 957 Tcontr(:, k), qcontr(:, k), qcontr2(:, k), fcontrN(:, k), fcontrP(:, k), & 958 flight_dist(:, k), flight_h2o(:, k), & 959 dcf_avi(:, k), dqi_avi(:, k), dqvc_avi(:, k)) 960 961 962 !--If .TRUE., calls an externalised version of the generalised 963 !--lognormal condensation scheme (Bony and Emanuel 2001) 964 !--Numerically, convergence is conserved with this option 965 !--The objective is to simplify LSCP 966 ELSE IF (ok_external_lognormal) THEN 967 968 CALL condensation_lognormal(& 969 klon, Tbef(:), zq(:), zqs(:), gammasat(:), ratqs(:, k), & 970 keepgoing(:), rneb(:, k), zqn(:), qvc(:)) 971 972 ELSE !--Generalised lognormal (Bony and Emanuel 2001) 973 974 DO i = 1, klon !todoan : check if loop in i is needed 975 976 IF (keepgoing(i)) THEN 977 978 zpdf_sig(i) = ratqs(i, k) * zq(i) 979 zpdf_k(i) = -sqrt(log(1. + (zpdf_sig(i) / zq(i))**2)) 980 zpdf_delta(i) = log(zq(i) / (gammasat(i) * zqs(i))) 981 zpdf_a(i) = zpdf_delta(i) / (zpdf_k(i) * sqrt(2.)) 982 zpdf_b(i) = zpdf_k(i) / (2. * sqrt(2.)) 983 zpdf_e1(i) = zpdf_a(i) - zpdf_b(i) 984 zpdf_e1(i) = sign(min(ABS(zpdf_e1(i)), 5.), zpdf_e1(i)) 985 zpdf_e1(i) = 1. - erf(zpdf_e1(i)) 986 zpdf_e2(i) = zpdf_a(i) + zpdf_b(i) 987 zpdf_e2(i) = sign(min(ABS(zpdf_e2(i)), 5.), zpdf_e2(i)) 988 zpdf_e2(i) = 1. - erf(zpdf_e2(i)) 866 989 867 990 IF (zpdf_e1(i)<1.e-10) THEN 868 991 rneb(i, k) = 0. 869 zqn(i) = gammasat(i) * zqs(i) 992 zqn(i) = zqs(i) 993 !--AB grid-mean vapor in the cloud - we assume saturation adjustment 994 qvc(i) = 0. 870 995 ELSE 871 996 rneb(i, k) = 0.5 * zpdf_e1(i) 872 997 zqn(i) = zq(i) * zpdf_e2(i) / zpdf_e1(i) 873 ENDIF 874 875 rnebss(i, k) = 0.0 !--added by OB (needed because of the convergence loop on time) 876 fcontrN(i, k) = 0.0 !--idem 877 fcontrP(i, k) = 0.0 !--idem 878 qss(i, k) = 0.0 !--idem 879 880 ELSE ! in case of ice supersaturation by Audran 881 882 !------------------------------------ 883 ! ICE SUPERSATURATION 884 !------------------------------------ 885 886 CALL ice_sursat(pplay(i, k), paprs(i, k) - paprs(i, k + 1), dtime, i, k, temp(i, k), zq(i), & 887 gamma_ss(i, k), zqs(i), Tbef(i), rneb_seri(i, k), ratqs(i, k), & 888 rneb(i, k), zqn(i), rnebss(i, k), qss(i, k), & 889 Tcontr(i, k), qcontr(i, k), qcontr2(i, k), fcontrN(i, k), fcontrP(i, k)) 890 891 ENDIF ! ((flag_ice_sursat.EQ.0).OR.(Tbef(i).gt.t_glace_min)) 998 !--AB grid-mean vapor in the cloud - we assume saturation adjustment 999 qvc(i) = rneb(i, k) * zqs(i) 1000 END IF 1001 1002 END IF ! keepgoing 1003 END DO ! loop on klon 1004 1005 END IF ! .NOT. ok_ice_supersat 1006 1007 DO i = 1, klon 1008 IF (keepgoing(i)) THEN 892 1009 893 1010 ! If vertical heterogeneity, change fraction by volume as well … … 895 1012 ctot_vol(i, k) = rneb(i, k) 896 1013 rneblsvol(i, k) = ctot_vol(i, k) 897 END IF1014 END IF 898 1015 899 1016 … … 911 1028 912 1029 ! LEA_R : check formule 913 qlbef(i) = max(0., zqn(i) - zqs(i)) 1030 IF (ok_unadjusted_clouds) THEN 1031 !--AB We relax the saturation adjustment assumption 1032 !-- qvc (grid-mean vapor in cloud) is calculated by the condensation scheme 1033 IF (rneb(i, k) > eps) THEN 1034 qlbef(i) = MAX(0., zqn(i) - qvc(i) / rneb(i, k)) 1035 ELSE 1036 qlbef(i) = 0. 1037 ENDIF 1038 ELSE 1039 qlbef(i) = max(0., zqn(i) - zqs(i)) 1040 ENDIF 1041 914 1042 num = -Tbef(i) + zt(i) + rneb(i, k) * ((1 - zfice(i)) * RLVTT & 915 1043 + zfice(i) * RLSTT) / RCPD / (1.0 + RVTMP2 * (zq(i) + zmqc(i))) * qlbef(i) … … 978 1106 zqn(i) = zq(i) 979 1107 rneb(i, k) = 1.0 980 zcond(i) = MAX(0.0, zqn(i) - zqs(i)) 1108 IF (ok_unadjusted_clouds) THEN 1109 !--AB We relax the saturation adjustment assumption 1110 !-- qvc (grid-mean vapor in cloud) is calculated by the condensation scheme 1111 zcond(i) = MAX(0., zqn(i) - qvc(i)) 1112 ELSE 1113 IF (ok_unadjusted_clouds) THEN 1114 !--AB We relax the saturation adjustment assumption 1115 !-- qvc (grid-mean vapor in cloud) is calculated by the condensation scheme 1116 zcond(i) = MAX(0., zqn(i) * rneb(i, k) - qvc(i)) 1117 ELSE 1118 zcond(i) = MAX(0.0, zqn(i) - zqs(i)) * rneb(i, k) 1119 ENDIF 1120 ENDIF 981 1121 rhcl(i, k) = 1.0 982 1122 ELSE … … 1006 1146 * RLVTT / RCPD / (1.0 + RVTMP2 * (zq(i) + zmqc(i) + zcond(i))) & 1007 1147 + zfice(i) * zcond(i) * RLSTT / RCPD / (1.0 + RVTMP2 * (zq(i) + zmqc(i) + zcond(i))) 1008 END DO1148 END DO 1009 1149 1010 1150 ! If vertical heterogeneity, change volume fraction … … 1012 1152 ctot_vol(1:klon, k) = min(max(ctot_vol(1:klon, k), 0.), 1.) 1013 1153 rneblsvol(1:klon, k) = ctot_vol(1:klon, k) 1014 ENDIF 1154 END IF 1155 1156 !--AB Write diagnostics and tracers for ice supersaturation 1157 IF (ok_ice_supersat) THEN 1158 CALL calc_qsat_ecmwf(klon, zt, qzero, pplay(:, k), RTT, 1, .FALSE., qsatl(:, k), zdqs) 1159 CALL calc_qsat_ecmwf(klon, zt, qzero, pplay(:, k), RTT, 2, .FALSE., qsati(:, k), zdqs) 1160 1161 DO i = 1, klon 1162 1163 cf_seri(i, k) = rneb(i, k) 1164 1165 IF (.NOT. ok_unadjusted_clouds) THEN 1166 qvc(i) = zqs(i) * rneb(i, k) 1167 END IF 1168 IF (zq(i) > min_qParent) THEN 1169 rvc_seri(i, k) = qvc(i) / zq(i) 1170 ELSE 1171 rvc_seri(i, k) = min_ratio 1172 END IF 1173 !--The MIN barrier is NEEDED because of: 1174 !-- 1) very rare pathological cases of the lsc scheme (rvc = 1. + 1e-16 sometimes) 1175 !-- 2) the thermal scheme does NOT guarantee that qvc <= qvap (or even qincld <= qtot) 1176 !--The MAX barrier is a safeguard that should not be activated 1177 rvc_seri(i, k) = MIN(MAX(rvc_seri(i, k), 0.), 1.) 1178 1179 !--Diagnostics 1180 gamma_cond(i, k) = gammasat(i) 1181 IF (issrfra(i, k) < eps) THEN 1182 issrfra(i, k) = 0. 1183 qissr(i, k) = 0. 1184 END IF 1185 subfra(i, k) = 1. - cf_seri(i, k) - issrfra(i, k) 1186 qsub(i, k) = zq(i) - qvc(i) - qissr(i, k) 1187 IF (subfra(i, k) < eps) THEN 1188 subfra(i, k) = 0. 1189 qsub(i, k) = 0. 1190 END IF 1191 qcld(i, k) = qvc(i) + zcond(i) 1192 IF (cf_seri(i, k) < eps) THEN 1193 qcld(i, k) = 0. 1194 END IF 1195 END DO 1196 END IF 1015 1197 1016 1198 ! ---------------------------------------------------------------- … … 1024 1206 zoliql(i) = zcond(i) * (1. - zfice(i)) 1025 1207 zoliqi(i) = zcond(i) * zfice(i) 1026 END DO1208 END DO 1027 1209 1028 1210 CALL poprecip_postcld(klon, dtime, paprs(:, k), paprs(:, k + 1), pplay(:, k), & … … 1332 1514 znebprecipcld(i) = 0.0 1333 1515 ENDIF 1334 ENDDO1516 ENDDO 1335 1517 1336 1518 ENDIF … … 1425 1607 frac_impa(i, kk) = 1. - zneb(i) * zfrac_lessi 1426 1608 1427 ENDIF 1428 1429 ENDDO 1430 1431 ENDDO 1432 1433 !--save some variables for ice supersaturation 1434 1435 DO i = 1, klon 1436 ! for memory 1437 rneb_seri(i, k) = rneb(i, k) 1438 1439 ! for diagnostics 1440 rnebclr(i, k) = 1.0 - rneb(i, k) - rnebss(i, k) 1441 1442 qvc(i, k) = zqs(i) * rneb(i, k) 1443 qclr(i, k) = MAX(1.e-10, zq(i) - qvc(i, k) - qss(i, k)) !--added by OB because of pathologic cases with the lognormal 1444 qcld(i, k) = qvc(i, k) + zcond(i) 1445 ENDDO 1446 !q_sat 1447 CALL calc_qsat_ecmwf(klon, Tbef(:), qzero(:), pplay(:, k), RTT, 1, .FALSE., qsatl(:, k), zdqs(:)) 1448 CALL calc_qsat_ecmwf(klon, Tbef(:), qzero(:), pplay(:, k), RTT, 2, .FALSE., qsats(:, k), zdqs(:)) 1449 1450 1609 END IF 1610 1611 END DO 1612 1613 END DO 1451 1614 1452 1615 ! Outputs: … … 1465 1628 ! c_iso: same for isotopes 1466 1629 d_t(i, k) = zt(i) - temp(i, k) 1467 END DO1468 1469 END DO1630 END DO 1631 1632 END DO 1470 1633 1471 1634 -
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_condensation.f90
-
Property
svn:mergeinfo
set to
(toggle deleted branches)
/LMDZ6/trunk/libf/phylmd/lmdz_lscp_condensation.F90 merged eligible /LMDZ4/branches/LMDZ4-dev/libf/phylmd/lmdz_lscp_condensation.F90 1074-1276,1281-1284 /LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/lmdz_lscp_condensation.F90 1293-1401 /LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/lmdz_lscp_condensation.F90 1436-1453 /LMDZ5/branches/LMDZ5V2.0-dev/libf/phylmd/lmdz_lscp_condensation.F90 1456-1491 /LMDZ5/branches/LMDZ_tree_FC/libf/phylmd/lmdz_lscp_condensation.F90 2924-2946 /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_condensation.F90 4175-4488 /LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/lmdz_lscp_condensation.F90 4660-4721 /LMDZ6/branches/Ocean_skin/libf/phylmd/lmdz_lscp_condensation.F90 3428-4369 /LMDZ6/branches/blowing_snow/libf/phylmd/lmdz_lscp_condensation.F90 4485-4522
r5223 r5224 74 74 75 75 76 IF ( pdf_e1 .LT.eps ) THEN76 IF ( pdf_e1 < eps ) THEN 77 77 cldfra(i) = 0. 78 78 qincld(i) = qsat(i) … … 300 300 !--If ok_weibull_warm_clouds = .TRUE., the Weibull law is used for 301 301 !--all clouds, and the lognormal scheme is not activated 302 IF ( ( temp(i) .GT.temp_nowater ) .AND. .NOT. ok_weibull_warm_clouds ) THEN302 IF ( ( temp(i) > temp_nowater ) .AND. .NOT. ok_weibull_warm_clouds ) THEN 303 303 304 304 pdf_std = ratqs(i) * qtot(i) … … 315 315 316 316 317 IF ( pdf_e1 .LT.eps ) THEN317 IF ( pdf_e1 < eps ) THEN 318 318 cldfra(i) = 0. 319 319 qincld(i) = qsat(i) … … 330 330 331 331 !--Initialisation 332 IF ( temp(i) .GT.temp_nowater ) THEN332 IF ( temp(i) > temp_nowater ) THEN 333 333 !--If the air mass is warm (liquid water can exist), 334 334 !--all the memory is lost and the scheme becomes statistical, … … 460 460 461 461 !--If there is a cloud 462 IF ( cldfra(i) .GT.eps ) THEN462 IF ( cldfra(i) > eps ) THEN 463 463 464 464 qvapincld = qvc(i) / cldfra(i) … … 468 468 !--Most probably, we advected a cloud with no ice water content (possible 469 469 !--if the entire cloud precipited for example) 470 IF ( qiceincld .LT.eps ) THEN470 IF ( qiceincld < eps ) THEN 471 471 dcf_sub(i) = - cldfra(i) 472 472 dqvc_sub(i) = - qvc(i) … … 493 493 + 0.7957 * ( qiceincld * rho * 1e3 )**0.2535 * ( temp(i) - RTT + 190. ) ) / 2. 494 494 495 IF ( qvapincld .GE.qsat(i) ) THEN495 IF ( qvapincld >= qsat(i) ) THEN 496 496 !--If the cloud is initially supersaturated 497 497 !--Exact explicit integration (qvc exact, qice explicit) … … 507 507 qice_ratio = ( 1. - 2. / 3. / kappa / r_ice**2. * dtime * ( qsat(i) - qvapincld ) ) 508 508 509 IF ( qice_ratio .LT.0. ) THEN509 IF ( qice_ratio < 0. ) THEN 510 510 !--If all the ice has been sublimated, we sublimate 511 511 !--completely the cloud and do not activate the sublimation … … 540 540 541 541 !--If the vapor in cloud is below vapor needed for the cloud to survive 542 IF ( qvapincld .LT.qvapincld_new ) THEN542 IF ( qvapincld < qvapincld_new ) THEN 543 543 !--Sublimation of the subsaturated cloud 544 544 !--iflag_cloud_sublim_pdf selects the PDF of the ice water content … … 548 548 !--iflag = 3 --> gamma distribution (Karcher et al 2018) 549 549 550 IF ( iflag_cloud_sublim_pdf .EQ.1 ) THEN550 IF ( iflag_cloud_sublim_pdf == 1 ) THEN 551 551 !--Uniform distribution starting at qvapincld 552 552 pdf_e1 = 1. / ( 2. * qiceincld ) … … 556 556 * pdf_e1 / 2. 557 557 558 ELSEIF ( iflag_cloud_sublim_pdf .EQ.2 ) THEN558 ELSEIF ( iflag_cloud_sublim_pdf == 2 ) THEN 559 559 !--Exponential distribution starting at qvapincld 560 560 pdf_alpha = 1. / qiceincld … … 565 565 + qvapincld - qvapincld_new * pdf_e1 ) 566 566 567 ELSEIF ( iflag_cloud_sublim_pdf .GE.3 ) THEN567 ELSEIF ( iflag_cloud_sublim_pdf >= 3 ) THEN 568 568 !--Gamma distribution starting at qvapincld 569 569 pdf_alpha = ( mu_subl_pdf_lscp + 1. ) / qiceincld … … 608 608 609 609 !--If there is a clear-sky region 610 IF ( ( 1. - cldfra(i) ) .GT.eps ) THEN610 IF ( ( 1. - cldfra(i) ) > eps ) THEN 611 611 612 612 !--Water quantity in the clear-sky + potential liquid cloud (gridbox average) … … 626 626 * ( ( 1. - cldfra(i) ) * cell_area(i) )**( 1. / 4. ) & 627 627 * MAX( temp(i) - temp_thresh_pdf_lscp, 0. ) 628 IF ( rhl_clr .GT.rhlmid_pdf_lscp ) THEN628 IF ( rhl_clr > rhlmid_pdf_lscp ) THEN 629 629 pdf_std = pdf_e1 * ( 2. * rhlmid_pdf_lscp - rhl_clr ) / rhlmid_pdf_lscp 630 630 ELSE … … 660 660 qvc(i) = cldfra(i) * qsat(i) 661 661 662 ELSEIF ( cf_cond .GT.cond_thresh_pdf_lscp ) THEN662 ELSEIF ( cf_cond > cond_thresh_pdf_lscp ) THEN 663 663 !--We check that there is something to condense, if not the 664 664 !--condensation process stops … … 670 670 pdf_e4 = ( 2. * pdf_e3 * pdf_e1 - pdf_x ) & 671 671 / ( pdf_e3 * pdf_e1 / rhlmid_pdf_lscp - 1. ) 672 IF ( ( MIN(pdf_e4, rhl_clr) .LT. rhlmid_pdf_lscp ) .OR. ( pdf_e4 .GT.rhl_clr ) ) THEN672 IF ( ( MIN(pdf_e4, rhl_clr) < rhlmid_pdf_lscp ) .OR. ( pdf_e4 > rhl_clr ) ) THEN 673 673 pdf_e4 = pdf_x / ( pdf_e3 * pdf_e1 / rhlmid_pdf_lscp + 1. ) 674 674 ENDIF … … 720 720 !--If there is still clear sky, we diagnose the ISSR 721 721 !--We recalculte the PDF properties (after the condensation process) 722 IF ( ( ( 1. - dcf_con(i) - cldfra(i) ) .GT.eps ) .AND. .NOT. ok_warm_cloud ) THEN722 IF ( ( ( 1. - dcf_con(i) - cldfra(i) ) > eps ) .AND. .NOT. ok_warm_cloud ) THEN 723 723 !--Water quantity in the clear-sky + potential liquid cloud (gridbox average) 724 724 qclr = qtot(i) - dqi_con(i) - dqvc_con(i) - qcld(i) … … 737 737 * ( ( 1. - dcf_con(i) - cldfra(i) ) * cell_area(i) )**( 1. / 4. ) & 738 738 * MAX( temp(i) - temp_thresh_pdf_lscp, 0. ) 739 IF ( rhl_clr .GT.rhlmid_pdf_lscp ) THEN739 IF ( rhl_clr > rhlmid_pdf_lscp ) THEN 740 740 pdf_std = pdf_e1 * ( 2. * rhlmid_pdf_lscp - rhl_clr ) / rhlmid_pdf_lscp 741 741 ELSE … … 772 772 !--but does not cover the entire mesh. 773 773 ! 774 IF ( ( cldfra(i) .LT. ( 1. - dcf_con(i) - eps ) ) .AND. ( cldfra(i) .GT.eps ) &774 IF ( ( cldfra(i) < ( 1. - dcf_con(i) - eps ) ) .AND. ( cldfra(i) > eps ) & 775 775 .AND. .NOT. ok_warm_cloud ) THEN 776 776 … … 879 879 !--First, we mix the subsaturated sky (subfra_mix) and the cloud close 880 880 !--to this fraction (sigma_mix * cldfra_mix). 881 IF ( subfra(i) .GT.eps ) THEN881 IF ( subfra(i) > eps ) THEN 882 882 883 883 IF ( ok_unadjusted_clouds ) THEN … … 898 898 / ( subfra_mix + cldfra_mix * sigma_mix ) 899 899 900 IF ( qvapinmix .GT.qsat(i) ) THEN900 IF ( qvapinmix > qsat(i) ) THEN 901 901 !--If the mixed air is supersaturated, we condense the subsaturated 902 902 !--region which was mixed. … … 916 916 !--for which the mixed air is always supersatured, therefore 917 917 !--the cloud necessarily expands 918 IF ( issrfra(i) .GT.eps ) THEN918 IF ( issrfra(i) > eps ) THEN 919 919 920 920 IF ( ok_unadjusted_clouds ) THEN … … 994 994 !------------------------------------------- 995 995 996 IF ( cldfra(i) .LT.eps ) THEN996 IF ( cldfra(i) < eps ) THEN 997 997 !--If the cloud is too small, it is sublimated. 998 998 cldfra(i) = 0. -
Property
svn:mergeinfo
set to
(toggle deleted branches)
-
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_ini.F90
r5117 r5224 6 6 !-------------------- 7 7 8 REAL RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, R G, RV, RPI9 !$OMP THREADPRIVATE(RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, R G, RV, RPI)8 REAL RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RV, RG, RPI, EPS_W 9 !$OMP THREADPRIVATE(RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RV, RG, RPI, EPS_W) 10 10 11 11 REAL, SAVE, PROTECTED :: seuil_neb=0.001 ! cloud fraction threshold: a cloud can precipitate when exceeded … … 40 40 !$OMP THREADPRIVATE(ztfondue) 41 41 42 REAL, SAVE, PROTECTED :: temp_nowater=23 3.15 ! temperature below which liquid water no longer exists42 REAL, SAVE, PROTECTED :: temp_nowater=235.15 ! temperature below which liquid water no longer exists 43 43 !$OMP THREADPRIVATE(temp_nowater) 44 44 … … 140 140 !$OMP THREADPRIVATE(dist_liq) 141 141 142 REAL, SAVE, PROTECTED 142 REAL, SAVE, PROTECTED :: tresh_cl=0.0 ! cloud fraction threshold for cloud top search 143 143 !$OMP THREADPRIVATE(tresh_cl) 144 145 !--Parameters for condensation and ice supersaturation 146 LOGICAL, SAVE, PROTECTED :: ok_external_lognormal=.FALSE. ! if True, the lognormal condensation scheme is calculated in the lmdz_lscp_condensation routine 147 !$OMP THREADPRIVATE(ok_external_lognormal) 148 149 LOGICAL, SAVE, PROTECTED :: ok_ice_supersat=.FALSE. ! activates the condensation scheme that allows for ice supersaturation 150 !$OMP THREADPRIVATE(ok_ice_supersat) 151 152 LOGICAL, SAVE, PROTECTED :: ok_unadjusted_clouds=.FALSE. ! if True, relax the saturation adjustment assumption for ice clouds 153 !$OMP THREADPRIVATE(ok_unadjusted_clouds) 154 155 LOGICAL, SAVE, PROTECTED :: ok_weibull_warm_clouds=.FALSE. ! if True, the weibull condensation scheme replaces the lognormal condensation scheme at positive temperatures 156 !$OMP THREADPRIVATE(ok_weibull_warm_clouds) 157 158 INTEGER, SAVE, PROTECTED :: iflag_cloud_sublim_pdf=3 ! iflag for the distribution of water inside ice clouds 159 !$OMP THREADPRIVATE(iflag_cloud_sublim_pdf) 160 161 REAL, SAVE, PROTECTED :: depo_coef_cirrus=.5 ! [-] deposition coefficient for growth of ice crystals in cirrus clouds 162 !$OMP THREADPRIVATE(depo_coef_cirrus) 163 164 REAL, SAVE, PROTECTED :: capa_cond_cirrus=.5 ! [-] capacitance factor for growth/sublimation of ice crystals in cirrus clouds 165 !$OMP THREADPRIVATE(capa_cond_cirrus) 166 167 REAL, SAVE, PROTECTED :: mu_subl_pdf_lscp=1./3. ! [-] shape factor of the gamma distribution of water inside ice clouds 168 !$OMP THREADPRIVATE(mu_subl_pdf_lscp) 169 170 REAL, SAVE, PROTECTED :: beta_pdf_lscp=8.75E-4 ! [] tuning coefficient for the standard deviation of the PDF of water vapor in the clear sky region 171 !$OMP THREADPRIVATE(beta_pdf_lscp) 172 173 REAL, SAVE, PROTECTED :: temp_thresh_pdf_lscp=188. ! [K] factor for the PDF fit of water vapor in UTLS - below this temperature, water vapor is homogeneously distributed in the clear sky region 174 !$OMP THREADPRIVATE(temp_thresh_pdf_lscp) 175 176 REAL, SAVE, PROTECTED :: rhlmid_pdf_lscp=52.8 ! [%] factor for the PDF fit of water vapor in UTLS - below this rel hum wrt liq, std increases with RHliq, above it decreases with RHliq 177 !$OMP THREADPRIVATE(rhlmid_pdf_lscp) 178 179 REAL, SAVE, PROTECTED :: k0_pdf_lscp=2.80 ! [-] factor for the PDF fit of water vapor in UTLS 180 !$OMP THREADPRIVATE(k0_pdf_lscp) 181 182 REAL, SAVE, PROTECTED :: kappa_pdf_lscp=0.0236 ! [] factor for the PDF fit of water vapor in UTLS 183 !$OMP THREADPRIVATE(kappa_pdf_lscp) 184 185 REAL, SAVE, PROTECTED :: rhl0_pdf_lscp=88.7 ! [%] factor for the PDF fit of water vapor in UTLS 186 !$OMP THREADPRIVATE(rhl0_pdf_lscp) 187 188 REAL, SAVE, PROTECTED :: cond_thresh_pdf_lscp=1.E-10 ! [-] threshold for the formation of new cloud 189 !$OMP THREADPRIVATE(cond_thresh_pdf_lscp) 190 191 REAL, SAVE, PROTECTED :: a_homofreez=2.349 ! [-] factor for the Koop homogeneous freezing fit 192 !$OMP THREADPRIVATE(a_homofreez) 193 194 REAL, SAVE, PROTECTED :: b_homofreez=259. ! [K] factor for the Koop homogeneous freezing fit 195 !$OMP THREADPRIVATE(b_homofreez) 196 197 REAL, SAVE, PROTECTED :: delta_hetfreez=1. ! [-] value between 0 and 1 to simulate for heterogeneous freezing. 198 !$OMP THREADPRIVATE(delta_hetfreez) 199 200 REAL, SAVE, PROTECTED :: coef_mixing_lscp=1e-7 ! [-] tuning coefficient for the mixing process 201 !$OMP THREADPRIVATE(coef_mixing_lscp) 202 203 REAL, SAVE, PROTECTED :: coef_shear_lscp=0.1 ! [-] additional coefficient for the shearing process (subprocess of the mixing process) 204 !$OMP THREADPRIVATE(coef_shear_lscp) 205 206 REAL, SAVE, PROTECTED :: chi_mixing_lscp=1.1 ! [-] factor for the macro distribution of ISSRs wrt clouds in a gridbox 207 !$OMP THREADPRIVATE(chi_mixing_lscp) 208 209 ! REAL, SAVE, PROTECTED :: contrail_cross_section=200000. 210 ! !$OMP THREADPRIVATE(contrail_cross_section) 211 !--End of the parameters for condensation and ice supersaturation 144 212 145 213 !--Parameters for poprecip … … 247 315 CONTAINS 248 316 249 SUBROUTINE lscp_ini(dtime,lunout_in,prt_level_in,ok_ice_sursat, iflag_ratqs, fl_cor_ebil_in, RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in, & 250 RVTMP2_in, RTT_in,RD_in,RG_in,RV_in,RPI_in) 317 SUBROUTINE lscp_ini(dtime,lunout_in,prt_level_in,ok_ice_supersat_in, iflag_ratqs, fl_cor_ebil_in, & 318 RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in, RVTMP2_in, & 319 RTT_in, RD_in, RV_in, RG_in, RPI_in, EPS_W_in) 251 320 252 321 253 322 USE lmdz_ioipsl_getin_p, ONLY: getin_p 254 USE ice_sursat_mod, ONLY: ice_sursat_init255 323 USE lmdz_cloudth_ini, ONLY: cloudth_ini 256 324 USE lmdz_abort_physic, ONLY: abort_physic … … 258 326 REAL, INTENT(IN) :: dtime 259 327 INTEGER, INTENT(IN) :: lunout_in,prt_level_in,iflag_ratqs,fl_cor_ebil_in 260 LOGICAL, INTENT(IN) :: ok_ice_su rsat328 LOGICAL, INTENT(IN) :: ok_ice_supersat_in 261 329 262 330 REAL, INTENT(IN) :: RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in 263 REAL, INTENT(IN) :: RVTMP2_in, RTT_in, RD_in, RG_in, RV_in, RPI_in331 REAL, INTENT(IN) :: RVTMP2_in, RTT_in, RD_in, RV_in, RG_in, RPI_in, EPS_W_in 264 332 CHARACTER (LEN=20) :: modname='lscp_ini_mod' 265 333 CHARACTER (LEN=80) :: abort_message … … 270 338 fl_cor_ebil=fl_cor_ebil_in 271 339 340 ok_ice_supersat=ok_ice_supersat_in 341 272 342 RG=RG_in 273 343 RD=RD_in 344 RV=RV_in 274 345 RCPD=RCPD_in 275 346 RLVTT=RLVTT_in … … 280 351 RVTMP2=RVTMP2_in 281 352 RPI=RPI_in 353 EPS_W=EPS_W_in 282 354 283 355 … … 327 399 CALL getin_p('gamma_taud',gamma_taud) 328 400 CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp) 401 CALL getin_p('temp_nowater',temp_nowater) 402 ! for poprecip 329 403 CALL getin_p('ok_poprecip',ok_poprecip) 330 404 CALL getin_p('ok_corr_vap_evasub',ok_corr_vap_evasub) … … 346 420 CALL getin_p('snow_fallspeed_clr',snow_fallspeed_clr) 347 421 CALL getin_p('snow_fallspeed_cld',snow_fallspeed_cld) 422 ! for condensation and ice supersaturation 423 CALL getin_p('ok_external_lognormal',ok_external_lognormal) 424 CALL getin_p('ok_unadjusted_clouds',ok_unadjusted_clouds) 425 CALL getin_p('ok_weibull_warm_clouds',ok_weibull_warm_clouds) 426 CALL getin_p('iflag_cloud_sublim_pdf',iflag_cloud_sublim_pdf) 427 CALL getin_p('depo_coef_cirrus',depo_coef_cirrus) 428 CALL getin_p('capa_cond_cirrus',capa_cond_cirrus) 429 CALL getin_p('mu_subl_pdf_lscp',mu_subl_pdf_lscp) 430 CALL getin_p('beta_pdf_lscp',beta_pdf_lscp) 431 CALL getin_p('temp_thresh_pdf_lscp',temp_thresh_pdf_lscp) 432 CALL getin_p('rhlmid_pdf_lscp',rhlmid_pdf_lscp) 433 CALL getin_p('k0_pdf_lscp',k0_pdf_lscp) 434 CALL getin_p('kappa_pdf_lscp',kappa_pdf_lscp) 435 CALL getin_p('rhl0_pdf_lscp',rhl0_pdf_lscp) 436 CALL getin_p('cond_thresh_pdf_lscp',cond_thresh_pdf_lscp) 437 CALL getin_p('a_homofreez',a_homofreez) 438 CALL getin_p('b_homofreez',b_homofreez) 439 CALL getin_p('delta_hetfreez',delta_hetfreez) 440 CALL getin_p('coef_mixing_lscp',coef_mixing_lscp) 441 CALL getin_p('coef_shear_lscp',coef_shear_lscp) 442 CALL getin_p('chi_mixing_lscp',chi_mixing_lscp) 443 !CALL getin_p('contrail_cross_section',contrail_cross_section) 348 444 349 445 … … 391 487 WRITE(lunout,*) 'lscp_ini, iflag_oldbug_fisrtilp', iflag_oldbug_fisrtilp 392 488 WRITE(lunout,*) 'lscp_ini, fl_cor_ebil', fl_cor_ebil 489 WRITE(lunout,*) 'lscp_ini, temp_nowater', temp_nowater 490 ! for poprecip 393 491 WRITE(lunout,*) 'lscp_ini, ok_poprecip', ok_poprecip 394 492 WRITE(lunout,*) 'lscp_ini, ok_corr_vap_evasub', ok_corr_vap_evasub … … 404 502 WRITE(lunout,*) 'lscp_ini, snow_fallspeed_clr:', snow_fallspeed_clr 405 503 WRITE(lunout,*) 'lscp_ini, snow_fallspeed_cld:', snow_fallspeed_cld 504 ! for condensation and ice supersaturation 505 WRITE(lunout,*) 'lscp_ini, ok_external_lognormal:', ok_external_lognormal 506 WRITE(lunout,*) 'lscp_ini, ok_ice_supersat:', ok_ice_supersat 507 WRITE(lunout,*) 'lscp_ini, ok_unadjusted_clouds:', ok_unadjusted_clouds 508 WRITE(lunout,*) 'lscp_ini, ok_weibull_warm_clouds:', ok_weibull_warm_clouds 509 WRITE(lunout,*) 'lscp_ini, iflag_cloud_sublim_pdf:', iflag_cloud_sublim_pdf 510 WRITE(lunout,*) 'lscp_ini, depo_coef_cirrus:', depo_coef_cirrus 511 WRITE(lunout,*) 'lscp_ini, capa_cond_cirrus:', capa_cond_cirrus 512 WRITE(lunout,*) 'lscp_ini, mu_subl_pdf_lscp:', mu_subl_pdf_lscp 513 WRITE(lunout,*) 'lscp_ini, beta_pdf_lscp:', beta_pdf_lscp 514 WRITE(lunout,*) 'lscp_ini, temp_thresh_pdf_lscp:', temp_thresh_pdf_lscp 515 WRITE(lunout,*) 'lscp_ini, rhlmid_pdf_lscp:', rhlmid_pdf_lscp 516 WRITE(lunout,*) 'lscp_ini, k0_pdf_lscp:', k0_pdf_lscp 517 WRITE(lunout,*) 'lscp_ini, kappa_pdf_lscp:', kappa_pdf_lscp 518 WRITE(lunout,*) 'lscp_ini, rhl0_pdf_lscp:', rhl0_pdf_lscp 519 WRITE(lunout,*) 'lscp_ini, a_homofreez:', a_homofreez 520 WRITE(lunout,*) 'lscp_ini, b_homofreez:', b_homofreez 521 WRITE(lunout,*) 'lscp_ini, delta_hetfreez', delta_hetfreez 522 WRITE(lunout,*) 'lscp_ini, coef_mixing_lscp:', coef_mixing_lscp 523 WRITE(lunout,*) 'lscp_ini, coef_shear_lscp:', coef_shear_lscp 524 WRITE(lunout,*) 'lscp_ini, chi_mixing_lscp:', chi_mixing_lscp 525 ! WRITE(lunout,*) 'lscp_ini, contrail_cross_section:', contrail_cross_section 406 526 407 527 … … 423 543 424 544 545 !--Check flags for condensation and ice supersaturation 546 IF ( ok_external_lognormal .AND. ok_ice_supersat ) THEN 547 abort_message = 'in lscp, ok_external_lognormal=y is incompatible with ok_ice_supersat=y' 548 CALL abort_physic (modname,abort_message,1) 549 ENDIF 550 551 IF ( ok_weibull_warm_clouds .AND. .NOT. ok_ice_supersat ) THEN 552 abort_message = 'in lscp, ok_weibull_warm_clouds=y needs ok_ice_supersat=y' 553 CALL abort_physic (modname,abort_message,1) 554 ENDIF 555 556 IF ( ok_unadjusted_clouds .AND. .NOT. ok_ice_supersat ) THEN 557 abort_message = 'in lscp, ok_unadjusted_clouds=y needs ok_ice_supersat=y' 558 CALL abort_physic (modname,abort_message,1) 559 ENDIF 560 561 425 562 !AA Temporary initialisation 426 563 a_tr_sca(1) = -0.5 … … 428 565 a_tr_sca(3) = -0.5 429 566 a_tr_sca(4) = -0.5 430 431 IF (ok_ice_sursat) CALL ice_sursat_init()432 567 433 568 CALL cloudth_ini(iflag_cloudth_vert,iflag_ratqs) -
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_poprecip.F90
r5103 r5224 247 247 248 248 ELSEIF ( ( rain(i) + snow(i) ) <= 0. ) THEN 249 250 249 !--If no precip, we reinitialize the cloud fraction used for the precip to 0 251 250 precipfraccld(i) = 0. -
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90
r5174 r5224 445 445 mean_pdf = sursat_env * 1. / tau_mixingenv / (invtau_phaserelax + 1. / tau_mixingenv) 446 446 cldfraliq(i) = 0.5 * (1. - erf((sursat_iceliq - mean_pdf) / (SQRT(2. * sigma2_pdf)))) 447 IF (cldfraliq(i) .GT.liqfra_max) THEN447 IF (cldfraliq(i) > liqfra_max) THEN 448 448 cldfraliq(i) = liqfra_max 449 449 ENDIF … … 502 502 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 503 503 USE lmdz_yoethf 504 505 USE lmdz_yomcst 504 USE lmdz_yomcst, ONLY: rcpd, retv, rlstt, rlvtt 505 USE lmdz_lscp_ini, ONLY: iflag_gammasat, temp_nowater, RTT 506 USE lmdz_lscp_ini, ONLY: a_homofreez, b_homofreez, delta_hetfreez 506 507 507 508 IMPLICIT NONE 508 INCLUDE "FCTTRE.h"509 INCLUDE "FCTTRE.h" 509 510 510 511 INTEGER, INTENT(IN) :: klon ! number of horizontal grid points … … 564 565 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 565 566 566 USE lmdz_lscp_ini, ONLY: iflag_gammasat, t_glace_min, RTT 567 USE lmdz_lscp_ini, ONLY: iflag_gammasat, temp_nowater, RTT 568 USE lmdz_lscp_ini, ONLY: a_homofreez, b_homofreez, delta_hetfreez 567 569 568 570 IMPLICIT NONE … … 578 580 579 581 REAL, DIMENSION(klon) :: qsi, qsl, dqsl, dqsi 580 REAL fcirrus, fac 581 REAL, PARAMETER :: acirrus = 2.349 582 REAL, PARAMETER :: bcirrus = 259.0 582 REAL f_homofreez, fac 583 583 584 584 INTEGER i … … 594 594 dgammasatdt(i) = 0. 595 595 596 ELSEIF ((temp(i) < RTT) .AND. (temp(i) > t_glace_min)) THEN 597 598 IF (iflag_gammasat >= 2) THEN 599 gammasat(i) = qsl(i) / qsi(i) 600 dgammasatdt(i) = (dqsl(i) * qsi(i) - dqsi(i) * qsl(i)) / qsi(i) / qsi(i) 596 ELSE 597 ! cold clouds: qsi > qsl 598 599 ! homogeneous freezing of aerosols, according to 600 ! Koop, 2000 and Ren and MacKenzie, 2005 (QJRMS) 601 ! 'Cirrus regime' 602 ! if f_homofreez > qsl / qsi, liquid nucleation 603 ! if f_homofreez < qsl / qsi, homogeneous freezing of aerosols 604 ! Note: f_homofreez = qsl / qsi for temp ~= -38degC 605 f_homofreez = a_homofreez - temp(i) / b_homofreez 606 607 IF (iflag_gammasat >= 3) THEN 608 ! condensation at homogeneous freezing threshold for temp < -38 degC 609 ! condensation at liquid saturation for temp > -38 degC 610 IF (f_homofreez <= qsl(i) / qsi(i)) THEN 611 gammasat(i) = f_homofreez 612 dgammasatdt(i) = - 1. / b_homofreez 613 ELSE 614 gammasat(i) = qsl(i) / qsi(i) 615 dgammasatdt(i) = (dqsl(i) * qsi(i) - dqsi(i) * qsl(i)) / qsi(i) / qsi(i) 616 END IF 617 618 ELSE IF ( iflag_gammasat == 2 ) THEN 619 ! condensation at homogeneous freezing threshold for temp < -38 degC 620 ! condensation at a threshold linearly decreasing between homogeneous 621 ! freezing and ice saturation for -38 degC < temp < temp_nowater 622 ! condensation at ice saturation for temp > temp_nowater 623 ! If temp_nowater = 235.15 K, this is equivalent to iflag_gammasat = 1 624 IF ( f_homofreez <= qsl(i) / qsi(i) ) THEN 625 gammasat(i) = f_homofreez 626 dgammasatdt(i) = - 1. / b_homofreez 627 ELSE IF ( temp(i) <= temp_nowater ) THEN 628 ! Here, we assume that f_homofreez = qsl / qsi for temp = -38 degC = 235.15 K 629 dgammasatdt(i) = ( a_homofreez - 235.15 / b_homofreez - 1. ) & 630 / ( 235.15 - temp_nowater ) 631 gammasat(i) = dgammasatdt(i) * ( temp(i) - temp_nowater ) + 1. 632 ELSE 633 gammasat(i) = 1. 634 dgammasatdt(i) = 0. 635 END IF 636 637 ELSE IF (iflag_gammasat == 1) THEN 638 ! condensation at homogeneous freezing threshold for temp < -38 degC 639 ! condensation at ice saturation for temp > -38 degC 640 IF (f_homofreez <= qsl(i) / qsi(i)) THEN 641 gammasat(i) = f_homofreez 642 dgammasatdt(i) = - 1. / b_homofreez 643 ELSE 644 gammasat(i) = 1. 645 dgammasatdt(i) = 0. 646 END IF 647 648 601 649 ELSE 650 ! condensation at ice saturation for temp < -38 degC 651 ! condensation at ice saturation for temp > -38 degC 602 652 gammasat(i) = 1. 603 653 dgammasatdt(i) = 0. 604 ENDIF 605 606 ELSE 607 608 IF (iflag_gammasat >=1) THEN 609 ! homogeneous freezing of aerosols, according to 610 ! Koop, 2000 and Karcher 2008, QJRMS 611 ! 'Cirrus regime' 612 fcirrus = acirrus - temp(i) / bcirrus 613 IF (fcirrus > qsl(i) / qsi(i)) THEN 614 gammasat(i) = qsl(i) / qsi(i) 615 dgammasatdt(i) = (dqsl(i) * qsi(i) - dqsi(i) * qsl(i)) / qsi(i) / qsi(i) 616 ELSE 617 gammasat(i) = fcirrus 618 dgammasatdt(i) = -1.0 / bcirrus 619 ENDIF 620 621 ELSE 622 623 gammasat(i) = 1. 624 dgammasatdt(i) = 0. 625 626 ENDIF 627 628 ENDIF 654 END IF 655 656 ! Note that the delta_hetfreez parameter allows to linearly decrease the 657 ! condensation threshold between the calculated threshold and the ice saturation 658 ! for delta_hetfreez = 1, the threshold is the calculated condensation threshold 659 ! for delta_hetfreez = 0, the threshold is the ice saturation 660 gammasat(i) = (1. - delta_hetfreez) + delta_hetfreez * gammasat(i) 661 dgammasatdt(i) = delta_hetfreez * dgammasatdt(i) 662 663 END IF 629 664 630 665 END DO … … 702 737 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 703 738 739 740 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 741 FUNCTION GAMMAINC (p, x) 742 743 !*****************************************************************************80 744 ! 745 !! GAMMAINC computes the regularized lower incomplete Gamma Integral 746 ! 747 ! Modified: 748 ! 749 ! 20 January 2008 750 ! 751 ! Author: 752 ! 753 ! Original FORTRAN77 version by B Shea. 754 ! FORTRAN90 version by John Burkardt. 755 ! 756 ! Reference: 757 ! 758 ! B Shea, 759 ! Algorithm AS 239: 760 ! Chi-squared and Incomplete Gamma Integral, 761 ! Applied Statistics, 762 ! Volume 37, Number 3, 1988, pages 466-473. 763 ! 764 ! Parameters: 765 ! 766 ! Input, real X, P, the parameters of the incomplete 767 ! gamma ratio. 0 <= X, and 0 < P. 768 ! 769 ! Output, real GAMMAINC, the value of the incomplete 770 ! Gamma integral. 771 ! 772 IMPLICIT NONE 773 774 REAL A 775 REAL AN 776 REAL ARG 777 REAL B 778 REAL C 779 REAL, PARAMETER :: ELIMIT = - 88.0E+00 780 REAL GAMMAINC 781 REAL, PARAMETER :: OFLO = 1.0E+37 782 REAL P 783 REAL, PARAMETER :: PLIMIT = 1000.0E+00 784 REAL PN1 785 REAL PN2 786 REAL PN3 787 REAL PN4 788 REAL PN5 789 REAL PN6 790 REAL RN 791 REAL, PARAMETER :: TOL = 1.0E-14 792 REAL X 793 REAL, PARAMETER :: XBIG = 1.0E+08 794 795 GAMMAINC = 0.0E+00 796 797 IF (X == 0.0E+00) THEN 798 GAMMAINC = 0.0E+00 799 RETURN 800 END IF 801 ! 802 ! IF P IS LARGE, USE A NORMAL APPROXIMATION. 803 ! 804 IF (PLIMIT < P) THEN 805 806 PN1 = 3.0E+00 * SQRT (P) * ((X / P)**(1.0E+00 / 3.0E+00) & 807 + 1.0E+00 / (9.0E+00 * P) - 1.0E+00) 808 809 GAMMAINC = 0.5E+00 * (1. + ERF (PN1)) 810 RETURN 811 812 END IF 813 ! 814 ! IF X IS LARGE SET GAMMAD = 1. 815 ! 816 IF (XBIG < X) THEN 817 GAMMAINC = 1.0E+00 818 RETURN 819 END IF 820 ! 821 ! USE PEARSON'S SERIES EXPANSION. 822 ! (NOTE THAT P IS NOT LARGE ENOUGH TO FORCE OVERFLOW IN ALOGAM). 823 ! 824 IF (X <= 1.0E+00 .OR. X < P) THEN 825 826 ARG = P * LOG (X) - X - LOG_GAMMA (P + 1.0E+00) 827 C = 1.0E+00 828 GAMMAINC = 1.0E+00 829 A = P 830 831 DO 832 833 A = A + 1.0E+00 834 C = C * X / A 835 GAMMAINC = GAMMAINC + C 836 837 IF (C <= TOL) THEN 838 EXIT 839 END IF 840 841 END DO 842 843 ARG = ARG + LOG (GAMMAINC) 844 845 IF (ELIMIT <= ARG) THEN 846 GAMMAINC = EXP (ARG) 847 ELSE 848 GAMMAINC = 0.0E+00 849 END IF 850 ! 851 ! USE A CONTINUED FRACTION EXPANSION. 852 ! 853 ELSE 854 855 ARG = P * LOG (X) - X - LOG_GAMMA (P) 856 A = 1.0E+00 - P 857 B = A + X + 1.0E+00 858 C = 0.0E+00 859 PN1 = 1.0E+00 860 PN2 = X 861 PN3 = X + 1.0E+00 862 PN4 = X * B 863 GAMMAINC = PN3 / PN4 864 865 DO 866 867 A = A + 1.0E+00 868 B = B + 2.0E+00 869 C = C + 1.0E+00 870 AN = A * C 871 PN5 = B * PN3 - AN * PN1 872 PN6 = B * PN4 - AN * PN2 873 874 IF (PN6 /= 0.0E+00) THEN 875 876 RN = PN5 / PN6 877 878 IF (ABS (GAMMAINC - RN) <= MIN (TOL, TOL * RN)) THEN 879 EXIT 880 END IF 881 882 GAMMAINC = RN 883 884 END IF 885 886 PN1 = PN3 887 PN2 = PN4 888 PN3 = PN5 889 PN4 = PN6 890 ! 891 ! RE-SCALE TERMS IN CONTINUED FRACTION IF TERMS ARE LARGE. 892 ! 893 IF (OFLO <= ABS (PN5)) THEN 894 PN1 = PN1 / OFLO 895 PN2 = PN2 / OFLO 896 PN3 = PN3 / OFLO 897 PN4 = PN4 / OFLO 898 END IF 899 900 END DO 901 902 ARG = ARG + LOG (GAMMAINC) 903 904 IF (ELIMIT <= ARG) THEN 905 GAMMAINC = 1.0E+00 - EXP (ARG) 906 ELSE 907 GAMMAINC = 1.0E+00 908 END IF 909 910 END IF 911 912 RETURN 913 END FUNCTION GAMMAINC 914 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 915 704 916 END MODULE lmdz_lscp_tools 705 917 -
LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_mod.F90
r5221 r5224 1 ! $Id$2 3 1 MODULE phyetat0_mod 4 2 USE lmdz_abort_physic, ONLY: abort_physic … … 21 19 du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, & 22 20 falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, & 23 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, & 21 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, & 22 cf_ancien, rvc_ancien, radpas, radsol, rain_fall, ratqs, & 24 23 rnebcon, rugoro, sig1, snow_fall, bs_fall, solaire_etat0, sollw, sollwdown, & 25 24 solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, & … … 397 396 ancien_ok = ancien_ok.AND.phyetat0_get(ql_ancien, "QLANCIEN", "QLANCIEN", 0.) 398 397 ancien_ok = ancien_ok.AND.phyetat0_get(qs_ancien, "QSANCIEN", "QSANCIEN", 0.) 399 ancien_ok = ancien_ok.AND.phyetat0_get(rneb_ancien, "RNEBANCIEN", "RNEBANCIEN", 0.)400 398 ancien_ok = ancien_ok.AND.phyetat0_get(u_ancien, "UANCIEN", "UANCIEN", 0.) 401 399 ancien_ok = ancien_ok.AND.phyetat0_get(v_ancien, "VANCIEN", "VANCIEN", 0.) … … 413 411 ENDIF 414 412 413 ! cas specifique des variables de la sursaturation par rapport a la glace 414 IF (ok_ice_supersat) THEN 415 ancien_ok = ancien_ok.AND.phyetat0_get(cf_ancien, "CFANCIEN", "CFANCIEN", 0.) 416 ancien_ok = ancien_ok.AND.phyetat0_get(rvc_ancien, "RVCANCIEN", "RVCANCIEN", 0.) 417 ELSE 418 cf_ancien(:, :) = 0. 419 rvc_ancien(:, :) = 0. 420 ENDIF 421 415 422 ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain 416 423 ! dummy values (as is the case when generated by ce0l, … … 419 426 (maxval(ql_ancien)==minval(ql_ancien)) .OR. & 420 427 (maxval(qs_ancien)==minval(qs_ancien)) .OR. & 421 (maxval(rneb_ancien)==minval(rneb_ancien)) .OR. &422 428 (maxval(prw_ancien)==minval(prw_ancien)) .OR. & 423 429 (maxval(prlw_ancien)==minval(prlw_ancien)) .OR. & … … 431 437 (maxval(prbsw_ancien)==minval(prbsw_ancien))) THEN 432 438 ancien_ok = .FALSE. 439 ENDIF 440 ENDIF 441 442 IF (ok_ice_supersat) THEN 443 IF ((maxval(cf_ancien)==minval(cf_ancien)) .OR. & 444 (maxval(rvc_ancien)==minval(rvc_ancien))) THEN 445 ancien_ok = .false. 433 446 ENDIF 434 447 ENDIF -
LMDZ6/branches/Amaury_dev/libf/phylmd/phyredem.F90
r5139 r5224 1 ! $Id$2 3 1 SUBROUTINE phyredem(fichnom) 4 2 … … 18 16 zval, rugoro, t_ancien, q_ancien, & 19 17 prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, & 20 ql_ancien, qs_ancien, qbs_ancien, rneb_ancien, u_ancien, &18 ql_ancien, qs_ancien, qbs_ancien, cf_ancien, rvc_ancien, u_ancien, & 21 19 v_ancien, clwcon, rnebcon, ratqs, pbl_tke, & 22 20 wake_delta_pbl_tke, zmax0, f0, sig1, w01, & … … 250 248 ENDIF 251 249 252 CALL put_field(pass, "RNEBANCIEN", "RNEBANCIEN", rneb_ancien) 250 IF (ok_ice_supersat) THEN 251 CALL put_field(pass, "CFANCIEN", "CFANCIEN", cf_ancien) 252 CALL put_field(pass, "RVCANCIEN", "RVCANCIEN", rvc_ancien) 253 ENDIF 253 254 254 255 CALL put_field(pass, "PRWANCIEN", "PRWANCIEN", prw_ancien) -
LMDZ6/branches/Amaury_dev/libf/phylmd/phys_local_var_mod.F90
r5219 r5224 1 2 ! $Id$3 4 1 MODULE phys_local_var_mod 5 2 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_STRATAER … … 23 20 REAL, SAVE, ALLOCATABLE :: u_seri(:, :), v_seri(:, :) 24 21 !$OMP THREADPRIVATE(u_seri, v_seri) 25 REAL, SAVE, ALLOCATABLE :: rneb_seri(:, :) 26 !$OMP THREADPRIVATE(rneb_seri) 27 REAL, SAVE, ALLOCATABLE :: d_rneb_dyn(:, :) 28 !$OMP THREADPRIVATE(d_rneb_dyn) 22 REAL, SAVE, ALLOCATABLE :: cf_seri(:,:), rvc_seri(:,:) 23 !$OMP THREADPRIVATE(cf_seri, rvc_seri) 29 24 REAL, SAVE, ALLOCATABLE :: l_mixmin(:, :, :), l_mix(:, :, :), wprime(:, :, :) 30 25 !$OMP THREADPRIVATE(l_mixmin, l_mix, wprime) … … 45 40 REAL, SAVE, ALLOCATABLE :: d_u_dyn(:, :), d_v_dyn(:, :) 46 41 !$OMP THREADPRIVATE(d_u_dyn, d_v_dyn) 42 REAL, SAVE, ALLOCATABLE :: d_cf_dyn(:, :), d_rvc_dyn(:, :) 43 !$OMP THREADPRIVATE(d_cf_dyn, d_rvc_dyn) 47 44 REAL, SAVE, ALLOCATABLE :: d_tr_dyn(:, :, :) 48 45 !$OMP THREADPRIVATE(d_tr_dyn) … … 640 637 !$OMP THREADPRIVATE(zn2mout) 641 638 642 REAL, SAVE, ALLOCATABLE :: qclr(:, :) 643 !$OMP THREADPRIVATE(qclr) 644 REAL, SAVE, ALLOCATABLE :: qcld(:, :) 645 !$OMP THREADPRIVATE(qcld) 646 REAL, SAVE, ALLOCATABLE :: qss(:, :) 647 !$OMP THREADPRIVATE(qss) 648 REAL, SAVE, ALLOCATABLE :: qvc(:, :) 649 !$OMP THREADPRIVATE(qvc) 650 REAL, SAVE, ALLOCATABLE :: rnebclr(:, :) 651 !$OMP THREADPRIVATE(rnebclr) 652 REAL, SAVE, ALLOCATABLE :: rnebss(:, :) 653 !$OMP THREADPRIVATE(rnebss) 654 REAL, SAVE, ALLOCATABLE :: gamma_ss(:, :) 655 !$OMP THREADPRIVATE(gamma_ss) 656 REAL, SAVE, ALLOCATABLE :: N1_ss(:, :) 657 !$OMP THREADPRIVATE(N1_ss) 658 REAL, SAVE, ALLOCATABLE :: N2_ss(:, :) 659 !$OMP THREADPRIVATE(N2_ss) 660 REAL, SAVE, ALLOCATABLE :: drneb_sub(:, :) 661 !$OMP THREADPRIVATE(drneb_sub) 662 REAL, SAVE, ALLOCATABLE :: drneb_con(:, :) 663 !$OMP THREADPRIVATE(drneb_con) 664 REAL, SAVE, ALLOCATABLE :: drneb_tur(:, :) 665 !$OMP THREADPRIVATE(drneb_tur) 666 REAL, SAVE, ALLOCATABLE :: drneb_avi(:, :) 667 !$OMP THREADPRIVATE(drneb_avi) 668 REAL, SAVE, ALLOCATABLE :: zqsatl(:, :) 669 !$OMP THREADPRIVATE(zqsatl) 670 REAL, SAVE, ALLOCATABLE :: zqsats(:, :) 671 !$OMP THREADPRIVATE(zqsats) 672 REAL, SAVE, ALLOCATABLE :: Tcontr(:, :) 673 !$OMP THREADPRIVATE(Tcontr) 674 REAL, SAVE, ALLOCATABLE :: qcontr(:, :) 675 !$OMP THREADPRIVATE(qcontr) 676 REAL, SAVE, ALLOCATABLE :: qcontr2(:, :) 677 !$OMP THREADPRIVATE(qcontr2) 678 REAL, SAVE, ALLOCATABLE :: fcontrN(:, :) 679 !$OMP THREADPRIVATE(fcontrN) 680 REAL, SAVE, ALLOCATABLE :: fcontrP(:, :) 681 !$OMP THREADPRIVATE(fcontrP) 639 !-- LSCP - condensation and ice supersaturation variables 640 REAL, SAVE, ALLOCATABLE :: qsub(:,:), qissr(:,:), qcld(:,:) 641 !$OMP THREADPRIVATE(qsub, qissr, qcld) 642 REAL, SAVE, ALLOCATABLE :: subfra(:,:), issrfra(:,:) 643 !$OMP THREADPRIVATE(subfra, issrfra) 644 REAL, SAVE, ALLOCATABLE :: gamma_cond(:,:) 645 !$OMP THREADPRIVATE(gamma_cond) 646 REAL, SAVE, ALLOCATABLE :: ratio_qi_qtot(:,:) 647 !$OMP THREADPRIVATE(ratio_qi_qtot) 648 REAL, SAVE, ALLOCATABLE :: dcf_sub(:,:), dcf_con(:,:), dcf_mix(:,:) 649 !$OMP THREADPRIVATE(dcf_sub, dcf_con, dcf_mix) 650 REAL, SAVE, ALLOCATABLE :: dqi_adj(:,:), dqi_sub(:,:), dqi_con(:,:), dqi_mix(:,:) 651 !$OMP THREADPRIVATE(dqi_adj, dqi_sub, dqi_con, dqi_mix) 652 REAL, SAVE, ALLOCATABLE :: dqvc_adj(:,:), dqvc_sub(:,:), dqvc_con(:,:), dqvc_mix(:,:) 653 !$OMP THREADPRIVATE(dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix) 654 REAL, SAVE, ALLOCATABLE :: qsatliq(:,:), qsatice(:,:) 655 !$OMP THREADPRIVATE(qsatliq, qsatice) 656 657 !-- LSCP - aviation and contrails variables 658 REAL, SAVE, ALLOCATABLE :: Tcontr(:,:), qcontr(:,:), qcontr2(:,:) 659 !$OMP THREADPRIVATE(Tcontr, qcontr, qcontr2) 660 REAL, SAVE, ALLOCATABLE :: fcontrN(:,:), fcontrP(:,:) 661 !$OMP THREADPRIVATE(fcontrN, fcontrP) 662 REAL, SAVE, ALLOCATABLE :: dcf_avi(:,:), dqi_avi(:,:), dqvc_avi(:,:) 663 !$OMP THREADPRIVATE(dcf_avi, dqi_avi, dqvc_avi) 664 REAL, SAVE, ALLOCATABLE :: flight_dist(:,:), flight_h2o(:,:) 665 !$OMP THREADPRIVATE(flight_dist, flight_h2o) 666 667 !-- LSCP - mixed phase clouds variables 682 668 REAL, SAVE, ALLOCATABLE :: distcltop(:, :) 683 669 !$OMP THREADPRIVATE(distcltop) … … 686 672 687 673 688 !-- POPRECIP variables674 !-- LSCP - POPRECIP variables 689 675 REAL, SAVE, ALLOCATABLE :: qraindiag(:, :) 690 676 !$OMP THREADPRIVATE(qraindiag) … … 831 817 ! SN 832 818 ALLOCATE(u_seri(klon, klev), v_seri(klon, klev)) 819 ALLOCATE(cf_seri(klon, klev), rvc_seri(klon, klev)) 833 820 ALLOCATE(l_mixmin(klon, klev + 1, nbsrf), l_mix(klon, klev + 1, nbsrf), wprime(klon, klev + 1, nbsrf)) 834 821 ALLOCATE(pbl_eps(klon, klev + 1, nbsrf + 1)) … … 843 830 ALLOCATE(d_q_dyn2d(klon), d_ql_dyn2d(klon), d_qs_dyn2d(klon), d_qbs_dyn2d(klon)) 844 831 ALLOCATE(d_u_dyn(klon, klev), d_v_dyn(klon, klev)) 832 ALLOCATE(d_cf_dyn(klon,klev),d_rvc_dyn(klon,klev)) 845 833 ALLOCATE(d_tr_dyn(klon, klev, nbtr)) !RomP 846 834 ALLOCATE(d_t_con(klon, klev), d_q_con(klon, klev), d_q_con_zmasse(klon, klev)) … … 1206 1194 ALLOCATE(zn2mout(klon, 6)) 1207 1195 1208 ! Supersaturation 1209 ALLOCATE(rneb_seri(klon, klev)) 1210 ALLOCATE(d_rneb_dyn(klon, klev)) 1211 ALLOCATE(qclr(klon, klev), qcld(klon, klev), qss(klon, klev), qvc(klon, klev)) 1212 ALLOCATE(rnebclr(klon, klev), rnebss(klon, klev), gamma_ss(klon, klev)) 1213 ALLOCATE(N1_ss(klon, klev), N2_ss(klon, klev)) 1214 ALLOCATE(drneb_sub(klon, klev), drneb_con(klon, klev), drneb_tur(klon, klev), drneb_avi(klon, klev)) 1215 ALLOCATE(zqsatl(klon, klev), zqsats(klon, klev)) 1216 ALLOCATE(Tcontr(klon, klev), qcontr(klon, klev), qcontr2(klon, klev), fcontrN(klon, klev), fcontrP(klon, klev)) 1217 1218 !--POPRECIP variables 1196 !-- LSCP - condensation and ice supersaturation variables 1197 ALLOCATE(qsub(klon,klev), qissr(klon,klev), qcld(klon,klev)) 1198 ALLOCATE(subfra(klon,klev), issrfra(klon,klev)) 1199 ALLOCATE(gamma_cond(klon,klev), ratio_qi_qtot(klon,klev)) 1200 ALLOCATE(dcf_sub(klon,klev), dcf_con(klon,klev), dcf_mix(klon,klev)) 1201 ALLOCATE(dqi_adj(klon,klev), dqi_sub(klon,klev), dqi_con(klon,klev), dqi_mix(klon,klev)) 1202 ALLOCATE(dqvc_adj(klon,klev), dqvc_sub(klon,klev), dqvc_con(klon,klev), dqvc_mix(klon,klev)) 1203 ALLOCATE(qsatliq(klon,klev), qsatice(klon,klev)) 1204 1205 !-- LSCP - aviation and contrails variables 1206 ALLOCATE(Tcontr(klon,klev), qcontr(klon,klev), qcontr2(klon,klev)) 1207 ALLOCATE(fcontrN(klon,klev), fcontrP(klon,klev)) 1208 ALLOCATE(dcf_avi(klon,klev), dqi_avi(klon,klev), dqvc_avi(klon,klev)) 1209 ALLOCATE(flight_dist(klon,klev), flight_h2o(klon,klev)) 1210 1211 !-- LSCP - POPRECIP variables 1219 1212 ALLOCATE(qraindiag(klon, klev), qsnowdiag(klon, klev)) 1220 1213 ALLOCATE(dqreva(klon, klev), dqssub(klon, klev)) … … 1285 1278 ! SN 1286 1279 DEALLOCATE(u_seri, v_seri) 1280 DEALLOCATE(cf_seri,rvc_seri) 1287 1281 DEALLOCATE(l_mixmin, l_mix, wprime) 1288 1282 DEALLOCATE(tke_shear, tke_buoy, tke_trans) … … 1294 1288 DEALLOCATE(d_q_dyn2d, d_ql_dyn2d, d_qs_dyn2d, d_qbs_dyn2d) 1295 1289 DEALLOCATE(d_u_dyn, d_v_dyn) 1290 DEALLOCATE(d_cf_dyn,d_rvc_dyn) 1296 1291 DEALLOCATE(d_tr_dyn) !RomP 1297 1292 DEALLOCATE(d_t_con, d_q_con, d_q_con_zmasse) … … 1604 1599 DEALLOCATE(zn2mout) 1605 1600 1606 ! Supersaturation 1607 DEALLOCATE(rneb_seri) 1608 DEALLOCATE(d_rneb_dyn) 1609 DEALLOCATE(qclr, qcld, qss, qvc) 1610 DEALLOCATE(rnebclr, rnebss, gamma_ss) 1611 DEALLOCATE(N1_ss, N2_ss) 1612 DEALLOCATE(drneb_sub, drneb_con, drneb_tur, drneb_avi) 1613 DEALLOCATE(zqsatl, zqsats) 1614 DEALLOCATE(Tcontr, qcontr, qcontr2, fcontrN, fcontrP) 1615 1616 !--POPRECIP variables 1601 !-- LSCP - condensation and ice supersaturation variables 1602 DEALLOCATE(qsub, qissr, qcld) 1603 DEALLOCATE(subfra, issrfra) 1604 DEALLOCATE(gamma_cond, ratio_qi_qtot) 1605 DEALLOCATE(dcf_sub, dcf_con, dcf_mix) 1606 DEALLOCATE(dqi_adj, dqi_sub, dqi_con, dqi_mix) 1607 DEALLOCATE(dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix) 1608 DEALLOCATE(qsatliq, qsatice) 1609 1610 !-- LSCP - aviation and contrails variables 1611 DEALLOCATE(Tcontr, qcontr, qcontr2) 1612 DEALLOCATE(fcontrN, fcontrP) 1613 DEALLOCATE(dcf_avi, dqi_avi, dqvc_avi) 1614 DEALLOCATE(flight_dist, flight_h2o) 1615 1616 !-- LSCP - POPRECIP variables 1617 1617 DEALLOCATE(qraindiag, qsnowdiag) 1618 1618 DEALLOCATE(dqreva, dqssub) -
LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_ctrlout_mod.F90
r5219 r5224 1 2 ! $Id$3 4 1 MODULE phys_output_ctrlout_mod 5 2 … … 450 447 TYPE(ctrl_out), SAVE :: o_SWdn200clr = ctrl_out((/ 10, 1, 10, 10, 10, 10, 11, 11, 11, 11/), & 451 448 'SWdn200clr', 'SWdn clear sky at 200mb', 'W/m2', (/ ('', i=1, 10) /)) 452 453 ! arajouter 454 ! type(ctrl_out),save :: o_LWupTOA = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'LWupTOA', & 455 ! (/ ('', i=1, 10) /)) 456 ! type(ctrl_out),save :: o_LWupTOAclr = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'LWupTOAclr', & 457 ! (/ ('', i=1, 10) /)) 449 TYPE(ctrl_out), SAVE :: o_LWupTOA = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11/), & 450 'LWupTOA', 'LWup at TOA', 'W/m2', (/ ('', i=1, 10) /)) 451 TYPE(ctrl_out), SAVE :: o_LWupTOAclr = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11/), & 452 'LWupTOAclr', 'LWup clear sky at TOA', 'W/m2', (/ ('', i=1, 10) /)) 458 453 ! type(ctrl_out),save :: o_LWdnTOA = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'LWdnTOA', & 459 454 ! (/ ('', i=1, 10) /)) … … 2118 2113 'albslw3', 'Surface albedo LW3', '-', (/ ('', i=1, 10) /)) 2119 2114 2120 !--aviation & supersaturation 2121 TYPE(ctrl_out), SAVE :: o_oclr = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2122 'oclr', 'Clear sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2123 TYPE(ctrl_out), SAVE :: o_ocld = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2124 'ocld', 'Cloudy sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2125 TYPE(ctrl_out), SAVE :: o_oss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2126 'oss', 'ISSR total water', 'kg/kg', (/ ('', i=1, 10) /)) 2127 TYPE(ctrl_out), SAVE :: o_ovc = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2128 'ovc', 'In-cloup vapor', 'kg/kg', (/ ('', i=1, 10) /)) 2129 TYPE(ctrl_out), SAVE :: o_rnebclr = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2130 'rnebclr', 'Clear sky fraction', '-', (/ ('', i=1, 10) /)) 2131 TYPE(ctrl_out), SAVE :: o_rnebss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2132 'rnebss', 'ISSR fraction', '-', (/ ('', i=1, 10) /)) 2133 TYPE(ctrl_out), SAVE :: o_rnebseri = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2134 'rnebseri', 'Cloud fraction', '-', (/ ('', i=1, 10) /)) 2135 TYPE(ctrl_out), SAVE :: o_gammass = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2136 'gammass', 'Gamma supersaturation', '', (/ ('', i=1, 10) /)) 2137 TYPE(ctrl_out), SAVE :: o_N1_ss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2138 'N1ss', 'N1', '', (/ ('', i=1, 10) /)) 2139 TYPE(ctrl_out), SAVE :: o_N2_ss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2140 'N2ss', 'N2', '', (/ ('', i=1, 10) /)) 2141 TYPE(ctrl_out), SAVE :: o_drnebsub = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2142 'drnebsub', 'Cloud fraction change because of sublimation', 's-1', (/ ('', i=1, 10) /)) 2143 TYPE(ctrl_out), SAVE :: o_drnebcon = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2144 'drnebcon', 'Cloud fraction change because of condensation', 's-1', (/ ('', i=1, 10) /)) 2145 TYPE(ctrl_out), SAVE :: o_drnebtur = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2146 'drnebtur', 'Cloud fraction change because of turbulence', 's-1', (/ ('', i=1, 10) /)) 2147 TYPE(ctrl_out), SAVE :: o_drnebavi = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2148 'drnebavi', 'Cloud fraction change because of aviation', 's-1', (/ ('', i=1, 10) /)) 2149 TYPE(ctrl_out), SAVE :: o_qsatl = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2150 'qsatl', 'Saturation with respect to liquid water', '', (/ ('', i=1, 10) /)) 2151 TYPE(ctrl_out), SAVE :: o_qsats = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2152 'qsats', 'Saturation with respect to solid water', '', (/ ('', i=1, 10) /)) 2153 TYPE(ctrl_out), SAVE :: o_flight_m = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2154 'flightm', 'Flown meters', 'm/s/mesh', (/ ('', i=1, 10) /)) 2155 TYPE(ctrl_out), SAVE :: o_flight_h2o = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2156 'flighth2o', 'H2O flight emission', 'kg H2O/s/mesh', (/ ('', i=1, 10) /)) 2157 TYPE(ctrl_out), SAVE :: o_Tcontr = ctrl_out((/ 1, 1, 1, 1, 11, 11, 11, 11, 11, 11/),& 2115 !-- LSCP - condensation and ice supersaturation variables 2116 TYPE(ctrl_out), SAVE :: o_cfseri = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2117 'cfseri', 'Cloud fraction', '-', (/ ('', i=1, 10) /)) 2118 TYPE(ctrl_out), SAVE :: o_dcfdyn = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2119 'dcfdyn', 'Dynamics cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2120 TYPE(ctrl_out), SAVE :: o_rvcseri = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2121 'rvcseri', 'Cloudy water vapor to total water vapor ratio', '-', (/ ('', i=1, 10) /)) 2122 TYPE(ctrl_out), SAVE :: o_drvcdyn = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2123 'drvcdyn', 'Dynamics cloudy water vapor to total water vapor ratio tendency', 's-1', (/ ('', i=1, 10) /)) 2124 TYPE(ctrl_out), SAVE :: o_qsub = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2125 'qsub', 'Subsaturated clear sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2126 TYPE(ctrl_out), SAVE :: o_qissr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2127 'qissr', 'Supersaturated clear sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2128 TYPE(ctrl_out), SAVE :: o_qcld = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2129 'qcld', 'Cloudy sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2130 TYPE(ctrl_out), SAVE :: o_subfra = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2131 'subfra', 'Subsaturated clear sky fraction', '-', (/ ('', i=1, 10) /)) 2132 TYPE(ctrl_out), SAVE :: o_issrfra = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2133 'issrfra', 'Supersaturated clear sky fraction', '-', (/ ('', i=1, 10) /)) 2134 TYPE(ctrl_out), SAVE :: o_gammacond = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2135 'gammacond', 'Condensation threshold w.r.t. saturation', '-', (/ ('', i=1, 10) /)) 2136 TYPE(ctrl_out), SAVE :: o_dcfsub = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2137 'dcfsub', 'Sublimation cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2138 TYPE(ctrl_out), SAVE :: o_dcfcon = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2139 'dcfcon', 'Condensation cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2140 TYPE(ctrl_out), SAVE :: o_dcfmix = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2141 'dcfmix', 'Cloud mixing cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2142 TYPE(ctrl_out), SAVE :: o_dqiadj = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2143 'dqiadj', 'Temperature adjustment ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2144 TYPE(ctrl_out), SAVE :: o_dqisub = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2145 'dqisub', 'Sublimation ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2146 TYPE(ctrl_out), SAVE :: o_dqicon = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2147 'dqicon', 'Condensation ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2148 TYPE(ctrl_out), SAVE :: o_dqimix = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2149 'dqimix', 'Cloud mixing ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2150 TYPE(ctrl_out), SAVE :: o_dqvcadj = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2151 'dqvcadj', 'Temperature adjustment cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2152 TYPE(ctrl_out), SAVE :: o_dqvcsub = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2153 'dqvcsub', 'Sublimation cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2154 TYPE(ctrl_out), SAVE :: o_dqvccon = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2155 'dqvccon', 'Condensation cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2156 TYPE(ctrl_out), SAVE :: o_dqvcmix = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2157 'dqvcmix', 'Cloud mixing cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2158 TYPE(ctrl_out), SAVE :: o_qsatl = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2159 'qsatl', 'Saturation with respect to liquid', 'kg/kg', (/ ('', i=1, 10) /)) 2160 TYPE(ctrl_out), SAVE :: o_qsati = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2161 'qsati', 'Saturation with respect to ice', 'kg/kg', (/ ('', i=1, 10) /)) 2162 2163 !-- LSCP - aviation variables 2164 TYPE(ctrl_out), SAVE :: o_Tcontr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2158 2165 'Tcontr', 'Temperature threshold for contrail formation', 'K', (/ ('',i=1,10) /)) 2159 TYPE(ctrl_out), SAVE :: o_qcontr = ctrl_out((/ 1 , 1, 1,1, 11, 11, 11, 11, 11, 11/),&2160 'qcontr', 'Specific humidity threshold for contrail formation', 'Pa', (/ ('', i=1, 10) /))2161 TYPE(ctrl_out), SAVE :: o_qcontr2 = ctrl_out((/ 1 , 1, 1,1, 11, 11, 11, 11, 11, 11/),&2162 'qcontr2', 'Specific humidity threshold for contrail formation', 'kg/kg', (/ ('', i=1, 10) /))2163 TYPE(ctrl_out), SAVE :: o_fcontrN = ctrl_out((/ 2, 2, 2, 2, 2, 2, 11, 11, 11, 11/),&2166 TYPE(ctrl_out), SAVE :: o_qcontr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2167 'qcontr', 'Specific humidity threshold for contrail formation', 'Pa', (/ ('', i=1, 10) /)) 2168 TYPE(ctrl_out), SAVE :: o_qcontr2 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2169 'qcontr2', 'Specific humidity threshold for contrail formation', 'kg/kg', (/ ('', i=1, 10) /)) 2170 TYPE(ctrl_out), SAVE :: o_fcontrN = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2164 2171 'fcontrN', 'Fraction with non-persistent contrail in clear-sky', '-', (/ ('', i=1,10)/)) 2165 TYPE(ctrl_out), SAVE :: o_fcontrP = ctrl_out((/ 2, 2, 2, 2, 2, 2, 11, 11, 11, 11/),&2172 TYPE(ctrl_out), SAVE :: o_fcontrP = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2166 2173 'fcontrP', 'Fraction with persistent contrail in ISSR', '-', (/ ('', i=1,10)/)) 2174 TYPE(ctrl_out), SAVE :: o_dcfavi = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2175 'dcfavi', 'Aviation cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2176 TYPE(ctrl_out), SAVE :: o_dqiavi = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2177 'dqiavi', 'Aviation ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2178 TYPE(ctrl_out), SAVE :: o_dqvcavi = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2179 'dqvcavi', 'Aviation cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2180 TYPE(ctrl_out), SAVE :: o_flight_dist = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2181 'flightdist', 'Aviation flown distance', 'm/s/mesh', (/ ('', i=1, 10) /)) 2182 TYPE(ctrl_out), SAVE :: o_flight_h2o = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2183 'flighth2o', 'Aviation H2O flight emission', 'kg H2O/s/mesh', (/ ('', i=1, 10) /)) 2167 2184 2168 2185 !!!!!!!!!!!!! Sorties niveaux standards de pression NMC -
LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_write_mod.F90
r5219 r5224 1 2 ! $Id$3 4 1 MODULE phys_output_write_mod 5 2 … … 54 51 o_SWdnTOAclr, o_nettop, o_SWup200, & 55 52 o_SWup200clr, o_SWdn200, o_SWdn200clr, & 53 o_LWupTOA, o_LWupTOAclr, & 56 54 o_LWup200, o_LWup200clr, o_LWdn200, & 57 55 o_LWdn200clr, o_sols, o_sols0, & … … 218 216 o_p_tropopause, o_z_tropopause, o_t_tropopause, & 219 217 o_col_O3_strato, o_col_O3_tropo, & 220 !--aviation & supersaturation 221 o_oclr, o_ocld, o_oss, o_ovc, o_rnebss, o_rnebclr, o_rnebseri, o_gammass, & 222 o_N1_ss, o_N2_ss, o_qsatl, o_qsats, & 223 o_drnebsub, o_drnebcon, o_drnebtur, o_drnebavi, o_flight_m, o_flight_h2o, & 218 !-- LSCP - condensation and ice supersaturation variables 219 o_cfseri, o_dcfdyn, o_rvcseri, o_drvcdyn, & 220 o_qsub, o_qissr, o_qcld, o_subfra, o_issrfra, o_gammacond, & 221 o_dcfsub, o_dcfcon, o_dcfmix, o_dqiadj, o_dqisub, o_dqicon, o_dqimix, & 222 o_dqvcadj, o_dqvcsub, o_dqvccon, o_dqvcmix, o_qsatl, o_qsati, & 223 !-- LSCP - aviation variables 224 224 o_Tcontr, o_qcontr, o_qcontr2, o_fcontrN, o_fcontrP, & 225 o_dcfavi, o_dqiavi, o_dqvcavi, o_flight_dist, o_flight_h2o, & 225 226 !--interactive CO2 226 227 o_flx_co2_ocean, o_flx_co2_ocean_cor, & … … 260 261 o_SAD_sulfate, o_reff_sulfate, o_sulfmmr, o_nd_mode, o_sulfmmr_mode 261 262 262 USE ice_sursat_mod, ONLY: flight_m, flight_h2o263 263 USE lmdz_lscp_ini, ONLY: ok_poprecip 264 264 … … 326 326 cldq, flwp, fiwp, ue, ve, uq, vq, & 327 327 uwat, vwat, & 328 rneb_seri, d_rneb_dyn, &329 328 plcl, plfc, wbeff, convoccur, upwd, dnwd, dnwd0, prw, prlw, prsw, prbsw, water_budget, & 330 329 s_pblh, s_pblt, s_lcl, s_therm, uwriteSTD, & … … 340 339 wdtrainA, wdtrainS, wdtrainM, n2, s2, strig, zcong, zlcl_th, proba_notrig, & 341 340 random_notrig, & 342 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 343 N1_ss, N2_ss, zqsatl, zqsats, & 341 cf_seri, d_cf_dyn, rvc_seri, d_rvc_dyn, & 342 qsub, qissr, qcld, subfra, issrfra, gamma_cond, & 343 dcf_sub, dcf_con, dcf_mix, & 344 dqi_adj, dqi_sub, dqi_con, dqi_mix, & 345 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, & 346 qsatliq, qsatice, & 344 347 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 345 d rneb_sub, drneb_con, drneb_tur, drneb_avi, &348 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 346 349 alp_bl_det, alp_bl_fluct_m, alp_bl_conv, & 347 350 alp_bl_stat, alp_bl_fluct_tke, slab_wfbils, & … … 1071 1074 CALL histwrite_phy(o_LWupSFCclr, zx_tmp_fi2d) 1072 1075 CALL histwrite_phy(o_LWdnSFCclr, sollwdownclr) 1076 1077 IF (vars_defined) THEN 1078 zx_tmp_fi2d(:) = lwup(:,klevp1) 1079 ENDIF 1080 CALL histwrite_phy(o_LWupTOA, zx_tmp_fi2d) 1081 1082 IF (vars_defined) THEN 1083 zx_tmp_fi2d(:) = lwup0(:,klevp1) 1084 ENDIF 1085 CALL histwrite_phy(o_LWupTOAclr, zx_tmp_fi2d) 1073 1086 1074 1087 IF (type_trac/='inca' .OR. config_inca=='aeNP') THEN … … 2058 2071 ENDIF 2059 2072 2060 !--aviation & supersaturation 2061 IF (ok_ice_sursat) THEN 2062 CALL histwrite_phy(o_oclr, qclr) 2063 CALL histwrite_phy(o_ocld, qcld) 2064 CALL histwrite_phy(o_oss, qss) 2065 CALL histwrite_phy(o_ovc, qvc) 2066 CALL histwrite_phy(o_rnebclr, rnebclr) 2067 CALL histwrite_phy(o_rnebss, rnebss) 2068 CALL histwrite_phy(o_rnebseri, rneb_seri) 2069 CALL histwrite_phy(o_gammass, gamma_ss) 2070 CALL histwrite_phy(o_N1_ss, N1_ss) 2071 CALL histwrite_phy(o_N2_ss, N2_ss) 2072 CALL histwrite_phy(o_drnebsub, drneb_sub) 2073 CALL histwrite_phy(o_drnebcon, drneb_con) 2074 CALL histwrite_phy(o_drnebtur, drneb_tur) 2075 CALL histwrite_phy(o_drnebavi, drneb_avi) 2076 CALL histwrite_phy(o_qsatl, zqsatl) 2077 CALL histwrite_phy(o_qsats, zqsats) 2073 !-- LSCP - condensation and supersaturation variables 2074 IF (ok_ice_supersat) THEN 2075 CALL histwrite_phy(o_cfseri, cf_seri) 2076 CALL histwrite_phy(o_dcfdyn, d_cf_dyn) 2077 CALL histwrite_phy(o_rvcseri, rvc_seri) 2078 CALL histwrite_phy(o_drvcdyn, d_rvc_dyn) 2079 CALL histwrite_phy(o_qsub, qsub) 2080 CALL histwrite_phy(o_qissr, qissr) 2081 CALL histwrite_phy(o_qcld, qcld) 2082 CALL histwrite_phy(o_subfra, subfra) 2083 CALL histwrite_phy(o_issrfra, issrfra) 2084 CALL histwrite_phy(o_gammacond, gamma_cond) 2085 CALL histwrite_phy(o_dcfsub, dcf_sub) 2086 CALL histwrite_phy(o_dcfcon, dcf_con) 2087 CALL histwrite_phy(o_dcfmix, dcf_mix) 2088 CALL histwrite_phy(o_dqiadj, dqi_adj) 2089 CALL histwrite_phy(o_dqisub, dqi_sub) 2090 CALL histwrite_phy(o_dqicon, dqi_con) 2091 CALL histwrite_phy(o_dqimix, dqi_mix) 2092 CALL histwrite_phy(o_dqvcadj, dqvc_adj) 2093 CALL histwrite_phy(o_dqvcsub, dqvc_sub) 2094 CALL histwrite_phy(o_dqvccon, dqvc_con) 2095 CALL histwrite_phy(o_dqvcmix, dqvc_mix) 2096 CALL histwrite_phy(o_qsatl, qsatliq) 2097 CALL histwrite_phy(o_qsati, qsatice) 2098 ENDIF 2099 !-- LSCP - aviation variables 2100 IF (ok_plane_contrail) THEN 2078 2101 CALL histwrite_phy(o_Tcontr, Tcontr) 2079 2102 CALL histwrite_phy(o_qcontr, qcontr) … … 2081 2104 CALL histwrite_phy(o_fcontrN, fcontrN) 2082 2105 CALL histwrite_phy(o_fcontrP, fcontrP) 2083 ENDIF 2084 IF (ok_plane_contrail) THEN 2085 CALL histwrite_phy(o_flight_m, flight_m) 2106 CALL histwrite_phy(o_dcfavi, dcf_avi) 2107 CALL histwrite_phy(o_dqiavi, dqi_avi) 2108 CALL histwrite_phy(o_dqvcavi, dqvc_avi) 2109 CALL histwrite_phy(o_flight_dist, flight_dist) 2086 2110 ENDIF 2087 2111 IF (ok_plane_h2o) THEN -
LMDZ6/branches/Amaury_dev/libf/phylmd/phys_state_var_mod.F90
r5137 r5224 1 2 ! $Id$ 3 4 MODULE phys_state_var_mod 1 MODULE phys_state_var_mod 5 2 ! Variables sauvegardees pour le startphy.nc 6 3 !====================================================================== … … 93 90 REAL, ALLOCATABLE, SAVE :: u_ancien(:,:), v_ancien(:,:) 94 91 !$OMP THREADPRIVATE(u_ancien, v_ancien) 92 REAL, ALLOCATABLE, SAVE :: cf_ancien(:,:), rvc_ancien(:,:) 93 !$OMP THREADPRIVATE(cf_ancien, rvc_ancien) 95 94 !!! RomP >>> 96 95 REAL, ALLOCATABLE, SAVE :: tr_ancien(:,:,:) … … 101 100 REAL, ALLOCATABLE, SAVE :: clwcon(:,:),rnebcon(:,:) 102 101 !$OMP THREADPRIVATE(clwcon,rnebcon) 103 REAL, ALLOCATABLE, SAVE :: rneb_ancien(:,:)104 !$OMP THREADPRIVATE(rneb_ancien)105 102 REAL, ALLOCATABLE, SAVE :: qtc_cv(:,:),sigt_cv(:,:),detrain_cv(:,:),fm_cv(:,:) 106 103 !$OMP THREADPRIVATE(qtc_cv,sigt_cv,detrain_cv,fm_cv) … … 587 584 ALLOCATE(prw_ancien(klon), prlw_ancien(klon), prsw_ancien(klon), prbsw_ancien(klon)) 588 585 ALLOCATE(u_ancien(klon,klev), v_ancien(klon,klev)) 586 ALLOCATE(cf_ancien(klon,klev), rvc_ancien(klon,klev)) 589 587 !!! Rom P >>> 590 588 ALLOCATE(tr_ancien(klon,klev,nbtr)) 591 589 !!! Rom P <<< 592 590 ALLOCATE(clwcon(klon,klev),rnebcon(klon,klev)) 593 ALLOCATE(rneb_ancien(klon,klev))594 591 ALLOCATE(qtc_cv(klon,klev),sigt_cv(klon,klev),detrain_cv(klon,klev),fm_cv(klon,klev)) 595 592 ALLOCATE(ratqs(klon,klev)) … … 812 809 DEALLOCATE(zthe, zpic, zval) 813 810 DEALLOCATE(rugoro, t_ancien, q_ancien, clwcon, rnebcon) 814 DEALLOCATE(qs_ancien, ql_ancien, qbs_ancien , rneb_ancien)811 DEALLOCATE(qs_ancien, ql_ancien, qbs_ancien) 815 812 DEALLOCATE(prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien) 816 813 DEALLOCATE(qtc_cv,sigt_cv,detrain_cv,fm_cv) 817 814 DEALLOCATE(u_ancien, v_ancien) 815 DEALLOCATE(cf_ancien, rvc_ancien) 818 816 DEALLOCATE(tr_ancien) !RomP 819 817 DEALLOCATE(ratqs, pbl_tke,coefh,coefm) -
LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90
r5221 r5224 1 ! $Id$2 3 !#define IO_DEBUG4 1 MODULE physiq_mod 5 2 IMPLICIT NONE … … 70 67 USE tracinca_mod, ONLY: config_inca 71 68 USE tropopause_m, ONLY: dyn_tropopause 72 USE ice_sursat_mod, ONLY: flight_init, airplane73 69 USE lmdz_vampir 74 70 USE lmdz_writefield_phy … … 139 135 ! [Variables internes non sauvegardees de la physique] 140 136 ! Variables locales pour effectuer les appels en serie 141 t_seri, q_seri, ql_seri, qs_seri, qbs_seri, u_seri, v_seri, tr_seri, rneb_seri, & 137 t_seri,q_seri,ql_seri,qs_seri,qbs_seri, & 138 u_seri,v_seri,cf_seri,rvc_seri,tr_seri, & 142 139 rhcl, & 143 140 ! Dynamic tendencies (diagnostics) 144 d_t_dyn, d_q_dyn, d_ql_dyn, d_qs_dyn, d_qbs_dyn, d_u_dyn, d_v_dyn, d_tr_dyn, d_rneb_dyn, & 141 d_t_dyn, d_q_dyn, d_ql_dyn, d_qs_dyn, d_qbs_dyn, & 142 d_u_dyn, d_v_dyn,d_cf_dyn,d_rvc_dyn,d_tr_dyn, & 145 143 d_q_dyn2d, d_ql_dyn2d, d_qs_dyn2d, d_qbs_dyn2d, & 146 144 ! Physic tendencies … … 314 312 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 315 313 distcltop, temp_cltop, & 316 zqsatl, zqsats, & 317 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 314 !-- LSCP - condensation and ice supersaturation variables 315 qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, & 316 dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, & 317 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, & 318 !-- LSCP - aviation and contrails variables 318 319 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 320 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 321 ! 319 322 cldemi, & 320 323 cldfra, cldtau, fiwc, & … … 496 499 497 500 ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional) 498 INTEGER, SAVE :: ivap, iliq, isol, i rneb, ibs499 !$OMP THREADPRIVATE(ivap, iliq, isol, i rneb, ibs)501 INTEGER, SAVE :: ivap, iliq, isol, ibs, icf, irvc 502 !$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc) 500 503 501 504 … … 1317 1320 iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) 1318 1321 isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) 1319 irneb = strIdx(tracers(:)%name, addPhase('H2O', 'r'))1320 1322 ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) 1323 icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) 1324 irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) 1321 1325 ! CALL init_etat0_limit_unstruct 1322 1326 ! IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) … … 1360 1364 ENDIF 1361 1365 1362 IF (ok_ice_su rsat.AND.(iflag_ice_thermo==0)) THEN1363 WRITE (lunout, *) ' ok_ice_su rsat=y requires iflag_ice_thermo=1 as well'1366 IF (ok_ice_supersat.AND.(iflag_ice_thermo==0)) THEN 1367 WRITE (lunout, *) ' ok_ice_supersat=y requires iflag_ice_thermo=1 as well' 1364 1368 abort_message = 'see above' 1365 1369 CALL abort_physic(modname, abort_message, 1) 1366 1370 ENDIF 1367 1371 1368 IF (ok_ice_su rsat.AND.(nqo<4)) THEN1369 WRITE (lunout, *) ' ok_ice_su rsat=y requires 4H2O tracers ', &1370 '(H2O_g, H2O_l, H2O_s, H2O_ r) but nqo=', nqo, '. Might as well stop here.'1372 IF (ok_ice_supersat.AND.(nqo<5)) THEN 1373 WRITE (lunout, *) ' ok_ice_supersat=y requires 5 H2O tracers ', & 1374 '(H2O_g, H2O_l, H2O_s, H2O_f, H2O_c) but nqo=', nqo, '. Might as well stop here.' 1371 1375 abort_message = 'see above' 1372 1376 CALL abort_physic(modname, abort_message, 1) 1373 1377 ENDIF 1374 1378 1375 IF (ok_plane_h2o.AND..NOT.ok_ice_su rsat) THEN1376 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_su rsat=y '1379 IF (ok_plane_h2o.AND..NOT.ok_ice_supersat) THEN 1380 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_supersat=y ' 1377 1381 abort_message = 'see above' 1378 1382 CALL abort_physic(modname, abort_message, 1) 1379 1383 ENDIF 1380 1384 1381 IF (ok_plane_contrail.AND..NOT.ok_ice_su rsat) THEN1382 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_su rsat=y '1385 IF (ok_plane_contrail.AND..NOT.ok_ice_supersat) THEN 1386 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_supersat=y ' 1383 1387 abort_message = 'see above' 1384 1388 CALL abort_physic(modname, abort_message, 1) … … 1386 1390 1387 1391 IF (ok_bs) THEN 1388 IF ((ok_ice_su rsat.AND.nqo <5).OR.(.NOT.ok_ice_sursat.AND.nqo<4)) THEN1392 IF ((ok_ice_supersat.AND.nqo <6).OR.(.NOT.ok_ice_supersat.AND.nqo<4)) THEN 1389 1393 WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', & 1390 1394 'but nqo=', nqo … … 1795 1799 RG, RD, RCPD, RKAPPA, RLVTT, RETV) 1796 1800 CALL ratqs_ini(klon, klev, iflag_thermals, lunout, nbsrf, is_lic, is_ter, RG, RV, RD, RCPD, RLSTT, RLVTT, RTT) 1797 CALL lscp_ini(pdtphys, lunout, prt_level, ok_ice_sursat, iflag_ratqs, fl_cor_ebil, RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG, RV, RPI) 1801 CALL lscp_ini(pdtphys, lunout, prt_level, ok_ice_supersat, iflag_ratqs, fl_cor_ebil, & 1802 RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RV, RG, RPI, EPS_W) 1798 1803 CALL blowing_snow_ini(RCPD, RLSTT, RLVTT, RLMLT, & 1799 1804 RVTMP2, RTT, RD, RG, RV, RPI) … … 2265 2270 sollwdown(:)) 2266 2271 2272 !--Init for LSCP - condensation 2273 ratio_qi_qtot(:,:) = 0. 2274 2267 2275 ENDIF 2268 2276 … … 2361 2369 ql_seri(i, k) = qx(i, k, iliq) 2362 2370 qbs_seri(i, k) = 0. 2371 cf_seri(i, k) = 0. 2372 rvc_seri(i, k) = 0. 2363 2373 !CR: ATTENTION, on rajoute la variable glace 2364 2374 IF (nqo==2) THEN !--vapour and liquid only 2365 2375 qs_seri(i, k) = 0. 2366 rneb_seri(i, k) = 0.2367 2376 ELSE IF (nqo==3) THEN !--vapour, liquid and ice 2368 2377 qs_seri(i, k) = qx(i, k, isol) 2369 rneb_seri(i, k) = 0. 2370 ELSE IF (nqo>=4) THEN !--vapour, liquid, ice and rneb and blowing snow 2378 ELSE IF (nqo>=4) THEN !--vapour, liquid, ice, blowing snow, cloud fraction and cloudy water vapor to total water vapor ratio 2371 2379 qs_seri(i, k) = qx(i, k, isol) 2372 IF (ok_ice_sursat) THEN 2373 rneb_seri(i, k) = qx(i, k, irneb) 2374 ENDIF 2380 IF (ok_ice_supersat) THEN 2381 cf_seri(i, k) = qx(i, k, icf) 2382 rvc_seri(i, k) = qx(i, k, irvc) 2383 END IF 2375 2384 IF (ok_bs) THEN 2376 2385 qbs_seri(i, k) = qx(i, k, ibs) 2377 END IF2378 END IF2379 END DO2380 END DO2386 END IF 2387 END IF 2388 END DO 2389 END DO 2381 2390 ! Lea Raillard qs_ini for cloud phase param. 2382 2391 qs_ini(:, :) = qs_seri(:, :) … … 2450 2459 d_qs_dyn(:, :) = (qs_seri(:, :) - qs_ancien(:, :)) / phys_tstep 2451 2460 d_qbs_dyn(:, :) = (qbs_seri(:, :) - qbs_ancien(:, :)) / phys_tstep 2461 d_cf_dyn(:, :) = (cf_seri(:, :) - cf_ancien(:, :)) / phys_tstep 2462 d_rvc_dyn(:, :) = (rvc_seri(:, :) - rvc_ancien(:, :))/phys_tstep 2452 2463 CALL water_int(klon, klev, q_seri, zmasse, zx_tmp_fi2d) 2453 2464 d_q_dyn2d(:) = (zx_tmp_fi2d(:) - prw_ancien(:)) / phys_tstep … … 2461 2472 IF (nqtot > nqo) d_tr_dyn(:, :, :) = (tr_seri(:, :, :) - tr_ancien(:, :, :)) / phys_tstep 2462 2473 ! !! RomP <<< 2463 !!d_rneb_dyn(:,:)=(rneb_seri(:,:)-rneb_ancien(:,:))/phys_tstep2464 d_rneb_dyn(:, :) = 0.02465 2474 ELSE 2466 2475 d_u_dyn(:, :) = 0.0 … … 2470 2479 d_ql_dyn(:, :) = 0.0 2471 2480 d_qs_dyn(:, :) = 0.0 2481 d_qbs_dyn(:, :) = 0.0 2482 d_cf_dyn(:, :) = 0.0 2483 d_rvc_dyn(:, :) = 0.0 2472 2484 d_q_dyn2d(:) = 0.0 2473 2485 d_ql_dyn2d(:) = 0.0 … … 2477 2489 IF (nqtot > nqo) d_tr_dyn(:, :, :) = 0.0 2478 2490 ! !! RomP <<< 2479 d_rneb_dyn(:, :) = 0.02480 d_qbs_dyn(:, :) = 0.02481 2491 ancien_ok = .TRUE. 2482 2492 ENDIF … … 2585 2595 ! "zmasse" changes a little.) 2586 2596 ENDIF 2597 ENDIF 2598 2599 !-- Needed for LSCP - condensation and ice supersaturation 2600 IF (ok_ice_supersat) THEN 2601 DO k = 1, klev 2602 DO i = 1, klon 2603 IF ((q_seri(i, k) + ql_seri(i, k) + qs_seri(i, k)) > 0.) THEN 2604 ratio_qi_qtot(i, k) = qs_seri(i, k) / (q_seri(i, k) + ql_seri(i, k) + qs_seri(i, k)) 2605 rvc_seri(i, k) = rvc_seri(i, k) * q_seri(i, k) / (q_seri(i, k) + ql_seri(i, k) + qs_seri(i, k)) 2606 ELSE 2607 ratio_qi_qtot(i, k) = 0. 2608 rvc_seri(i, k) = 0. 2609 ENDIF 2610 ENDDO 2611 ENDDO 2587 2612 ENDIF 2588 2613 … … 3738 3763 3739 3764 !--mise à jour de flight_m et flight_h2o dans leur module 3740 IF (ok_plane_h2o .OR. ok_plane_contrail) THEN3741 CALL airplane(debut, pphis, pplay, paprs,t_seri)3742 ENDIF3765 !IF (ok_plane_h2o .OR. ok_plane_contrail) THEN 3766 ! CALL airplane(debut,pphis,pplay,paprs,t_seri) 3767 !ENDIF 3743 3768 3744 3769 CALL lscp(klon, klev, phys_tstep, missing_val, paprs, pplay, & 3745 3770 t_seri, q_seri, qs_ini, ptconv, ratqs, & 3746 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri,&3771 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 3747 3772 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 3748 3773 radocond, picefra, rain_lsc, snow_lsc, & … … 3750 3775 prfl, psfl, rhcl, & 3751 3776 zqasc, fraca, ztv, zpspsk, ztla, zthl, iflag_cld_th, & 3752 iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, temp_cltop, & 3753 pbl_tke(:, :, is_ave), pbl_eps(:, :, is_ave), qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 3777 iflag_ice_thermo, distcltop, temp_cltop, & 3778 pbl_tke(:, :, is_ave), pbl_eps(:, :, is_ave), & 3779 cell_area, & 3780 cf_seri, rvc_seri, u_seri, v_seri, & 3781 qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, & 3782 dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, & 3783 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, & 3754 3784 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 3785 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 3755 3786 cloudth_sth, cloudth_senv, cloudth_sigmath, cloudth_sigmaenv, & 3756 3787 qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, & … … 5421 5452 d_qx(i, k, isol) = (qs_seri(i, k) - qx(i, k, isol)) / phys_tstep 5422 5453 ENDIF 5423 !--ice_sursat: nqo=4, on ajoute rneb 5424 IF (nqo>=4 .AND. ok_ice_sursat) THEN 5425 d_qx(i, k, irneb) = (rneb_seri(i, k) - qx(i, k, irneb)) / phys_tstep 5454 !--ice_supersat: nqo=5, we add cloud fraction and cloudy water vapor to total water vapor ratio 5455 IF (nqo>=5 .and. ok_ice_supersat) THEN 5456 d_qx(i, k, icf) = (cf_seri(i, k) - qx(i, k, icf)) / phys_tstep 5457 d_qx(i, k, irvc) = (rvc_seri(i, k) - qx(i, k, irvc)) / phys_tstep 5426 5458 ENDIF 5427 5459 … … 5458 5490 qs_ancien(:, :) = qs_seri(:, :) 5459 5491 qbs_ancien(:, :) = qbs_seri(:, :) 5460 rneb_ancien(:, :) = rneb_seri(:, :) 5492 cf_ancien(:, :) = cf_seri(:, :) 5493 rvc_ancien(:, :) = rvc_seri(:, :) 5461 5494 CALL water_int(klon, klev, q_ancien, zmasse, prw_ancien) 5462 5495 CALL water_int(klon, klev, ql_ancien, zmasse, prlw_ancien) -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_condensation.f90
-
Property
svn:mergeinfo
set to
(toggle deleted branches)
/LMDZ6/trunk/libf/phylmdiso/lmdz_lscp_condensation.F90 merged eligible /LMDZ4/branches/LMDZ4-dev/libf/phylmdiso/lmdz_lscp_condensation.F90 1074-1276,1281-1284 /LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmdiso/lmdz_lscp_condensation.F90 1293-1401 /LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmdiso/lmdz_lscp_condensation.F90 1436-1453 /LMDZ5/branches/LMDZ5V2.0-dev/libf/phylmdiso/lmdz_lscp_condensation.F90 1456-1491 /LMDZ5/branches/LMDZ_tree_FC/libf/phylmdiso/lmdz_lscp_condensation.F90 2924-2946 /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_condensation.F90 4175-4488 /LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/lmdz_lscp_condensation.F90 4660-4721 /LMDZ6/branches/Ocean_skin/libf/phylmdiso/lmdz_lscp_condensation.F90 3428-4369 /LMDZ6/branches/blowing_snow/libf/phylmdiso/lmdz_lscp_condensation.F90 4485-4522
r5223 r5224 1 link ../phylmd/lmdz_lscp_condensation. F901 link ../phylmd/lmdz_lscp_condensation.f90 -
Property
svn:mergeinfo
set to
(toggle deleted branches)
-
LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyetat0_mod.F90
r5221 r5224 1 ! $Id: phyetat0.F90 3890 2021-05-05 15:15:06Z jyg $2 3 1 MODULE phyetat0_mod 4 2 USE lmdz_abort_physic, ONLY: abort_physic … … 26 24 du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, & 27 25 falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, & 28 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, & 26 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, & 27 cf_ancien, rvc_ancien, radpas, radsol, rain_fall, ratqs, & 29 28 rnebcon, rugoro, sig1, snow_fall, bs_fall, solaire_etat0, sollw, sollwdown, & 30 29 solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, & … … 421 420 ancien_ok=ancien_ok.AND.phyetat0_get(ql_ancien,"QLANCIEN","QLANCIEN",0.) 422 421 ancien_ok=ancien_ok.AND.phyetat0_get(qs_ancien,"QSANCIEN","QSANCIEN",0.) 423 ancien_ok=ancien_ok.AND.phyetat0_get(rneb_ancien,"RNEBANCIEN","RNEBANCIEN",0.)424 422 ancien_ok=ancien_ok.AND.phyetat0_get(u_ancien,"UANCIEN","UANCIEN",0.) 425 423 ancien_ok=ancien_ok.AND.phyetat0_get(v_ancien,"VANCIEN","VANCIEN",0.) … … 437 435 ENDIF 438 436 437 ! cas specifique des variables de la sursaturation par rapport a la glace 438 IF ( ok_ice_supersat ) THEN 439 ancien_ok=ancien_ok.AND.phyetat0_get(cf_ancien,"CFANCIEN","CFANCIEN",0.) 440 ancien_ok=ancien_ok.AND.phyetat0_get(rvc_ancien,"RVCANCIEN","RVCANCIEN",0.) 441 ELSE 442 cf_ancien(:,:)=0. 443 rvc_ancien(:,:)=0. 444 ENDIF 445 439 446 ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain 440 447 ! dummy values (as is the case when generated by ce0l, … … 443 450 (maxval(ql_ancien)==minval(ql_ancien)) .OR. & 444 451 (maxval(qs_ancien)==minval(qs_ancien)) .OR. & 445 (maxval(rneb_ancien)==minval(rneb_ancien)) .OR. &446 452 (maxval(prw_ancien)==minval(prw_ancien)) .OR. & 447 453 (maxval(prlw_ancien)==minval(prlw_ancien)) .OR. & … … 456 462 ancien_ok=.FALSE. 457 463 ENDIF 464 ENDIF 465 466 IF ( ok_ice_supersat ) THEN 467 IF ( (maxval(cf_ancien)==minval(cf_ancien)) .OR. & 468 (maxval(rvc_ancien)==minval(rvc_ancien)) ) THEN 469 ancien_ok=.false. 470 ENDIF 458 471 ENDIF 459 472 -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyredem.F90
r5158 r5224 19 19 zval, rugoro, t_ancien, q_ancien, & 20 20 prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, & 21 ql_ancien, qs_ancien, qbs_ancien, u_ancien, & 22 v_ancien, clwcon, rnebcon, ratqs, pbl_tke, & 21 ql_ancien, qs_ancien, qbs_ancien, cf_ancien, & 22 rvc_ancien, u_ancien, v_ancien, & 23 clwcon, rnebcon, ratqs, pbl_tke, & 23 24 wake_delta_pbl_tke, zmax0, f0, sig1, w01, & 24 25 wake_deltat, wake_deltaq, wake_s, wake_dens, & … … 266 267 CALL put_field(pass,"QBSANCIEN", "QBSANCIEN", qbs_ancien) 267 268 CALL put_field(pass,"PRBSWANCIEN", "PRBSWANCIEN", prbsw_ancien) 269 ENDIF 270 271 IF ( ok_ice_supersat ) THEN 272 CALL put_field(pass,"CFANCIEN", "CFANCIEN", cf_ancien) 273 CALL put_field(pass,"RVCANCIEN", "RVCANCIEN", rvc_ancien) 268 274 ENDIF 269 275 -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90
r5221 r5224 1 2 ! $Id: physiq_mod.F90 3908 2021-05-20 07:11:13Z idelkadi $3 4 !#define IO_DEBUG5 1 MODULE physiq_mod 6 2 … … 72 68 USE tracinca_mod, ONLY: config_inca 73 69 USE tropopause_m, ONLY: dyn_tropopause 74 USE ice_sursat_mod, ONLY: flight_init, airplane75 70 USE lmdz_vampir 76 71 USE lmdz_writefield_phy … … 181 176 ! [Variables internes non sauvegardees de la physique] 182 177 ! Variables locales pour effectuer les appels en serie 183 t_seri,q_seri,ql_seri,qs_seri,qbs_seri,u_seri,v_seri,tr_seri,rneb_seri, & 178 t_seri,q_seri,ql_seri,qs_seri,qbs_seri, & 179 u_seri,v_seri,cf_seri,rvc_seri,tr_seri, & 180 rhcl, & 184 181 qx_seri, & ! CR 185 182 rhcl, & 186 183 ! Dynamic tendencies (diagnostics) 187 d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, & 184 d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn, & 185 d_u_dyn,d_v_dyn,d_cf_dyn,d_rvc_dyn,d_tr_dyn, & 188 186 d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, & 189 187 ! Physic tendencies … … 360 358 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 361 359 distcltop, temp_cltop, & 362 zqsatl, zqsats, & 363 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 360 !-- LSCP - condensation and ice supersaturation variables 361 qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, & 362 dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, & 363 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, & 364 !-- LSCP - aviation and contrails variables 364 365 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 366 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 367 ! 365 368 cldemi, & 366 369 cldfra, cldtau, fiwc, & … … 578 581 ! reevap -> je commente les 2 lignes au dessus et je laisse la definition 579 582 ! plutot dans infotrac_phy 580 INTEGER,SAVE :: irneb, ibs 581 !$OMP THREADPRIVATE(irneb, ibs )583 INTEGER,SAVE :: irneb, ibs, icf,irvc 584 !$OMP THREADPRIVATE(irneb, ibs, icf,irvc) 582 585 583 586 … … 1450 1453 iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) 1451 1454 isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) 1452 irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))1453 1455 ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) 1456 icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) 1457 irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) 1454 1458 ! CALL init_etat0_limit_unstruct 1455 !IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)1459 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) 1456 1460 !CR:nvelles variables convection/poches froides 1457 1461 … … 1508 1512 ENDIF 1509 1513 1510 IF (ok_ice_su rsat.AND.(iflag_ice_thermo==0)) THEN1511 WRITE (lunout, *) ' ok_ice_su rsat=y requires iflag_ice_thermo=1 as well'1514 IF (ok_ice_supersat.AND.(iflag_ice_thermo==0)) THEN 1515 WRITE (lunout, *) ' ok_ice_supersat=y requires iflag_ice_thermo=1 as well' 1512 1516 abort_message='see above' 1513 1517 CALL abort_physic(modname,abort_message,1) 1514 1518 ENDIF 1515 1519 1516 IF (ok_ice_su rsat.AND.(nqo<4)) THEN1517 WRITE (lunout, *) ' ok_ice_su rsat=y requires 4 H2O tracers ', &1518 '(H2O_g, H2O_l, H2O_s, H2O_ r) but nqo=', nqo, '. Might as well stop here.'1520 IF (ok_ice_supersat.AND.(nqo<5)) THEN 1521 WRITE (lunout, *) ' ok_ice_supersat=y requires 4 H2O tracers ', & 1522 '(H2O_g, H2O_l, H2O_s, H2O_f, H2O_c) but nqo=', nqo, '. Might as well stop here.' 1519 1523 abort_message='see above' 1520 1524 CALL abort_physic(modname,abort_message,1) 1521 1525 ENDIF 1522 1526 1523 IF (ok_plane_h2o.AND..NOT.ok_ice_su rsat) THEN1524 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_su rsat=y '1527 IF (ok_plane_h2o.AND..NOT.ok_ice_supersat) THEN 1528 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_supersat=y ' 1525 1529 abort_message='see above' 1526 1530 CALL abort_physic(modname,abort_message,1) 1527 1531 ENDIF 1528 1532 1529 IF (ok_plane_contrail.AND..NOT.ok_ice_su rsat) THEN1530 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_su rsat=y '1533 IF (ok_plane_contrail.AND..NOT.ok_ice_supersat) THEN 1534 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_supersat=y ' 1531 1535 abort_message='see above' 1532 1536 CALL abort_physic(modname,abort_message,1) … … 1538 1542 CALL abort_physic(modname,abort_message, 1) 1539 1543 #endif 1540 IF ((ok_ice_su rsat.AND.nqo <5).OR.(.NOT.ok_ice_sursat.AND.nqo<4)) THEN1544 IF ((ok_ice_supersat.AND.nqo <6).OR.(.NOT.ok_ice_supersat.AND.nqo<4)) THEN 1541 1545 WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', & 1542 1546 'but nqo=', nqo … … 1981 1985 RG,RD,RCPD,RKAPPA,RLVTT,RETV) 1982 1986 CALL ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT) 1983 CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_sursat,iflag_ratqs,fl_cor_ebil,RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RG,RV,RPI) 1987 CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_supersat,iflag_ratqs,fl_cor_ebil, & 1988 RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RV,RG,RPI,EPS_W) 1984 1989 CALL blowing_snow_ini(RCPD, RLSTT, RLVTT, RLMLT, & 1985 1990 RVTMP2, RTT,RD,RG, RV, RPI) … … 2458 2463 sollwdown(:)) 2459 2464 2465 !--Init for LSCP - condensation 2466 ratio_qi_qtot(:,:) = 0. 2460 2467 2461 2468 … … 2565 2572 q_seri(i,k) = qx(i,k,ivap) 2566 2573 ql_seri(i,k) = qx(i,k,iliq) 2567 qbs_seri(i,k) = 0. 2574 qbs_seri(i,k)= 0. 2575 cf_seri(i,k) = 0. 2576 rvc_seri(i,k)= 0. 2568 2577 !CR: ATTENTION, on rajoute la variable glace 2569 2578 IF (nqo==2) THEN !--vapour and liquid only 2570 2579 qs_seri(i,k) = 0. 2571 rneb_seri(i,k) = 0.2572 2580 ELSE IF (nqo==3) THEN !--vapour, liquid and ice 2573 2581 qs_seri(i,k) = qx(i,k,isol) 2574 rneb_seri(i,k) = 0. 2575 ELSE IF (nqo>=4) THEN !--vapour, liquid, ice and rneb and blowing snow 2582 ELSE IF (nqo>=4) THEN !--vapour, liquid, ice, blowing snow, cloud fraction and cloudy water vapor to total water vapor ratio 2576 2583 qs_seri(i,k) = qx(i,k,isol) 2577 IF (ok_ice_sursat) THEN 2578 rneb_seri(i,k) = qx(i,k,irneb) 2584 IF (ok_ice_supersat) THEN 2585 cf_seri(i,k) = qx(i,k,icf) 2586 rvc_seri(i,k) = qx(i,k,irvc) 2579 2587 ENDIF 2580 2588 IF (ok_bs) THEN … … 2748 2756 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep 2749 2757 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep 2750 d_qbs_dyn(:,:) = (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep 2758 d_qbs_dyn(:,:)= (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep 2759 d_cf_dyn(:,:) = (cf_seri(:,:)-cf_ancien(:,:))/phys_tstep 2760 d_rvc_dyn(:,:)= (rvc_seri(:,:)-rvc_ancien(:,:))/phys_tstep 2751 2761 CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d) 2752 2762 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep … … 2760 2770 IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep 2761 2771 ! !! RomP <<< 2762 !!d_rneb_dyn(:,:)=(rneb_seri(:,:)-rneb_ancien(:,:))/phys_tstep2763 d_rneb_dyn(:,:)=0.02764 2772 2765 2773 #ifdef ISO … … 2843 2851 d_ql_dyn(:,:) = 0.0 2844 2852 d_qs_dyn(:,:) = 0.0 2853 d_qbs_dyn(:,:)= 0.0 2854 d_cf_dyn(:,:) = 0.0 2855 d_rvc_dyn(:,:)= 0.0 2845 2856 d_q_dyn2d(:) = 0.0 2846 2857 d_ql_dyn2d(:) = 0.0 … … 2869 2880 IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0 2870 2881 ! !! RomP <<< 2871 d_rneb_dyn(:,:)=0.02872 d_qbs_dyn(:,:)=0.02873 2882 ancien_ok = .TRUE. 2874 2883 #ifdef ISO … … 2980 2989 ! "zmasse" changes a little.) 2981 2990 ENDIF 2991 ENDIF 2992 2993 !-- Needed for LSCP - condensation and ice supersaturation 2994 IF (ok_ice_supersat) THEN 2995 DO k = 1, klev 2996 DO i = 1, klon 2997 IF ( ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) > 0. ) THEN 2998 ratio_qi_qtot(i,k) = qs_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) 2999 rvc_seri(i,k) = rvc_seri(i,k) * q_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) 3000 ELSE 3001 ratio_qi_qtot(i,k) = 0. 3002 rvc_seri(i,k) = 0. 3003 ENDIF 3004 ENDDO 3005 ENDDO 2982 3006 ENDIF 2983 3007 … … 5013 5037 5014 5038 !--mise à jour de flight_m et flight_h2o dans leur module 5015 IF (ok_plane_h2o .OR. ok_plane_contrail) THEN5016 CALL airplane(debut,pphis,pplay,paprs,t_seri)5017 ENDIF5039 !IF (ok_plane_h2o .OR. ok_plane_contrail) THEN 5040 ! CALL airplane(debut,pphis,pplay,paprs,t_seri) 5041 !ENDIF 5018 5042 5019 5043 CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, & 5020 5044 t_seri, q_seri,qs_ini,ptconv,ratqs, & 5021 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, &5045 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 5022 5046 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 5023 5047 radocond, picefra, rain_lsc, snow_lsc, & … … 5025 5049 prfl, psfl, rhcl, & 5026 5050 zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, & 5027 iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, temp_cltop, & 5028 pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 5029 Tcontr, qcontr, qcontr2, fcontrN, fcontrP , & 5051 iflag_ice_thermo, distcltop, temp_cltop, & 5052 pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), & 5053 cell_area, & 5054 cf_seri, rvc_seri, u_seri, v_seri, & 5055 qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, & 5056 dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, & 5057 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, & 5058 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 5059 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 5030 5060 cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, & 5031 5061 qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, & … … 7072 7102 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep 7073 7103 ENDIF 7074 !--ice_sursat: nqo=4, on ajoute rneb 7075 IF (nqo>=4 .AND. ok_ice_sursat) THEN 7076 d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep 7104 !--ice_supersat: nqo=5, we add cloud fraction and cloudy water vapor to total water vapor ratio 7105 IF (nqo>=5 .and. ok_ice_supersat) THEN 7106 d_qx(i, k, icf) = (cf_seri(i, k) - qx(i, k, icf)) / phys_tstep 7107 d_qx(i, k, irvc) = (rvc_seri(i, k) - qx(i, k, irvc)) / phys_tstep 7077 7108 ENDIF 7078 7109 … … 7080 7111 d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep 7081 7112 ENDIF 7082 7083 7113 7084 7114 ENDDO … … 7126 7156 ql_ancien(:,:) = ql_seri(:,:) 7127 7157 qs_ancien(:,:) = qs_seri(:,:) 7128 qbs_ancien(:,:) = qbs_seri(:,:) 7129 rneb_ancien(:,:) = rneb_seri(:,:) 7158 qbs_ancien(:,:)= qbs_seri(:,:) 7159 cf_ancien(:,:) = cf_seri(:,:) 7160 rvc_ancien(:,:)= rvc_seri(:,:) 7130 7161 #ifdef ISO 7131 7162 xt_ancien(:,:,:)=xt_seri(:,:,:)
Note: See TracChangeset
for help on using the changeset viewer.
