- Timestamp:
- Aug 4, 2025, 3:03:07 PM (11 days ago)
- Location:
- LMDZ6/branches/contrails
- Files:
-
- 17 edited
-
DefLists/field_def_lmdz.xml (modified) (5 diffs)
-
libf/phylmd/lmdz_aviation.f90 (modified) (7 diffs)
-
libf/phylmd/lmdz_call_cloud_optics_prop.f90 (modified) (9 diffs)
-
libf/phylmd/lmdz_cloud_optics_prop.f90 (modified) (27 diffs)
-
libf/phylmd/lmdz_cloud_optics_prop_ini.f90 (modified) (4 diffs)
-
libf/phylmd/lmdz_lscp_condensation.f90 (modified) (4 diffs)
-
libf/phylmd/lmdz_lscp_ini.f90 (modified) (13 diffs)
-
libf/phylmd/lmdz_lscp_main.f90 (modified) (12 diffs)
-
libf/phylmd/lmdz_lscp_precip.f90 (modified) (2 diffs)
-
libf/phylmd/phys_local_var_mod.F90 (modified) (6 diffs)
-
libf/phylmd/phys_output_ctrlout_mod.F90 (modified) (2 diffs)
-
libf/phylmd/phys_output_write_mod.F90 (modified) (7 diffs)
-
libf/phylmd/physiq_mod.F90 (modified) (9 diffs)
-
libf/phylmd/radlwsw_m.F90 (modified) (5 diffs)
-
libf/phylmd/rrtm/radlsw.F90 (modified) (18 diffs)
-
libf/phylmd/rrtm/radlsw.intfb.h (modified) (4 diffs)
-
libf/phylmd/rrtm/recmwf_aero.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/contrails/DefLists/field_def_lmdz.xml
r5791 r5796 612 612 <field id="cldh_nocont" long_name="High-level cloudiness w/o contrails" unit="-" /> 613 613 <field id="contcov" long_name="Total contrails cover" unit="-" /> 614 <field id="iwp_ nocont" long_name="Cloud ice water path w/ocontrails" unit="kg/m2" />614 <field id="iwp_cont" long_name="Cloud ice water path of contrails" unit="kg/m2" /> 615 615 <field id="tops_nocont" long_name="Solar rad. at TOA w/o contrails" unit="W/m2" /> 616 616 <field id="topl_nocont" long_name="IR rad. at TOA w/o contrails" unit="W/m2" /> … … 766 766 <field id="dltpbltke_oce" long_name="TKE difference (w - x)" unit="m2/s2" /> 767 767 <field id="dltpbltke_sic" long_name="TKE difference (w - x)" unit="m2/s2" /> 768 <field id="cldtau" long_name="Cloud optical thickness" unit="1" />769 <field id="cldemi" long_name="Cloud optical emissivity" unit="1" />768 <field id="cldtau" long_name="Cloud optical thickness" unit="1" detect_missing_value=".true." /> 769 <field id="cldemi" long_name="Cloud optical emissivity" unit="1" detect_missing_value=".true." /> 770 770 <field id="tke_max" long_name="TKE max" unit="m2/s2" operation="maximum"/> 771 771 <field id="concso4" long_name="Concentration of Sulfate " unit="kg/m3" /> … … 953 953 <field id="dmc" long_name="Deep COnvective Mass Flux" unit="kg/(m2*s)" /> 954 954 <field id="ref_liq" long_name="Effective radius of convective cloud liquid water particle" unit="m" /> 955 <field id="ref_ice" long_name="Effective radius of startiform cloud ice particle" unit="m" />955 <field id="ref_ice" long_name="Effective radius of startiform cloud ice particle" unit="m" detect_missing_value=".true." /> 956 956 <field id="stratomask" long_name="Stratospheric fraction" unit="-" /> 957 957 <field id="heat_volc" long_name="SW heating rate from volcano" unit="K/s" /> … … 995 995 <field id="nicseri" long_name="Contrail ice crystals concentration" unit="#/kg" /> 996 996 <field id="dnicdyn" long_name="Dynamics contrail ice crystals concentration tendency" unit="#/kg/s" /> 997 <field id="Tcritcont" long_name="Temperature threshold for contrail formation" unit="K" />998 <field id="qcritcont" long_name="Specific humidity threshold for contrail formation" unit="kg/kg" />999 <field id="potcontfraP" long_name="Fraction with pontential persistent contrail" unit="-" />1000 <field id="potcontfraNP" long_name="Fraction with potential non-persistent contrail" unit="-" />997 <field id="Tcritcont" long_name="Temperature threshold for contrail formation" unit="K" detect_missing_value=".true." /> 998 <field id="qcritcont" long_name="Specific humidity threshold for contrail formation" unit="kg/kg" detect_missing_value=".true." /> 999 <field id="potcontfraP" long_name="Fraction with pontential persistent contrail" unit="-" detect_missing_value=".true." /> 1000 <field id="potcontfraNP" long_name="Fraction with potential non-persistent contrail" unit="-" detect_missing_value=".true." /> 1001 1001 <field id="qice_cont" long_name="Contrails ice specific humidity" unit="kg/kg" /> 1002 1002 <field id="dcfcini" long_name="Initial formation contrail fraction tendency" unit="s-1" /> … … 1023 1023 <field id="flightdist" long_name="Aviation flown distance concentration" unit="m/s/m3" /> 1024 1024 <field id="flightfuel" long_name="Aviation fuel consumption concentration" unit="kg/s/m3" /> 1025 <field id="AEI_cont" long_name="Apparent emission index contrails" unit="#/kg" /> 1026 <field id="AEI_surv_cont" long_name="Apparent emission index contrails after vortex loss" unit="#/kg" /> 1027 <field id="fsurv_cont" long_name="Survival fraction after vortex loss" unit="-" /> 1028 <field id="section_cont" long_name="Cross section of newly formed contrails" unit="m2" /> 1025 <field id="AEI_cont" long_name="Apparent emission index contrails" unit="#/kg" detect_missing_value=".true." /> 1026 <field id="AEI_surv_cont" long_name="Apparent emission index contrails after vortex loss" unit="#/kg" detect_missing_value=".true." /> 1027 <field id="fsurv_cont" long_name="Survival fraction after vortex loss" unit="-" detect_missing_value=".true." /> 1028 <field id="section_cont" long_name="Cross section of newly formed contrails" unit="m2" detect_missing_value=".true." /> 1029 <field id="nice_ygcont" long_name="Ice particle number concentration in young contrails" unit="#/cm3" detect_missing_value=".true." /> 1030 <field id="iwc_ygcont" long_name="Ice water content in young contrails" unit="g/m3" detect_missing_value=".true." /> 1031 <field id="rvol_ygcont" long_name="Ice crystals volumic radius in young contrails" unit="microns" detect_missing_value=".true." /> 1032 <field id="tau_ygcont" long_name="Young contrails optical depth" unit="-" detect_missing_value=".true." /> 1033 <field id="nice_cont" long_name="Ice particle number concentration in contrails" unit="#/cm3" detect_missing_value=".true." /> 1034 <field id="iwc_cont" long_name="Ice water content in contrails" unit="g/m3" detect_missing_value=".true." /> 1035 <field id="rvol_cont" long_name="Ice crystals volumic radius in contrails" unit="microns" detect_missing_value=".true." /> 1036 <field id="tau_cont" long_name="Contrails optical depth" unit="-" detect_missing_value=".true." /> 1029 1037 <field id="dqavi" long_name="Water vapor emissions from aviation tendency" unit="kg/kg/s" /> 1030 <field id="cldfra_ nocont" long_name="Cloud fraction w/ocontrails" unit="-" />1031 <field id="c ldtau_nocont" long_name="Cloud optical thickness w/o contrails" unit="1" />1032 <field id="cont tau" long_name="Contrails optical thickness" unit="1" />1033 <field id="c ontemi" long_name="Contrails optical emissivity" unit="1" />1034 <field id="cldemi_nocont" long_name="Cloud optical emissivity w/o contrails" unit="1" />1035 <field id="iwc _nocont" long_name="Cloud ice water content seen by radiation w/ocontrails" unit="kg/m3" />1036 <field id="ref_ice_ nocont" long_name="Effective radius of ice crystals w/o contrails" unit="microns" />1038 <field id="cldfra_cont" long_name="Cloud fraction of contrails" unit="-" /> 1039 <field id="conttau" long_name="Contrails optical thickness" unit="1" detect_missing_value=".true." /> 1040 <field id="contemi" long_name="Contrails optical emissivity" unit="1" detect_missing_value=".true." /> 1041 <field id="cldtau_nocont" long_name="Cloud optical thickness w/o contrails" unit="1" detect_missing_value=".true." /> 1042 <field id="cldemi_nocont" long_name="Cloud optical emissivity w/o contrails" unit="1" detect_missing_value=".true." /> 1043 <field id="iwcon_cont" long_name="Cloud ice water content seen by radiation of contrails" unit="kg/m3" /> 1044 <field id="ref_ice_cont" long_name="Effective radius of ice crystals of contrails" unit="microns" detect_missing_value=".true." /> 1037 1045 1038 1046 <field id="fluxt" long_name="flux h" unit="W/m2" /> -
LMDZ6/branches/contrails/libf/phylmd/lmdz_aviation.f90
r5790 r5796 225 225 !--Add a source of contrails from aviation 226 226 IF ( ( potcontfraP(i) .GT. eps ) .AND. ( flight_dist(i) .GT. 1e-20 ) ) THEN 227 !section_contrails(i) = CONTRAIL_CROSS_SECTION_ONERA() 228 section_contrails(i) = CONTRAIL_CROSS_SECTION_SCHUMANN( & 227 section_contrails(i) = CONTRAIL_CROSS_SECTION( & 229 228 dtime, rho(i), flight_dist(i), flight_fuel(i)) 230 229 icesat_ratio = qpotcontP / potcontfraP(i) / qsat(i) 231 !--If Nice init is fixed in the plume232 !Nice_per_m_init_contrails = Nice_init_contrails * 1e6 * section_contrails(i)233 !--Else if it is parameterized234 230 CALL CONTRAIL_ICE_NUMBER_CONCENTRATION(temp(i), icesat_ratio, rho(i), & 235 flight_dist(i), flight_fuel(i), Nice_per_m_init_contrails, & 231 flight_dist(i), flight_fuel(i), section_contrails(i), & 232 Nice_per_m_init_contrails, & 236 233 AEI_contrails(i), AEI_surv_contrails(i), fsurv_contrails(i)) 237 234 … … 254 251 255 252 !********************************************************************************** 256 FUNCTION CONTRAIL_CROSS_SECTION_ONERA() 257 258 USE lmdz_lscp_ini, ONLY: initial_width_contrails, initial_height_contrails 259 260 IMPLICIT NONE 261 262 ! 263 ! Output 264 ! 265 REAL :: contrail_cross_section_onera ! [m2] 266 ! 267 ! Local 268 ! 269 270 contrail_cross_section_onera = initial_width_contrails * initial_height_contrails 271 272 END FUNCTION CONTRAIL_CROSS_SECTION_ONERA 273 274 275 !********************************************************************************** 276 !--Based on Schumann (1998) 277 FUNCTION CONTRAIL_CROSS_SECTION_SCHUMANN(dtime, rho_air, flight_dist, flight_fuel) 278 253 FUNCTION CONTRAIL_CROSS_SECTION(dtime, rho_air, flight_dist, flight_fuel) 254 255 USE lmdz_lscp_ini, ONLY: iflag_cross_sec_contrail 279 256 USE lmdz_lscp_ini, ONLY: initial_width_contrails, initial_height_contrails 280 257 … … 291 268 ! Output 292 269 ! 293 REAL :: contrail_cross_section _schumann! [m2]270 REAL :: contrail_cross_section ! [m2] 294 271 ! 295 272 ! Local … … 297 274 REAL :: dilution_factor 298 275 299 !--The contrail is formed on average in the middle of the timestep 300 dilution_factor = 7000. * (dtime / 2.)**0.8 301 contrail_cross_section_schumann = flight_fuel / flight_dist * dilution_factor / rho_air 302 303 END FUNCTION CONTRAIL_CROSS_SECTION_SCHUMANN 276 IF ( iflag_cross_sec_contrail .EQ. 0 ) THEN 277 contrail_cross_section = initial_width_contrails * initial_height_contrails 278 ELSEIF ( iflag_cross_sec_contrail .EQ. 1 ) THEN 279 !--Based on Schumann (1998) 280 !--The contrail is formed on average in the middle of the timestep 281 dilution_factor = 7000. * (dtime / 2.)**0.8 282 contrail_cross_section = flight_fuel / flight_dist * dilution_factor / rho_air 283 ENDIF 284 285 END FUNCTION CONTRAIL_CROSS_SECTION 304 286 305 287 306 288 !********************************************************************************** 307 289 SUBROUTINE CONTRAIL_ICE_NUMBER_CONCENTRATION(temp, icesat_ratio, rho_air, & 308 flight_dist, flight_fuel, Nice_per_m_init_contrails, &290 flight_dist, flight_fuel, cross_section, Nice_per_m_init_contrails, & 309 291 AEI_contrails, AEI_surv_contrails, fsurv_contrails) 310 292 311 USE lmdz_lscp_ini, ONLY: RPI 293 USE lmdz_lscp_ini, ONLY: RPI, iflag_AEI_contrail, iflag_vortex_loss 294 USE lmdz_lscp_ini, ONLY: Nice_init_contrails, fraction_survival_contrails 312 295 USE lmdz_lscp_ini, ONLY: EI_soot_aviation, air_to_fuel_ratio_engine, wingspan 313 296 USE lmdz_lscp_ini, ONLY: Naer_amb, raer_amb_mean, raer_amb_std, r_soot_mean, r_soot_std … … 325 308 REAL, INTENT(IN) :: flight_dist ! flown distance [m/s/m3] 326 309 REAL, INTENT(IN) :: flight_fuel ! fuel consumed [kg/s/m3] 310 REAL, INTENT(IN) :: cross_section ! contrail cross section [m2] 327 311 ! 328 312 ! Output … … 344 328 REAL :: Nice_per_m, fuel_per_m, frac_surv 345 329 330 ! fuel consumption in kg/m flown 331 fuel_per_m = flight_fuel / flight_dist 332 346 333 !------------------------------ 347 334 !-- INITIAL ICE NUCLEATION -- 348 335 !------------------------------ 349 336 ! 350 !--Karcher et al. (2015), Bier and Burkhardt (2019, 2022) 351 !log_liqsat_ratio = LOG(liq_satratio) 352 353 !! dry core radius in nm 354 !! HERE SHOULD IT BE liqsat_ratio OR liqsat_ratio - 1. ? 355 !rd_act_amb = (4. / 27. / LOG(liqsat_ratio)**2 / 0.5)**(1./3.) 356 !! Integrate lognormal distribution between rd_act_amb and +inf 357 !coef_expo = 4. / SQRT(2. * RPI) / LOG(raer_amb_std) 358 !phi_amb = 1. / (1. + (rd_act_amb / raer_amb_mean)**coef_expo) 359 ! 360 !! BU22, Eq. A1, dry core radius in nm 361 !rd_act_soot = 0.96453426 + 1.21152973 / log_liqsat_ratio - 0.00520358 / log_liqsat_ratio**2 & 362 ! + 2.32286432e-5 / log_liqsat_ratio**3 - 4.36979055e-8 / log_liqsat_ratio**4 363 !rd_act_soot = MIN(150., MAX(1., rd_act_soot)) 364 !! Integrate lognormal distribution between rd_act_amb and +inf 365 !coef_expo = 4. / SQRT(2. * RPI) / LOG(r_soot_std) 366 !phi_amb = 1. / (1. + (rd_act_soot / r_soot_mean)**coef_expo) 367 ! 368 !dil_coef = (0.01 / t0)**0.9 369 ! 370 !! BU22, Eq. 5b 371 !AEI_soot = phi_soot * EI_soot_aviation 372 !AEI_amb = phi_amb * air_to_fuel_ratio_engine * (1. - dil_coef) / dil_coef & 373 ! / rho_air * Naer_amb * 1e6 374 !AEI_contrails = AEI_soot + AEI_amb 375 AEI_contrails = EI_soot_aviation 376 337 IF ( iflag_AEI_contrail .EQ. 0 ) THEN 338 !--If Nice init is fixed in the plume, in #/cm3 339 AEI_contrails = Nice_init_contrails * 1e6 * cross_section / fuel_per_m 340 ELSEIF ( iflag_AEI_contrail .EQ. 1 ) THEN 341 AEI_contrails = EI_soot_aviation 342 !ELSEIF ( iflag_AEI_contrail .EQ. 2 ) THEN 343 ! !--Karcher et al. (2015), Bier and Burkhardt (2019, 2022) 344 ! log_liqsat_ratio = LOG(liq_satratio) 345 346 ! ! dry core radius in nm 347 ! ! HERE SHOULD IT BE liqsat_ratio OR liqsat_ratio - 1. ? 348 ! rd_act_amb = (4. / 27. / LOG(liqsat_ratio)**2 / 0.5)**(1./3.) 349 ! ! Integrate lognormal distribution between rd_act_amb and +inf 350 ! coef_expo = 4. / SQRT(2. * RPI) / LOG(raer_amb_std) 351 ! phi_amb = 1. / (1. + (rd_act_amb / raer_amb_mean)**coef_expo) 352 ! 353 ! ! BU22, Eq. A1, dry core radius in nm 354 ! rd_act_soot = 0.96453426 + 1.21152973 / log_liqsat_ratio - 0.00520358 / log_liqsat_ratio**2 & 355 ! + 2.32286432e-5 / log_liqsat_ratio**3 - 4.36979055e-8 / log_liqsat_ratio**4 356 ! rd_act_soot = MIN(150., MAX(1., rd_act_soot)) 357 ! ! Integrate lognormal distribution between rd_act_amb and +inf 358 ! coef_expo = 4. / SQRT(2. * RPI) / LOG(r_soot_std) 359 ! phi_amb = 1. / (1. + (rd_act_soot / r_soot_mean)**coef_expo) 360 ! 361 ! dil_coef = (0.01 / t0)**0.9 362 ! 363 ! ! BU22, Eq. 5b 364 ! AEI_soot = phi_soot * EI_soot_aviation 365 ! AEI_amb = phi_amb * air_to_fuel_ratio_engine * (1. - dil_coef) / dil_coef & 366 ! / rho_air * Naer_amb * 1e6 367 ! AEI_contrails = AEI_soot + AEI_amb 368 ENDIF 377 369 378 370 !---------------------------- … … 383 375 !--which is an update of Unterstrasser (2016, U16 hereinafter) 384 376 385 ! fuel consumption in kg/m flown386 fuel_per_m = flight_fuel / flight_dist387 388 ! LU25, Eq. A2389 z_atm = 607.46 * (icesat_ratio - 1.)**0.897 * (temp / 205.)**2.225390 391 ! water vapor emissions [kg/m flown], LU25, Eq. 2392 ! U16, Eq. 6393 rho_emit = fuel_per_m * EI_H2O_aviation / plume_area_loss394 ! LU25, Eq. A3395 temp_205 = temp - 205.396 z_emit = 1106.6 * (rho_emit * 1e5)**(0.678 + 0.0116 * temp_205) &397 * EXP(- (0.0807 + 0.000428 * temp_205) * temp_205)398 399 ! U16, Eq. 4400 z_desc = SQRT(8. * circ_0_loss / RPI / N_Brunt_Vaisala_aviation )401 402 377 ! initial number of ice crystals [#/m flown], LU25, Eq. 1 403 378 Nice_per_m = fuel_per_m * AEI_contrails 404 ! ice crystals number concentration [#/m3], LU25, Eq. A1 405 nice_init = Nice_per_m / plume_area_loss 406 ! LU25, Eq. 9, 13d, 13e, 13f and 13g 407 z_delta = (nice_init / nice_init_ref_loss)**(-0.16) * (1.27 * z_atm + 0.42 * z_emit) - 0.49 * z_desc 408 409 ! LU25, Eq. 11, 12, 13a, 13b and 13c 410 fsurv_contrails = 0.42 + 1.31 / RPI * ATAN(-1. + z_delta / 100.) 411 fsurv_contrails = MIN(1., MAX(0., fsurv_contrails)) 379 380 IF ( iflag_vortex_loss .EQ. 0 ) THEN 381 fsurv_contrails = fraction_survival_contrails 382 ELSEIF ( iflag_vortex_loss .EQ. 1 ) THEN 383 ! LU25, Eq. A2 384 z_atm = 607.46 * (icesat_ratio - 1.)**0.897 * (temp / 205.)**2.225 385 386 ! water vapor emissions [kg/m flown], LU25, Eq. 2 387 ! U16, Eq. 6 388 rho_emit = fuel_per_m * EI_H2O_aviation / plume_area_loss 389 ! LU25, Eq. A3 390 temp_205 = temp - 205. 391 z_emit = 1106.6 * (rho_emit * 1e5)**(0.678 + 0.0116 * temp_205) & 392 * EXP(- (0.0807 + 0.000428 * temp_205) * temp_205) 393 394 ! U16, Eq. 4 395 z_desc = SQRT(8. * circ_0_loss / RPI / N_Brunt_Vaisala_aviation ) 396 397 ! U16, Eq. 3, 10d, 10e, 10f, 10g and 10h 398 z_delta = (AEI_contrails / 2.8e14)**(-0.18) * (1.7 * z_atm + 1.15 * z_emit) - 0.6 * z_desc 399 400 ! U16, Eq. 9, 10a, 10b and 10c 401 fsurv_contrails = 0.4 + 1.19 / RPI * ATAN(-1.35 + z_delta / 100.) 402 fsurv_contrails = MIN(1., MAX(0., fsurv_contrails)) 403 ELSEIF ( iflag_vortex_loss .EQ. 2 ) THEN 404 ! LU25, Eq. A2 405 z_atm = 607.46 * (icesat_ratio - 1.)**0.897 * (temp / 205.)**2.225 406 407 ! water vapor emissions [kg/m flown], LU25, Eq. 2 408 ! U16, Eq. 6 409 rho_emit = fuel_per_m * EI_H2O_aviation / plume_area_loss 410 ! LU25, Eq. A3 411 temp_205 = temp - 205. 412 z_emit = 1106.6 * (rho_emit * 1e5)**(0.678 + 0.0116 * temp_205) & 413 * EXP(- (0.0807 + 0.000428 * temp_205) * temp_205) 414 415 ! U16, Eq. 4 416 z_desc = SQRT(8. * circ_0_loss / RPI / N_Brunt_Vaisala_aviation ) 417 418 ! ice crystals number concentration [#/m3], LU25, Eq. A1 419 nice_init = Nice_per_m / plume_area_loss 420 ! LU25, Eq. 9, 13d, 13e, 13f and 13g 421 z_delta = (nice_init / nice_init_ref_loss)**(-0.16) * (1.27 * z_atm + 0.42 * z_emit) - 0.49 * z_desc 422 423 ! LU25, Eq. 11, 12, 13a, 13b and 13c 424 fsurv_contrails = 0.42 + 1.31 / RPI * ATAN(-1. + z_delta / 100.) 425 fsurv_contrails = MIN(1., MAX(0., fsurv_contrails)) 426 ENDIF 412 427 413 428 Nice_per_m_init_contrails = Nice_per_m * fsurv_contrails -
LMDZ6/branches/contrails/libf/phylmd/lmdz_call_cloud_optics_prop.f90
r5790 r5796 5 5 6 6 SUBROUTINE call_cloud_optics_prop(klon, klev, ok_newmicro,& 7 paprs, pplay, temp, radocond, picefra, pcl c, &7 paprs, pplay, temp, radocond, picefra, pclf, pclc, & 8 8 pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, ok_aie, & 9 9 mass_solu_aero, mass_solu_aero_pi, pcldtaupi, distcltop, temp_cltop, re, fl, reliq, reice, & … … 12 12 icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon, & 13 13 !--AB contrails 14 contfra , qice_cont, Nice_cont, pclc_nocont, &14 contfravol, contfra, qice_cont, Nice_cont, pclc_cont, & 15 15 pcltau_nocont, pclemi_nocont, pcltau_cont, pclemi_cont, pch_nocont, pct_cont, & 16 xfiwp_nocont, xfiwc_nocont, reice_nocont) 16 xfiwp_cont, xfiwc_cont, reice_cont, & 17 missing_val) 17 18 18 19 ! Interface between the LMDZ physics monitor and the cloud properties calculation routines … … 34 35 ! input: 35 36 INTEGER, INTENT(IN) :: klon, klev ! number of horizontal and vertical grid points 37 REAL, INTENT(IN) :: missing_val 36 38 REAL, INTENT(IN) :: paprs(klon, klev+1)! pressure at bottom interfaces [Pa] 37 39 REAL, INTENT(IN) :: pplay(klon, klev) ! pressure at the middle of layers [Pa] … … 48 50 REAL, INTENT(OUT) :: distcltop(klon,klev) ! distance from large scale cloud top [m] 49 51 REAL, INTENT(OUT) :: temp_cltop(klon,klev)!temperature at large scale cloud top [K] 52 REAL, INTENT(IN) :: pclf(klon, klev) ! cloud fraction for radiation [-] 50 53 51 54 LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection … … 53 56 54 57 ! inout: 55 REAL, INTENT(INOUT) :: pclc(klon, klev) ! cloud fractionfor radiation [-]58 REAL, INTENT(INOUT) :: pclc(klon, klev) ! cloud cover for radiation [-] 56 59 57 60 ! out: … … 95 98 96 99 !--AB for contrails. All these are used / outputed only if ok_plane_contrail=y 100 REAL, INTENT(IN) :: contfravol(klon, klev) ! contrails volumic fraction [-] 97 101 REAL, INTENT(IN) :: contfra(klon, klev) ! contrails fraction [-] 98 102 REAL, INTENT(IN) :: qice_cont(klon, klev) ! contrails condensed water [kg/kg] … … 100 104 REAL, INTENT(OUT) :: pch_nocont(klon) ! 2D high cloud cover without contrails[-] 101 105 REAL, INTENT(OUT) :: pct_cont(klon) ! 2D total contrails cover[-] 102 REAL, INTENT(OUT) :: xfiwp_ nocont(klon) ! ice water path (seen by radiation) withoutcontrails [kg/m2]103 REAL, INTENT(OUT) :: xfiwc_ nocont(klon, klev) ! ice water content seen by radiation withoutcontrails [kg/kg]104 REAL, INTENT(OUT) :: pclc_ nocont(klon, klev) ! cloud fraction for radiation withoutcontrails [-]106 REAL, INTENT(OUT) :: xfiwp_cont(klon) ! ice water path (seen by radiation) of contrails [kg/m2] 107 REAL, INTENT(OUT) :: xfiwc_cont(klon, klev) ! ice water content seen by radiation of contrails [kg/kg] 108 REAL, INTENT(OUT) :: pclc_cont(klon, klev) ! cloud fraction for radiation of contrails [-] 105 109 REAL, INTENT(OUT) :: pcltau_nocont(klon, klev) ! cloud optical depth without contrails [-] 106 110 REAL, INTENT(OUT) :: pclemi_nocont(klon, klev) ! cloud emissivity without contrails [-] 107 111 REAL, INTENT(OUT) :: pcltau_cont(klon, klev) ! contrails optical depth [-] 108 112 REAL, INTENT(OUT) :: pclemi_cont(klon, klev) ! contrails emissivity [-] 109 REAL, INTENT(OUT) :: reice_ nocont(klon, klev) ! ice effective radius withoutcontrails [micronts]113 REAL, INTENT(OUT) :: reice_cont(klon, klev) ! ice effective radius of contrails [micronts] 110 114 !--AB 111 115 … … 131 135 132 136 IF (ok_newmicro) THEN 133 CALL cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pcl c, &137 CALL cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pclf, pclc, & 134 138 pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, & 135 139 mass_solu_aero, mass_solu_aero_pi, pcldtaupi, distcltop, temp_cltop, re, fl, reliq, reice, & … … 138 142 icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon, & 139 143 !--AB for contrails 140 contfra , qice_cont, Nice_cont, pclc_nocont, pcltau_nocont, &144 contfravol, contfra, qice_cont, Nice_cont, pclc_cont, pcltau_nocont, & 141 145 pclemi_nocont, pcltau_cont, pclemi_cont, pch_nocont, pct_cont, & 142 xfiwp_nocont, xfiwc_nocont, reice_nocont) 146 xfiwp_cont, xfiwc_cont, reice_cont, & 147 missing_val) 143 148 ELSE 144 149 CALL nuage (paprs, pplay, & -
LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop.f90
r5790 r5796 4 4 CONTAINS 5 5 6 SUBROUTINE cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pcl c, &6 SUBROUTINE cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pclf, pclc, & 7 7 pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, & 8 8 mass_solu_aero, mass_solu_aero_pi, pcldtaupi, distcltop, temp_cltop, re, fl, reliq, reice, & … … 11 11 icefrac_optics, dNovrN, ptconv, rnebcon, ccwcon, & 12 12 !--AB contrails 13 contfra , qice_cont, Nice_cont, pclc_nocont, pcltau_nocont, &13 contfravol, contfra, qice_cont, Nice_cont, pclc_cont, pcltau_nocont, & 14 14 pclemi_nocont, pcltau_cont, pclemi_cont, pch_nocont, pct_cont, & 15 xfiwp_nocont, xfiwc_nocont, reice_nocont) 15 xfiwp_cont, xfiwc_cont, reice_cont, & 16 missing_val) 16 17 17 18 USE lmdz_cloud_optics_prop_ini , ONLY : flag_aerosol, ok_cdnc … … 33 34 USE lmdz_cloud_optics_prop_ini , ONLY : rei_coef, rei_min_temp 34 35 USE lmdz_cloud_optics_prop_ini , ONLY : zepsec, novlp, iflag_ice_thermo, ok_new_lscp 35 USE lmdz_cloud_optics_prop_ini , ONLY : ok_plane_contrail, eff2vol_radius_contrails, rho_ice 36 USE lmdz_cloud_optics_prop_ini , ONLY : ok_plane_contrail, rho_ice 37 USE lmdz_cloud_optics_prop_ini , ONLY : eff2vol_radius_contrails, rei_min_contrails 36 38 37 39 … … 59 61 ! input: 60 62 INTEGER, INTENT(IN) :: klon, klev ! number of horizontal and vertical grid points 63 REAL, INTENT(IN) :: missing_val 61 64 REAL, INTENT(IN) :: paprs(klon, klev+1)! pressure at bottom interfaces [Pa] 62 65 REAL, INTENT(IN) :: pplay(klon, klev) ! pressure at the middle of layers [Pa] … … 73 76 REAL, INTENT(OUT) :: distcltop(klon,klev) ! distance from large scale cloud top [m] 74 77 REAL, INTENT(OUT) :: temp_cltop(klon,klev)!temperature at large scale cloud top [K] 78 REAL, INTENT(IN) :: pclf(klon, klev) ! cloud fraction for radiation [-] 75 79 76 80 LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection 77 81 78 82 ! inout: 79 REAL, INTENT(INOUT) :: pclc(klon, klev) ! cloud fractionfor radiation [-]83 REAL, INTENT(INOUT) :: pclc(klon, klev) ! cloud cover for radiation [-] 80 84 81 85 ! out: … … 119 123 120 124 !--AB for contrails. All these are used / outputed only if ok_plane_contrail=y 121 REAL, INTENT(IN) :: contfra(klon, klev) ! contrails fraction [-] 125 REAL, INTENT(IN) :: contfravol(klon, klev) ! contrails volumic fraction [-] 126 REAL, INTENT(IN) :: contfra(klon, klev) ! contrails fraction for radiation [-] 122 127 REAL, INTENT(IN) :: qice_cont(klon, klev) ! contrails condensed water [kg/kg] 123 128 REAL, INTENT(IN) :: Nice_cont(klon, klev) ! contrails ice crystals concentration [#/kg] 124 129 REAL, INTENT(OUT) :: pch_nocont(klon) ! 2D high cloud cover without contrails[-] 125 130 REAL, INTENT(OUT) :: pct_cont(klon) ! 2D total contrails cover[-] 126 REAL, INTENT(OUT) :: xfiwp_ nocont(klon) ! ice water path (seen by radiation) withoutcontrails [kg/m2]127 REAL, INTENT(OUT) :: xfiwc_ nocont(klon, klev) ! ice water content seen by radiation withoutcontrails [kg/kg]128 REAL, INTENT(OUT) :: pclc_ nocont(klon, klev) ! cloud fraction for radiation withoutcontrails [-]131 REAL, INTENT(OUT) :: xfiwp_cont(klon) ! ice water path (seen by radiation) of contrails [kg/m2] 132 REAL, INTENT(OUT) :: xfiwc_cont(klon, klev) ! ice water content seen by radiation of contrails [kg/kg] 133 REAL, INTENT(OUT) :: pclc_cont(klon, klev) ! cloud fraction for radiation of contrails [-] 129 134 REAL, INTENT(OUT) :: pcltau_nocont(klon, klev) ! cloud optical depth without contrails [-] 130 135 REAL, INTENT(OUT) :: pclemi_nocont(klon, klev) ! cloud emissivity without contrails [-] 131 136 REAL, INTENT(OUT) :: pcltau_cont(klon, klev) ! contrails optical depth [-] 132 137 REAL, INTENT(OUT) :: pclemi_cont(klon, klev) ! contrails emissivity [-] 133 REAL, INTENT(OUT) :: reice_ nocont(klon, klev) ! ice effective radius withoutcontrails [microns]138 REAL, INTENT(OUT) :: reice_cont(klon, klev) ! ice effective radius of contrails [microns] 134 139 !--AB 135 140 … … 172 177 REAL zflwp_var, zfiwp_var 173 178 REAL d_rei_dt 174 REAL pclc_cont(klon,klev) 179 REAL pclc_nocont(klon,klev) 180 REAL pclf_nocont(klon,klev) 181 REAL xfiwc_nocont(klon,klev) 175 182 REAL mice_cont, rei_cont 176 183 … … 194 201 xfiwc = 0.D0 195 202 !--AB 196 IF ( ok_plane_contrail ) THEN 197 xfiwp_nocont = 0.D0 198 xfiwc_nocont = 0.D0 199 reice_nocont = 0. 200 ENDIF 203 xfiwp_cont = 0.D0 204 xfiwc_cont = 0.D0 205 reice_cont = 1. 201 206 202 207 reliq = 0. … … 254 259 DO k = 1, klev 255 260 DO i = 1, klon 261 pclf_nocont(i,k) = MAX(0., pclf(i, k) - contfravol(i, k)) 256 262 pclc_nocont(i,k) = MAX(0., pclc(i, k) - contfra(i, k)) 257 263 xfiwc_nocont(i, k) = MAX(0., xfiwc(i, k) - qice_cont(i, k)) 264 xfiwc_cont(i,k) = qice_cont(i,k) 258 265 ENDDO 259 266 ENDDO … … 343 350 IF (iflag_rei .EQ. 2) THEN 344 351 ! in-cloud ice water content in g/m3 345 iwc = icefrac_optics(i,k) * radocond(i,k) / pclc(i,k) * zrho(i,k) * 1000. 352 IF ( ptconv(i,k) ) THEN 353 !--Needed because pclf does not contain convective clouds (should be fixed...) 354 iwc = icefrac_optics(i,k) * radocond(i,k) / pclc(i,k) * zrho(i,k) * 1000. 355 ELSE 356 iwc = icefrac_optics(i,k) * radocond(i,k) / pclf(i,k) * zrho(i,k) * 1000. 357 ENDIF 346 358 ! this formula is a simplified version of the Sun 2001 one (as in the IFS model, 347 359 ! and which is activated for iflag_rei = 1). … … 355 367 dei = rei_coef * (iwc**0.2445) * ( temp(i,k) - rei_min_temp ) 356 368 ! we clip the results 357 deimin = 20. 369 deimin = 20. + 40. * COS(ABS(latitude_deg(i)) / 180. * RPI) 358 370 deimax = 155. 359 371 dei = MIN(MAX(dei, deimin), deimax) … … 364 376 ! It is recommended to use the rei formula from Sun and Rikkus 1999 with a revision 365 377 ! from Sun 2001 (as in the IFS model) 366 iwc=icefrac_optics(i, k)*radocond(i, k)/pclc(i,k)*zrho(i,k)*1000. !in cloud ice water content in g/m3 378 ! in cloud ice water content in g/m3 379 IF ( ptconv(i,k) ) THEN 380 !--Needed because pclf does not contain convective clouds (should be fixed...) 381 iwc = icefrac_optics(i,k) * radocond(i,k) / pclc(i,k) * zrho(i,k) * 1000. 382 ELSE 383 iwc = icefrac_optics(i,k) * radocond(i,k) / pclf(i,k) * zrho(i,k) * 1000. 384 ENDIF 367 385 dei=(1.2351+0.0105*(temp(i,k)-273.15))*(45.8966*(iwc**0.2214) + & 368 386 & 0.7957*(iwc**0.2535)*(temp(i,k)-83.15)) … … 371 389 !Etienne: deimax and deimin controled by rei_max and rei_min in physiq.def 372 390 deimax=rei_max*2.0 373 deimin=2.0*rei_min+40 *cos(abs(latitude_deg(i))/180.*RPI)391 deimin=2.0*rei_min+40.*cos(abs(latitude_deg(i))/180.*RPI) 374 392 dei=min(dei,deimax) 375 393 dei=max(dei,deimin) … … 472 490 IF (iflag_rei .EQ. 2) THEN 473 491 ! in-cloud ice water content in g/m3 474 iwc = icefrac_optics(i,k) * radocond(i,k) / pclc(i,k) * zrho(i,k) * 1000. 492 IF ( ptconv(i,k) ) THEN 493 !--Needed because pclf does not contain convective clouds (should be fixed...) 494 iwc = icefrac_optics(i,k) * radocond(i,k) / pclc(i,k) * zrho(i,k) * 1000. 495 ELSE 496 iwc = icefrac_optics(i,k) * radocond(i,k) / pclf(i,k) * zrho(i,k) * 1000. 497 ENDIF 475 498 ! this formula is a simplified version of the Sun 2001 one (as in the IFS model, 476 499 ! and which is activated for iflag_rei = 1). … … 484 507 dei = rei_coef * (iwc**0.2445) * ( temp(i,k) - rei_min_temp ) 485 508 ! we clip the results 486 deimin = 20. 509 deimin = 20. + 40. * COS(ABS(latitude_deg(i)) / 180. * RPI) 487 510 deimax = 155. 488 511 dei = MIN(MAX(dei, deimin), deimax) … … 494 517 ! we use the rei formula from Sun and Rikkus 1999 with a revision 495 518 ! from Sun 2001 (as in the IFS model) 496 iwc=icefrac_optics(i, k)*radocond(i, k)/pclc(i,k)*zrho(i,k)*1000. !in cloud ice water content in g/m3 519 ! in cloud ice water content in g/m3 520 IF ( ptconv(i,k) ) THEN 521 !--Needed because pclf does not contain convective clouds (should be fixed...) 522 iwc = icefrac_optics(i,k) * radocond(i,k) / pclc(i,k) * zrho(i,k) * 1000. 523 ELSE 524 iwc = icefrac_optics(i,k) * radocond(i,k) / pclf(i,k) * zrho(i,k) * 1000. 525 ENDIF 497 526 dei=(1.2351+0.0105*(temp(i,k)-273.15))*(45.8966*(iwc**0.2214) + & 498 527 &0.7957*(iwc**0.2535)*(temp(i,k)-83.15)) … … 501 530 !Etienne: deimax and deimin controled by rei_max and rei_min in physiq.def 502 531 deimax=rei_max*2.0 503 deimin=2.0*rei_min+40 *cos(abs(latitude_deg(i))/180.*RPI)532 deimin=2.0*rei_min+40.*cos(abs(latitude_deg(i))/180.*RPI) 504 533 dei=min(dei,deimax) 505 534 dei=max(dei,deimin) … … 565 594 re(i, k) = rad_chaud(i, k)*fl(i, k) 566 595 rel = 0. 567 rei = 0.596 rei = 1. 568 597 pclc(i, k) = 0.0 569 598 pcltau(i, k) = 0.0 … … 571 600 572 601 !--AB contrails 573 rei ce_nocont(i,k) = 0.602 rei_cont = 1. 574 603 pclc_nocont(i,k) = 0. 575 604 pclc_cont(i,k) = 0. 576 pcltau_cont(i,k) = 0.577 pclemi_cont(i,k) = 0.578 pcltau_nocont(i,k) = 0.579 pclemi_nocont(i,k) = 0.605 pcltau_cont(i,k) = missing_val 606 pclemi_cont(i,k) = missing_val 607 pcltau_nocont(i,k) = missing_val 608 pclemi_nocont(i,k) = missing_val 580 609 581 610 ELSE … … 604 633 IF (iflag_rei .EQ. 2) THEN 605 634 ! in-cloud ice water content in g/m3 606 iwc = xfiwc_nocont(i, k) / pclc_nocont(i,k) * zrho(i,k) * 1000. 635 IF ( ptconv(i,k) ) THEN 636 !--Needed because pclf does not contain convective clouds (should be fixed...) 637 iwc = xfiwc_nocont(i, k) / pclc_nocont(i,k) * zrho(i,k) * 1000. 638 ELSE 639 iwc = xfiwc_nocont(i, k) / pclf_nocont(i,k) * zrho(i,k) * 1000. 640 ENDIF 607 641 ! this formula is a simplified version of the Sun 2001 one (as in the IFS model, 608 642 ! and which is activated for iflag_rei = 1). … … 616 650 dei = rei_coef * (iwc**0.2445) * ( temp(i,k) - rei_min_temp ) 617 651 ! we clip the results 618 !deimin = 20.652 deimin = 20. + 40. * COS(ABS(latitude_deg(i)) / 180. * RPI) 619 653 deimax = 155. 620 !dei = MIN(MAX(dei, deimin), deimax) 621 dei = MIN(dei, deimax) 654 dei = MIN(MAX(dei, deimin), deimax) 622 655 ! formula to convert effective diameter to effective radius 623 656 rei = 3. * SQRT(3.) / 8. * dei … … 628 661 ! we use the rei formula from Sun and Rikkus 1999 with a revision 629 662 ! from Sun 2001 (as in the IFS model) 630 iwc = xfiwc_nocont(i, k) / pclc_nocont(i,k) * zrho(i,k) * 1000. !in cloud ice water content in g/m3 663 ! in cloud ice water content in g/m3 664 IF ( ptconv(i,k) ) THEN 665 !--Needed because pclf does not contain convective clouds (should be fixed...) 666 iwc = xfiwc_nocont(i, k) / pclc_nocont(i,k) * zrho(i,k) * 1000. 667 ELSE 668 iwc = xfiwc_nocont(i, k) / pclf_nocont(i,k) * zrho(i,k) * 1000. 669 ENDIF 631 670 dei=(1.2351+0.0105*(temp(i,k)-273.15))*(45.8966*(iwc**0.2214) + & 632 671 &0.7957*(iwc**0.2535)*(temp(i,k)-83.15)) … … 635 674 !Etienne: deimax and deimin controled by rei_max and rei_min in physiq.def 636 675 deimax=rei_max*2.0 637 deimin=2.0*rei_min+40 *cos(abs(latitude_deg(i))/180.*RPI)676 deimin=2.0*rei_min+40.*cos(abs(latitude_deg(i))/180.*RPI) 638 677 dei=min(dei,deimax) 639 678 dei=max(dei,deimin) … … 662 701 !--Diagnostics of clouds emissivity, optical depth and ice crystal radius 663 702 !--without contrails 664 reice_nocont(i,k) = rei665 703 pcltau_nocont(i,k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448E-03+2.431/rei) 666 704 ! -- cloud infrared emissivity: … … 678 716 !--Diagnostics of clouds emissivity, optical depth and ice crystal radius 679 717 !--without contrails 680 reice_nocont(i,k) = 1.681 718 pclc_nocont(i,k) = 0. 682 719 pclc(i,k) = contfra(i,k) … … 693 730 rei_cont = (mice_cont / rho_ice * 3. / 4. / RPI)**(1./3.) 694 731 !--Effective radius (in microns) 695 rei_cont = MIN(100., MAX(1., rei_cont / eff2vol_radius_contrails * 1e6)) 696 zfiwp_var = 1000.*(xfiwc(i, k)-xfiwc_nocont(i, k))& 697 / (pclc(i, k)-pclc_nocont(i, k))*rhodz(i, k) 732 rei_cont = MIN(100., MAX(rei_min_contrails, rei_cont / eff2vol_radius_contrails * 1e6)) 733 zfiwp_var = 1000.*xfiwc_cont(i, k)/pclc_cont(i, k)*rhodz(i, k) 698 734 699 735 pcltau_cont(i, k) = zfiwp_var*(3.448E-03+2.431/rei_cont) … … 711 747 ENDIF 712 748 713 rei = ( rei_cont * pclc_cont(i,k) + reice_nocont(i, k) * pclc_nocont(i, k) ) & 714 / ( pclc_cont(i,k) + pclc_nocont(i,k) ) 715 716 zflwp_var = 1000.*xflwc(i, k)/pclc(i, k)*rhodz(i, k) 717 zfiwp_var = 1000.*xfiwc(i, k)/pclc(i, k)*rhodz(i, k) 718 719 pcltau(i,k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448E-03+2.431/rei) 720 ! -- cloud infrared emissivity: 721 ! [the broadband infrared absorption coefficient is PARAMETERized 722 ! as a function of the effective cld droplet radius] 723 ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995): 724 k_ice = k_ice0 + 1.0/rei 725 pclemi(i, k) = 1.0 - exp(-coef_chau*zflwp_var-df*k_ice*zfiwp_var) 749 pcltau(i,k) = (pclc_nocont(i,k)*pcltau_nocont(i,k) & 750 & + pclc_cont(i,k)*pcltau_cont(i,k)) & 751 & / pclc(i,k) 752 pclemi(i,k) = (pclc_nocont(i,k)*pclemi_nocont(i,k) & 753 & + pclc_cont(i,k)*pclemi_cont(i,k)) & 754 & / pclc(i,k) 755 756 IF ( pclc_nocont(i,k) .EQ. 0. ) THEN 757 pcltau_nocont(i,k) = missing_val 758 pclemi_nocont(i,k) = missing_val 759 ENDIF 760 761 IF ( pclc_cont(i,k) .EQ. 0. ) THEN 762 pcltau_cont(i,k) = missing_val 763 pclemi_cont(i,k) = missing_val 764 ENDIF 726 765 727 766 ENDIF 728 767 729 768 reice(i, k) = rei 769 reice_cont(i,k) = rei_cont 730 770 731 771 xflwp(i) = xflwp(i) + xflwc(i, k)*rhodz(i, k) 732 772 xfiwp(i) = xfiwp(i) + xfiwc(i, k)*rhodz(i, k) 733 xfiwp_nocont(i) = xfiwp_nocont(i) + xfiwc_nocont(i, k)*rhodz(i, k) 734 735 !--We weight the optical properties with the cloud fractions 736 !--This is only used for the diagnostics 737 pcltau_nocont(i, k) = pcltau_nocont(i, k) * pclc_nocont(i,k) 738 pclemi_nocont(i, k) = pclemi_nocont(i, k) * pclc_nocont(i,k) 739 pcltau_cont(i, k) = pcltau_cont(i, k) * pclc_cont(i,k) 740 pclemi_cont(i, k) = pclemi_cont(i, k) * pclc_cont(i,k) 741 pcltau(i, k) = pcltau(i, k) * pclc(i,k) 742 pclemi(i, k) = pclemi(i, k) * pclc(i,k) 773 xfiwp_cont(i) = xfiwp_cont(i) + xfiwc_cont(i, k)*rhodz(i, k) 743 774 744 775 ENDDO -
LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop_ini.f90
r5794 r5796 12 12 LOGICAL, PROTECTED :: ok_icefra_lscp, ok_new_lscp 13 13 LOGICAL, PROTECTED :: ok_plane_contrail 14 LOGICAL, PROTECTED :: ok_higher_cirrus_cover15 14 REAL, PROTECTED :: bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula 16 15 REAL, ALLOCATABLE :: latitude_deg(:) … … 26 25 REAL, PROTECTED :: zepsec 27 26 REAL, PROTECTED :: eff2vol_radius_contrails=0.7 27 REAL, PROTECTED :: rei_min_contrails=10. 28 28 REAL, PROTECTED :: rho_ice=920. ! Ice crystal density (assuming spherical geometry) [kg/m3] 29 29 REAL, PARAMETER :: thres_tau=0.3, thres_neb=0.001 … … 45 45 !$OMP THREADPRIVATE(rei_coef, rei_min_temp) 46 46 !$OMP THREADPRIVATE(zepsec) 47 !$OMP THREADPRIVATE(eff2vol_radius_contrails, r ho_ice)48 !$OMP THREADPRIVATE(ok_plane_contrail , ok_higher_cirrus_cover)47 !$OMP THREADPRIVATE(eff2vol_radius_contrails, rei_min_contrails, rho_ice) 48 !$OMP THREADPRIVATE(ok_plane_contrail) 49 49 50 50 … … 117 117 CALL getin_p('eff2vol_radius_contrails', eff2vol_radius_contrails) 118 118 write(lunout,*)'eff2vol_radius_contrails=',eff2vol_radius_contrails 119 CALL getin_p('ok_higher_cirrus_cover', ok_higher_cirrus_cover) 120 write(lunout,*)'ok_higher_cirrus_cover=',ok_higher_cirrus_cover 121 122 IF ( ok_higher_cirrus_cover .AND. iflag_rei .GT. 0 ) THEN 123 abort_message = 'in cloud_optics, ok_higher_cirrus_cover is not implemented for iflag_rei > 0' 124 CALL abort_physic (modname,abort_message,1) 125 ENDIF 119 CALL getin_p('rei_min_contrails', rei_min_contrails) 120 write(lunout,*)'rei_min_contrails=',rei_min_contrails 126 121 127 122 END SUBROUTINE cloud_optics_prop_ini -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_condensation.f90
r5790 r5796 134 134 USE lmdz_lscp_ini, ONLY: coef_mixing_lscp, coef_shear_lscp, chi_mixing 135 135 USE lmdz_lscp_ini, ONLY: aspect_ratio_cirrus, cooling_rate_ice_thresh 136 USE lmdz_lscp_ini, ONLY: ok_ice_sedim, f allice_sedim, cice_velo, dice_velo136 USE lmdz_lscp_ini, ONLY: ok_ice_sedim, ffallv_sed, cice_velo, dice_velo 137 137 USE lmdz_lscp_ini, ONLY: chi_sedim 138 138 … … 1247 1247 mice = qcont(i) / MAX(eps, Ncont(i)) 1248 1248 icefall_velo = ICECRYSTAL_VELO(mice, temp(i), pplay(i)) 1249 !--Volumic radius (in meters)1250 dei = (mice / rho_ice * 3. / 4. / RPI)**(1./3.)1251 1249 !--Effective radius (in meters) 1252 dei = MIN(1e-4, MAX(1e-6, dei / eff2vol_radius_contrails)) 1250 dei = (mice / rho_ice * 3. / 4. / RPI)**(1./3.) / eff2vol_radius_contrails 1251 dei = MIN(1e-4, MAX(1e-6, dei)) 1253 1252 !--Effective radius to effective diameter 1254 1253 dei = 8. / 3. / SQRT(3.) * dei … … 1298 1297 IF ( cldfra(i) .GT. eps ) THEN 1299 1298 iwc = rho(i) * ( qcld(i) - qvc(i) ) / cldfra(i) 1300 icefall_velo = f allice_sedim* cice_velo * MAX(0., iwc)**dice_velo1299 icefall_velo = ffallv_sed * cice_velo * MAX(0., iwc)**dice_velo 1301 1300 1302 1301 !--Sedimentation … … 1716 1715 !------------------------------------------- 1717 1716 1718 IF ( (contfra(i) .LT. eps) .OR. (qcont(i) .LT. (qsat(i) * contfra(i))) ) THEN 1717 IF ( (contfra(i) .LT. eps) .OR. (qcont(i) .LT. (qsat(i) * contfra(i))) & 1718 & .OR. (Ncont(i) .LT. eps) ) THEN 1719 1719 cldfra(i) = cldfra(i) - contfra(i) 1720 1720 qcld(i) = qcld(i) - qcont(i) -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_ini.f90
r5794 r5796 166 166 !$OMP THREADPRIVATE(ok_nodeep_lscp) 167 167 168 LOGICAL, SAVE, PROTECTED :: ok_nodeep_lscp_rad=.FALSE. ! if True, the deep convection clouds are not accounted two times in radiative transfer169 !$OMP THREADPRIVATE(ok_nodeep_lscp_rad)170 171 168 LOGICAL, SAVE, PROTECTED :: ok_higher_cirrus_cover=.FALSE. ! if True, the cirrus cover is increased for radiative transfer, following Brooks et al. (2005) 172 169 !$OMP THREADPRIVATE(ok_higher_cirrus_cover) … … 235 232 !$OMP THREADPRIVATE(ok_plane_contrail) 236 233 234 INTEGER, SAVE, PROTECTED :: iflag_cross_sec_contrail=0 ! choice of the initial cross section parameterization 235 !$OMP THREADPRIVATE(iflag_cross_sec_contrail) 236 237 INTEGER, SAVE, PROTECTED :: iflag_AEI_contrail=0 ! choice of the emission index parameterization 238 !$OMP THREADPRIVATE(iflag_AEI_contrail) 239 240 INTEGER, SAVE, PROTECTED :: iflag_vortex_loss=0 ! choice of the vortex loss parameterization 241 !$OMP THREADPRIVATE(iflag_vortex_loss) 242 237 243 REAL, SAVE, PROTECTED :: aspect_ratio_contrails ! [-] aspect ratio of contrails 238 244 !$OMP THREADPRIVATE(aspect_ratio_contrails) … … 249 255 REAL, SAVE, PROTECTED :: Nice_init_contrails=100. ! [#/cm3] initial ice crystals concentration in contrails 250 256 !$OMP THREADPRIVATE(Nice_init_contrails) 257 258 REAL, SAVE, PROTECTED :: fraction_survival_contrails=1. ! [-] fraction of ice crystals that survive the vortex downwash phase, for contrails 259 !$OMP THREADPRIVATE(fraction_survival_contrails) 251 260 252 261 REAL, SAVE, PROTECTED :: N_Brunt_Vaisala_aviation=0.01 ! [s-1] average Brunt Vaisala frequency, for contrail formation … … 420 429 !$OMP THREADPRIVATE(ok_ice_sedim) 421 430 422 REAL, SAVE, PROTECTED :: f allice_sedim=1.! Tuning factor for ice fallspeed velocity for sedimentation [-]423 !$OMP THREADPRIVATE(f allice_sedim)431 REAL, SAVE, PROTECTED :: ffallv_sed=1. ! Tuning factor for ice fallspeed velocity for sedimentation [-] 432 !$OMP THREADPRIVATE(ffallv_sed) 424 433 425 434 REAL, SAVE, PROTECTED :: chi_sedim=1E5 ! [-] factor for increasing the chance that sedimented ice falls into moist air … … 580 589 CALL getin_p('snow_fallspeed_cld',snow_fallspeed_cld) 581 590 CALL getin_p('ok_ice_sedim',ok_ice_sedim) 582 CALL getin_p('f allice_sedim',fallice_sedim)591 CALL getin_p('ffallv_sed',ffallv_sed) 583 592 CALL getin_p('chi_sedim',chi_sedim) 584 593 ! for condensation and ice supersaturation … … 586 595 CALL getin_p('ok_weibull_warm_clouds',ok_weibull_warm_clouds) 587 596 CALL getin_p('ok_nodeep_lscp',ok_nodeep_lscp) 588 CALL getin_p('ok_nodeep_lscp_rad',ok_nodeep_lscp_rad)589 597 CALL getin_p('ok_higher_cirrus_cover',ok_higher_cirrus_cover) 590 598 ffallv_issr=ffallv_lsc … … 608 616 CALL getin_p('chi_mixing',chi_mixing) 609 617 ! for aviation 618 CALL getin_p('iflag_cross_sec_contrail',iflag_cross_sec_contrail) 619 CALL getin_p('iflag_AEI_contrail',iflag_AEI_contrail) 620 CALL getin_p('iflag_vortex_loss',iflag_vortex_loss) 610 621 aspect_ratio_contrails=aspect_ratio_cirrus 611 622 CALL getin_p('aspect_ratio_contrails',aspect_ratio_contrails) … … 617 628 CALL getin_p('chi_mixing_contrails',chi_mixing_contrails) 618 629 CALL getin_p('Nice_init_contrails',Nice_init_contrails) 630 CALL getin_p('fraction_survival_contrails',fraction_survival_contrails) 619 631 CALL getin_p('EI_H2O_aviation',EI_H2O_aviation) 620 632 CALL getin_p('EI_soot_aviation',EI_soot_aviation) … … 713 725 WRITE(lunout,*) 'lscp_ini, snow_fallspeed_cld:', snow_fallspeed_cld 714 726 WRITE(lunout,*) 'lscp_ini, ok_ice_sedim:', ok_ice_sedim 715 WRITE(lunout,*) 'lscp_ini, f allice_sedim:', fallice_sedim727 WRITE(lunout,*) 'lscp_ini, ffallv_sed:', ffallv_sed 716 728 WRITE(lunout,*) 'lscp_ini, chi_sedim:', chi_sedim 717 729 ! for condensation and ice supersaturation … … 720 732 WRITE(lunout,*) 'lscp_ini, ok_weibull_warm_clouds:', ok_weibull_warm_clouds 721 733 WRITE(lunout,*) 'lscp_ini, ok_nodeep_lscp:', ok_nodeep_lscp 722 WRITE(lunout,*) 'lscp_ini, ok_nodeep_lscp_rad:', ok_nodeep_lscp_rad723 734 WRITE(lunout,*) 'lscp_ini, ok_higher_cirrus_cover:', ok_higher_cirrus_cover 724 735 WRITE(lunout,*) 'lscp_ini, ffallv_issr', ffallv_issr … … 741 752 WRITE(lunout,*) 'lscp_ini, chi_mixing:', chi_mixing 742 753 ! for aviation 754 WRITE(lunout,*) 'lscp_ini, iflag_cross_sec_contrail:', iflag_cross_sec_contrail 755 WRITE(lunout,*) 'lscp_ini, iflag_AEI_contrail:', iflag_AEI_contrail 756 WRITE(lunout,*) 'lscp_ini, iflag_vortex_loss:', iflag_vortex_loss 743 757 WRITE(lunout,*) 'lscp_ini, aspect_ratio_contrails:', aspect_ratio_contrails 744 758 WRITE(lunout,*) 'lscp_ini, coef_mixing_contrails:', coef_mixing_contrails … … 746 760 WRITE(lunout,*) 'lscp_ini, chi_mixing_contrails:', chi_mixing_contrails 747 761 WRITE(lunout,*) 'lscp_ini, Nice_init_contrails:', Nice_init_contrails 762 WRITE(lunout,*) 'lscp_ini, fraction_survival_contrails:', fraction_survival_contrails 748 763 WRITE(lunout,*) 'lscp_ini, EI_H2O_aviation:', EI_H2O_aviation 749 764 WRITE(lunout,*) 'lscp_ini, EI_soot_aviation:', EI_soot_aviation … … 812 827 ENDIF 813 828 814 IF ( ok_ice_sedim .AND. ffallv_issr .NE. 0. ) THEN815 abort_message = 'in lscp, ok_ice_sedim=y needs ffallv_issr=0.'816 CALL abort_physic (modname,abort_message,1)817 ENDIF818 819 829 IF ( (iflag_icefrac .GE. 1) .AND. (.NOT. ok_poprecip .AND. (iflag_evap_prec .LT. 4)) ) THEN 820 830 abort_message = 'in lscp, icefracturb works with poprecip or with precip evap option >=4' -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_main.f90
r5794 r5796 124 124 USE lmdz_lscp_ini, ONLY : ok_radocond_snow, a_tr_sca 125 125 USE lmdz_lscp_ini, ONLY : iflag_cloudth_vert, iflag_t_glace, iflag_fisrtilp_qsat 126 USE lmdz_lscp_ini, ONLY : min_frac_th_cld, temp_nowater 127 USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RVTMP2, RTT, RD, RG 126 USE lmdz_lscp_ini, ONLY : min_frac_th_cld, temp_nowater, rho_ice 127 USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RVTMP2, RTT, RD, RG, RPI 128 128 USE lmdz_lscp_ini, ONLY : ok_poprecip, ok_bug_phase_lscp 129 129 USE lmdz_lscp_ini, ONLY : ok_ice_supersat, ok_unadjusted_clouds, iflag_icefrac 130 130 USE lmdz_lscp_ini, ONLY : ok_weibull_warm_clouds, ok_no_issr_strato, ok_ice_sedim 131 131 USE lmdz_lscp_ini, ONLY : ok_plane_contrail 132 USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_ nodeep_lscp_rad, ok_higher_cirrus_cover132 USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_higher_cirrus_cover 133 133 USE lmdz_lscp_ini, ONLY : ok_lscp_mergecond, gamma_mixth 134 USE lmdz_lscp_ini, ONLY : eff2vol_radius_contrails 134 135 135 136 ! Temporary call for Lamquin et al (2012) diagnostics … … 144 145 USE phys_local_var_mod, ONLY : dcfc_auto, dqic_auto, dqtc_auto, dnic_auto 145 146 USE phys_local_var_mod, ONLY : dcf_auto, dqi_auto, dqvc_auto 146 USE geometry_mod, ONLY: longitude_deg, latitude_deg 147 USE phys_local_var_mod, ONLY : nice_ygcont, iwc_ygcont, rvol_ygcont, tau_ygcont 148 USE phys_local_var_mod, ONLY : nice_cont, iwc_cont, rvol_cont, tau_cont 147 149 148 150 IMPLICIT NONE … … 362 364 ! for condensation and ice supersaturation 363 365 REAL, DIMENSION(klon) :: qvc, qvcl, shear 366 REAL, DIMENSION(klon) :: zrneb_deep, zcond_deep 364 367 REAL :: delta_z, deepconv_coef 365 368 ! for contrails … … 369 372 REAL, DIMENSION(klon) :: dzsed_cont, flsed_cont, Nflsed_cont, cfsed_cont 370 373 REAL, DIMENSION(klon) :: dzsed_cont_abv, flsed_cont_abv, Nflsed_cont_abv, cfsed_cont_abv 374 REAL :: rho, rhodz, iwp_cont, rei_cont 371 375 !--for Lamquin et al 2012 diagnostics 372 376 REAL, DIMENSION(klon) :: issrfra100to150UP, issrfra150to200UP, issrfra200to250UP … … 805 809 806 810 DO i = 1, klon 807 pt_pron_clds(i) = ( cfcon(i,k) .LT. ( 1. - eps ) )811 pt_pron_clds(i) = .TRUE. 808 812 ENDDO 809 813 IF ( .NOT. ok_weibull_warm_clouds ) THEN … … 982 986 dcfc_sed(:,k), dqic_sed(:,k), dqtc_sed(:,k), dnic_sed(:,k), & 983 987 dcfc_auto(:,k), dqic_auto(:,k), dqtc_auto(:,k), dnic_auto(:,k)) 984 985 IF ( ok_nodeep_lscp ) THEN986 DO i = 1, klon987 !--If prognostic clouds are activated, deep convection vapor is988 !--re-added to the total water vapor989 IF ( keepgoing(i) .AND. ptconv(i,k) .AND. pt_pron_clds(i) ) THEN990 IF ( ( rneb(i,k) + cfcon(i,k) ) .GT. eps ) THEN991 zqn(i) = ( zqn(i) * rneb(i,k) &992 + ( qccon(i,k) + qvcon(i,k) ) * cfcon(i,k) ) &993 / ( rneb(i,k) + cfcon(i,k) )994 ELSE995 zqn(i) = 0.996 ENDIF997 rneb(i,k) = rneb(i,k) + cfcon(i,k)998 qvc(i) = qvc(i) + qvcon(i,k) * cfcon(i,k)999 ENDIF1000 ENDDO1001 ENDIF1002 988 1003 989 ELSE … … 1253 1239 ENDDO 1254 1240 1255 IF (ok_plane_contrail) THEN1256 1257 !--Ice water content of contrails1258 qice_cont(:,k) = qcont(:) - zqs(:) * contfra(:)1259 1260 !--If contrails do not precipitate1261 DO i = 1, klon1262 rneb(i,k) = rneb(i,k) - contfra(i)1263 zoliq(i) = zoliq(i) - qice_cont(i,k)1264 zoliqi(i) = zoliqi(i) - qice_cont(i,k)1265 ENDDO1266 ENDIF1267 1268 1241 !================================================================ 1269 1242 ! Flag for the new and more microphysical treatment of precipitation from Atelier Nuage (R) … … 1302 1275 zifl(:) = zifl(:) + flauto(:) 1303 1276 ziflcld(:) = ziflcld(:) + flauto(:) 1304 ENDIF1305 1306 IF ( ok_plane_contrail ) THEN1307 !--Contrails do not precipitate1308 DO i = 1, klon1309 rneb(i,k) = rneb(i,k) + contfra(i)1310 zoliq(i) = zoliq(i) + qice_cont(i,k)1311 zoliqi(i) = zoliqi(i) + qice_cont(i,k)1312 zradocond(i) = zradocond(i) + qice_cont(i,k)1313 zradoice(i) = zradoice(i) + qice_cont(i,k)1314 qradice_cont(i,k) = qice_cont(i,k)1315 ENDDO1316 1277 ENDIF 1317 1278 … … 1420 1381 qtc_seri(:,k) = qcont(:) 1421 1382 nic_seri(:,k) = Ncont(:) 1383 !--Ice water content of contrails 1384 qice_cont(:,k) = qcont(:) - zqs(:) * contfra(:) 1385 !--Radiative properties 1422 1386 contfrarad(:,k) = contfra(:) 1387 qradice_cont(:,k) = qice_cont(:,k) 1423 1388 ENDIF 1424 1389 … … 1433 1398 !--the sink of condensed water from precipitation 1434 1399 IF ( ptconv(i,k) ) THEN 1435 IF ( zcond(i) .GT. 0. ) THEN 1436 qvcon_old(i,k) = qvcon(i,k) 1437 qccon_old(i,k) = qccon(i,k) * zoliq(i) / zcond(i) 1438 ELSE 1439 qvcon_old(i,k) = 0. 1440 qccon_old(i,k) = 0. 1441 ENDIF 1400 qvcon_old(i,k) = qvcon(i,k) 1401 qccon_old(i,k) = qccon(i,k) 1442 1402 ELSE 1443 1403 qvcon_old(i,k) = 0. 1444 1404 qccon_old(i,k) = 0. 1445 ENDIF1446 1447 !--Deep convection clouds properties are not advected1448 IF ( ptconv(i,k) .AND. pt_pron_clds(i) .AND. ok_nodeep_lscp ) THEN1449 cf_seri(i,k) = MAX(0., cf_seri(i,k) - cfcon(i,k))1450 qvc_seri(i,k) = MAX(0., qvc_seri(i,k) - qvcon_old(i,k) * cfcon(i,k))1451 zoliq(i) = MAX(0., zoliq(i) - qccon_old(i,k) * cfcon(i,k))1452 zoliqi(i) = MAX(0., zoliqi(i) - qccon_old(i,k) * cfcon(i,k))1453 ENDIF1454 !--Deep convection clouds properties are removed from radiative properties1455 !--outputed from lscp (NB. rneb and radocond are only used for the radiative1456 !--properties and are NOT prognostics)1457 !--We must have iflag_coupl == 5 for this coupling to work1458 IF ( ptconv(i,k) .AND. pt_pron_clds(i) .AND. ok_nodeep_lscp_rad ) THEN1459 rneb(i,k) = MAX(0., rneb(i,k) - cfcon(i,k))1460 radocond(i,k) = MAX(0., radocond(i,k) - qccon_old(i,k) * cfcon(i,k))1461 1405 ENDIF 1462 1406 … … 1467 1411 cf_seri(i,k) = 0. 1468 1412 qvc_seri(i,k) = 0. 1469 qvc(i) = 0.1470 1413 ENDIF 1471 1414 1472 1415 !--Diagnostics 1473 1416 gamma_cond(i,k) = gammasat(i) 1474 subfra(i,k) = 1.- cf_seri(i,k) - issrfra(i,k)1475 qsub(i,k) = zq(i) - qvc(i) - qissr(i,k)1476 qcld(i,k) = qvc (i) + zoliq(i)1417 subfra(i,k) = totfra_in(i) - cf_seri(i,k) - issrfra(i,k) 1418 qsub(i,k) = qtot_in(i) - qvc_seri(i,k) - qissr(i,k) 1419 qcld(i,k) = qvc_seri(i,k) + zoliq(i) 1477 1420 1478 1421 IF ( ok_higher_cirrus_cover .AND. pt_pron_clds(i) .AND. .NOT. ptconv(i,k) ) THEN … … 1553 1496 ENDIF 1554 1497 1498 IF ( ok_plane_contrail ) THEN 1499 !--Other useful diagnostics 1500 DO i = 1, klon 1501 !--Very young countrails 1502 IF ( dcfc_ini(i,k) .GT. eps ) THEN 1503 rho = pplay(i,k) / zt(i) / RD 1504 nice_ygcont(i,k) = dnic_ini(i,k) / dcfc_ini(i,k) / 1e6 * rho 1505 iwc_ygcont(i,k) = dqic_ini(i,k) / dcfc_ini(i,k) * 1e3 * rho 1506 rvol_ygcont(i,k) = (dqic_ini(i,k) / MAX(eps, dnic_ini(i,k)) / rho_ice * 3. / 4. / RPI)**(1./3.) * 1e6 1507 1508 rhodz = ( paprs(i,k) - paprs(i,k+1) ) / RG 1509 iwp_cont = 1e3 * dqic_ini(i,k) / dcfc_ini(i,k) * rhodz 1510 rei_cont = MIN(100., MAX(10., rvol_ygcont(i,k) / eff2vol_radius_contrails)) 1511 tau_ygcont(i,k) = iwp_cont*(3.448e-3+2.431/rei_cont) 1512 ELSE 1513 nice_ygcont(i,k) = missing_val 1514 iwc_ygcont(i,k) = missing_val 1515 rvol_ygcont(i,k) = missing_val 1516 tau_ygcont(i,k) = missing_val 1517 ENDIF 1518 !--All contrails 1519 IF ( cfc_seri(i,k) .GT. 1e-3 ) THEN 1520 rho = pplay(i,k) / zt(i) / RD 1521 nice_cont(i,k) = nic_seri(i,k) / cfc_seri(i,k) / 1e6 * rho 1522 iwc_cont(i,k) = qice_cont(i,k) / cfc_seri(i,k) * 1e3 * rho 1523 rvol_cont(i,k) = (qice_cont(i,k) / MAX(eps, nic_seri(i,k)) / rho_ice * 3. / 4. / RPI)**(1./3.) * 1e6 1524 1525 rhodz = ( paprs(i,k) - paprs(i,k+1) ) / RG 1526 iwp_cont = 1e3 * qice_cont(i,k) / contfrarad(i,k) * rhodz 1527 rei_cont = MIN(100., MAX(10., rvol_cont(i,k) / eff2vol_radius_contrails)) 1528 tau_cont(i,k) = iwp_cont*(3.448e-3+2.431/rei_cont) 1529 ELSE 1530 nice_cont(i,k) = missing_val 1531 iwc_cont(i,k) = missing_val 1532 rvol_cont(i,k) = missing_val 1533 tau_cont(i,k) = missing_val 1534 ENDIF 1535 ENDDO 1536 ENDIF 1537 1555 1538 ! Outputs: 1556 1539 !------------------------------- -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_precip.f90
r5790 r5796 354 354 iflag_autoconversion, ok_radocond_snow, ok_bug_phase_lscp, & 355 355 niter_lscp 356 USE lmdz_lscp_ini, ONLY : ok_ice_sedim, fallice_sedim, eps357 356 USE lmdz_lscp_tools, ONLY : fallice_velocity 358 357 … … 1390 1389 cld_lc_lsc_snow, cld_lc_con_snow, gamma_freez, & 1391 1390 rain_fallspeed_clr, rain_fallspeed_cld, & 1392 snow_fallspeed_clr, snow_fallspeed_cld, & 1393 ok_ice_sedim, fallice_sedim 1391 snow_fallspeed_clr, snow_fallspeed_cld 1394 1392 1395 1393 -
LMDZ6/branches/contrails/libf/phylmd/phys_local_var_mod.F90
r5794 r5796 722 722 REAL, SAVE, ALLOCATABLE :: fsurv_contrails(:,:), section_contrails(:,:) 723 723 !$OMP THREADPRIVATE(fsurv_contrails, section_contrails) 724 REAL, SAVE, ALLOCATABLE :: nice_ygcont(:,:), iwc_ygcont(:,:) 725 !$OMP THREADPRIVATE(nice_ygcont, iwc_ygcont) 726 REAL, SAVE, ALLOCATABLE :: rvol_ygcont(:,:), tau_ygcont(:,:) 727 !$OMP THREADPRIVATE(rvol_ygcont, tau_ygcont) 728 REAL, SAVE, ALLOCATABLE :: nice_cont(:,:), iwc_cont(:,:) 729 !$OMP THREADPRIVATE(nice_cont, iwc_cont) 730 REAL, SAVE, ALLOCATABLE :: rvol_cont(:,:), tau_cont(:,:) 731 !$OMP THREADPRIVATE(rvol_cont, tau_cont) 724 732 REAL, SAVE, ALLOCATABLE :: qice_cont(:,:) 725 733 !$OMP THREADPRIVATE(qice_cont) … … 738 746 REAL, SAVE, ALLOCATABLE :: dnic_agg(:,:) 739 747 !$OMP THREADPRIVATE(dnic_agg) 740 REAL, SAVE, ALLOCATABLE :: cldfra_ nocont(:,:), cldtau_nocont(:,:), cldemi_nocont(:,:)741 !$OMP THREADPRIVATE(cldfra_ nocont, cldtau_nocont, cldemi_nocont)748 REAL, SAVE, ALLOCATABLE :: cldfra_cont(:,:), cldtau_nocont(:,:), cldemi_nocont(:,:) 749 !$OMP THREADPRIVATE(cldfra_cont, cldtau_nocont, cldemi_nocont) 742 750 REAL, SAVE, ALLOCATABLE :: cldh_nocont(:), contcov(:), conttau(:,:), contemi(:,:) 743 751 !$OMP THREADPRIVATE(cldh_nocont, contcov, conttau, contemi) 744 REAL, SAVE, ALLOCATABLE :: fiwp_ nocont(:), fiwc_nocont(:,:), ref_ice_nocont(:,:)745 !$OMP THREADPRIVATE(fiwp_ nocont, fiwc_nocont, ref_ice_nocont)752 REAL, SAVE, ALLOCATABLE :: fiwp_cont(:), fiwc_cont(:,:), ref_ice_cont(:,:) 753 !$OMP THREADPRIVATE(fiwp_cont, fiwc_cont, ref_ice_cont) 746 754 REAL, SAVE, ALLOCATABLE :: topsw_nocont(:), toplw_nocont(:) 747 755 !$OMP THREADPRIVATE(topsw_nocont, toplw_nocont) … … 1333 1341 ALLOCATE(AEI_contrails(klon,klev), AEI_surv_contrails(klon,klev)) 1334 1342 ALLOCATE(fsurv_contrails(klon,klev), section_contrails(klon,klev)) 1343 ALLOCATE(nice_ygcont(klon,klev), iwc_ygcont(klon,klev)) 1344 ALLOCATE(rvol_ygcont(klon,klev), tau_ygcont(klon,klev)) 1345 ALLOCATE(nice_cont(klon,klev), iwc_cont(klon,klev)) 1346 ALLOCATE(rvol_cont(klon,klev), tau_cont(klon,klev)) 1335 1347 ALLOCATE(qice_cont(klon,klev)) 1336 1348 ALLOCATE(contfra(klon,klev), qradice_cont(klon,klev)) … … 1341 1353 ALLOCATE(dcfc_sed(klon,klev), dqic_sed(klon,klev), dqtc_sed(klon,klev), dnic_sed(klon,klev)) 1342 1354 ALLOCATE(dcfc_auto(klon,klev), dqic_auto(klon,klev), dqtc_auto(klon,klev), dnic_auto(klon,klev)) 1343 ALLOCATE(cldfra_ nocont(klon,klev), cldtau_nocont(klon,klev), cldemi_nocont(klon,klev))1355 ALLOCATE(cldfra_cont(klon,klev), cldtau_nocont(klon,klev), cldemi_nocont(klon,klev)) 1344 1356 ALLOCATE(cldh_nocont(klon), contcov(klon), conttau(klon,klev), contemi(klon,klev)) 1345 ALLOCATE(fiwp_ nocont(klon), fiwc_nocont(klon,klev), ref_ice_nocont(klon,klev))1357 ALLOCATE(fiwp_cont(klon), fiwc_cont(klon,klev), ref_ice_cont(klon,klev)) 1346 1358 ALLOCATE(topsw_nocont(klon), toplw_nocont(klon)) 1347 1359 ALLOCATE(solsw_nocont(klon), sollw_nocont(klon)) … … 1779 1791 DEALLOCATE(Tcritcont, qcritcont, potcontfraP, potcontfraNP) 1780 1792 DEALLOCATE(AEI_contrails, AEI_surv_contrails, fsurv_contrails, section_contrails) 1793 DEALLOCATE(nice_ygcont, iwc_ygcont, rvol_ygcont, tau_ygcont) 1794 DEALLOCATE(nice_cont, iwc_cont, rvol_cont, tau_cont) 1781 1795 DEALLOCATE(qice_cont, contfra, qradice_cont) 1782 1796 DEALLOCATE(dcfc_ini, dqic_ini, dqtc_ini, dnic_ini) … … 1786 1800 DEALLOCATE(dcfc_sed, dqic_sed, dqtc_sed, dnic_sed) 1787 1801 DEALLOCATE(dcfc_auto, dqic_auto, dqtc_auto, dnic_auto) 1788 DEALLOCATE(cldfra_ nocont, cldtau_nocont, cldemi_nocont, conttau, contemi)1789 DEALLOCATE(cldh_nocont, contcov, fiwp_ nocont, fiwc_nocont, ref_ice_nocont)1802 DEALLOCATE(cldfra_cont, cldtau_nocont, cldemi_nocont, conttau, contemi) 1803 DEALLOCATE(cldh_nocont, contcov, fiwp_cont, fiwc_cont, ref_ice_cont) 1790 1804 DEALLOCATE(topsw_nocont, toplw_nocont) 1791 1805 DEALLOCATE(solsw_nocont, sollw_nocont) -
LMDZ6/branches/contrails/libf/phylmd/phys_output_ctrlout_mod.F90
r5791 r5796 2714 2714 TYPE(ctrl_out), SAVE :: o_section_contrails = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2715 2715 'section_cont', 'Cross section of newly formed contrails', 'm2', (/ ('', i=1, 10) /)) 2716 TYPE(ctrl_out), SAVE :: o_cldfra_nocont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2717 'cldfra_nocont', 'Cloud fraction w/o contrails', '-', (/ ('', i=1, 10) /)) 2716 TYPE(ctrl_out), SAVE :: o_nice_ygcont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2717 'nice_ygcont', 'Ice particle number concentration in young contrails', '#/cm3', (/ ('', i=1, 10) /)) 2718 TYPE(ctrl_out), SAVE :: o_iwc_ygcont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2719 'iwc_ygcont', 'Ice water content in young contrails', 'g/m3', (/ ('', i=1, 10) /)) 2720 TYPE(ctrl_out), SAVE :: o_rvol_ygcont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2721 'rvol_ygcont', 'Ice crystals volumic radius in young contrails', 'microns', (/ ('', i=1, 10) /)) 2722 TYPE(ctrl_out), SAVE :: o_tau_ygcont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2723 'tau_ygcont', 'Young contrails optical depth', '-', (/ ('', i=1, 10) /)) 2724 TYPE(ctrl_out), SAVE :: o_nice_cont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2725 'nice_cont', 'Ice particle number concentration in contrails', '#/cm3', (/ ('', i=1, 10) /)) 2726 TYPE(ctrl_out), SAVE :: o_iwc_cont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2727 'iwc_cont', 'Ice water content in contrails', 'g/m3', (/ ('', i=1, 10) /)) 2728 TYPE(ctrl_out), SAVE :: o_rvol_cont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2729 'rvol_cont', 'Ice crystals volumic radius in contrails', 'microns', (/ ('', i=1, 10) /)) 2730 TYPE(ctrl_out), SAVE :: o_tau_cont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2731 'tau_cont', 'Contrails optical depth', '-', (/ ('', i=1, 10) /)) 2732 TYPE(ctrl_out), SAVE :: o_cldfra_cont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2733 'cldfra_cont', 'Cloud fraction of contrails', '-', (/ ('', i=1, 10) /)) 2718 2734 TYPE(ctrl_out), SAVE :: o_cldtau_nocont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2719 2735 'cldtau_nocont', 'Cloud optical thickness w/o contrails', '1', (/ ('', i=1, 10) /)) … … 2728 2744 TYPE(ctrl_out), SAVE :: o_contemi = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2729 2745 'contemi', 'Contrails optical emissivity', '1', (/ ('', i=1, 10) /)) 2730 TYPE(ctrl_out), SAVE :: o_iwp_ nocont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &2731 'iwp_ nocont', 'Cloud ice water path w/ocontrails', 'kg/m2', (/ ('', i=1, 10) /))2732 TYPE(ctrl_out), SAVE :: o_iwc _nocont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &2733 'iwc _nocont', 'Cloud ice water content seen by radiation w/ocontrails', 'kg/kg', (/ ('', i=1, 10) /))2734 TYPE(ctrl_out), SAVE :: o_ref_ice_ nocont = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &2735 'ref_ice_ nocont', 'Effective radius of ice crystals w/ocontrails', 'microns', (/ ('', i=1, 10) /))2746 TYPE(ctrl_out), SAVE :: o_iwp_cont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2747 'iwp_cont', 'Cloud ice water path of contrails', 'kg/m2', (/ ('', i=1, 10) /)) 2748 TYPE(ctrl_out), SAVE :: o_iwcon_cont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2749 'iwcon_cont', 'Cloud ice water content seen by radiation of contrails', 'kg/kg', (/ ('', i=1, 10) /)) 2750 TYPE(ctrl_out), SAVE :: o_ref_ice_cont = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 2751 'ref_ice_cont', 'Effective radius of ice crystals of contrails', 'microns', (/ ('', i=1, 10) /)) 2736 2752 TYPE(ctrl_out), SAVE :: o_tops_nocont = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 2737 2753 'tops_nocont', 'Solar rad. at TOA w/o contrails', 'W/m2', (/ ('', i=1, 10) /)) -
LMDZ6/branches/contrails/libf/phylmd/phys_output_write_mod.F90
r5791 r5796 245 245 o_Tcritcont, o_qcritcont, o_potcontfraP, o_potcontfraNP, & 246 246 o_AEI_contrails, o_AEI_surv_contrails, o_fsurv_contrails, o_section_contrails, & 247 o_nice_ygcont, o_iwc_ygcont, o_rvol_ygcont, o_tau_ygcont, & 248 o_nice_cont, o_iwc_cont, o_rvol_cont, o_tau_cont, & 247 249 o_flight_dist, o_flight_fuel, o_qice_cont, & 248 250 o_dcfcini, o_dqicini, o_dqtcini, o_dnicini, & … … 251 253 o_dcfcsed, o_dqicsed, o_dqtcsed, o_dnicsed, & 252 254 o_dcfcauto, o_dqicauto, o_dqtcauto, o_dnicauto, & 253 o_cldfra_ nocont, o_cldtau_nocont, o_cldemi_nocont, o_cldh_nocont, &254 o_contcov, o_conttau, o_contemi, o_iwp_ nocont, o_iwc_nocont, o_ref_ice_nocont, &255 o_cldfra_cont, o_cldtau_nocont, o_cldemi_nocont, o_cldh_nocont, & 256 o_contcov, o_conttau, o_contemi, o_iwp_cont, o_iwcon_cont, o_ref_ice_cont, & 255 257 o_tops_nocont, o_topl_nocont, o_sols_nocont, o_soll_nocont, o_nettop_nocont, & 256 258 !--interactive CO2 … … 411 413 Tcritcont, qcritcont, potcontfraP, potcontfraNP, & 412 414 AEI_contrails, AEI_surv_contrails, fsurv_contrails, section_contrails, & 415 nice_ygcont, iwc_ygcont, rvol_ygcont, tau_ygcont, & 416 nice_cont, iwc_cont, rvol_cont, tau_cont, & 413 417 flight_dist, flight_fuel, qice_cont, & 414 418 dcfc_ini, dqic_ini, dqtc_ini, dnic_ini, & … … 417 421 dcfc_sed, dqic_sed, dqtc_sed, dnic_sed, & 418 422 dcfc_auto, dqic_auto, dqtc_auto, dnic_auto, & 419 cldfra_ nocont, cldtau_nocont, cldemi_nocont, cldh_nocont, &420 contcov, conttau, contemi, fiwp_ nocont, fiwc_nocont, ref_ice_nocont, &423 cldfra_cont, cldtau_nocont, cldemi_nocont, cldh_nocont, & 424 contcov, conttau, contemi, fiwp_cont, fiwc_cont, ref_ice_cont, & 421 425 topsw_nocont, toplw_nocont, solsw_nocont, sollw_nocont, & 422 426 alp_bl_det, alp_bl_fluct_m, alp_bl_conv, & … … 2463 2467 CALL histwrite_phy(o_fsurv_contrails, fsurv_contrails) 2464 2468 CALL histwrite_phy(o_section_contrails, section_contrails) 2469 CALL histwrite_phy(o_nice_ygcont, nice_ygcont) 2470 CALL histwrite_phy(o_iwc_ygcont, iwc_ygcont) 2471 CALL histwrite_phy(o_rvol_ygcont, rvol_ygcont) 2472 CALL histwrite_phy(o_tau_ygcont, tau_ygcont) 2473 CALL histwrite_phy(o_nice_cont, nice_cont) 2474 CALL histwrite_phy(o_iwc_cont, iwc_cont) 2475 CALL histwrite_phy(o_rvol_cont, rvol_cont) 2476 CALL histwrite_phy(o_tau_cont, tau_cont) 2465 2477 CALL histwrite_phy(o_qice_cont, qice_cont) 2466 2478 CALL histwrite_phy(o_dcfcini, dcfc_ini) … … 2485 2497 CALL histwrite_phy(o_dqtcauto, dqtc_auto) 2486 2498 CALL histwrite_phy(o_dnicauto, dnic_auto) 2487 CALL histwrite_phy(o_cldfra_ nocont, cldfra_nocont)2499 CALL histwrite_phy(o_cldfra_cont, cldfra_cont) 2488 2500 CALL histwrite_phy(o_cldtau_nocont, cldtau_nocont) 2489 2501 CALL histwrite_phy(o_cldemi_nocont, cldemi_nocont) … … 2492 2504 CALL histwrite_phy(o_conttau, conttau) 2493 2505 CALL histwrite_phy(o_contemi, contemi) 2494 CALL histwrite_phy(o_iwp_ nocont, fiwp_nocont)2495 CALL histwrite_phy(o_iwc _nocont, fiwc_nocont)2496 CALL histwrite_phy(o_ref_ice_ nocont, ref_ice_nocont)2506 CALL histwrite_phy(o_iwp_cont, fiwp_cont) 2507 CALL histwrite_phy(o_iwcon_cont, fiwc_cont) 2508 CALL histwrite_phy(o_ref_ice_cont, ref_ice_cont) 2497 2509 IF (ok_rad_contrail) THEN 2498 2510 IF (vars_defined) zx_tmp_fi2d = topsw_nocont * swradcorr -
LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90
r5794 r5796 345 345 qice_cont, contfra, qradice_cont, & 346 346 Tcritcont, qcritcont, potcontfraP, potcontfraNP, & 347 cldfra_ nocont, cldtau_nocont, cldemi_nocont, cldh_nocont, &348 conttau, contemi, contcov, fiwp_ nocont, fiwc_nocont, ref_ice_nocont, &347 cldfra_cont, cldtau_nocont, cldemi_nocont, cldh_nocont, & 348 conttau, contemi, contcov, fiwp_cont, fiwc_cont, ref_ice_cont, & 349 349 topsw_nocont, toplw_nocont, solsw_nocont, sollw_nocont, & 350 350 topsw_nocontp, toplw_nocontp, solsw_nocontp, sollw_nocontp, & … … 1238 1238 ! "CRF off" 1239 1239 REAL, dimension(klon, klev) :: cldfrarad ! fraction nuageuse 1240 REAL, dimension(klon, klev) :: cldfravol ! volumic cloud fraction 1240 1241 !--AB contrails 1241 REAL, dimension(klon, klev) :: cldfrarad_ nocont ! fraction nuageuse without contrails1242 REAL, dimension(klon, klev) :: cldfrarad_cont ! fraction nuageuse without contrails 1242 1243 1243 1244 REAL :: calday, zxsnow_dummy(klon) … … 4602 4603 ENDIF 4603 4604 4605 IF ( ok_ice_supersat ) THEN 4606 cldfravol(:,:) = cf_seri(:,:) 4607 ELSE 4608 cldfravol(:,:) = cldfra(:,:) 4609 ENDIF 4610 4604 4611 !Rajout appel a interface calcul proprietes optiques des nuages 4605 4612 CALL call_cloud_optics_prop(klon, klev, ok_newmicro, & 4606 paprs, pplay, t_seri, radocond, picefra, cldfra , &4613 paprs, pplay, t_seri, radocond, picefra, cldfravol, cldfra, & 4607 4614 cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, & 4608 4615 flwp, fiwp, flwc, fiwc, ok_aie, & … … 4613 4620 zfice, dNovrN, ptconv, rnebcon, clwcon, & 4614 4621 !--AB contrails 4615 c ontfra, qradice_cont, nic_seri, cldfra_nocont, &4622 cfc_seri, contfra, qradice_cont, nic_seri, cldfra_cont, & 4616 4623 cldtau_nocont, cldemi_nocont, conttau, contemi, cldh_nocont, contcov, & 4617 fiwp_nocont, fiwc_nocont, ref_ice_nocont) 4624 fiwp_cont, fiwc_cont, ref_ice_cont, & 4625 missing_val) 4618 4626 4619 4627 ! … … 4625 4633 cldfrarad = cldfra 4626 4634 !--AB contrails 4627 IF (ok_rad_contrail) cldfrarad_ nocont = cldfra_nocont4635 IF (ok_rad_contrail) cldfrarad_cont = cldfra_cont 4628 4636 4629 4637 ! … … 4657 4665 DO k=1, klev 4658 4666 DO i=1, klon 4659 cldfrarad_ nocont(i,k) = cldfra_nocont(i,k) * beta(i,k)4667 cldfrarad_cont(i,k) = cldfra_cont(i,k) * beta(i,k) 4660 4668 ENDDO 4661 4669 ENDDO … … 4694 4702 DO k=1, klev 4695 4703 DO i=1, klon 4696 cldfrarad_ nocont(i,k) = cldfra_nocont(i,k) * beta(i,k)4704 cldfrarad_cont(i,k) = cldfra_cont(i,k) * beta(i,k) 4697 4705 ENDDO 4698 4706 ENDDO … … 4818 4826 cloud_cover_sw, & 4819 4827 !--AB contrails radiative effects 4820 cldfrarad_ nocont, fiwc_nocont, ref_ice_nocont, &4828 cldfrarad_cont, fiwc_cont, ref_ice_cont, & 4821 4829 topsw_nocont, solsw_nocont, toplw_nocont, sollw_nocont) 4822 4830 … … 4906 4914 cloud_cover_sw, & 4907 4915 !--AB contrails radiative effects 4908 cldfrarad_ nocont, fiwc_nocont, ref_ice_nocont, &4916 cldfrarad_cont, fiwc_cont, ref_ice_cont, & 4909 4917 topsw_nocontp, solsw_nocontp, toplw_nocontp, sollw_nocontp) 4910 4918 ENDIF !ok_4xCO2atm -
LMDZ6/branches/contrails/libf/phylmd/radlwsw_m.F90
r5791 r5796 49 49 cloud_cover_sw, & 50 50 !--AB contrails radiative effects 51 cldfra_ nocont, fiwc_nocont, ref_ice_nocont, &51 cldfra_cont, fiwc_cont, ref_ice_cont, & 52 52 topsw_nocont, solsw_nocont, toplw_nocont, sollw_nocont) 53 53 … … 289 289 REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i 290 290 !--AB contrails radiative effects 291 REAL, DIMENSION(klon,klev), INTENT(in) :: cldfra_ nocont292 REAL, DIMENSION(klon,klev), INTENT(in) :: fiwc_ nocont293 REAL, DIMENSION(klon,klev), INTENT(in) :: ref_ice_ nocont291 REAL, DIMENSION(klon,klev), INTENT(in) :: cldfra_cont 292 REAL, DIMENSION(klon,klev), INTENT(in) :: fiwc_cont 293 REAL, DIMENSION(klon,klev), INTENT(in) :: ref_ice_cont 294 294 REAL, DIMENSION(klon), INTENT(out) :: topsw_nocont 295 295 REAL, DIMENSION(klon), INTENT(out) :: solsw_nocont … … 494 494 REAL(KIND=8) ZFLCCUP_i (klon,klev+1) 495 495 !--AB contrails radiative effects 496 REAL(KIND=8) cldfra_ nocont_i(klon,klev)497 REAL(KIND=8) fiwc_ nocont_i(klon,klev)498 REAL(KIND=8) ref_ice_ nocont_i(klon,klev)496 REAL(KIND=8) cldfra_cont_i(klon,klev) 497 REAL(KIND=8) fiwc_cont_i(klon,klev) 498 REAL(KIND=8) ref_ice_cont_i(klon,klev) 499 499 REAL(KIND=8) ZTOPSWNOCONT(klon) 500 500 REAL(KIND=8) ZSOLSWNOCONT(klon) … … 934 934 ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k) 935 935 ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k) 936 IF (ok_rad_contrail) THEN936 !IF (ok_rad_contrail) THEN 937 937 !--AB contrails radiative effects 938 cldfra_ nocont_i(1:klon,k) = cldfra_nocont(1:klon,klev+1-k)939 fiwc_ nocont_i(1:klon,k) = fiwc_nocont(1:klon,klev+1-k)940 ref_ice_ nocont_i(1:klon,k) = ref_ice_nocont(1:klon,klev+1-k)941 ENDIF938 cldfra_cont_i(1:klon,k) = cldfra_cont(1:klon,klev+1-k) 939 fiwc_cont_i(1:klon,k) = fiwc_cont(1:klon,klev+1-k) 940 ref_ice_cont_i(1:klon,k) = ref_ice_cont(1:klon,klev+1-k) 941 !ENDIF 942 942 ENDDO 943 943 DO k=1,kflev … … 1023 1023 ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat, flag_aer_feedback, & ! flags aerosols 1024 1024 !--AB contrails radiative effect 1025 ok_rad_contrail, cldfra_ nocont_i, fiwc_nocont_i, ref_ice_nocont_i, &1025 ok_rad_contrail, cldfra_cont_i, fiwc_cont_i, ref_ice_cont_i, & 1026 1026 ZTOPSWNOCONT, ZSOLSWNOCONT, ZTOPLWNOCONT, ZSOLLWNOCONT) 1027 1027 -
LMDZ6/branches/contrails/libf/phylmd/rrtm/radlsw.F90
r5791 r5796 8 8 & PTH , PT , PTS , PNBAS, PNTOP,& 9 9 & PREF_LIQ, PREF_ICE,& 10 & PCLFR_CONT, PQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 10 11 & PEMIT, PFCT , PFLT , PFCS , PFLS,& 11 12 & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,& … … 182 183 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 183 184 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KLON,KLEV) 185 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR_CONT(KLON,KLEV) ! AB FOR CONTRAILS 184 186 REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KLON,KLEV) 185 187 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON) … … 190 192 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) 191 193 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP(KLON,KLEV) 194 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP_CONT(KLON,KLEV) ! AB FOR CONTRAILS 192 195 REAL(KIND=JPRB) ,INTENT(IN) :: PQLWP(KLON,KLEV) 193 196 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV) … … 208 211 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KLON,KLEV) 209 212 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KLON,KLEV) 213 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_CONT(KLON,KLEV) ! AB FOR CONTRAILS 210 214 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) 211 215 REAL(KIND=JPRB) ,INTENT(OUT) :: PFCT(KLON,KLEV+1) … … 259 263 & , ZFIWP(KLON) , ZFLWP(KLON) , ZFRWP(KLON)& 260 264 & , ZIWC(KLON) , ZLWC(KLON)& 265 & , ZFIWP_CONT(KLON) , ZIWC_CONT(KLON)& ! AB FOR CONTRAILS 261 266 !cc , ZRWC(KLON) 262 267 & , ZMU0(KLON) , ZOZ(KLON,KLEV) , ZOZN(KLON,KLEV)& … … 275 280 & ZALFICE(KLON) , ZGAMICE(KLON) , ZBICE(KLON) , ZDESR(KLON)& 276 281 & , ZRADIP(KLON) , ZRADLP(KLON) & 282 & , ZRADIP_CONT(KLON)& ! AB FOR CONTRAILS 277 283 !cc , ZRADRD(KLON) 278 284 & , ZRAINT(KLON) , ZRES(KLON)& … … 292 298 & ZMULTI, ZMULTL, ZOI , ZOL, & 293 299 & ZOMGMX, ZOR, ZRMUZ, ZRWGKG, ZTAUD, ZTAUMX, ZTEMPC, & 294 & ZTOI, ZTOL, ZTOR, ZZFIWP, ZZFLWP, ZDPOG, ZPODT 300 & ZTOI, ZTOL, ZTOR, ZZFIWP, ZZFLWP, ZDPOG, ZPODT, & 301 & ZIWGKG_CONT, ZTOI_CONT, ZOI_CONT, ZGI_CONT, ZRSAID_CONT ! AB FOR CONTRAILS 295 302 296 303 REAL(KIND=JPRB) :: ZALND, ZASEA, ZD, ZDEN, ZNTOT, ZNUM, ZRATIO, Z1RADI, & … … 454 461 ZIWGKG=0.0_JPRB 455 462 ENDIF 463 ! AB FOR CONTRAILS 464 IF (PCLFR_CONT(JL,IKL) > REPSC ) THEN 465 ZIWGKG_CONT=MAX(PQIWP_CONT(JL,IKL)*1000.0_JPRB,0.0_JPRB) 466 ZIWGKG_CONT=ZIWGKG_CONT/PCLFR_CONT(JL,IKL) 467 ELSE 468 ZIWGKG_CONT=0.0_JPRB 469 ENDIF 470 ! AB 456 471 ZRWGKG=0.0_JPRB 457 472 ZRAINT(JL)=0.0_JPRB … … 472 487 ZFLWP(JL)= ZLWGKG*ZDPOG 473 488 ZFIWP(JL)= ZIWGKG*ZDPOG 489 ZFIWP_CONT(JL)= ZIWGKG_CONT*ZDPOG ! AB FOR CONTRAILS 474 490 ZFRWP(JL)= ZRWGKG*ZDPOG 475 491 ZPODT=PAP(JL,IKL)/(RD*PT(JL,IKL)) 476 492 ZLWC(JL)=ZLWGKG*ZPODT 477 493 ZIWC(JL)=ZIWGKG*ZPODT 494 ZIWC_CONT(JL)=ZIWGKG_CONT*ZPODT ! AB FOR CONTRAILS 478 495 ! ZRWC(JL)=ZRWGKG*ZPODT 479 496 … … 601 618 ! IKL or JK ?? - I think IKL but needs to be verified 602 619 ZRADIP(JL)=PREF_ICE(JL,IKL) 620 ZRADIP_CONT(JL)=PREF_ICE_CONT(JL,IKL) ! AB FOR CONTRAILS 603 621 ENDIF 604 622 … … 623 641 ZGR =0.0_JPRB 624 642 ZOR =0.0_JPRB 625 IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN 643 ! AB FOR CONTRAILS 644 ZTOI_CONT=0.0_JPRB 645 ZGI_CONT =0.0_JPRB 646 ZOI_CONT =0.0_JPRB 647 IF (ZFLWP(JL)+ZFIWP(JL)+ZFIWP_CONT(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN 648 ! AB 649 !IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN 626 650 IF (ZFLWP(JL) >= REPSCW ) THEN 627 651 IF (NLIQOPT /= 0 ) THEN … … 641 665 ENDIF 642 666 643 IF (ZFIWP(JL) >= REPSCW ) THEN 667 IF (ZFIWP(JL)+ZFIWP_CONT(JL) >= REPSCW ) THEN ! AB FOR CONTRAILS 668 !IF (ZFIWP(JL) >= REPSCW ) THEN 644 669 IF (NICEOPT <= 1) THEN 645 670 !-- SW: Ebert-Curry … … 647 672 ZGI = REBCUE(JSW)+REBCUF(JSW)*ZRADIP(JL) 648 673 ZOI = 1.0_JPRB - REBCUC(JSW)-REBCUD(JSW)*ZRADIP(JL) 674 ! AB FOR CONTRAILS 675 ZTOI_CONT = ZFIWP_CONT(JL)*(REBCUA(JSW)+REBCUB(JSW)/ZRADIP_CONT(JL)) 676 ZGI_CONT = REBCUE(JSW)+REBCUF(JSW)*ZRADIP_CONT(JL) 677 ZOI_CONT = 1.0_JPRB - REBCUC(JSW)-REBCUD(JSW)*ZRADIP_CONT(JL) 678 ! AB 649 679 650 680 ELSEIF (NICEOPT == 2) THEN … … 683 713 ! ENDIF 684 714 715 ZCLDSW(JL,JK) = PCLFR(JL,IKL)+PCLFR_CONT(JL,IKL) ! AB FOR CONTRAILS 716 685 717 ! - MIX of WATER and ICE CLOUDS 686 ZTAUMX= ZTOL + ZTOI + ZTOR 687 ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR 688 ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR 718 ! AB FOR CONTRAILS 719 ZTAUMX= (PCLFR(JL,IKL) * (ZTOL + ZTOI + ZTOR) & 720 & + PCLFR_CONT(JL,IKL) * ZTOI_CONT) & 721 & / ZCLDSW(JL,JK) 722 ZOMGMX= (PCLFR(JL,IKL) * (ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR) & 723 & + PCLFR_CONT(JL,IKL) * ZTOI_CONT*ZOI_CONT) & 724 & / ZCLDSW(JL,JK) 725 ZASYMX= (PCLFR(JL,IKL) * (ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR) & 726 & + PCLFR_CONT(JL,IKL) * ZTOI_CONT*ZOI_CONT*ZGI_CONT) & 727 & / ZCLDSW(JL,JK) 728 !ZTAUMX= ZTOL + ZTOI + ZTOR 729 !ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR 730 !ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR 731 ! AB 689 732 690 733 ZASYMX= ZASYMX/ZOMGMX … … 693 736 ! --- SW FINAL CLOUD OPTICAL PARAMETERS 694 737 695 ZCLDSW(JL,JK) = PCLFR(JL,IKL)738 !ZCLDSW(JL,JK) = PCLFR(JL,IKL) ! AB FOR CONTRAILS 696 739 ZTAU(JL,JSW,JK) = ZTAUMX 697 740 ZOMEGA(JL,JSW,JK)= ZOMGMX … … 849 892 ZMSAID = 0.0_JPRB 850 893 851 IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN 894 IF (ZFLWP(JL)+ZFIWP(JL)+ZFIWP_CONT(JL) > REPSCW) THEN ! AB FOR CONTRAILS 895 !IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN 852 896 853 897 IF (NLIQOPT == 0 .OR. NLIQOPT >= 3 ) THEN … … 880 924 ! ice cloud spectral emissivity a la Ebert-Curry (1992) 881 925 ZRSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP(JL) 926 ZRSAID_CONT= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP_CONT(JL) ! AB FOR CONTRAILS 882 927 883 928 ELSEIF (NICEOPT == 2) THEN … … 899 944 ENDIF 900 945 901 ZTAUD = ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL) 946 ! AB FOR CONTRAILS 947 ZTAUD = (PCLFR(JL,IKL) * (ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL)) & 948 & + PCLFR_CONT(JL,IKL) * ZRSAID_CONT*ZFIWP_CONT(JL)) & 949 & / ZCLDSW(JL,JK) 950 !ZTAUD = ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL) 951 ! AB 902 952 903 953 ! Diffusivity correction within clouds a la Savijarvi -
LMDZ6/branches/contrails/libf/phylmd/rrtm/radlsw.intfb.h
r5791 r5796 9 9 & PTH , PT , PTS , PNBAS, PNTOP,& 10 10 & PREF_LIQ, PREF_ICE,& 11 & PCLFR_CONT, PQIWP_CONT, PREF_ICE_CONT,& 11 12 & PEMIT, PFCT , PFLT , PFCS , PFLS,& 12 13 & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,& … … 41 42 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 42 43 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KLON,KLEV) 44 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR_CONT(KLON,KLEV) 43 45 REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KLON,KLEV) 44 46 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON) … … 49 51 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) 50 52 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP(KLON,KLEV) 53 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP_CONT(KLON,KLEV) 51 54 REAL(KIND=JPRB) ,INTENT(IN) :: PQLWP(KLON,KLEV) 52 55 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV) … … 60 63 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KLON,KLEV) 61 64 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KLON,KLEV) 65 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_CONT(KLON,KLEV) 62 66 LOGICAL ,INTENT(IN) :: LRDUST 63 67 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV,NSW) -
LMDZ6/branches/contrails/libf/phylmd/rrtm/recmwf_aero.F90
r5791 r5796 43 43 & flag_aer_feedback, & 44 44 !--AB contrails radiative effect 45 & ok_rad_contrail, PCLFR_ NOCONT, PQIWP_NOCONT, PREF_ICE_NOCONT, &45 & ok_rad_contrail, PCLFR_CONT, PQIWP_CONT, PREF_ICE_CONT, & 46 46 & PTOPSWNOCONT, PSOLSWNOCONT, PTOPLWNOCONT, PSOLLWNOCONT) 47 47 !--fin … … 274 274 !--AB contrails radiative effect 275 275 LOGICAL ,INTENT(IN) :: ok_rad_contrail 276 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR_ NOCONT(KPROMA,KLEV)277 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP_ NOCONT(KPROMA,KLEV)278 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_ NOCONT(KPROMA,KLEV)276 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR_CONT(KPROMA,KLEV) 277 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP_CONT(KPROMA,KLEV) 278 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_CONT(KPROMA,KLEV) 279 279 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWNOCONT(KPROMA), PSOLSWNOCONT(KPROMA) ! No contrails experiment forcing at TOA and surface (SW) 280 280 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWNOCONT(KPROMA), PSOLLWNOCONT(KPROMA) ! No contrails experiment forcing at TOA and surface (LW) … … 360 360 REAL(KIND=JPRB) :: LWDN0_AERO(KPROMA,KLEV+1,5) 361 361 !--AB contrails radiative effect 362 REAL(KIND=JPRB) :: ZRCLC_NOCONT(KPROMA,KLEV), ZQIWP_NOCONT(KPROMA,KLEV) 362 REAL(KIND=JPRB) :: ZRCLC_CONT(KPROMA,KLEV), ZQIWP_CONT(KPROMA,KLEV) 363 REAL(KIND=JPRB) :: ZRCLC_ZERO(KPROMA,KLEV), ZQIWP_ZERO(KPROMA,KLEV) 364 REAL(KIND=JPRB) :: PREF_ICE_ZERO(KPROMA,KLEV) 363 365 REAL(KIND=JPRB) :: PREF_LIQ_NOCONT(KPROMA,KLEV) 366 REAL(KIND=JPRB) :: PREF_ICE_NOCONT(KPROMA,KLEV) 364 367 REAL(KIND=JPRB) :: PPIZA_NOCONT(KPROMA,KLEV,NSW) 365 368 REAL(KIND=JPRB) :: PCGA_NOCONT(KPROMA,KLEV,NSW) … … 413 416 ! ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3 414 417 ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK) 415 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)))416 IF (ZRCLC(JL,JK) > REPCLC) THEN417 ZQLWP(JL,JK)=PQLWP(JL,JK)418 ZQIWP(JL,JK)=PQIWP(JL,JK)419 ELSE420 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK)421 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK)422 ENDIF423 418 ZQRAIN(JL,JK)=0. 424 419 ZQRAINT(JL,JK)=0. … … 429 424 ENDDO 430 425 ENDDO 426 427 IF ( ok_rad_contrail ) THEN 428 DO JK=1,KLEV 429 DO JL=IBEG,IEND 430 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)-PCLFR_CONT(JL,JK))) 431 IF (ZRCLC(JL,JK) > REPCLC) THEN 432 ZQLWP(JL,JK)=PQLWP(JL,JK) 433 ZQIWP(JL,JK)=PQIWP(JL,JK)-PQIWP_CONT(JL,JK) 434 ELSE 435 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 436 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 437 ENDIF 438 ZRCLC_CONT(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR_CONT(JL,JK))) 439 IF (ZRCLC_CONT(JL,JK) > REPCLC) THEN 440 ZQIWP_CONT(JL,JK)=PQIWP_CONT(JL,JK) 441 ELSE 442 ZQIWP_CONT(JL,JK)=REPH2O*ZRCLC_CONT(JL,JK) 443 ENDIF 444 ENDDO 445 ENDDO 446 ELSE 447 DO JK=1,KLEV 448 DO JL=IBEG,IEND 449 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK))) 450 IF (ZRCLC(JL,JK) > REPCLC) THEN 451 ZQLWP(JL,JK)=PQLWP(JL,JK) 452 ZQIWP(JL,JK)=PQIWP(JL,JK) 453 ELSE 454 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 455 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 456 ENDIF 457 ZRCLC_CONT(JL,JK)=0.0_JPRB 458 ZQIWP_CONT(JL,JK)=0.0_JPRB 459 ENDDO 460 ENDDO 461 ENDIF 431 462 432 463 IF (NAER == 0) THEN … … 512 543 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 513 544 & PREF_LIQ_PI, PREF_ICE_PI,& 545 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 514 546 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 515 547 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 553 585 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 554 586 & PREF_LIQ, PREF_ICE,& 587 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 555 588 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 556 589 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 594 627 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 595 628 & PREF_LIQ_PI, PREF_ICE_PI,& 629 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 596 630 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 597 631 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 634 668 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 635 669 & PREF_LIQ, PREF_ICE,& 670 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 636 671 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 637 672 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 676 711 !--this needs to be changed to fixed cloud optical properties 677 712 & PREF_LIQ_PI, PREF_ICE_PI,& 713 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 678 714 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 679 715 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 701 737 !--Double call to radiative routine for contrails 702 738 !--The calculation are done again WITHOUT contrails 703 IF ( ok_rad_contrail) THEN739 IF ( ok_rad_contrail ) THEN 704 740 705 741 !--The same base case is used … … 707 743 IF ( flag_aerosol .EQ. 0 ) THEN 708 744 PREF_LIQ_NOCONT(:,:) = PREF_LIQ_PI(:,:) 745 PREF_ICE_NOCONT(:,:) = PREF_ICE_PI(:,:) 709 746 PPIZA_NOCONT(:,:,:) = PPIZA_ZERO(:,:,:) 710 747 PCGA_NOCONT(:,:,:) = PCGA_ZERO(:,:,:) … … 713 750 ELSEIF ( .not. ok_ade .AND. .not. ok_aie ) THEN 714 751 PREF_LIQ_NOCONT(:,:) = PREF_LIQ_PI(:,:) 752 PREF_ICE_NOCONT(:,:) = PREF_ICE_PI(:,:) 715 753 PPIZA_NOCONT(:,:,:) = PPIZA_NAT(:,:,:) 716 754 PCGA_NOCONT(:,:,:) = PCGA_NAT(:,:,:) … … 719 757 ELSEIF ( .not. ok_ade .AND. ok_aie ) THEN 720 758 PREF_LIQ_NOCONT(:,:) = PREF_LIQ(:,:) 759 PREF_ICE_NOCONT(:,:) = PREF_ICE(:,:) 721 760 PPIZA_NOCONT(:,:,:) = PPIZA_NAT(:,:,:) 722 761 PCGA_NOCONT(:,:,:) = PCGA_NAT(:,:,:) … … 725 764 ELSEIF ( ok_ade .AND. .not. ok_aie ) THEN 726 765 PREF_LIQ_NOCONT(:,:) = PREF_LIQ_PI(:,:) 766 PREF_ICE_NOCONT(:,:) = PREF_ICE_PI(:,:) 727 767 PPIZA_NOCONT(:,:,:) = PPIZA_TOT(:,:,:) 728 768 PCGA_NOCONT(:,:,:) = PCGA_TOT(:,:,:) … … 731 771 ELSEIF ( ok_ade .AND. ok_aie ) THEN 732 772 PREF_LIQ_NOCONT(:,:) = PREF_LIQ(:,:) 773 PREF_ICE_NOCONT(:,:) = PREF_ICE(:,:) 733 774 PPIZA_NOCONT(:,:,:) = PPIZA_TOT(:,:,:) 734 775 PCGA_NOCONT(:,:,:) = PCGA_TOT(:,:,:) … … 739 780 DO JK=1,KLEV 740 781 DO JL=IBEG,IEND 741 ZRCLC_NOCONT(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR_NOCONT(JL,JK))) 742 IF (ZRCLC_NOCONT(JL,JK) > REPCLC) THEN 743 ZQIWP_NOCONT(JL,JK)=PQIWP_NOCONT(JL,JK) 744 ELSE 745 ZQIWP_NOCONT(JL,JK)=REPH2O*ZRCLC_NOCONT(JL,JK) 746 ENDIF 782 ZRCLC_ZERO(JL,JK)=0.0_JPRB 783 ZQIWP_ZERO(JL,JK)=0.0_JPRB 784 PREF_ICE_ZERO(JL,JK)=1.0_JPRB 747 785 ENDDO 748 786 ENDDO … … 753 791 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 754 792 & ZCCNL , ZCCNO ,& 755 & PCCO2 , ZRCLC _NOCONT, PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,&756 & ZQ , ZQIWP _NOCONT, ZQLWP , ZQS , ZQRAIN,ZQRAINT ,&793 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 794 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 757 795 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 758 796 & PREF_LIQ_NOCONT, PREF_ICE_NOCONT,& 797 & ZRCLC_ZERO, ZQIWP_ZERO, PREF_ICE_ZERO,& ! AB FOR CONTRAILS 759 798 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 760 799 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,&
Note: See TracChangeset
for help on using the changeset viewer.
