Changeset 5204
- Timestamp:
- Sep 20, 2024, 1:28:24 PM (4 hours ago)
- Location:
- LMDZ6/trunk
- Files:
-
- 2 deleted
- 20 edited
- 4 copied
-
. (modified) (1 prop)
-
DefLists/field_def_lmdz.xml (modified) (2 diffs)
-
libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90 (modified) (4 diffs)
-
libf/phylmd/clesphys.h (modified) (2 diffs)
-
libf/phylmd/conf_phys_m.F90 (modified) (5 diffs)
-
libf/phylmd/create_etat0_unstruct_mod.F90 (modified) (2 diffs)
-
libf/phylmd/ice_sursat_mod.F90 (deleted)
-
libf/phylmd/lmdz_lscp.F90 (modified) (20 diffs)
-
libf/phylmd/lmdz_lscp_condensation.F90 (copied) (copied from LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_condensation.F90)
-
libf/phylmd/lmdz_lscp_ini.F90 (modified) (12 diffs)
-
libf/phylmd/lmdz_lscp_poprecip.F90 (modified) (1 diff)
-
libf/phylmd/lmdz_lscp_tools.F90 (modified) (4 diffs)
-
libf/phylmd/phyetat0_mod.F90 (modified) (5 diffs)
-
libf/phylmd/phyredem.F90 (modified) (2 diffs)
-
libf/phylmd/phys_local_var_mod.F90 (modified) (10 diffs)
-
libf/phylmd/phys_output_ctrlout_mod.F90 (modified) (2 diffs)
-
libf/phylmd/phys_output_write_mod.F90 (modified) (8 diffs)
-
libf/phylmd/phys_state_var_mod.F90 (modified) (4 diffs)
-
libf/phylmd/physiq_mod.F90 (modified) (19 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)
-
libf/phylmdiso/phyetat0_mod.F90 (modified) (5 diffs)
-
libf/phylmdiso/phyredem.F90 (modified) (2 diffs)
-
libf/phylmdiso/phys_local_var_mod.F90 (copied) (copied from LMDZ6/branches/cirrus/libf/phylmdiso/phys_local_var_mod.F90)
-
libf/phylmdiso/phys_output_ctrlout_mod.F90 (copied) (copied from LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_ctrlout_mod.F90)
-
libf/phylmdiso/physiq_mod.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk
- Property svn:mergeinfo changed
/LMDZ6/branches/cirrus (added) merged: 4945,4951,4974,5019,5025,5041,5055,5161-5163,5165,5202-5203
- Property svn:mergeinfo changed
-
LMDZ6/trunk/DefLists/field_def_lmdz.xml
r5150 r5204 156 156 <field id="LWupSFC" long_name="Upwd. IR rad. at surface" unit="W/m2" /> 157 157 <field id="LWupSFCclr" long_name="CS Upwd. IR rad. at surface" unit="W/m2" /> 158 <field id="LWupTOA" long_name="LWup at TOA" unit="W/m2" /> 159 <field id="LWupTOAclr" long_name="LWup clear sky at TOA" unit="W/m2" /> 158 160 <field id="LWupTOAcleanclr" long_name="CS clean (no aerosol) Upwd. IR rad. at TOA" unit="W/m2" /> 159 161 <field id="LWdnSFC" long_name="Down. IR rad. at surface" unit="W/m2" /> … … 879 881 <field id="dqch4" long_name="H2O due to CH4 oxidation and photolysis" unit="(kg/kg)/s" /> 880 882 <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" /> 883 <field id="cfseri" long_name="Cloud fraction" unit="-" /> 884 <field id="dcfdyn" long_name="Dynamics cloud fraction tendency" unit="s-1" /> 885 <field id="rvcseri" long_name="Cloudy water vapor to total water vapor ratio" unit="-" /> 886 <field id="drvcdyn" long_name="Dynamics cloudy water vapor to total water vapor ratio tendency" unit="s-1" /> 887 <field id="qsub" long_name="Subsaturated clear sky total water" unit="kg/kg" /> 888 <field id="qissr" long_name="Supersaturated clear sky total water" unit="kg/kg" /> 889 <field id="qcld" long_name="Cloudy sky total water" unit="kg/kg" /> 890 <field id="subfra" long_name="Subsaturated clear sky fraction" unit="kg/kg" /> 891 <field id="issrfra" long_name="Supersaturated clear sky fraction" unit="kg/kg" /> 892 <field id="gammacond" long_name="Condensation threshold w.r.t. saturation" unit="-" /> 893 <field id="dcfsub" long_name="Sublimation cloud fraction tendency" unit="s-1" /> 894 <field id="dcfcon" long_name="Condensation cloud fraction tendency" unit="s-1" /> 895 <field id="dcfmix" long_name="Cloud mixing cloud fraction tendency" unit="s-1" /> 896 <field id="dqiadj" long_name="Temperature adjustment ice tendency" unit="kg/kg/s" /> 897 <field id="dqisub" long_name="Sublimation ice tendency" unit="kg/kg/s" /> 898 <field id="dqicon" long_name="Condensation ice tendency" unit="kg/kg/s" /> 899 <field id="dqimix" long_name="Cloud mixing ice tendency" unit="kg/kg/s" /> 900 <field id="dqvcadj" long_name="Temperature adjustment cloudy water vapor tendency" unit="kg/kg/s" /> 901 <field id="dqvcsub" long_name="Sublimation cloudy water vapor tendency" unit="kg/kg/s" /> 902 <field id="dqvccon" long_name="Condensation cloudy water vapor tendency" unit="kg/kg/s" /> 903 <field id="dqvcmix" long_name="Cloud mixing cloudy water vapor tendency" unit="kg/kg/s" /> 904 <field id="qsatl" long_name="Saturation with respect to liquid" unit="kg/kg" /> 905 <field id="qsati" long_name="Saturation with respect to ice" unit="kg/kg" /> 906 <field id="Tcontr" long_name="Temperature threshold for contrail formation" unit="K" /> 907 <field id="qcontr" long_name="Specific humidity threshold for contrail formation" unit="Pa" /> 908 <field id="qcontr2" long_name="Specific humidity threshold for contrail formation" unit="kg/kg" /> 909 <field id="fcontrN" long_name="Fraction with non-persistent contrail in clear-sky" unit="-" /> 910 <field id="fcontrP" long_name="Fraction with persistent contrail in ISSR" unit="-" /> 911 <field id="dcfavi" long_name="Aviation cloud fraction tendency" unit="s-1" /> 912 <field id="dqiavi" long_name="Aviation ice tendency" unit="kg/kg/s" /> 913 <field id="dqvcavi" long_name="Aviation cloudy water vapor tendency" unit="kg/kg/s" /> 914 <field id="flightdist" long_name="Aviation flown distance" unit="m/s/mesh" /> 915 <field id="flighth2o" long_name="Aviation H2O flight emission" unit="kg H2O/s/mesh" /> 904 916 <field id="fluxt" long_name="flux h" unit="W/m2" /> 905 917 <field id="fluxq" long_name="flux q" unit="-" /> -
LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90
r4801 r5204 49 49 prw_ancien, u10m,v10m, treedrg, u_ancien, v_ancien, wake_delta_pbl_TKE, wake_dens, & 50 50 ale_bl, ale_bl_trig, alp_bl, & 51 ale_wake, ale_bl_stat, AWAKE_S 51 ale_wake, ale_bl_stat, AWAKE_S, & 52 cf_ancien, rvc_ancien 52 53 53 54 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 ioipsl_getincom 98 99 IMPLICIT NONE … … 242 243 ale_wake=0. 243 244 ale_bl_stat=0. 245 246 cf_ancien = 0. 247 rvc_ancien = 0. 244 248 245 249 z0m(:,:)=0 ! ym missing 5th subsurface initialization … … 287 291 288 292 ratqs_inter_ = 0.002 289 rneb_ancien = 0.290 293 CALL phyredem( "startphy.nc" ) 291 294 -
LMDZ6/trunk/libf/phylmd/clesphys.h
r5017 r5204 94 94 LOGICAL :: ok_airs 95 95 INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo 96 LOGICAL :: ok_ice_su rsat, ok_plane_h2o, ok_plane_contrail96 LOGICAL :: ok_ice_supersat, ok_plane_h2o, ok_plane_contrail 97 97 LOGICAL :: ok_chlorophyll 98 98 LOGICAL :: ok_strato … … 157 157 & , ok_lic_melt, ok_lic_cond, aer_type & 158 158 & , iflag_rrtm, ok_strato,ok_hines, ok_qch4 & 159 & , iflag_ice_thermo, ok_ice_su rsat&159 & , iflag_ice_thermo, ok_ice_supersat & 160 160 & , ok_plane_h2o, ok_plane_contrail & 161 161 & , ok_gwd_rando, NSW, iflag_albedo & -
LMDZ6/trunk/libf/phylmd/conf_phys_m.F90
r4843 r5204 173 173 INTEGER,SAVE :: iflag_clw_omp 174 174 INTEGER,SAVE :: iflag_ice_thermo_omp 175 LOGICAL,SAVE :: ok_ice_su rsat_omp175 LOGICAL,SAVE :: ok_ice_supersat_omp 176 176 LOGICAL,SAVE :: ok_plane_h2o_omp, ok_plane_contrail_omp 177 177 REAL,SAVE :: rad_froid_omp, rad_chau1_omp, rad_chau2_omp … … 1347 1347 1348 1348 ! 1349 !Config Key = ok_ice_su rsat1350 !Config Desc = 1351 !Config Def = 01352 !Config Help = 1353 ! 1354 ok_ice_su rsat_omp = 01355 CALL getin('ok_ice_su rsat',ok_ice_sursat_omp)1349 !Config Key = ok_ice_supersat 1350 !Config Desc = include ice supersaturation for cold clouds 1351 !Config Def = .FALSE. 1352 !Config Help = 1353 ! 1354 ok_ice_supersat_omp = .FALSE. 1355 CALL getin('ok_ice_supersat',ok_ice_supersat_omp) 1356 1356 1357 1357 !Config Key = ok_plane_h2o 1358 !Config Desc = 1359 !Config Def = 01358 !Config Desc = include H2O emissions from aviation 1359 !Config Def = .FALSE. 1360 1360 !Config Help = 1361 1361 ! … … 1364 1364 1365 1365 !Config Key = ok_plane_contrail 1366 !Config Desc = 1367 !Config Def = 01366 !Config Desc = include the formation of contrail cirrus clouds 1367 !Config Def = .FALSE. 1368 1368 !Config Help = 1369 1369 ! … … 2345 2345 rad_chau2 = rad_chau2_omp 2346 2346 iflag_ice_thermo = iflag_ice_thermo_omp 2347 ok_ice_su rsat = ok_ice_sursat_omp2347 ok_ice_supersat = ok_ice_supersat_omp 2348 2348 ok_plane_h2o = ok_plane_h2o_omp 2349 2349 ok_plane_contrail = ok_plane_contrail_omp … … 2770 2770 WRITE(lunout,*) ' rad_chau2 = ',rad_chau2 2771 2771 WRITE(lunout,*) ' iflag_ice_thermo = ',iflag_ice_thermo 2772 WRITE(lunout,*) ' ok_ice_su rsat = ',ok_ice_sursat2772 WRITE(lunout,*) ' ok_ice_supersat = ',ok_ice_supersat 2773 2773 WRITE(lunout,*) ' ok_plane_h2o = ',ok_plane_h2o 2774 2774 WRITE(lunout,*) ' ok_plane_contrail = ',ok_plane_contrail -
LMDZ6/trunk/libf/phylmd/create_etat0_unstruct_mod.F90
r5084 r5204 258 258 prw_ancien = 0. 259 259 agesno = 0. 260 261 ! LSCP condensation and ice supersaturation 262 cf_ancien = 0. 263 rvc_ancien = 0. 260 264 261 265 wake_delta_pbl_TKE(:,:,:)=0 … … 310 314 END IF 311 315 ratqs_inter_ = 0.002 312 rneb_ancien = 0.313 316 314 317 CALL gather_omp(cell_area,cell_area_mpi) -
LMDZ6/trunk/libf/phylmd/lmdz_lscp.F90
r5191 r5204 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, & … … 100 106 USE lmdz_lscp_tools, ONLY : icefrac_lscp, icefrac_lscp_turb 101 107 USE lmdz_lscp_tools, ONLY : fallice_velocity, distance_to_cloud_top 102 USE ice_sursat_mod, ONLY : ice_sursat108 USE lmdz_lscp_condensation, ONLY : condensation_lognormal, condensation_ice_supersat 103 109 USE lmdz_lscp_poprecip, ONLY : poprecip_precld, poprecip_postcld 104 110 105 111 ! Use du module lmdz_lscp_ini contenant les constantes 106 USE lmdz_lscp_ini, ONLY : prt_level, lunout 112 USE lmdz_lscp_ini, ONLY : prt_level, lunout, eps 107 113 USE lmdz_lscp_ini, ONLY : seuil_neb, niter_lscp, iflag_evap_prec, t_coup, DDT0, ztfondue, rain_int_min 108 114 USE lmdz_lscp_ini, ONLY : ok_radocond_snow, a_tr_sca, cld_expo_con, cld_expo_lsc … … 113 119 USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG 114 120 USE lmdz_lscp_ini, ONLY : ok_poprecip 115 USE lmdz_lscp_ini, ONLY : iflag_icefrac 121 USE lmdz_lscp_ini, ONLY : ok_external_lognormal, ok_ice_supersat, ok_unadjusted_clouds, iflag_icefrac 122 116 123 IMPLICIT NONE 117 124 … … 135 142 INTEGER, INTENT(IN) :: iflag_ice_thermo! flag to activate the ice thermodynamics 136 143 ! 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 144 LOGICAL, DIMENSION(klon,klev), INTENT(IN) :: ptconv ! grid points where deep convection scheme is active 140 145 … … 146 151 REAL, DIMENSION(klon,klev), INTENT(IN) :: pspsk ! exner potential (p/100000)**(R/cp) 147 152 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]153 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: tke !--turbulent kinetic energy [m2/s2] 154 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: tke_dissip !--TKE dissipation [m2/s3] 150 155 151 156 ! INPUT/OUTPUT variables … … 155 160 REAL, DIMENSION(klon,klev), INTENT(INOUT) :: ratqs ! function of pressure that sets the large-scale 156 161 157 158 ! Input sursaturation en glace 159 REAL, DIMENSION(klon,klev), INTENT(INOUT):: rneb_seri ! fraction nuageuse en memoire 162 ! INPUT/OUTPUT condensation and ice supersaturation 163 !-------------------------------------------------- 164 REAL, DIMENSION(klon,klev), INTENT(INOUT):: cf_seri ! cloud fraction [-] 165 REAL, DIMENSION(klon,klev), INTENT(INOUT):: ratio_qi_qtot ! solid specific water to total specific water ratio [-] 166 REAL, DIMENSION(klon,klev), INTENT(INOUT):: rvc_seri ! cloudy water vapor to total water vapor ratio [-] 167 REAL, DIMENSION(klon,klev), INTENT(IN) :: u_seri ! eastward wind [m/s] 168 REAL, DIMENSION(klon,klev), INTENT(IN) :: v_seri ! northward wind [m/s] 169 REAL, DIMENSION(klon), INTENT(IN) :: cell_area ! area of each cell [m2] 170 171 ! INPUT/OUTPUT aviation 172 !-------------------------------------------------- 173 REAL, DIMENSION(klon,klev), INTENT(IN) :: flight_dist ! Aviation distance flown within the mesh [m/s/mesh] 174 REAL, DIMENSION(klon,klev), INTENT(IN) :: flight_h2o ! Aviation H2O emitted within the mesh [kg H2O/s/mesh] 160 175 161 176 ! OUTPUT variables 162 177 !----------------- 163 178 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 179 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t ! temperature increment [K] 180 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q ! specific humidity increment [kg/kg] 181 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_ql ! liquid water increment [kg/kg] 182 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_qi ! cloud ice mass increment [kg/kg] 183 REAL, DIMENSION(klon,klev), INTENT(OUT) :: rneb ! cloud fraction [-] 184 REAL, DIMENSION(klon,klev), INTENT(OUT) :: rneblsvol ! cloud fraction per unit volume [-] 185 REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfraclr ! precip fraction clear-sky part [-] 186 REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfracld ! precip fraction cloudy part [-] 172 187 REAL, DIMENSION(klon,klev), INTENT(OUT) :: cldfraliq ! liquid fraction of cloud [-] 173 188 REAL, DIMENSION(klon,klev), INTENT(OUT) :: sigma2_icefracturb ! Variance of the diagnostic supersaturation distribution (icefrac_turb) [-] 174 189 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 190 REAL, DIMENSION(klon,klev), INTENT(OUT) :: radocond ! condensed water used in the radiation scheme [kg/kg] 191 REAL, DIMENSION(klon,klev), INTENT(OUT) :: radicefrac ! ice fraction of condensed water for radiation scheme 192 REAL, DIMENSION(klon,klev), INTENT(OUT) :: rhcl ! clear-sky relative humidity [-] 193 REAL, DIMENSION(klon), INTENT(OUT) :: rain ! surface large-scale rainfall [kg/s/m2] 194 REAL, DIMENSION(klon), INTENT(OUT) :: snow ! surface large-scale snowfall [kg/s/m2] 195 REAL, DIMENSION(klon,klev+1), INTENT(OUT) :: prfl ! large-scale rainfall flux in the column [kg/s/m2] 196 REAL, DIMENSION(klon,klev+1), INTENT(OUT) :: psfl ! large-scale snowfall flux in the column [kg/s/m2] 197 REAL, DIMENSION(klon,klev), INTENT(OUT) :: distcltop ! distance to cloud top [m] 198 REAL, DIMENSION(klon,klev), INTENT(OUT) :: temp_cltop ! temperature of cloud top [K] 199 REAL, DIMENSION(klon,klev), INTENT(OUT) :: beta ! conversion rate of condensed water 187 200 188 201 ! fraction of aerosol scavenging through impaction and nucleation (for on-line) … … 191 204 REAL, DIMENSION(klon,klev), INTENT(OUT) :: frac_nucl ! scavenging fraction due tu nucleation [-] 192 205 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 206 ! for condensation and ice supersaturation 207 208 REAL, DIMENSION(klon,klev), INTENT(OUT) :: qsub !--specific total water content in sub-saturated clear sky region [kg/kg] 209 REAL, DIMENSION(klon,klev), INTENT(OUT) :: qissr !--specific total water content in supersat region [kg/kg] 210 REAL, DIMENSION(klon,klev), INTENT(OUT) :: qcld !--specific total water content in cloudy region [kg/kg] 211 REAL, DIMENSION(klon,klev), INTENT(OUT) :: subfra !--mesh fraction of subsaturated clear sky [-] 212 REAL, DIMENSION(klon,klev), INTENT(OUT) :: issrfra !--mesh fraction of ISSR [-] 213 REAL, DIMENSION(klon,klev), INTENT(OUT) :: gamma_cond !--coefficient governing the ice nucleation RHi threshold [-] 214 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dcf_sub !--cloud fraction tendency because of sublimation [s-1] 215 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dcf_con !--cloud fraction tendency because of condensation [s-1] 216 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dcf_mix !--cloud fraction tendency because of cloud mixing [s-1] 217 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqi_adj !--specific ice content tendency because of temperature adjustment [kg/kg/s] 218 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqi_sub !--specific ice content tendency because of sublimation [kg/kg/s] 219 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqi_con !--specific ice content tendency because of condensation [kg/kg/s] 220 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqi_mix !--specific ice content tendency because of cloud mixing [kg/kg/s] 221 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqvc_adj !--specific cloud water vapor tendency because of temperature adjustment [kg/kg/s] 222 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqvc_sub !--specific cloud water vapor tendency because of sublimation [kg/kg/s] 223 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqvc_con !--specific cloud water vapor tendency because of condensation [kg/kg/s] 224 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqvc_mix !--specific cloud water vapor tendency because of cloud mixing [kg/kg/s] 225 REAL, DIMENSION(klon,klev), INTENT(OUT) :: qsatl !--saturation specific humidity wrt liquid [kg/kg] 226 REAL, DIMENSION(klon,klev), INTENT(OUT) :: qsati !--saturation specific humidity wrt ice [kg/kg] 227 228 ! for contrails and aviation 229 230 REAL, DIMENSION(klon,klev), INTENT(OUT) :: Tcontr !--threshold temperature for contrail formation [K] 231 REAL, DIMENSION(klon,klev), INTENT(OUT) :: qcontr !--threshold humidity for contrail formation [kg/kg] 232 REAL, DIMENSION(klon,klev), INTENT(OUT) :: qcontr2 !--// (2nd expression more consistent with LMDZ expression of q) 233 REAL, DIMENSION(klon,klev), INTENT(OUT) :: fcontrN !--fraction of grid favourable to non-persistent contrails 234 REAL, DIMENSION(klon,klev), INTENT(OUT) :: fcontrP !--fraction of grid favourable to persistent contrails 235 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dcf_avi !--cloud fraction tendency because of aviation [s-1] 236 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqi_avi !--specific ice content tendency because of aviation [kg/kg/s] 237 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqvc_avi !--specific cloud water vapor tendency because of aviation [kg/kg/s] 238 211 239 212 240 ! for POPRECIP … … 225 253 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqsfreez !--snow tendency due to freezing [kg/kg/s] 226 254 REAL, DIMENSION(klon,klev), INTENT(OUT) :: dqrfreez !--rain tendency due to freezing [kg/kg/s] 255 256 ! for thermals 257 258 REAL, DIMENSION(klon,klev), INTENT(OUT) :: cloudth_sth !--mean saturation deficit in thermals 259 REAL, DIMENSION(klon,klev), INTENT(OUT) :: cloudth_senv !--mean saturation deficit in environment 260 REAL, DIMENSION(klon,klev), INTENT(OUT) :: cloudth_sigmath !--std of saturation deficit in thermals 261 REAL, DIMENSION(klon,klev), INTENT(OUT) :: cloudth_sigmaenv !--std of saturation deficit in environment 227 262 228 263 … … 291 326 REAL, DIMENSION(klon) :: zdistcltop, ztemp_cltop 292 327 REAL, DIMENSION(klon) :: zqliq, zqice, zqvapcl ! for icefrac_lscp_turb 328 329 ! for condensation and ice supersaturation 330 REAL, DIMENSION(klon) :: qvc, shear 331 REAL :: delta_z 332 !--Added for ice supersaturation (ok_ice_supersat) and contrails (ok_plane_contrails) 333 ! Constants used for calculating ratios that are advected (using a parent-child 334 ! formalism). This is not done in the dynamical core because at this moment, 335 ! only isotopes can use this parent-child formalism. Note that the two constants 336 ! are the same as the one use in the dynamical core, being also defined in 337 ! dyn3d_common/infotrac.F90 338 REAL :: min_qParent, min_ratio 293 339 294 340 INTEGER i, k, n, kk, iter … … 376 422 ztemp_cltop(:) = 0.0 377 423 ztupnew(:)=0.0 378 !--ice supersaturation 379 gamma_ss(:,:) = 1.0 380 qss(:,:) = 0.0 381 rnebss(:,:) = 0.0 382 Tcontr(:,:) = missing_val 383 qcontr(:,:) = missing_val 384 qcontr2(:,:) = missing_val 385 fcontrN(:,:) = 0.0 386 fcontrP(:,:) = 0.0 424 387 425 distcltop(:,:)=0. 388 426 temp_cltop(:,:)=0. 427 428 !--Ice supersaturation 429 gamma_cond(:,:) = 1. 430 qissr(:,:) = 0. 431 issrfra(:,:) = 0. 432 dcf_sub(:,:) = 0. 433 dcf_con(:,:) = 0. 434 dcf_mix(:,:) = 0. 435 dqi_adj(:,:) = 0. 436 dqi_sub(:,:) = 0. 437 dqi_con(:,:) = 0. 438 dqi_mix(:,:) = 0. 439 dqvc_adj(:,:) = 0. 440 dqvc_sub(:,:) = 0. 441 dqvc_con(:,:) = 0. 442 dqvc_mix(:,:) = 0. 443 fcontrN(:,:) = 0. 444 fcontrP(:,:) = 0. 445 Tcontr(:,:) = missing_val 446 qcontr(:,:) = missing_val 447 qcontr2(:,:) = missing_val 448 dcf_avi(:,:) = 0. 449 dqi_avi(:,:) = 0. 450 dqvc_avi(:,:) = 0. 451 qvc(:) = 0. 452 shear(:) = 0. 453 min_qParent = 1.e-30 454 min_ratio = 1.e-16 389 455 390 456 !-- poprecip … … 777 843 rneblsvol(i,k)=ctot_vol(i,k) 778 844 zqn(i)=qcloud(i) 845 !--AB grid-mean vapor in the cloud - we assume saturation adjustment 846 qvc(i) = rneb(i,k) * zqs(i) 779 847 ENDDO 780 848 … … 812 880 DO iter=1,iflag_fisrtilp_qsat+1 813 881 882 keepgoing(:) = .FALSE. 883 814 884 DO i=1,klon 815 885 816 886 ! keepgoing = .true. while convergence is not satisfied 817 keepgoing(i)=ABS(DT(i)).GT.DDT0 818 819 IF ((keepgoing(i) .OR. (n_i(i) .EQ. 0)) .AND. lognormale(i)) THEN 887 888 IF (((ABS(DT(i)).GT.DDT0) .OR. (n_i(i) .EQ. 0)) .AND. lognormale(i)) THEN 820 889 821 890 ! if not convergence: 891 ! we calculate a new iteration 892 keepgoing(i) = .TRUE. 822 893 823 894 ! P2.2.1> cloud fraction and condensed water mass calculation … … 852 923 CALL icefrac_lscp(klon, zt(:), iflag_ice_thermo, zdistcltop(:),ztemp_cltop(:),zfice(:),dzfice(:)) 853 924 925 !--AB Activates a condensation scheme that allows for 926 !--ice supersaturation and contrails evolution from aviation 927 IF (ok_ice_supersat) THEN 928 929 !--Calculate the shear value (input for condensation and ice supersat) 930 DO i = 1, klon 931 !--Cell thickness [m] 932 delta_z = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * Tbef(i) * RD 933 IF ( iftop ) THEN 934 ! top 935 shear(i) = SQRT( ( (u_seri(i,k) - u_seri(i,k-1)) / delta_z )**2. & 936 + ( (v_seri(i,k) - v_seri(i,k-1)) / delta_z )**2. ) 937 ELSEIF ( k .EQ. 1 ) THEN 938 ! surface 939 shear(i) = SQRT( ( (u_seri(i,k+1) - u_seri(i,k)) / delta_z )**2. & 940 + ( (v_seri(i,k+1) - v_seri(i,k)) / delta_z )**2. ) 941 ELSE 942 ! other layers 943 shear(i) = SQRT( ( ( (u_seri(i,k+1) + u_seri(i,k)) / 2. & 944 - (u_seri(i,k) + u_seri(i,k-1)) / 2. ) / delta_z )**2. & 945 + ( ( (v_seri(i,k+1) + v_seri(i,k)) / 2. & 946 - (v_seri(i,k) + v_seri(i,k-1)) / 2. ) / delta_z )**2. ) 947 ENDIF 948 ENDDO 949 950 !--------------------------------------------- 951 !-- CONDENSATION AND ICE SUPERSATURATION -- 952 !--------------------------------------------- 953 954 CALL condensation_ice_supersat( & 955 klon, dtime, missing_val, & 956 pplay(:,k), paprs(:,k), paprs(:,k+1), & 957 cf_seri(:,k), rvc_seri(:,k), ratio_qi_qtot(:,k), & 958 shear(:), tke_dissip(:,k), cell_area(:), & 959 Tbef(:), zq(:), zqs(:), gammasat(:), ratqs(:,k), keepgoing(:), & 960 rneb(:,k), zqn(:), qvc(:), issrfra(:,k), qissr(:,k), & 961 dcf_sub(:,k), dcf_con(:,k), dcf_mix(:,k), & 962 dqi_adj(:,k), dqi_sub(:,k), dqi_con(:,k), dqi_mix(:,k), & 963 dqvc_adj(:,k), dqvc_sub(:,k), dqvc_con(:,k), dqvc_mix(:,k), & 964 Tcontr(:,k), qcontr(:,k), qcontr2(:,k), fcontrN(:,k), fcontrP(:,k), & 965 flight_dist(:,k), flight_h2o(:,k), & 966 dcf_avi(:,k), dqi_avi(:,k), dqvc_avi(:,k)) 967 968 969 !--If .TRUE., calls an externalised version of the generalised 970 !--lognormal condensation scheme (Bony and Emanuel 2001) 971 !--Numerically, convergence is conserved with this option 972 !--The objective is to simplify LSCP 973 ELSEIF ( ok_external_lognormal ) THEN 974 975 CALL condensation_lognormal( & 976 klon, Tbef(:), zq(:), zqs(:), gammasat(:), ratqs(:,k), & 977 keepgoing(:), rneb(:,k), zqn(:), qvc(:)) 978 979 980 ELSE !--Generalised lognormal (Bony and Emanuel 2001) 981 854 982 DO i=1,klon !todoan : check if loop in i is needed 855 983 856 IF ( (keepgoing(i) .OR. (n_i(i) .EQ. 0)) .AND. lognormale(i)) THEN984 IF (keepgoing(i)) THEN 857 985 858 986 zpdf_sig(i)=ratqs(i,k)*zq(i) … … 868 996 zpdf_e2(i)=1.-erf(zpdf_e2(i)) 869 997 870 IF ((.NOT.ok_ice_sursat).OR.(Tbef(i).GT.t_glace_min)) THEN871 872 998 IF (zpdf_e1(i).LT.1.e-10) THEN 873 999 rneb(i,k)=0. 874 zqn(i)=gammasat(i)*zqs(i) 1000 zqn(i)=zqs(i) 1001 !--AB grid-mean vapor in the cloud - we assume saturation adjustment 1002 qvc(i) = 0. 875 1003 ELSE 876 1004 rneb(i,k)=0.5*zpdf_e1(i) 877 1005 zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i) 1006 !--AB grid-mean vapor in the cloud - we assume saturation adjustment 1007 qvc(i) = rneb(i,k) * zqs(i) 878 1008 ENDIF 879 1009 880 rnebss(i,k)=0.0 !--added by OB (needed because of the convergence loop on time) 881 fcontrN(i,k)=0.0 !--idem 882 fcontrP(i,k)=0.0 !--idem 883 qss(i,k)=0.0 !--idem 884 885 ELSE ! in case of ice supersaturation by Audran 886 887 !------------------------------------ 888 ! ICE SUPERSATURATION 889 !------------------------------------ 890 891 CALL ice_sursat(pplay(i,k), paprs(i,k)-paprs(i,k+1), dtime, i, k, temp(i,k), zq(i), & 892 gamma_ss(i,k), zqs(i), Tbef(i), rneb_seri(i,k), ratqs(i,k), & 893 rneb(i,k), zqn(i), rnebss(i,k), qss(i,k), & 894 Tcontr(i,k), qcontr(i,k), qcontr2(i,k), fcontrN(i,k), fcontrP(i,k) ) 895 896 ENDIF ! ((flag_ice_sursat.eq.0).or.(Tbef(i).gt.t_glace_min)) 1010 ENDIF ! keepgoing 1011 ENDDO ! loop on klon 1012 1013 ENDIF ! .NOT. ok_ice_supersat 1014 1015 DO i=1,klon 1016 IF (keepgoing(i)) THEN 897 1017 898 1018 ! If vertical heterogeneity, change fraction by volume as well … … 917 1037 918 1038 ! LEA_R : check formule 919 qlbef(i)=max(0.,zqn(i)-zqs(i)) 1039 IF ( ok_unadjusted_clouds ) THEN 1040 !--AB We relax the saturation adjustment assumption 1041 !-- qvc (grid-mean vapor in cloud) is calculated by the condensation scheme 1042 IF ( rneb(i,k) .GT. eps ) THEN 1043 qlbef(i) = MAX(0., zqn(i) - qvc(i) / rneb(i,k)) 1044 ELSE 1045 qlbef(i) = 0. 1046 ENDIF 1047 ELSE 1048 qlbef(i)=max(0.,zqn(i)-zqs(i)) 1049 ENDIF 1050 920 1051 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT & 921 1052 +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i) … … 953 1084 954 1085 ! Partition function depending on temperature 955 CALL icefrac_lscp(klon, zt,iflag_ice_thermo, zdistcltop,ztemp_cltop,zfice,dzfice)1086 CALL icefrac_lscp(klon, zt, iflag_ice_thermo, zdistcltop, ztemp_cltop, zfice, dzfice) 956 1087 957 1088 ! Partition function depending on tke for non shallow-convective clouds … … 984 1115 zqn(i) = zq(i) 985 1116 rneb(i,k) = 1.0 986 zcond(i) = MAX(0.0,zqn(i)-zqs(i)) 1117 IF ( ok_unadjusted_clouds ) THEN 1118 !--AB We relax the saturation adjustment assumption 1119 !-- qvc (grid-mean vapor in cloud) is calculated by the condensation scheme 1120 zcond(i) = MAX(0., zqn(i) - qvc(i)) 1121 ELSE 1122 zcond(i) = MAX(0.0,zqn(i)-zqs(i)) 1123 ENDIF 987 1124 rhcl(i,k)=1.0 988 1125 ELSE 989 zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k) 1126 IF ( ok_unadjusted_clouds ) THEN 1127 !--AB We relax the saturation adjustment assumption 1128 !-- qvc (grid-mean vapor in cloud) is calculated by the condensation scheme 1129 zcond(i) = MAX(0., zqn(i) * rneb(i,k) - qvc(i)) 1130 ELSE 1131 zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k) 1132 ENDIF 990 1133 ! following line is very strange and probably wrong: 991 1134 rhcl(i,k)=(zqs(i)+zq(i))/2./zqs(i) … … 1019 1162 rneblsvol(1:klon,k)=ctot_vol(1:klon,k) 1020 1163 ENDIF 1164 1165 !--AB Write diagnostics and tracers for ice supersaturation 1166 IF ( ok_ice_supersat ) THEN 1167 CALL calc_qsat_ecmwf(klon,zt,qzero,pplay(:,k),RTT,1,.false.,qsatl(:,k),zdqs) 1168 CALL calc_qsat_ecmwf(klon,zt,qzero,pplay(:,k),RTT,2,.false.,qsati(:,k),zdqs) 1169 1170 DO i = 1, klon 1171 1172 cf_seri(i,k) = rneb(i,k) 1173 1174 IF ( .NOT. ok_unadjusted_clouds ) THEN 1175 qvc(i) = zqs(i) * rneb(i,k) 1176 ENDIF 1177 IF ( zq(i) .GT. min_qParent ) THEN 1178 rvc_seri(i,k) = qvc(i) / zq(i) 1179 ELSE 1180 rvc_seri(i,k) = min_ratio 1181 ENDIF 1182 !--The MIN barrier is NEEDED because of: 1183 !-- 1) very rare pathological cases of the lsc scheme (rvc = 1. + 1e-16 sometimes) 1184 !-- 2) the thermal scheme does NOT guarantee that qvc <= qvap (or even qincld <= qtot) 1185 !--The MAX barrier is a safeguard that should not be activated 1186 rvc_seri(i,k) = MIN(MAX(rvc_seri(i,k), 0.), 1.) 1187 1188 !--Diagnostics 1189 gamma_cond(i,k) = gammasat(i) 1190 IF ( issrfra(i,k) .LT. eps ) THEN 1191 issrfra(i,k) = 0. 1192 qissr(i,k) = 0. 1193 ENDIF 1194 subfra(i,k) = 1. - cf_seri(i,k) - issrfra(i,k) 1195 qsub(i,k) = zq(i) - qvc(i) - qissr(i,k) 1196 IF ( subfra(i,k) .LT. eps ) THEN 1197 subfra(i,k) = 0. 1198 qsub(i,k) = 0. 1199 ENDIF 1200 qcld(i,k) = qvc(i) + zcond(i) 1201 IF ( cf_seri(i,k) .LT. eps ) THEN 1202 qcld(i,k) = 0. 1203 ENDIF 1204 ENDDO 1205 ENDIF 1206 1021 1207 1022 1208 ! ---------------------------------------------------------------- … … 1440 1626 ENDDO 1441 1627 1442 !--save some variables for ice supersaturation1443 !1444 DO i = 1, klon1445 ! for memory1446 rneb_seri(i,k) = rneb(i,k)1447 1448 ! for diagnostics1449 rnebclr(i,k) = 1.0 - rneb(i,k) - rnebss(i,k)1450 1451 qvc(i,k) = zqs(i) * rneb(i,k)1452 qclr(i,k) = MAX(1.e-10,zq(i) - qvc(i,k) - qss(i,k)) !--added by OB because of pathologic cases with the lognormal1453 qcld(i,k) = qvc(i,k) + zcond(i)1454 ENDDO1455 !q_sat1456 CALL calc_qsat_ecmwf(klon,Tbef(:),qzero(:),pplay(:,k),RTT,1,.false.,qsatl(:,k),zdqs(:))1457 CALL calc_qsat_ecmwf(klon,Tbef(:),qzero(:),pplay(:,k),RTT,2,.false.,qsats(:,k),zdqs(:))1458 1459 1460 1461 1628 ! Outputs: 1462 1629 !------------------------------- -
LMDZ6/trunk/libf/phylmd/lmdz_lscp_ini.F90
r5007 r5204 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 ioipsl_getin_p_mod, ONLY : getin_p 254 USE ice_sursat_mod, ONLY: ice_sursat_init255 323 USE lmdz_cloudth_ini, ONLY : cloudth_ini 256 324 257 325 REAL, INTENT(IN) :: dtime 258 326 INTEGER, INTENT(IN) :: lunout_in,prt_level_in,iflag_ratqs,fl_cor_ebil_in 259 LOGICAL, INTENT(IN) :: ok_ice_su rsat327 LOGICAL, INTENT(IN) :: ok_ice_supersat_in 260 328 261 329 REAL, INTENT(IN) :: RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in 262 REAL, INTENT(IN) :: RVTMP2_in, RTT_in, RD_in, RG_in, RV_in, RPI_in330 REAL, INTENT(IN) :: RVTMP2_in, RTT_in, RD_in, RV_in, RG_in, RPI_in, EPS_W_in 263 331 character (len=20) :: modname='lscp_ini_mod' 264 332 character (len=80) :: abort_message … … 269 337 fl_cor_ebil=fl_cor_ebil_in 270 338 339 ok_ice_supersat=ok_ice_supersat_in 340 271 341 RG=RG_in 272 342 RD=RD_in 343 RV=RV_in 273 344 RCPD=RCPD_in 274 345 RLVTT=RLVTT_in … … 279 350 RVTMP2=RVTMP2_in 280 351 RPI=RPI_in 352 EPS_W=EPS_W_in 281 353 282 354 … … 326 398 CALL getin_p('gamma_taud',gamma_taud) 327 399 CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp) 400 CALL getin_p('temp_nowater',temp_nowater) 401 ! for poprecip 328 402 CALL getin_p('ok_poprecip',ok_poprecip) 329 403 CALL getin_p('ok_corr_vap_evasub',ok_corr_vap_evasub) … … 345 419 CALL getin_p('snow_fallspeed_clr',snow_fallspeed_clr) 346 420 CALL getin_p('snow_fallspeed_cld',snow_fallspeed_cld) 421 ! for condensation and ice supersaturation 422 CALL getin_p('ok_external_lognormal',ok_external_lognormal) 423 CALL getin_p('ok_unadjusted_clouds',ok_unadjusted_clouds) 424 CALL getin_p('ok_weibull_warm_clouds',ok_weibull_warm_clouds) 425 CALL getin_p('iflag_cloud_sublim_pdf',iflag_cloud_sublim_pdf) 426 CALL getin_p('depo_coef_cirrus',depo_coef_cirrus) 427 CALL getin_p('capa_cond_cirrus',capa_cond_cirrus) 428 CALL getin_p('mu_subl_pdf_lscp',mu_subl_pdf_lscp) 429 CALL getin_p('beta_pdf_lscp',beta_pdf_lscp) 430 CALL getin_p('temp_thresh_pdf_lscp',temp_thresh_pdf_lscp) 431 CALL getin_p('rhlmid_pdf_lscp',rhlmid_pdf_lscp) 432 CALL getin_p('k0_pdf_lscp',k0_pdf_lscp) 433 CALL getin_p('kappa_pdf_lscp',kappa_pdf_lscp) 434 CALL getin_p('rhl0_pdf_lscp',rhl0_pdf_lscp) 435 CALL getin_p('cond_thresh_pdf_lscp',cond_thresh_pdf_lscp) 436 CALL getin_p('a_homofreez',a_homofreez) 437 CALL getin_p('b_homofreez',b_homofreez) 438 CALL getin_p('delta_hetfreez',delta_hetfreez) 439 CALL getin_p('coef_mixing_lscp',coef_mixing_lscp) 440 CALL getin_p('coef_shear_lscp',coef_shear_lscp) 441 CALL getin_p('chi_mixing_lscp',chi_mixing_lscp) 442 !CALL getin_p('contrail_cross_section',contrail_cross_section) 347 443 348 444 … … 390 486 WRITE(lunout,*) 'lscp_ini, iflag_oldbug_fisrtilp', iflag_oldbug_fisrtilp 391 487 WRITE(lunout,*) 'lscp_ini, fl_cor_ebil', fl_cor_ebil 488 WRITE(lunout,*) 'lscp_ini, temp_nowater', temp_nowater 489 ! for poprecip 392 490 WRITE(lunout,*) 'lscp_ini, ok_poprecip', ok_poprecip 393 491 WRITE(lunout,*) 'lscp_ini, ok_corr_vap_evasub', ok_corr_vap_evasub … … 403 501 WRITE(lunout,*) 'lscp_ini, snow_fallspeed_clr:', snow_fallspeed_clr 404 502 WRITE(lunout,*) 'lscp_ini, snow_fallspeed_cld:', snow_fallspeed_cld 503 ! for condensation and ice supersaturation 504 WRITE(lunout,*) 'lscp_ini, ok_external_lognormal:', ok_external_lognormal 505 WRITE(lunout,*) 'lscp_ini, ok_ice_supersat:', ok_ice_supersat 506 WRITE(lunout,*) 'lscp_ini, ok_unadjusted_clouds:', ok_unadjusted_clouds 507 WRITE(lunout,*) 'lscp_ini, ok_weibull_warm_clouds:', ok_weibull_warm_clouds 508 WRITE(lunout,*) 'lscp_ini, iflag_cloud_sublim_pdf:', iflag_cloud_sublim_pdf 509 WRITE(lunout,*) 'lscp_ini, depo_coef_cirrus:', depo_coef_cirrus 510 WRITE(lunout,*) 'lscp_ini, capa_cond_cirrus:', capa_cond_cirrus 511 WRITE(lunout,*) 'lscp_ini, mu_subl_pdf_lscp:', mu_subl_pdf_lscp 512 WRITE(lunout,*) 'lscp_ini, beta_pdf_lscp:', beta_pdf_lscp 513 WRITE(lunout,*) 'lscp_ini, temp_thresh_pdf_lscp:', temp_thresh_pdf_lscp 514 WRITE(lunout,*) 'lscp_ini, rhlmid_pdf_lscp:', rhlmid_pdf_lscp 515 WRITE(lunout,*) 'lscp_ini, k0_pdf_lscp:', k0_pdf_lscp 516 WRITE(lunout,*) 'lscp_ini, kappa_pdf_lscp:', kappa_pdf_lscp 517 WRITE(lunout,*) 'lscp_ini, rhl0_pdf_lscp:', rhl0_pdf_lscp 518 WRITE(lunout,*) 'lscp_ini, a_homofreez:', a_homofreez 519 WRITE(lunout,*) 'lscp_ini, b_homofreez:', b_homofreez 520 WRITE(lunout,*) 'lscp_ini, delta_hetfreez', delta_hetfreez 521 WRITE(lunout,*) 'lscp_ini, coef_mixing_lscp:', coef_mixing_lscp 522 WRITE(lunout,*) 'lscp_ini, coef_shear_lscp:', coef_shear_lscp 523 WRITE(lunout,*) 'lscp_ini, chi_mixing_lscp:', chi_mixing_lscp 524 ! WRITE(lunout,*) 'lscp_ini, contrail_cross_section:', contrail_cross_section 405 525 406 526 … … 425 545 426 546 547 !--Check flags for condensation and ice supersaturation 548 IF ( ok_external_lognormal .AND. ok_ice_supersat ) THEN 549 abort_message = 'in lscp, ok_external_lognormal=y is incompatible with ok_ice_supersat=y' 550 CALL abort_physic (modname,abort_message,1) 551 ENDIF 552 553 IF ( ok_weibull_warm_clouds .AND. .NOT. ok_ice_supersat ) THEN 554 abort_message = 'in lscp, ok_weibull_warm_clouds=y needs ok_ice_supersat=y' 555 CALL abort_physic (modname,abort_message,1) 556 ENDIF 557 558 IF ( ok_unadjusted_clouds .AND. .NOT. ok_ice_supersat ) THEN 559 abort_message = 'in lscp, ok_unadjusted_clouds=y needs ok_ice_supersat=y' 560 CALL abort_physic (modname,abort_message,1) 561 ENDIF 562 563 427 564 !AA Temporary initialisation 428 565 a_tr_sca(1) = -0.5 … … 431 568 a_tr_sca(4) = -0.5 432 569 433 IF (ok_ice_sursat) CALL ice_sursat_init()434 435 570 CALL cloudth_ini(iflag_cloudth_vert,iflag_ratqs) 436 571 -
LMDZ6/trunk/libf/phylmd/lmdz_lscp_poprecip.F90
r5047 r5204 247 247 248 248 ELSEIF ( ( rain(i) + snow(i) ) .LE. 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/trunk/libf/phylmd/lmdz_lscp_tools.F90
r5170 r5204 581 581 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 582 582 583 use lmdz_lscp_ini, only: iflag_gammasat, t_glace_min, RTT 583 use lmdz_lscp_ini, only: iflag_gammasat, temp_nowater, RTT 584 use lmdz_lscp_ini, only: a_homofreez, b_homofreez, delta_hetfreez 584 585 585 586 IMPLICIT NONE … … 596 597 597 598 REAL, DIMENSION(klon) :: qsi,qsl,dqsl,dqsi 598 REAL fcirrus, fac 599 REAL, PARAMETER :: acirrus=2.349 600 REAL, PARAMETER :: bcirrus=259.0 599 REAL f_homofreez, fac 601 600 602 601 INTEGER i … … 605 604 CALL CALC_QSAT_ECMWF(klon,temp,qtot,pressure,RTT,2,.false.,qsi,dqsi) 606 605 607 DO i =1,klon608 609 IF ( temp(i) .GE. RTT) THEN606 DO i = 1, klon 607 608 IF ( temp(i) .GE. RTT ) THEN 610 609 ! warm clouds: condensation at saturation wrt liquid 611 gammasat(i)=1. 612 dgammasatdt(i)=0. 613 614 ELSEIF ((temp(i) .LT. RTT) .AND. (temp(i) .GT. t_glace_min)) THEN 610 gammasat(i) = 1. 611 dgammasatdt(i) = 0. 612 613 ELSE 614 ! cold clouds: qsi > qsl 615 615 616 IF (iflag_gammasat .GE. 2) THEN 617 gammasat(i)=qsl(i)/qsi(i) 618 dgammasatdt(i)=(dqsl(i)*qsi(i)-dqsi(i)*qsl(i))/qsi(i)/qsi(i) 616 ! homogeneous freezing of aerosols, according to 617 ! Koop, 2000 and Ren and MacKenzie, 2005 (QJRMS) 618 ! 'Cirrus regime' 619 ! if f_homofreez > qsl / qsi, liquid nucleation 620 ! if f_homofreez < qsl / qsi, homogeneous freezing of aerosols 621 ! Note: f_homofreez = qsl / qsi for temp ~= -38degC 622 f_homofreez = a_homofreez - temp(i) / b_homofreez 623 624 IF ( iflag_gammasat .GE. 3 ) THEN 625 ! condensation at homogeneous freezing threshold for temp < -38 degC 626 ! condensation at liquid saturation for temp > -38 degC 627 IF ( f_homofreez .LE. qsl(i) / qsi(i) ) THEN 628 gammasat(i) = f_homofreez 629 dgammasatdt(i) = - 1. / b_homofreez 630 ELSE 631 gammasat(i) = qsl(i) / qsi(i) 632 dgammasatdt(i) = ( dqsl(i) * qsi(i) - dqsi(i) * qsl(i) ) / qsi(i) / qsi(i) 633 ENDIF 634 635 ELSEIF ( iflag_gammasat .EQ. 2 ) THEN 636 ! condensation at homogeneous freezing threshold for temp < -38 degC 637 ! condensation at a threshold linearly decreasing between homogeneous 638 ! freezing and ice saturation for -38 degC < temp < temp_nowater 639 ! condensation at ice saturation for temp > temp_nowater 640 ! If temp_nowater = 235.15 K, this is equivalent to iflag_gammasat = 1 641 IF ( f_homofreez .LE. qsl(i) / qsi(i) ) THEN 642 gammasat(i) = f_homofreez 643 dgammasatdt(i) = - 1. / b_homofreez 644 ELSEIF ( temp(i) .LE. temp_nowater ) THEN 645 ! Here, we assume that f_homofreez = qsl / qsi for temp = -38 degC = 235.15 K 646 dgammasatdt(i) = ( a_homofreez - 235.15 / b_homofreez - 1. ) & 647 / ( 235.15 - temp_nowater ) 648 gammasat(i) = dgammasatdt(i) * ( temp(i) - temp_nowater ) + 1. 649 ELSE 650 gammasat(i) = 1. 651 dgammasatdt(i) = 0. 652 ENDIF 653 654 ELSEIF ( iflag_gammasat .EQ. 1 ) THEN 655 ! condensation at homogeneous freezing threshold for temp < -38 degC 656 ! condensation at ice saturation for temp > -38 degC 657 IF ( f_homofreez .LE. qsl(i) / qsi(i) ) THEN 658 gammasat(i) = f_homofreez 659 dgammasatdt(i) = - 1. / b_homofreez 660 ELSE 661 gammasat(i) = 1. 662 dgammasatdt(i) = 0. 663 ENDIF 664 619 665 ELSE 620 gammasat(i)=1. 621 dgammasatdt(i)=0. 666 ! condensation at ice saturation for temp < -38 degC 667 ! condensation at ice saturation for temp > -38 degC 668 gammasat(i) = 1. 669 dgammasatdt(i) = 0. 670 622 671 ENDIF 623 672 624 ELSE 625 626 IF (iflag_gammasat .GE.1) THEN 627 ! homogeneous freezing of aerosols, according to 628 ! Koop, 2000 and Karcher 2008, QJRMS 629 ! 'Cirrus regime' 630 fcirrus=acirrus-temp(i)/bcirrus 631 IF (fcirrus .GT. qsl(i)/qsi(i)) THEN 632 gammasat(i)=qsl(i)/qsi(i) 633 dgammasatdt(i)=(dqsl(i)*qsi(i)-dqsi(i)*qsl(i))/qsi(i)/qsi(i) 634 ELSE 635 gammasat(i)=fcirrus 636 dgammasatdt(i)=-1.0/bcirrus 637 ENDIF 638 639 ELSE 640 641 gammasat(i)=1. 642 dgammasatdt(i)=0. 643 644 ENDIF 673 ! Note that the delta_hetfreez parameter allows to linearly decrease the 674 ! condensation threshold between the calculated threshold and the ice saturation 675 ! for delta_hetfreez = 1, the threshold is the calculated condensation threshold 676 ! for delta_hetfreez = 0, the threshold is the ice saturation 677 gammasat(i) = ( 1. - delta_hetfreez ) + delta_hetfreez * gammasat(i) 678 dgammasatdt(i) = delta_hetfreez * dgammasatdt(i) 645 679 646 680 ENDIF … … 722 756 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 723 757 758 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 759 FUNCTION GAMMAINC ( p, x ) 760 761 !*****************************************************************************80 762 ! 763 !! GAMMAINC computes the regularized lower incomplete Gamma Integral 764 ! 765 ! Modified: 766 ! 767 ! 20 January 2008 768 ! 769 ! Author: 770 ! 771 ! Original FORTRAN77 version by B Shea. 772 ! FORTRAN90 version by John Burkardt. 773 ! 774 ! Reference: 775 ! 776 ! B Shea, 777 ! Algorithm AS 239: 778 ! Chi-squared and Incomplete Gamma Integral, 779 ! Applied Statistics, 780 ! Volume 37, Number 3, 1988, pages 466-473. 781 ! 782 ! Parameters: 783 ! 784 ! Input, real X, P, the parameters of the incomplete 785 ! gamma ratio. 0 <= X, and 0 < P. 786 ! 787 ! Output, real GAMMAINC, the value of the incomplete 788 ! Gamma integral. 789 ! 790 IMPLICIT NONE 791 792 REAL A 793 REAL AN 794 REAL ARG 795 REAL B 796 REAL C 797 REAL, PARAMETER :: ELIMIT = - 88.0E+00 798 REAL GAMMAINC 799 REAL, PARAMETER :: OFLO = 1.0E+37 800 REAL P 801 REAL, PARAMETER :: PLIMIT = 1000.0E+00 802 REAL PN1 803 REAL PN2 804 REAL PN3 805 REAL PN4 806 REAL PN5 807 REAL PN6 808 REAL RN 809 REAL, PARAMETER :: TOL = 1.0E-14 810 REAL X 811 REAL, PARAMETER :: XBIG = 1.0E+08 812 813 GAMMAINC = 0.0E+00 814 815 IF ( X == 0.0E+00 ) THEN 816 GAMMAINC = 0.0E+00 817 RETURN 818 END IF 819 ! 820 ! IF P IS LARGE, USE A NORMAL APPROXIMATION. 821 ! 822 IF ( PLIMIT < P ) THEN 823 824 PN1 = 3.0E+00 * SQRT ( P ) * ( ( X / P )**( 1.0E+00 / 3.0E+00 ) & 825 + 1.0E+00 / ( 9.0E+00 * P ) - 1.0E+00 ) 826 827 GAMMAINC = 0.5E+00 * ( 1. + ERF ( PN1 ) ) 828 RETURN 829 830 END IF 831 ! 832 ! IF X IS LARGE SET GAMMAD = 1. 833 ! 834 IF ( XBIG < X ) THEN 835 GAMMAINC = 1.0E+00 836 RETURN 837 END IF 838 ! 839 ! USE PEARSON'S SERIES EXPANSION. 840 ! (NOTE THAT P IS NOT LARGE ENOUGH TO FORCE OVERFLOW IN ALOGAM). 841 ! 842 IF ( X <= 1.0E+00 .OR. X < P ) THEN 843 844 ARG = P * LOG ( X ) - X - LOG_GAMMA ( P + 1.0E+00 ) 845 C = 1.0E+00 846 GAMMAINC = 1.0E+00 847 A = P 848 849 DO 850 851 A = A + 1.0E+00 852 C = C * X / A 853 GAMMAINC = GAMMAINC + C 854 855 IF ( C <= TOL ) THEN 856 EXIT 857 END IF 858 859 END DO 860 861 ARG = ARG + LOG ( GAMMAINC ) 862 863 IF ( ELIMIT <= ARG ) THEN 864 GAMMAINC = EXP ( ARG ) 865 ELSE 866 GAMMAINC = 0.0E+00 867 END IF 868 ! 869 ! USE A CONTINUED FRACTION EXPANSION. 870 ! 871 ELSE 872 873 ARG = P * LOG ( X ) - X - LOG_GAMMA ( P ) 874 A = 1.0E+00 - P 875 B = A + X + 1.0E+00 876 C = 0.0E+00 877 PN1 = 1.0E+00 878 PN2 = X 879 PN3 = X + 1.0E+00 880 PN4 = X * B 881 GAMMAINC = PN3 / PN4 882 883 DO 884 885 A = A + 1.0E+00 886 B = B + 2.0E+00 887 C = C + 1.0E+00 888 AN = A * C 889 PN5 = B * PN3 - AN * PN1 890 PN6 = B * PN4 - AN * PN2 891 892 IF ( PN6 /= 0.0E+00 ) THEN 893 894 RN = PN5 / PN6 895 896 IF ( ABS ( GAMMAINC - RN ) <= MIN ( TOL, TOL * RN ) ) THEN 897 EXIT 898 END IF 899 900 GAMMAINC = RN 901 902 END IF 903 904 PN1 = PN3 905 PN2 = PN4 906 PN3 = PN5 907 PN4 = PN6 908 ! 909 ! RE-SCALE TERMS IN CONTINUED FRACTION IF TERMS ARE LARGE. 910 ! 911 IF ( OFLO <= ABS ( PN5 ) ) THEN 912 PN1 = PN1 / OFLO 913 PN2 = PN2 / OFLO 914 PN3 = PN3 / OFLO 915 PN4 = PN4 / OFLO 916 END IF 917 918 END DO 919 920 ARG = ARG + LOG ( GAMMAINC ) 921 922 IF ( ELIMIT <= ARG ) THEN 923 GAMMAINC = 1.0E+00 - EXP ( ARG ) 924 ELSE 925 GAMMAINC = 1.0E+00 926 END IF 927 928 END IF 929 930 RETURN 931 END FUNCTION GAMMAINC 932 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 933 724 934 END MODULE lmdz_lscp_tools 725 935 -
LMDZ6/trunk/libf/phylmd/phyetat0_mod.F90
r5199 r5204 21 21 du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, & 22 22 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, & 23 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, & 24 cf_ancien, rvc_ancien, radpas, radsol, rain_fall, ratqs, & 24 25 rnebcon, rugoro, sig1, snow_fall, bs_fall, solaire_etat0, sollw, sollwdown, & 25 26 solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, & … … 397 398 ancien_ok=ancien_ok.AND.phyetat0_get(ql_ancien,"QLANCIEN","QLANCIEN",0.) 398 399 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 400 ancien_ok=ancien_ok.AND.phyetat0_get(u_ancien,"UANCIEN","UANCIEN",0.) 401 401 ancien_ok=ancien_ok.AND.phyetat0_get(v_ancien,"VANCIEN","VANCIEN",0.) … … 412 412 prbsw_ancien(:)=0. 413 413 ENDIF 414 415 ! cas specifique des variables de la sursaturation par rapport a la glace 416 IF ( ok_ice_supersat ) THEN 417 ancien_ok=ancien_ok.AND.phyetat0_get(cf_ancien,"CFANCIEN","CFANCIEN",0.) 418 ancien_ok=ancien_ok.AND.phyetat0_get(rvc_ancien,"RVCANCIEN","RVCANCIEN",0.) 419 ELSE 420 cf_ancien(:,:)=0. 421 rvc_ancien(:,:)=0. 422 ENDIF 414 423 415 424 ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain … … 419 428 (maxval(ql_ancien).EQ.minval(ql_ancien)) .OR. & 420 429 (maxval(qs_ancien).EQ.minval(qs_ancien)) .OR. & 421 (maxval(rneb_ancien).EQ.minval(rneb_ancien)) .OR. &422 430 (maxval(prw_ancien).EQ.minval(prw_ancien)) .OR. & 423 431 (maxval(prlw_ancien).EQ.minval(prlw_ancien)) .OR. & … … 432 440 ancien_ok=.false. 433 441 ENDIF 442 ENDIF 443 444 IF ( ok_ice_supersat ) THEN 445 IF ( (maxval(cf_ancien).EQ.minval(cf_ancien)) .OR. & 446 (maxval(rvc_ancien).EQ.minval(rvc_ancien)) ) THEN 447 ancien_ok=.false. 448 ENDIF 434 449 ENDIF 435 450 -
LMDZ6/trunk/libf/phylmd/phyredem.F90
r4744 r5204 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, rneb_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, awake_s, & … … 252 253 ENDIF 253 254 254 CALL put_field(pass,"RNEBANCIEN", "RNEBANCIEN", rneb_ancien) 255 IF ( ok_ice_supersat ) THEN 256 CALL put_field(pass,"CFANCIEN", "CFANCIEN", cf_ancien) 257 CALL put_field(pass,"RVCANCIEN", "RVCANCIEN", rvc_ancien) 258 ENDIF 255 259 256 260 CALL put_field(pass,"PRWANCIEN", "PRWANCIEN", prw_ancien) -
LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90
r5188 r5204 22 22 REAL, SAVE, ALLOCATABLE :: u_seri(:,:), v_seri(:,:) 23 23 !$OMP THREADPRIVATE(u_seri, v_seri) 24 REAL, SAVE, ALLOCATABLE :: rneb_seri(:,:) 25 !$OMP THREADPRIVATE(rneb_seri) 26 REAL, SAVE, ALLOCATABLE :: d_rneb_dyn(:,:) 27 !$OMP THREADPRIVATE(d_rneb_dyn) 24 REAL, SAVE, ALLOCATABLE :: cf_seri(:,:), rvc_seri(:,:) 25 !$OMP THREADPRIVATE(cf_seri, rvc_seri) 28 26 REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:),l_mix(:,:,:),wprime(:,:,:) 29 27 !$OMP THREADPRIVATE(l_mixmin, l_mix, wprime) … … 44 42 REAL, SAVE, ALLOCATABLE :: d_u_dyn(:,:), d_v_dyn(:,:) 45 43 !$OMP THREADPRIVATE(d_u_dyn, d_v_dyn) 44 REAL, SAVE, ALLOCATABLE :: d_cf_dyn(:,:), d_rvc_dyn(:,:) 45 !$OMP THREADPRIVATE(d_cf_dyn, d_rvc_dyn) 46 46 REAL, SAVE, ALLOCATABLE :: d_tr_dyn(:,:,:) 47 47 !$OMP THREADPRIVATE(d_tr_dyn) … … 639 639 !$OMP THREADPRIVATE(zn2mout) 640 640 641 REAL, SAVE, ALLOCATABLE :: qclr(:,:) 642 !$OMP THREADPRIVATE(qclr) 643 REAL, SAVE, ALLOCATABLE :: qcld(:,:) 644 !$OMP THREADPRIVATE(qcld) 645 REAL, SAVE, ALLOCATABLE :: qss(:,:) 646 !$OMP THREADPRIVATE(qss) 647 REAL, SAVE, ALLOCATABLE :: qvc(:,:) 648 !$OMP THREADPRIVATE(qvc) 649 REAL, SAVE, ALLOCATABLE :: rnebclr(:,:) 650 !$OMP THREADPRIVATE(rnebclr) 651 REAL, SAVE, ALLOCATABLE :: rnebss(:,:) 652 !$OMP THREADPRIVATE(rnebss) 653 REAL, SAVE, ALLOCATABLE :: gamma_ss(:,:) 654 !$OMP THREADPRIVATE(gamma_ss) 655 REAL, SAVE, ALLOCATABLE :: N1_ss(:,:) 656 !$OMP THREADPRIVATE(N1_ss) 657 REAL, SAVE, ALLOCATABLE :: N2_ss(:,:) 658 !$OMP THREADPRIVATE(N2_ss) 659 REAL, SAVE, ALLOCATABLE :: drneb_sub(:,:) 660 !$OMP THREADPRIVATE(drneb_sub) 661 REAL, SAVE, ALLOCATABLE :: drneb_con(:,:) 662 !$OMP THREADPRIVATE(drneb_con) 663 REAL, SAVE, ALLOCATABLE :: drneb_tur(:,:) 664 !$OMP THREADPRIVATE(drneb_tur) 665 REAL, SAVE, ALLOCATABLE :: drneb_avi(:,:) 666 !$OMP THREADPRIVATE(drneb_avi) 667 REAL, SAVE, ALLOCATABLE :: zqsatl(:,:) 668 !$OMP THREADPRIVATE(zqsatl) 669 REAL, SAVE, ALLOCATABLE :: zqsats(:,:) 670 !$OMP THREADPRIVATE(zqsats) 671 REAL, SAVE, ALLOCATABLE :: Tcontr(:,:) 672 !$OMP THREADPRIVATE(Tcontr) 673 REAL, SAVE, ALLOCATABLE :: qcontr(:,:) 674 !$OMP THREADPRIVATE(qcontr) 675 REAL, SAVE, ALLOCATABLE :: qcontr2(:,:) 676 !$OMP THREADPRIVATE(qcontr2) 677 REAL, SAVE, ALLOCATABLE :: fcontrN(:,:) 678 !$OMP THREADPRIVATE(fcontrN) 679 REAL, SAVE, ALLOCATABLE :: fcontrP(:,:) 680 !$OMP THREADPRIVATE(fcontrP) 641 !-- LSCP - condensation and ice supersaturation variables 642 REAL, SAVE, ALLOCATABLE :: qsub(:,:), qissr(:,:), qcld(:,:) 643 !$OMP THREADPRIVATE(qsub, qissr, qcld) 644 REAL, SAVE, ALLOCATABLE :: subfra(:,:), issrfra(:,:) 645 !$OMP THREADPRIVATE(subfra, issrfra) 646 REAL, SAVE, ALLOCATABLE :: gamma_cond(:,:) 647 !$OMP THREADPRIVATE(gamma_cond) 648 REAL, SAVE, ALLOCATABLE :: ratio_qi_qtot(:,:) 649 !$OMP THREADPRIVATE(ratio_qi_qtot) 650 REAL, SAVE, ALLOCATABLE :: dcf_sub(:,:), dcf_con(:,:), dcf_mix(:,:) 651 !$OMP THREADPRIVATE(dcf_sub, dcf_con, dcf_mix) 652 REAL, SAVE, ALLOCATABLE :: dqi_adj(:,:), dqi_sub(:,:), dqi_con(:,:), dqi_mix(:,:) 653 !$OMP THREADPRIVATE(dqi_adj, dqi_sub, dqi_con, dqi_mix) 654 REAL, SAVE, ALLOCATABLE :: dqvc_adj(:,:), dqvc_sub(:,:), dqvc_con(:,:), dqvc_mix(:,:) 655 !$OMP THREADPRIVATE(dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix) 656 REAL, SAVE, ALLOCATABLE :: qsatliq(:,:), qsatice(:,:) 657 !$OMP THREADPRIVATE(qsatliq, qsatice) 658 659 !-- LSCP - aviation and contrails variables 660 REAL, SAVE, ALLOCATABLE :: Tcontr(:,:), qcontr(:,:), qcontr2(:,:) 661 !$OMP THREADPRIVATE(Tcontr, qcontr, qcontr2) 662 REAL, SAVE, ALLOCATABLE :: fcontrN(:,:), fcontrP(:,:) 663 !$OMP THREADPRIVATE(fcontrN, fcontrP) 664 REAL, SAVE, ALLOCATABLE :: dcf_avi(:,:), dqi_avi(:,:), dqvc_avi(:,:) 665 !$OMP THREADPRIVATE(dcf_avi, dqi_avi, dqvc_avi) 666 REAL, SAVE, ALLOCATABLE :: flight_dist(:,:), flight_h2o(:,:) 667 !$OMP THREADPRIVATE(flight_dist, flight_h2o) 668 669 !-- LSCP - mixed phase clouds variables 681 670 REAL, SAVE, ALLOCATABLE :: distcltop(:,:) 682 671 !$OMP THREADPRIVATE(distcltop) … … 684 673 !$OMP THREADPRIVATE(temp_cltop) 685 674 686 687 !--POPRECIP variables 675 !-- LSCP - POPRECIP variables 688 676 REAL, SAVE, ALLOCATABLE :: qraindiag(:,:) 689 677 !$OMP THREADPRIVATE(qraindiag) … … 843 831 ! SN 844 832 ALLOCATE(u_seri(klon,klev),v_seri(klon,klev)) 833 ALLOCATE(cf_seri(klon,klev),rvc_seri(klon,klev)) 845 834 ALLOCATE(l_mixmin(klon,klev+1,nbsrf),l_mix(klon,klev+1,nbsrf),wprime(klon,klev+1,nbsrf)) 846 835 ALLOCATE(pbl_eps(klon,klev+1,nbsrf+1)) … … 855 844 ALLOCATE(d_q_dyn2d(klon),d_ql_dyn2d(klon),d_qs_dyn2d(klon), d_qbs_dyn2d(klon)) 856 845 ALLOCATE(d_u_dyn(klon,klev),d_v_dyn(klon,klev)) 846 ALLOCATE(d_cf_dyn(klon,klev),d_rvc_dyn(klon,klev)) 857 847 ALLOCATE(d_tr_dyn(klon,klev,nbtr)) !RomP 858 848 ALLOCATE(d_t_con(klon,klev),d_q_con(klon,klev),d_q_con_zmasse(klon,klev)) … … 1218 1208 ALLOCATE(zn2mout(klon,6)) 1219 1209 1220 ! Supersaturation 1221 ALLOCATE(rneb_seri(klon,klev)) 1222 ALLOCATE(d_rneb_dyn(klon,klev)) 1223 ALLOCATE(qclr(klon,klev), qcld(klon,klev), qss(klon,klev), qvc(klon,klev)) 1224 ALLOCATE(rnebclr(klon,klev), rnebss(klon,klev), gamma_ss(klon,klev)) 1225 ALLOCATE(N1_ss(klon,klev), N2_ss(klon,klev)) 1226 ALLOCATE(drneb_sub(klon,klev), drneb_con(klon,klev), drneb_tur(klon,klev), drneb_avi(klon,klev)) 1227 ALLOCATE(zqsatl(klon,klev), zqsats(klon,klev)) 1228 ALLOCATE(Tcontr(klon,klev), qcontr(klon,klev), qcontr2(klon,klev), fcontrN(klon,klev), fcontrP(klon,klev)) 1229 1230 !--POPRECIP variables 1210 !-- LSCP - condensation and ice supersaturation variables 1211 ALLOCATE(qsub(klon,klev), qissr(klon,klev), qcld(klon,klev)) 1212 ALLOCATE(subfra(klon,klev), issrfra(klon,klev)) 1213 ALLOCATE(gamma_cond(klon,klev), ratio_qi_qtot(klon,klev)) 1214 ALLOCATE(dcf_sub(klon,klev), dcf_con(klon,klev), dcf_mix(klon,klev)) 1215 ALLOCATE(dqi_adj(klon,klev), dqi_sub(klon,klev), dqi_con(klon,klev), dqi_mix(klon,klev)) 1216 ALLOCATE(dqvc_adj(klon,klev), dqvc_sub(klon,klev), dqvc_con(klon,klev), dqvc_mix(klon,klev)) 1217 ALLOCATE(qsatliq(klon,klev), qsatice(klon,klev)) 1218 1219 !-- LSCP - aviation and contrails variables 1220 ALLOCATE(Tcontr(klon,klev), qcontr(klon,klev), qcontr2(klon,klev)) 1221 ALLOCATE(fcontrN(klon,klev), fcontrP(klon,klev)) 1222 ALLOCATE(dcf_avi(klon,klev), dqi_avi(klon,klev), dqvc_avi(klon,klev)) 1223 ALLOCATE(flight_dist(klon,klev), flight_h2o(klon,klev)) 1224 1225 !-- LSCP - POPRECIP variables 1231 1226 ALLOCATE(qraindiag(klon,klev), qsnowdiag(klon,klev)) 1232 1227 ALLOCATE(dqreva(klon,klev), dqssub(klon,klev)) … … 1297 1292 ! SN 1298 1293 DEALLOCATE(u_seri,v_seri) 1294 DEALLOCATE(cf_seri,rvc_seri) 1299 1295 DEALLOCATE(l_mixmin,l_mix,wprime) 1300 1296 DEALLOCATE(tke_shear,tke_buoy,tke_trans) … … 1306 1302 DEALLOCATE(d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, d_qbs_dyn2d) 1307 1303 DEALLOCATE(d_u_dyn,d_v_dyn) 1304 DEALLOCATE(d_cf_dyn,d_rvc_dyn) 1308 1305 DEALLOCATE(d_tr_dyn) !RomP 1309 1306 DEALLOCATE(d_t_con,d_q_con,d_q_con_zmasse) … … 1616 1613 DEALLOCATE(zn2mout) 1617 1614 1618 ! Supersaturation 1619 DEALLOCATE(rneb_seri) 1620 DEALLOCATE(d_rneb_dyn) 1621 DEALLOCATE(qclr, qcld, qss, qvc) 1622 DEALLOCATE(rnebclr, rnebss, gamma_ss) 1623 DEALLOCATE(N1_ss, N2_ss) 1624 DEALLOCATE(drneb_sub, drneb_con, drneb_tur, drneb_avi) 1625 DEALLOCATE(zqsatl, zqsats) 1626 DEALLOCATE(Tcontr, qcontr, qcontr2, fcontrN, fcontrP) 1627 1628 !--POPRECIP variables 1615 !-- LSCP - condensation and ice supersaturation variables 1616 DEALLOCATE(qsub, qissr, qcld) 1617 DEALLOCATE(subfra, issrfra) 1618 DEALLOCATE(gamma_cond, ratio_qi_qtot) 1619 DEALLOCATE(dcf_sub, dcf_con, dcf_mix) 1620 DEALLOCATE(dqi_adj, dqi_sub, dqi_con, dqi_mix) 1621 DEALLOCATE(dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix) 1622 DEALLOCATE(qsatliq, qsatice) 1623 1624 !-- LSCP - aviation and contrails variables 1625 DEALLOCATE(Tcontr, qcontr, qcontr2) 1626 DEALLOCATE(fcontrN, fcontrP) 1627 DEALLOCATE(dcf_avi, dqi_avi, dqvc_avi) 1628 DEALLOCATE(flight_dist, flight_h2o) 1629 1630 !-- LSCP - POPRECIP variables 1629 1631 DEALLOCATE(qraindiag, qsnowdiag) 1630 1632 DEALLOCATE(dqreva, dqssub) -
LMDZ6/trunk/libf/phylmd/phys_output_ctrlout_mod.F90
r5150 r5204 450 450 TYPE(ctrl_out), SAVE :: o_SWdn200clr = ctrl_out((/ 10, 1, 10, 10, 10, 10, 11, 11, 11, 11/), & 451 451 '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) /)) 452 TYPE(ctrl_out), SAVE :: o_LWupTOA = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11/), & 453 'LWupTOA', 'LWup at TOA', 'W/m2', (/ ('', i=1, 10) /)) 454 TYPE(ctrl_out), SAVE :: o_LWupTOAclr = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11/), & 455 'LWupTOAclr', 'LWup clear sky at TOA', 'W/m2', (/ ('', i=1, 10) /)) 458 456 ! type(ctrl_out),save :: o_LWdnTOA = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'LWdnTOA', & 459 457 ! (/ ('', i=1, 10) /)) … … 2120 2118 'albslw3', 'Surface albedo LW3', '-', (/ ('', i=1, 10) /)) 2121 2119 2122 !--aviation & supersaturation 2123 TYPE(ctrl_out), SAVE :: o_oclr = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2124 'oclr', 'Clear sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2125 TYPE(ctrl_out), SAVE :: o_ocld = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2126 'ocld', 'Cloudy sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2127 TYPE(ctrl_out), SAVE :: o_oss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2128 'oss', 'ISSR total water', 'kg/kg', (/ ('', i=1, 10) /)) 2129 TYPE(ctrl_out), SAVE :: o_ovc = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2130 'ovc', 'In-cloup vapor', 'kg/kg', (/ ('', i=1, 10) /)) 2131 TYPE(ctrl_out), SAVE :: o_rnebclr = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2132 'rnebclr', 'Clear sky fraction', '-', (/ ('', i=1, 10) /)) 2133 TYPE(ctrl_out), SAVE :: o_rnebss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2134 'rnebss', 'ISSR fraction', '-', (/ ('', i=1, 10) /)) 2135 TYPE(ctrl_out), SAVE :: o_rnebseri = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2136 'rnebseri', 'Cloud fraction', '-', (/ ('', i=1, 10) /)) 2137 TYPE(ctrl_out), SAVE :: o_gammass = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2138 'gammass', 'Gamma supersaturation', '', (/ ('', i=1, 10) /)) 2139 TYPE(ctrl_out), SAVE :: o_N1_ss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2140 'N1ss', 'N1', '', (/ ('', i=1, 10) /)) 2141 TYPE(ctrl_out), SAVE :: o_N2_ss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2142 'N2ss', 'N2', '', (/ ('', i=1, 10) /)) 2143 TYPE(ctrl_out), SAVE :: o_drnebsub = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2144 'drnebsub', 'Cloud fraction change because of sublimation', 's-1', (/ ('', i=1, 10) /)) 2145 TYPE(ctrl_out), SAVE :: o_drnebcon = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2146 'drnebcon', 'Cloud fraction change because of condensation', 's-1', (/ ('', i=1, 10) /)) 2147 TYPE(ctrl_out), SAVE :: o_drnebtur = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2148 'drnebtur', 'Cloud fraction change because of turbulence', 's-1', (/ ('', i=1, 10) /)) 2149 TYPE(ctrl_out), SAVE :: o_drnebavi = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2150 'drnebavi', 'Cloud fraction change because of aviation', 's-1', (/ ('', i=1, 10) /)) 2151 TYPE(ctrl_out), SAVE :: o_qsatl = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2152 'qsatl', 'Saturation with respect to liquid water', '', (/ ('', i=1, 10) /)) 2153 TYPE(ctrl_out), SAVE :: o_qsats = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2154 'qsats', 'Saturation with respect to solid water', '', (/ ('', i=1, 10) /)) 2155 TYPE(ctrl_out), SAVE :: o_flight_m = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2156 'flightm', 'Flown meters', 'm/s/mesh', (/ ('', i=1, 10) /)) 2157 TYPE(ctrl_out), SAVE :: o_flight_h2o = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), & 2158 'flighth2o', 'H2O flight emission', 'kg H2O/s/mesh', (/ ('', i=1, 10) /)) 2159 TYPE(ctrl_out), SAVE :: o_Tcontr = ctrl_out((/ 1, 1, 1, 1, 11, 11, 11, 11, 11, 11/),& 2120 !-- LSCP - condensation and ice supersaturation variables 2121 TYPE(ctrl_out), SAVE :: o_cfseri = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2122 'cfseri', 'Cloud fraction', '-', (/ ('', i=1, 10) /)) 2123 TYPE(ctrl_out), SAVE :: o_dcfdyn = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2124 'dcfdyn', 'Dynamics cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2125 TYPE(ctrl_out), SAVE :: o_rvcseri = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2126 'rvcseri', 'Cloudy water vapor to total water vapor ratio', '-', (/ ('', i=1, 10) /)) 2127 TYPE(ctrl_out), SAVE :: o_drvcdyn = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2128 'drvcdyn', 'Dynamics cloudy water vapor to total water vapor ratio tendency', 's-1', (/ ('', i=1, 10) /)) 2129 TYPE(ctrl_out), SAVE :: o_qsub = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2130 'qsub', 'Subsaturated clear sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2131 TYPE(ctrl_out), SAVE :: o_qissr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2132 'qissr', 'Supersaturated clear sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2133 TYPE(ctrl_out), SAVE :: o_qcld = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2134 'qcld', 'Cloudy sky total water', 'kg/kg', (/ ('', i=1, 10) /)) 2135 TYPE(ctrl_out), SAVE :: o_subfra = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2136 'subfra', 'Subsaturated clear sky fraction', '-', (/ ('', i=1, 10) /)) 2137 TYPE(ctrl_out), SAVE :: o_issrfra = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2138 'issrfra', 'Supersaturated clear sky fraction', '-', (/ ('', i=1, 10) /)) 2139 TYPE(ctrl_out), SAVE :: o_gammacond = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2140 'gammacond', 'Condensation threshold w.r.t. saturation', '-', (/ ('', i=1, 10) /)) 2141 TYPE(ctrl_out), SAVE :: o_dcfsub = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2142 'dcfsub', 'Sublimation cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2143 TYPE(ctrl_out), SAVE :: o_dcfcon = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2144 'dcfcon', 'Condensation cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2145 TYPE(ctrl_out), SAVE :: o_dcfmix = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2146 'dcfmix', 'Cloud mixing cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2147 TYPE(ctrl_out), SAVE :: o_dqiadj = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2148 'dqiadj', 'Temperature adjustment ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2149 TYPE(ctrl_out), SAVE :: o_dqisub = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2150 'dqisub', 'Sublimation ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2151 TYPE(ctrl_out), SAVE :: o_dqicon = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2152 'dqicon', 'Condensation ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2153 TYPE(ctrl_out), SAVE :: o_dqimix = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2154 'dqimix', 'Cloud mixing ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2155 TYPE(ctrl_out), SAVE :: o_dqvcadj = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2156 'dqvcadj', 'Temperature adjustment cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2157 TYPE(ctrl_out), SAVE :: o_dqvcsub = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2158 'dqvcsub', 'Sublimation cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2159 TYPE(ctrl_out), SAVE :: o_dqvccon = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2160 'dqvccon', 'Condensation cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2161 TYPE(ctrl_out), SAVE :: o_dqvcmix = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2162 'dqvcmix', 'Cloud mixing cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2163 TYPE(ctrl_out), SAVE :: o_qsatl = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2164 'qsatl', 'Saturation with respect to liquid', 'kg/kg', (/ ('', i=1, 10) /)) 2165 TYPE(ctrl_out), SAVE :: o_qsati = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2166 'qsati', 'Saturation with respect to ice', 'kg/kg', (/ ('', i=1, 10) /)) 2167 2168 !-- LSCP - aviation variables 2169 TYPE(ctrl_out), SAVE :: o_Tcontr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2160 2170 'Tcontr', 'Temperature threshold for contrail formation', 'K', (/ ('',i=1,10) /)) 2161 TYPE(ctrl_out), SAVE :: o_qcontr = ctrl_out((/ 1 , 1, 1,1, 11, 11, 11, 11, 11, 11/),&2162 'qcontr', 'Specific humidity threshold for contrail formation', 'Pa', (/ ('', i=1, 10) /))2163 TYPE(ctrl_out), SAVE :: o_qcontr2 = ctrl_out((/ 1 , 1, 1,1, 11, 11, 11, 11, 11, 11/),&2164 'qcontr2', 'Specific humidity threshold for contrail formation', 'kg/kg', (/ ('', i=1, 10) /))2165 TYPE(ctrl_out), SAVE :: o_fcontrN = ctrl_out((/ 2, 2, 2, 2, 2, 2, 11, 11, 11, 11/),&2171 TYPE(ctrl_out), SAVE :: o_qcontr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2172 'qcontr', 'Specific humidity threshold for contrail formation', 'Pa', (/ ('', i=1, 10) /)) 2173 TYPE(ctrl_out), SAVE :: o_qcontr2 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2174 'qcontr2', 'Specific humidity threshold for contrail formation', 'kg/kg', (/ ('', i=1, 10) /)) 2175 TYPE(ctrl_out), SAVE :: o_fcontrN = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2166 2176 'fcontrN', 'Fraction with non-persistent contrail in clear-sky', '-', (/ ('', i=1,10)/)) 2167 TYPE(ctrl_out), SAVE :: o_fcontrP = ctrl_out((/ 2, 2, 2, 2, 2, 2, 11, 11, 11, 11/),&2177 TYPE(ctrl_out), SAVE :: o_fcontrP = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/),& 2168 2178 'fcontrP', 'Fraction with persistent contrail in ISSR', '-', (/ ('', i=1,10)/)) 2179 TYPE(ctrl_out), SAVE :: o_dcfavi = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2180 'dcfavi', 'Aviation cloud fraction tendency', 's-1', (/ ('', i=1, 10) /)) 2181 TYPE(ctrl_out), SAVE :: o_dqiavi = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2182 'dqiavi', 'Aviation ice tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2183 TYPE(ctrl_out), SAVE :: o_dqvcavi = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2184 'dqvcavi', 'Aviation cloudy water vapor tendency', 'kg/kg/s', (/ ('', i=1, 10) /)) 2185 TYPE(ctrl_out), SAVE :: o_flight_dist = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2186 'flightdist', 'Aviation flown distance', 'm/s/mesh', (/ ('', i=1, 10) /)) 2187 TYPE(ctrl_out), SAVE :: o_flight_h2o = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2188 'flighth2o', 'Aviation H2O flight emission', 'kg H2O/s/mesh', (/ ('', i=1, 10) /)) 2169 2189 2170 2190 !!!!!!!!!!!!! Sorties niveaux standards de pression NMC -
LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90
r5150 r5204 54 54 o_SWdnTOAclr, o_nettop, o_SWup200, & 55 55 o_SWup200clr, o_SWdn200, o_SWdn200clr, & 56 o_LWupTOA, o_LWupTOAclr, & 56 57 o_LWup200, o_LWup200clr, o_LWdn200, & 57 58 o_LWdn200clr, o_sols, o_sols0, & … … 218 219 o_p_tropopause, o_z_tropopause, o_t_tropopause, & 219 220 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, & 221 !-- LSCP - condensation and ice supersaturation variables 222 o_cfseri, o_dcfdyn, o_rvcseri, o_drvcdyn, & 223 o_qsub, o_qissr, o_qcld, o_subfra, o_issrfra, o_gammacond, & 224 o_dcfsub, o_dcfcon, o_dcfmix, o_dqiadj, o_dqisub, o_dqicon, o_dqimix, & 225 o_dqvcadj, o_dqvcsub, o_dqvccon, o_dqvcmix, o_qsatl, o_qsati, & 226 !-- LSCP - aviation variables 224 227 o_Tcontr, o_qcontr, o_qcontr2, o_fcontrN, o_fcontrP, & 228 o_dcfavi, o_dqiavi, o_dqvcavi, o_flight_dist, o_flight_h2o, & 225 229 !--interactive CO2 226 230 o_flx_co2_ocean, o_flx_co2_ocean_cor, & … … 262 266 #endif 263 267 264 USE ice_sursat_mod, ONLY: flight_m, flight_h2o265 268 USE lmdz_lscp_ini, ONLY: ok_poprecip 266 269 … … 328 331 cldq, flwp, fiwp, ue, ve, uq, vq, & 329 332 uwat, vwat, & 330 rneb_seri, d_rneb_dyn, &331 333 plcl, plfc, wbeff, convoccur, upwd, dnwd, dnwd0, prw, prlw, prsw, prbsw, water_budget, & 332 334 s_pblh, s_pblt, s_lcl, s_therm, uwriteSTD, & … … 342 344 wdtrainA, wdtrainS, wdtrainM, n2, s2, strig, zcong, zlcl_th, proba_notrig, & 343 345 random_notrig, & 344 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 345 N1_ss, N2_ss, zqsatl, zqsats, & 346 cf_seri, d_cf_dyn, rvc_seri, d_rvc_dyn, & 347 qsub, qissr, qcld, subfra, issrfra, gamma_cond, & 348 dcf_sub, dcf_con, dcf_mix, & 349 dqi_adj, dqi_sub, dqi_con, dqi_mix, & 350 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, & 351 qsatliq, qsatice, & 346 352 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 347 d rneb_sub, drneb_con, drneb_tur, drneb_avi, &353 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 348 354 alp_bl_det, alp_bl_fluct_m, alp_bl_conv, & 349 355 alp_bl_stat, alp_bl_fluct_tke, slab_wfbils, & … … 1079 1085 CALL histwrite_phy(o_LWupSFCclr, zx_tmp_fi2d) 1080 1086 CALL histwrite_phy(o_LWdnSFCclr, sollwdownclr) 1087 1088 IF (vars_defined) THEN 1089 zx_tmp_fi2d(:) = lwup(:,klevp1) 1090 ENDIF 1091 CALL histwrite_phy(o_LWupTOA, zx_tmp_fi2d) 1092 1093 IF (vars_defined) THEN 1094 zx_tmp_fi2d(:) = lwup0(:,klevp1) 1095 ENDIF 1096 CALL histwrite_phy(o_LWupTOAclr, zx_tmp_fi2d) 1081 1097 1082 1098 IF (type_trac/='inca' .OR. config_inca=='aeNP') THEN … … 2068 2084 ENDIF 2069 2085 2070 !--aviation & supersaturation 2071 IF (ok_ice_sursat) THEN 2072 CALL histwrite_phy(o_oclr, qclr) 2073 CALL histwrite_phy(o_ocld, qcld) 2074 CALL histwrite_phy(o_oss, qss) 2075 CALL histwrite_phy(o_ovc, qvc) 2076 CALL histwrite_phy(o_rnebclr, rnebclr) 2077 CALL histwrite_phy(o_rnebss, rnebss) 2078 CALL histwrite_phy(o_rnebseri, rneb_seri) 2079 CALL histwrite_phy(o_gammass, gamma_ss) 2080 CALL histwrite_phy(o_N1_ss, N1_ss) 2081 CALL histwrite_phy(o_N2_ss, N2_ss) 2082 CALL histwrite_phy(o_drnebsub, drneb_sub) 2083 CALL histwrite_phy(o_drnebcon, drneb_con) 2084 CALL histwrite_phy(o_drnebtur, drneb_tur) 2085 CALL histwrite_phy(o_drnebavi, drneb_avi) 2086 CALL histwrite_phy(o_qsatl, zqsatl) 2087 CALL histwrite_phy(o_qsats, zqsats) 2086 !-- LSCP - condensation and supersaturation variables 2087 IF (ok_ice_supersat) THEN 2088 CALL histwrite_phy(o_cfseri, cf_seri) 2089 CALL histwrite_phy(o_dcfdyn, d_cf_dyn) 2090 CALL histwrite_phy(o_rvcseri, rvc_seri) 2091 CALL histwrite_phy(o_drvcdyn, d_rvc_dyn) 2092 CALL histwrite_phy(o_qsub, qsub) 2093 CALL histwrite_phy(o_qissr, qissr) 2094 CALL histwrite_phy(o_qcld, qcld) 2095 CALL histwrite_phy(o_subfra, subfra) 2096 CALL histwrite_phy(o_issrfra, issrfra) 2097 CALL histwrite_phy(o_gammacond, gamma_cond) 2098 CALL histwrite_phy(o_dcfsub, dcf_sub) 2099 CALL histwrite_phy(o_dcfcon, dcf_con) 2100 CALL histwrite_phy(o_dcfmix, dcf_mix) 2101 CALL histwrite_phy(o_dqiadj, dqi_adj) 2102 CALL histwrite_phy(o_dqisub, dqi_sub) 2103 CALL histwrite_phy(o_dqicon, dqi_con) 2104 CALL histwrite_phy(o_dqimix, dqi_mix) 2105 CALL histwrite_phy(o_dqvcadj, dqvc_adj) 2106 CALL histwrite_phy(o_dqvcsub, dqvc_sub) 2107 CALL histwrite_phy(o_dqvccon, dqvc_con) 2108 CALL histwrite_phy(o_dqvcmix, dqvc_mix) 2109 CALL histwrite_phy(o_qsatl, qsatliq) 2110 CALL histwrite_phy(o_qsati, qsatice) 2111 ENDIF 2112 !-- LSCP - aviation variables 2113 IF (ok_plane_contrail) THEN 2088 2114 CALL histwrite_phy(o_Tcontr, Tcontr) 2089 2115 CALL histwrite_phy(o_qcontr, qcontr) … … 2091 2117 CALL histwrite_phy(o_fcontrN, fcontrN) 2092 2118 CALL histwrite_phy(o_fcontrP, fcontrP) 2093 ENDIF 2094 IF (ok_plane_contrail) THEN 2095 CALL histwrite_phy(o_flight_m, flight_m) 2119 CALL histwrite_phy(o_dcfavi, dcf_avi) 2120 CALL histwrite_phy(o_dqiavi, dqi_avi) 2121 CALL histwrite_phy(o_dqvcavi, dqvc_avi) 2122 CALL histwrite_phy(o_flight_dist, flight_dist) 2096 2123 ENDIF 2097 2124 IF (ok_plane_h2o) THEN -
LMDZ6/trunk/libf/phylmd/phys_state_var_mod.F90
r5084 r5204 93 93 REAL, ALLOCATABLE, SAVE :: u_ancien(:,:), v_ancien(:,:) 94 94 !$OMP THREADPRIVATE(u_ancien, v_ancien) 95 REAL, ALLOCATABLE, SAVE :: cf_ancien(:,:), rvc_ancien(:,:) 96 !$OMP THREADPRIVATE(cf_ancien, rvc_ancien) 95 97 !!! RomP >>> 96 98 REAL, ALLOCATABLE, SAVE :: tr_ancien(:,:,:) … … 101 103 REAL, ALLOCATABLE, SAVE :: clwcon(:,:),rnebcon(:,:) 102 104 !$OMP THREADPRIVATE(clwcon,rnebcon) 103 REAL, ALLOCATABLE, SAVE :: rneb_ancien(:,:)104 !$OMP THREADPRIVATE(rneb_ancien)105 105 REAL, ALLOCATABLE, SAVE :: qtc_cv(:,:),sigt_cv(:,:),detrain_cv(:,:),fm_cv(:,:) 106 106 !$OMP THREADPRIVATE(qtc_cv,sigt_cv,detrain_cv,fm_cv) … … 587 587 ALLOCATE(prw_ancien(klon), prlw_ancien(klon), prsw_ancien(klon), prbsw_ancien(klon)) 588 588 ALLOCATE(u_ancien(klon,klev), v_ancien(klon,klev)) 589 ALLOCATE(cf_ancien(klon,klev), rvc_ancien(klon,klev)) 589 590 !!! Rom P >>> 590 591 ALLOCATE(tr_ancien(klon,klev,nbtr)) 591 592 !!! Rom P <<< 592 593 ALLOCATE(clwcon(klon,klev),rnebcon(klon,klev)) 593 ALLOCATE(rneb_ancien(klon,klev))594 594 ALLOCATE(qtc_cv(klon,klev),sigt_cv(klon,klev),detrain_cv(klon,klev),fm_cv(klon,klev)) 595 595 ALLOCATE(ratqs(klon,klev)) … … 811 811 DEALLOCATE(zthe, zpic, zval) 812 812 DEALLOCATE(rugoro, t_ancien, q_ancien, clwcon, rnebcon) 813 DEALLOCATE(qs_ancien, ql_ancien, qbs_ancien , rneb_ancien)813 DEALLOCATE(qs_ancien, ql_ancien, qbs_ancien) 814 814 DEALLOCATE(prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien) 815 815 DEALLOCATE(qtc_cv,sigt_cv,detrain_cv,fm_cv) 816 816 DEALLOCATE(u_ancien, v_ancien) 817 DEALLOCATE(cf_ancien, rvc_ancien) 817 818 DEALLOCATE(tr_ancien) !RomP 818 819 DEALLOCATE(ratqs, pbl_tke,coefh,coefm) -
LMDZ6/trunk/libf/phylmd/physiq_mod.F90
r5199 r5204 72 72 USE tracinca_mod, ONLY: config_inca 73 73 USE tropopause_m, ONLY: dyn_tropopause 74 USE ice_sursat_mod, ONLY: flight_init, airplane75 74 USE vampir 76 75 USE write_field_phy … … 156 155 ! [Variables internes non sauvegardees de la physique] 157 156 ! Variables locales pour effectuer les appels en serie 158 t_seri,q_seri,ql_seri,qs_seri,qbs_seri,u_seri,v_seri,tr_seri,rneb_seri, & 157 t_seri,q_seri,ql_seri,qs_seri,qbs_seri, & 158 u_seri,v_seri,cf_seri,rvc_seri,tr_seri, & 159 159 rhcl, & 160 160 ! Dynamic tendencies (diagnostics) 161 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, & 161 d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn, & 162 d_u_dyn,d_v_dyn,d_cf_dyn,d_rvc_dyn,d_tr_dyn, & 162 163 d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, & 163 164 ! Physic tendencies … … 333 334 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 334 335 distcltop, temp_cltop, & 335 zqsatl, zqsats, & 336 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 336 !-- LSCP - condensation and ice supersaturation variables 337 qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, & 338 dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, & 339 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, & 340 !-- LSCP - aviation and contrails variables 337 341 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 342 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 343 ! 338 344 cldemi, & 339 345 cldfra, cldtau, fiwc, & … … 510 516 ! 511 517 ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional) 512 INTEGER,SAVE :: ivap, iliq, isol, i rneb, ibs513 !$OMP THREADPRIVATE(ivap, iliq, isol, i rneb, ibs)518 INTEGER,SAVE :: ivap, iliq, isol, ibs, icf, irvc 519 !$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc) 514 520 ! 515 521 ! … … 1363 1369 iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) 1364 1370 isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) 1365 irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))1366 1371 ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) 1372 icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) 1373 irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) 1367 1374 ! CALL init_etat0_limit_unstruct 1368 1375 ! IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) … … 1406 1413 ENDIF 1407 1414 1408 IF (ok_ice_su rsat.AND.(iflag_ice_thermo.EQ.0)) THEN1409 WRITE (lunout, *) ' ok_ice_su rsat=y requires iflag_ice_thermo=1 as well'1415 IF (ok_ice_supersat.AND.(iflag_ice_thermo.EQ.0)) THEN 1416 WRITE (lunout, *) ' ok_ice_supersat=y requires iflag_ice_thermo=1 as well' 1410 1417 abort_message='see above' 1411 1418 CALL abort_physic(modname,abort_message,1) 1412 1419 ENDIF 1413 1420 1414 IF (ok_ice_su rsat.AND.(nqo.LT.4)) THEN1415 WRITE (lunout, *) ' ok_ice_su rsat=y requires 4H2O tracers ', &1416 '(H2O_g, H2O_l, H2O_s, H2O_ r) but nqo=', nqo, '. Might as well stop here.'1421 IF (ok_ice_supersat.AND.(nqo.LT.5)) THEN 1422 WRITE (lunout, *) ' ok_ice_supersat=y requires 5 H2O tracers ', & 1423 '(H2O_g, H2O_l, H2O_s, H2O_f, H2O_c) but nqo=', nqo, '. Might as well stop here.' 1417 1424 abort_message='see above' 1418 1425 CALL abort_physic(modname,abort_message,1) 1419 1426 ENDIF 1420 1427 1421 IF (ok_plane_h2o.AND..NOT.ok_ice_su rsat) THEN1422 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_su rsat=y '1428 IF (ok_plane_h2o.AND..NOT.ok_ice_supersat) THEN 1429 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_supersat=y ' 1423 1430 abort_message='see above' 1424 1431 CALL abort_physic(modname,abort_message,1) 1425 1432 ENDIF 1426 1433 1427 IF (ok_plane_contrail.AND..NOT.ok_ice_su rsat) THEN1428 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_su rsat=y '1434 IF (ok_plane_contrail.AND..NOT.ok_ice_supersat) THEN 1435 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_supersat=y ' 1429 1436 abort_message='see above' 1430 1437 CALL abort_physic(modname,abort_message,1) … … 1432 1439 1433 1440 IF (ok_bs) THEN 1434 IF ((ok_ice_su rsat.AND.nqo .LT.5).OR.(.NOT.ok_ice_sursat.AND.nqo.LT.4)) THEN1441 IF ((ok_ice_supersat.AND.nqo .LT.6).OR.(.NOT.ok_ice_supersat.AND.nqo.LT.4)) THEN 1435 1442 WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', & 1436 1443 'but nqo=', nqo … … 1850 1857 & RG,RD,RCPD,RKAPPA,RLVTT,RETV) 1851 1858 CALL ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT) 1852 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) 1859 CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_supersat,iflag_ratqs,fl_cor_ebil, & 1860 RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RV,RG,RPI,EPS_W) 1853 1861 CALL blowing_snow_ini(RCPD, RLSTT, RLVTT, RLMLT, & 1854 1862 RVTMP2, RTT,RD,RG, RV, RPI) … … 2336 2344 sollwdown(:)) 2337 2345 2346 !--Init for LSCP - condensation 2347 ratio_qi_qtot(:,:) = 0. 2338 2348 2339 2349 … … 2433 2443 q_seri(i,k) = qx(i,k,ivap) 2434 2444 ql_seri(i,k) = qx(i,k,iliq) 2435 qbs_seri(i,k) = 0. 2445 qbs_seri(i,k)= 0. 2446 cf_seri(i,k) = 0. 2447 rvc_seri(i,k)= 0. 2436 2448 !CR: ATTENTION, on rajoute la variable glace 2437 2449 IF (nqo.EQ.2) THEN !--vapour and liquid only 2438 2450 qs_seri(i,k) = 0. 2439 rneb_seri(i,k) = 0.2440 2451 ELSE IF (nqo.EQ.3) THEN !--vapour, liquid and ice 2441 2452 qs_seri(i,k) = qx(i,k,isol) 2442 rneb_seri(i,k) = 0. 2443 ELSE IF (nqo.GE.4) THEN !--vapour, liquid, ice and rneb and blowing snow 2453 ELSE IF (nqo.GE.4) THEN !--vapour, liquid, ice, blowing snow, cloud fraction and cloudy water vapor to total water vapor ratio 2444 2454 qs_seri(i,k) = qx(i,k,isol) 2445 IF (ok_ice_sursat) THEN 2446 rneb_seri(i,k) = qx(i,k,irneb) 2455 IF (ok_ice_supersat) THEN 2456 cf_seri(i,k) = qx(i,k,icf) 2457 rvc_seri(i,k) = qx(i,k,irvc) 2447 2458 ENDIF 2448 2459 IF (ok_bs) THEN … … 2522 2533 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep 2523 2534 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep 2524 d_qbs_dyn(:,:) = (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep 2535 d_qbs_dyn(:,:)= (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep 2536 d_cf_dyn(:,:) = (cf_seri(:,:)-cf_ancien(:,:))/phys_tstep 2537 d_rvc_dyn(:,:)= (rvc_seri(:,:)-rvc_ancien(:,:))/phys_tstep 2525 2538 CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d) 2526 2539 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep … … 2534 2547 IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep 2535 2548 ! !! RomP <<< 2536 !!d_rneb_dyn(:,:)=(rneb_seri(:,:)-rneb_ancien(:,:))/phys_tstep2537 d_rneb_dyn(:,:)=0.02538 2549 ELSE 2539 2550 d_u_dyn(:,:) = 0.0 … … 2543 2554 d_ql_dyn(:,:) = 0.0 2544 2555 d_qs_dyn(:,:) = 0.0 2556 d_qbs_dyn(:,:)= 0.0 2557 d_cf_dyn(:,:) = 0.0 2558 d_rvc_dyn(:,:)= 0.0 2545 2559 d_q_dyn2d(:) = 0.0 2546 2560 d_ql_dyn2d(:) = 0.0 … … 2550 2564 IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0 2551 2565 ! !! RomP <<< 2552 d_rneb_dyn(:,:)=0.02553 d_qbs_dyn(:,:)=0.02554 2566 ancien_ok = .TRUE. 2555 2567 ENDIF … … 2660 2672 ENDIF 2661 2673 ENDIF 2674 2675 !-- Needed for LSCP - condensation and ice supersaturation 2676 IF (ok_ice_supersat) THEN 2677 DO k = 1, klev 2678 DO i = 1, klon 2679 IF ( ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) .GT. 0. ) THEN 2680 ratio_qi_qtot(i,k) = qs_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) 2681 rvc_seri(i,k) = rvc_seri(i,k) * q_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) 2682 ELSE 2683 ratio_qi_qtot(i,k) = 0. 2684 rvc_seri(i,k) = 0. 2685 ENDIF 2686 ENDDO 2687 ENDDO 2688 ENDIF 2689 2662 2690 ! 2663 2691 ! Re-evaporer l'eau liquide nuageuse … … 3829 3857 3830 3858 !--mise à jour de flight_m et flight_h2o dans leur module 3831 IF (ok_plane_h2o .OR. ok_plane_contrail) THEN3832 CALL airplane(debut,pphis,pplay,paprs,t_seri)3833 ENDIF3859 !IF (ok_plane_h2o .OR. ok_plane_contrail) THEN 3860 ! CALL airplane(debut,pphis,pplay,paprs,t_seri) 3861 !ENDIF 3834 3862 3835 3863 CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, & 3836 3864 t_seri, q_seri,qs_ini,ptconv,ratqs, & 3837 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri,&3865 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 3838 3866 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 3839 3867 radocond, picefra, rain_lsc, snow_lsc, & … … 3841 3869 prfl, psfl, rhcl, & 3842 3870 zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, & 3843 iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, temp_cltop, & 3844 pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 3845 Tcontr, qcontr, qcontr2, fcontrN, fcontrP , & 3871 iflag_ice_thermo, distcltop, temp_cltop, & 3872 pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), & 3873 cell_area, & 3874 cf_seri, rvc_seri, u_seri, v_seri, & 3875 qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, & 3876 dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, & 3877 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, & 3878 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 3879 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 3846 3880 cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, & 3847 3881 qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, & … … 5550 5584 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep 5551 5585 ENDIF 5552 !--ice_sursat: nqo=4, on ajoute rneb 5553 IF (nqo.ge.4 .and. ok_ice_sursat) THEN 5554 d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep 5586 !--ice_supersat: nqo=5, we add cloud fraction and cloudy water vapor to total water vapor ratio 5587 IF (nqo.ge.5 .and. ok_ice_supersat) THEN 5588 d_qx(i,k,icf) = ( cf_seri(i,k) - qx(i,k,icf) ) / phys_tstep 5589 d_qx(i,k,irvc) = ( rvc_seri(i,k) - qx(i,k,irvc) ) / phys_tstep 5555 5590 ENDIF 5556 5591 … … 5586 5621 ql_ancien(:,:) = ql_seri(:,:) 5587 5622 qs_ancien(:,:) = qs_seri(:,:) 5588 qbs_ancien(:,:) = qbs_seri(:,:) 5589 rneb_ancien(:,:) = rneb_seri(:,:) 5623 qbs_ancien(:,:)= qbs_seri(:,:) 5624 cf_ancien(:,:) = cf_seri(:,:) 5625 rvc_ancien(:,:)= rvc_seri(:,:) 5590 5626 CALL water_int(klon,klev,q_ancien,zmasse,prw_ancien) 5591 5627 CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien) -
LMDZ6/trunk/libf/phylmdiso/phyetat0_mod.F90
r5199 r5204 25 25 du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, & 26 26 falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, & 27 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, & 27 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, & 28 cf_ancien, rvc_ancien, radpas, radsol, rain_fall, ratqs, & 28 29 rnebcon, rugoro, sig1, snow_fall, bs_fall, solaire_etat0, sollw, sollwdown, & 29 30 solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, & … … 420 421 ancien_ok=ancien_ok.AND.phyetat0_get(ql_ancien,"QLANCIEN","QLANCIEN",0.) 421 422 ancien_ok=ancien_ok.AND.phyetat0_get(qs_ancien,"QSANCIEN","QSANCIEN",0.) 422 ancien_ok=ancien_ok.AND.phyetat0_get(rneb_ancien,"RNEBANCIEN","RNEBANCIEN",0.)423 423 ancien_ok=ancien_ok.AND.phyetat0_get(u_ancien,"UANCIEN","UANCIEN",0.) 424 424 ancien_ok=ancien_ok.AND.phyetat0_get(v_ancien,"VANCIEN","VANCIEN",0.) … … 435 435 prbsw_ancien(:)=0. 436 436 ENDIF 437 438 ! cas specifique des variables de la sursaturation par rapport a la glace 439 IF ( ok_ice_supersat ) THEN 440 ancien_ok=ancien_ok.AND.phyetat0_get(cf_ancien,"CFANCIEN","CFANCIEN",0.) 441 ancien_ok=ancien_ok.AND.phyetat0_get(rvc_ancien,"RVCANCIEN","RVCANCIEN",0.) 442 ELSE 443 cf_ancien(:,:)=0. 444 rvc_ancien(:,:)=0. 445 ENDIF 437 446 438 447 ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain … … 442 451 (maxval(ql_ancien).EQ.minval(ql_ancien)) .OR. & 443 452 (maxval(qs_ancien).EQ.minval(qs_ancien)) .OR. & 444 (maxval(rneb_ancien).EQ.minval(rneb_ancien)) .OR. &445 453 (maxval(prw_ancien).EQ.minval(prw_ancien)) .OR. & 446 454 (maxval(prlw_ancien).EQ.minval(prlw_ancien)) .OR. & … … 455 463 ancien_ok=.false. 456 464 ENDIF 465 ENDIF 466 467 IF ( ok_ice_supersat ) THEN 468 IF ( (maxval(cf_ancien).EQ.minval(cf_ancien)) .OR. & 469 (maxval(rvc_ancien).EQ.minval(rvc_ancien)) ) THEN 470 ancien_ok=.false. 471 ENDIF 457 472 ENDIF 458 473 -
LMDZ6/trunk/libf/phylmdiso/phyredem.F90
r4613 r5204 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, & … … 265 266 CALL put_field(pass,"QBSANCIEN", "QBSANCIEN", qbs_ancien) 266 267 CALL put_field(pass,"PRBSWANCIEN", "PRBSWANCIEN", prbsw_ancien) 268 ENDIF 269 270 IF ( ok_ice_supersat ) THEN 271 CALL put_field(pass,"CFANCIEN", "CFANCIEN", cf_ancien) 272 CALL put_field(pass,"RVCANCIEN", "RVCANCIEN", rvc_ancien) 267 273 ENDIF 268 274 -
LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90
r5199 r5204 72 72 USE tracinca_mod, ONLY: config_inca 73 73 USE tropopause_m, ONLY: dyn_tropopause 74 USE ice_sursat_mod, ONLY: flight_init, airplane75 74 USE vampir 76 75 USE write_field_phy … … 195 194 ! [Variables internes non sauvegardees de la physique] 196 195 ! Variables locales pour effectuer les appels en serie 197 t_seri,q_seri,ql_seri,qs_seri,qbs_seri,u_seri,v_seri,tr_seri,rneb_seri, & 196 t_seri,q_seri,ql_seri,qs_seri,qbs_seri, & 197 u_seri,v_seri,cf_seri,rvc_seri,tr_seri, & 198 rhcl, & 198 199 qx_seri, & ! CR 199 200 rhcl, & 200 201 ! Dynamic tendencies (diagnostics) 201 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, & 202 d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn, & 203 d_u_dyn,d_v_dyn,d_cf_dyn,d_rvc_dyn,d_tr_dyn, & 202 204 d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, & 203 205 ! Physic tendencies … … 374 376 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 375 377 distcltop, temp_cltop, & 376 zqsatl, zqsats, & 377 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 378 !-- LSCP - condensation and ice supersaturation variables 379 qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, & 380 dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, & 381 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, & 382 !-- LSCP - aviation and contrails variables 378 383 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 384 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 385 ! 379 386 cldemi, & 380 387 cldfra, cldtau, fiwc, & … … 584 591 ! reevap -> je commente les 2 lignes au dessus et je laisse la definition 585 592 ! plutot dans infotrac_phy 586 INTEGER,SAVE :: irneb, ibs 587 !$OMP THREADPRIVATE(irneb, ibs )593 INTEGER,SAVE :: irneb, ibs, icf,irvc 594 !$OMP THREADPRIVATE(irneb, ibs, icf,irvc) 588 595 ! 589 596 ! … … 1479 1486 iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) 1480 1487 isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) 1481 irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))1482 1488 ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) 1489 icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) 1490 irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) 1483 1491 ! CALL init_etat0_limit_unstruct 1484 !IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)1492 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) 1485 1493 !CR:nvelles variables convection/poches froides 1486 1494 … … 1533 1541 ENDIF 1534 1542 1535 IF (ok_ice_su rsat.AND.(iflag_ice_thermo.EQ.0)) THEN1536 WRITE (lunout, *) ' ok_ice_su rsat=y requires iflag_ice_thermo=1 as well'1543 IF (ok_ice_supersat.AND.(iflag_ice_thermo.EQ.0)) THEN 1544 WRITE (lunout, *) ' ok_ice_supersat=y requires iflag_ice_thermo=1 as well' 1537 1545 abort_message='see above' 1538 1546 CALL abort_physic(modname,abort_message,1) 1539 1547 ENDIF 1540 1548 1541 IF (ok_ice_su rsat.AND.(nqo.LT.4)) THEN1542 WRITE (lunout, *) ' ok_ice_su rsat=y requires 4H2O tracers ', &1543 '(H2O_g, H2O_l, H2O_s, H2O_ r) but nqo=', nqo, '. Might as well stop here.'1549 IF (ok_ice_supersat.AND.(nqo.LT.5)) THEN 1550 WRITE (lunout, *) ' ok_ice_supersat=y requires 5 H2O tracers ', & 1551 '(H2O_g, H2O_l, H2O_s, H2O_f, H2O_c) but nqo=', nqo, '. Might as well stop here.' 1544 1552 abort_message='see above' 1545 1553 CALL abort_physic(modname,abort_message,1) 1546 1554 ENDIF 1547 1555 1548 IF (ok_plane_h2o.AND..NOT.ok_ice_su rsat) THEN1549 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_su rsat=y '1556 IF (ok_plane_h2o.AND..NOT.ok_ice_supersat) THEN 1557 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_supersat=y ' 1550 1558 abort_message='see above' 1551 1559 CALL abort_physic(modname,abort_message,1) 1552 1560 ENDIF 1553 1561 1554 IF (ok_plane_contrail.AND..NOT.ok_ice_su rsat) THEN1555 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_su rsat=y '1562 IF (ok_plane_contrail.AND..NOT.ok_ice_supersat) THEN 1563 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_supersat=y ' 1556 1564 abort_message='see above' 1557 1565 CALL abort_physic(modname,abort_message,1) … … 1562 1570 abort_message='blowing snow cannot be activated with water isotopes yet' 1563 1571 CALL abort_physic(modname,abort_message, 1) 1564 #endif 1565 IF ((ok_ice_sursat.AND.nqo .LT.5).OR.(.NOT.ok_ice_sursat.AND.nqo.LT.4)) THEN 1572 IF ((ok_ice_supersat.AND.nqo .LT.6).OR.(.NOT.ok_ice_supersat.AND.nqo.LT.4)) THEN 1566 1573 WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', & 1567 1574 'but nqo=', nqo … … 2015 2022 & RG,RD,RCPD,RKAPPA,RLVTT,RETV) 2016 2023 CALL ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT) 2017 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) 2024 CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_supersat,iflag_ratqs,fl_cor_ebil, & 2025 RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RV,RG,RPI,EPS_W) 2018 2026 CALL blowing_snow_ini(RCPD, RLSTT, RLVTT, RLMLT, & 2019 2027 RVTMP2, RTT,RD,RG, RV, RPI) … … 2497 2505 sollwdown(:)) 2498 2506 2507 !--Init for LSCP - condensation 2508 ratio_qi_qtot(:,:) = 0. 2499 2509 2500 2510 … … 2604 2614 q_seri(i,k) = qx(i,k,ivap) 2605 2615 ql_seri(i,k) = qx(i,k,iliq) 2606 qbs_seri(i,k) = 0. 2616 qbs_seri(i,k)= 0. 2617 cf_seri(i,k) = 0. 2618 rvc_seri(i,k)= 0. 2607 2619 !CR: ATTENTION, on rajoute la variable glace 2608 2620 IF (nqo.EQ.2) THEN !--vapour and liquid only 2609 2621 qs_seri(i,k) = 0. 2610 rneb_seri(i,k) = 0.2611 2622 ELSE IF (nqo.EQ.3) THEN !--vapour, liquid and ice 2612 2623 qs_seri(i,k) = qx(i,k,isol) 2613 rneb_seri(i,k) = 0. 2614 ELSE IF (nqo.GE.4) THEN !--vapour, liquid, ice and rneb and blowing snow 2624 ELSE IF (nqo.GE.4) THEN !--vapour, liquid, ice, blowing snow, cloud fraction and cloudy water vapor to total water vapor ratio 2615 2625 qs_seri(i,k) = qx(i,k,isol) 2616 IF (ok_ice_sursat) THEN 2617 rneb_seri(i,k) = qx(i,k,irneb) 2626 IF (ok_ice_supersat) THEN 2627 cf_seri(i,k) = qx(i,k,icf) 2628 rvc_seri(i,k) = qx(i,k,irvc) 2618 2629 ENDIF 2619 2630 IF (ok_bs) THEN … … 2784 2795 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep 2785 2796 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep 2786 d_qbs_dyn(:,:) = (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep 2797 d_qbs_dyn(:,:)= (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep 2798 d_cf_dyn(:,:) = (cf_seri(:,:)-cf_ancien(:,:))/phys_tstep 2799 d_rvc_dyn(:,:)= (rvc_seri(:,:)-rvc_ancien(:,:))/phys_tstep 2787 2800 CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d) 2788 2801 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep … … 2796 2809 IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep 2797 2810 ! !! RomP <<< 2798 !!d_rneb_dyn(:,:)=(rneb_seri(:,:)-rneb_ancien(:,:))/phys_tstep2799 d_rneb_dyn(:,:)=0.02800 2811 2801 2812 #ifdef ISO … … 2879 2890 d_ql_dyn(:,:) = 0.0 2880 2891 d_qs_dyn(:,:) = 0.0 2892 d_qbs_dyn(:,:)= 0.0 2893 d_cf_dyn(:,:) = 0.0 2894 d_rvc_dyn(:,:)= 0.0 2881 2895 d_q_dyn2d(:) = 0.0 2882 2896 d_ql_dyn2d(:) = 0.0 … … 2905 2919 IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0 2906 2920 ! !! RomP <<< 2907 d_rneb_dyn(:,:)=0.02908 d_qbs_dyn(:,:)=0.02909 2921 ancien_ok = .TRUE. 2910 2922 #ifdef ISO … … 3017 3029 ! "zmasse" changes a little.) 3018 3030 ENDIF 3031 ENDIF 3032 3033 !-- Needed for LSCP - condensation and ice supersaturation 3034 IF (ok_ice_supersat) THEN 3035 DO k = 1, klev 3036 DO i = 1, klon 3037 IF ( ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) .GT. 0. ) THEN 3038 ratio_qi_qtot(i,k) = qs_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) 3039 rvc_seri(i,k) = rvc_seri(i,k) * q_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) 3040 ELSE 3041 ratio_qi_qtot(i,k) = 0. 3042 rvc_seri(i,k) = 0. 3043 ENDIF 3044 ENDDO 3045 ENDDO 3019 3046 ENDIF 3020 3047 … … 5060 5087 5061 5088 !--mise à jour de flight_m et flight_h2o dans leur module 5062 IF (ok_plane_h2o .OR. ok_plane_contrail) THEN5063 CALL airplane(debut,pphis,pplay,paprs,t_seri)5064 ENDIF5089 !IF (ok_plane_h2o .OR. ok_plane_contrail) THEN 5090 ! CALL airplane(debut,pphis,pplay,paprs,t_seri) 5091 !ENDIF 5065 5092 5066 5093 CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, & 5067 5094 t_seri, q_seri,qs_ini,ptconv,ratqs, & 5068 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri,&5095 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 5069 5096 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 5070 5097 radocond, picefra, rain_lsc, snow_lsc, & … … 5072 5099 prfl, psfl, rhcl, & 5073 5100 zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, & 5074 iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, temp_cltop, & 5075 pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 5076 Tcontr, qcontr, qcontr2, fcontrN, fcontrP , & 5101 iflag_ice_thermo, distcltop, temp_cltop, 5102 pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), & 5103 cell_area, & 5104 cf_seri, rvc_seri, u_seri, v_seri, & 5105 qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, & 5106 dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, & 5107 dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, & 5108 Tcontr, qcontr, qcontr2, fcontrN, fcontrP, & 5109 dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, & 5077 5110 cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, & 5078 5111 qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, & … … 7129 7162 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep 7130 7163 ENDIF 7131 !--ice_sursat: nqo=4, on ajoute rneb 7132 IF (nqo.ge.4 .and. ok_ice_sursat) THEN 7133 d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep 7164 !--ice_supersat: nqo=5, we add cloud fraction and cloudy water vapor to total water vapor ratio 7165 IF (nqo.ge.5 .and. ok_ice_supersat) THEN 7166 d_qx(i,k,icf) = ( cf_seri(i,k) - qx(i,k,icf) ) / phys_tstep 7167 d_qx(i,k,irvc) = ( rvc_seri(i,k) - qx(i,k,irvc) ) / phys_tstep 7134 7168 ENDIF 7135 7169 … … 7137 7171 d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep 7138 7172 ENDIF 7139 7140 7173 7141 7174 ENDDO … … 7186 7219 ql_ancien(:,:) = ql_seri(:,:) 7187 7220 qs_ancien(:,:) = qs_seri(:,:) 7188 qbs_ancien(:,:) = qbs_seri(:,:) 7189 rneb_ancien(:,:) = rneb_seri(:,:) 7221 qbs_ancien(:,:)= qbs_seri(:,:) 7222 cf_ancien(:,:) = cf_seri(:,:) 7223 rvc_ancien(:,:)= rvc_seri(:,:) 7190 7224 #ifdef ISO 7191 7225 xt_ancien(:,:,:)=xt_seri(:,:,:)
Note: See TracChangeset
for help on using the changeset viewer.
