source: LMDZ6/trunk/libf/phylmd/lmdz_lscp_ini.f90 @ 5407

Last change on this file since 5407 was 5406, checked in by evignon, 30 hours ago

changement de la parametrisation de la dissipation des cirrus et ajouts de commentaires.

  1. Borella
File size: 25.8 KB
RevLine 
[4664]1MODULE lmdz_lscp_ini
[4380]2
[4654]3IMPLICIT NONE
[4380]4
5  ! PARAMETERS for lscp:
6  !--------------------
[4535]7 
[5204]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)
[4869]10 
[4910]11  REAL, SAVE, PROTECTED :: seuil_neb=0.001      ! cloud fraction threshold: a cloud can precipitate when exceeded
[4380]12  !$OMP THREADPRIVATE(seuil_neb)
13
[4910]14  REAL, SAVE, PROTECTED :: min_neb_th=1e-10      ! a cloud produced by bi-gaussian really exists when exceeded
15  !$OMP THREADPRIVATE(min_neb_th)
16
17  REAL, SAVE, PROTECTED :: min_frac_thermals=1.e-10   ! minimum thermals fraction for use of bigaussian distribution
18  !$OMP THREADPRIVATE(min_frac_thermals)
19
[4666]20  INTEGER, SAVE :: lunout, prt_level            ! Logical unit number and level for standard output
21  !$OMP THREADPRIVATE(lunout,prt_level)
22
[4803]23  INTEGER, SAVE, PROTECTED :: niter_lscp=5      ! number of iterations to calculate autoconversion to precipitation
[4559]24  !$OMP THREADPRIVATE(niter_lscp)
[4380]25
[4803]26  INTEGER, SAVE, PROTECTED :: iflag_evap_prec=1 ! precipitation evaporation flag. 0: nothing, 1: "old way",
[4380]27                                                ! 2: Max cloud fraction above to calculate the max of reevaporation
[4563]28                                                ! >=4: LTP'method i.e. evaporation in the clear-sky fraction of the mesh only
29                                                ! pay attention that iflag_evap_prec=4 may lead to unrealistic and overestimated
30                                                ! evaporation. Use 5 instead
[4380]31  !$OMP THREADPRIVATE(iflag_evap_prec)
32
[4803]33  REAL, SAVE, PROTECTED :: t_coup=234.0         ! temperature threshold which determines the phase
34                                                ! for which the saturation vapor pressure is calculated
35  !$OMP THREADPRIVATE(t_coup)
36  REAL, SAVE, PROTECTED :: DDT0=0.01            ! iteration parameter
37  !$OMP THREADPRIVATE(DDT0)
[4380]38
[4803]39  REAL, SAVE, PROTECTED :: ztfondue=278.15      ! parameter to calculate melting fraction of precipitation
40  !$OMP THREADPRIVATE(ztfondue)
[4380]41
[5204]42  REAL, SAVE, PROTECTED :: temp_nowater=235.15  ! temperature below which liquid water no longer exists
[4803]43  !$OMP THREADPRIVATE(temp_nowater)
[4380]44
[4803]45  REAL, SAVE, PROTECTED :: a_tr_sca(4)          ! Variables for tracers temporary: alpha parameter for scavenging, 4 possible scavenging processes
[4380]46  !$OMP THREADPRIVATE(a_tr_sca)
47 
[4910]48  REAL, SAVE, PROTECTED ::  min_frac_th_cld=1.e-10   ! minimum thermal fraction to compute a thermal cloud fraction
49  !$OMP THREADPRIVATE(min_frac_th_cld)
50
[4803]51  LOGICAL, SAVE, PROTECTED :: ok_radocond_snow=.false. ! take into account the mass of ice precip in the cloud ice content seen by radiation
[4412]52  !$OMP THREADPRIVATE(ok_radocond_snow)
[4380]53
[4803]54  REAL, SAVE, PROTECTED :: t_glace_min=258.0    ! lower-bound temperature parameter for cloud phase determination
[4535]55  !$OMP THREADPRIVATE(t_glace_min)
[4420]56
[4803]57  REAL, SAVE, PROTECTED :: t_glace_max=273.15   ! upper-bound temperature parameter for cloud phase determination
[4535]58  !$OMP THREADPRIVATE(t_glace_max)
59
[4803]60  REAL, SAVE, PROTECTED :: exposant_glace=1.0   ! parameter for cloud phase determination
[4535]61  !$OMP THREADPRIVATE(exposant_glace)
62
[4803]63  INTEGER, SAVE, PROTECTED :: iflag_vice=0      ! which expression for ice crystall fall velocity
[4535]64  !$OMP THREADPRIVATE(iflag_vice)
65
[4803]66  INTEGER, SAVE, PROTECTED :: iflag_t_glace=0   ! which expression for cloud phase partitioning
[4535]67  !$OMP THREADPRIVATE(iflag_t_glace)
68
[5007]69  INTEGER, SAVE, PROTECTED :: iflag_cloudth_vert=0          ! option for determining cloud fraction and content in convective boundary layers
[4535]70  !$OMP THREADPRIVATE(iflag_cloudth_vert)
71
[5007]72  INTEGER, SAVE, PROTECTED :: iflag_gammasat=0              ! which threshold for homogeneous nucleation below -40oC
[4535]73  !$OMP THREADPRIVATE(iflag_gammasat)
74
[5007]75  INTEGER, SAVE, PROTECTED :: iflag_rain_incloud_vol=0      ! use of volume cloud fraction for rain autoconversion
[4535]76  !$OMP THREADPRIVATE(iflag_rain_incloud_vol)
77
[5007]78  INTEGER, SAVE, PROTECTED :: iflag_bergeron=0              ! bergeron effect for liquid precipitation treatment 
[4535]79  !$OMP THREADPRIVATE(iflag_bergeron)
80
[5007]81  INTEGER, SAVE, PROTECTED :: iflag_fisrtilp_qsat=0         ! qsat adjustment (iterative) during autoconversion
[4535]82  !$OMP THREADPRIVATE(iflag_fisrtilp_qsat)
83
[5007]84  INTEGER, SAVE, PROTECTED :: iflag_pdf=0                   ! type of subgrid scale qtot pdf
[4535]85  !$OMP THREADPRIVATE(iflag_pdf)
86
[5007]87  INTEGER, SAVE, PROTECTED :: iflag_icefrac=0               ! which phase partitioning function to use
88  !$OMP THREADPRIVATE(iflag_icefrac)
89
90  INTEGER, SAVE, PROTECTED :: iflag_autoconversion=0        ! autoconversion option
[4559]91  !$OMP THREADPRIVATE(iflag_autoconversion)
92
[5007]93
94  LOGICAL, SAVE, PROTECTED :: reevap_ice=.false.            ! no liquid precip for T< threshold
[4535]95  !$OMP THREADPRIVATE(reevap_ice)
96
[5007]97  REAL, SAVE, PROTECTED :: cld_lc_lsc=2.6e-4                ! liquid autoconversion coefficient, stratiform rain
[4535]98  !$OMP THREADPRIVATE(cld_lc_lsc)
99
[4803]100  REAL, SAVE, PROTECTED :: cld_lc_con=2.6e-4                ! liquid autoconversion coefficient, convective rain
[4535]101  !$OMP THREADPRIVATE(cld_lc_con)
102
[4803]103  REAL, SAVE, PROTECTED :: cld_tau_lsc=3600.                ! liquid autoconversion timescale, stratiform rain
[4535]104  !$OMP THREADPRIVATE(cld_tau_lsc)
105
[4803]106  REAL, SAVE, PROTECTED :: cld_tau_con=3600.                ! liquid autoconversion timescale, convective rain
[4535]107  !$OMP THREADPRIVATE(cld_tau_con)
108
[4803]109  REAL, SAVE, PROTECTED :: cld_expo_lsc=2.                  ! liquid autoconversion threshold exponent, stratiform rain
[4559]110  !$OMP THREADPRIVATE(cld_expo_lsc)
111
[4803]112  REAL, SAVE, PROTECTED :: cld_expo_con=2.                  ! liquid autoconversion threshold exponent, convective rain
[4559]113  !$OMP THREADPRIVATE(cld_expo_con)
114
[4803]115  REAL, SAVE, PROTECTED :: ffallv_lsc=1.                    ! tuning coefficient crystal fall velocity, stratiform
[4535]116  !$OMP THREADPRIVATE(ffallv_lsc)
117
[4803]118  REAL, SAVE, PROTECTED :: ffallv_con=1.                    ! tuning coefficient crystal fall velocity, convective
[4535]119  !$OMP THREADPRIVATE(ffallv_con)
120
[4803]121  REAL, SAVE, PROTECTED :: coef_eva=2e-5                    ! tuning coefficient liquid precip evaporation
[4535]122  !$OMP THREADPRIVATE(coef_eva)
123
[5007]124  REAL, SAVE, PROTECTED :: coef_sub                         ! tuning coefficient ice precip sublimation
[4830]125  !$OMP THREADPRIVATE(coef_sub)
[4535]126
[4803]127  REAL, SAVE, PROTECTED :: expo_eva=0.5                     ! tuning coefficient liquid precip evaporation
128  !$OMP THREADPRIVATE(expo_eva)
[4535]129
[5007]130  REAL, SAVE, PROTECTED :: expo_sub                         ! tuning coefficient ice precip sublimation
[4830]131  !$OMP THREADPRIVATE(expo_sub)
[4535]132
[4803]133  REAL, SAVE, PROTECTED :: cice_velo=1.645                  ! factor in the ice fall velocity formulation
134  !$OMP THREADPRIVATE(cice_velo)
135
136  REAL, SAVE, PROTECTED ::  dice_velo=0.16                  ! exponent in the ice fall velocity formulation
137  !$OMP THREADPRIVATE(dice_velo)
138
139  REAL, SAVE, PROTECTED :: dist_liq=300.                    ! typical deph of cloud-top liquid layer in mpcs
[4562]140  !$OMP THREADPRIVATE(dist_liq)
[4535]141
[5204]142  REAL, SAVE, PROTECTED  :: tresh_cl=0.0                  ! cloud fraction threshold for cloud top search
[4562]143  !$OMP THREADPRIVATE(tresh_cl)
144
[5204]145  !--Parameters for condensation and ice supersaturation
146
147  LOGICAL, SAVE, PROTECTED :: ok_ice_supersat=.FALSE.        ! activates the condensation scheme that allows for ice supersaturation
148  !$OMP THREADPRIVATE(ok_ice_supersat)
149
150  LOGICAL, SAVE, PROTECTED :: ok_unadjusted_clouds=.FALSE.   ! if True, relax the saturation adjustment assumption for ice clouds
151  !$OMP THREADPRIVATE(ok_unadjusted_clouds)
152
153  LOGICAL, SAVE, PROTECTED :: ok_weibull_warm_clouds=.FALSE. ! if True, the weibull condensation scheme replaces the lognormal condensation scheme at positive temperatures
154  !$OMP THREADPRIVATE(ok_weibull_warm_clouds)
155
[5406]156  INTEGER, SAVE, PROTECTED :: iflag_cloud_sublim_pdf=4       ! iflag for the distribution of water inside ice clouds
[5204]157  !$OMP THREADPRIVATE(iflag_cloud_sublim_pdf)
158
[5406]159  REAL, SAVE, PROTECTED :: depo_coef_cirrus=.7               ! [-] deposition coefficient for growth of ice crystals in cirrus clouds
[5204]160  !$OMP THREADPRIVATE(depo_coef_cirrus)
161
162  REAL, SAVE, PROTECTED :: capa_cond_cirrus=.5               ! [-] capacitance factor for growth/sublimation of ice crystals in cirrus clouds
163  !$OMP THREADPRIVATE(capa_cond_cirrus)
164
[5406]165  REAL, SAVE, PROTECTED :: std_subl_pdf_lscp=2.              ! [%] standard deviation of the gaussian distribution of water inside ice clouds
166  !$OMP THREADPRIVATE(std_subl_pdf_lscp)
167
[5204]168  REAL, SAVE, PROTECTED :: mu_subl_pdf_lscp=1./3.            ! [-] shape factor of the gamma distribution of water inside ice clouds
169  !$OMP THREADPRIVATE(mu_subl_pdf_lscp)
170 
[5406]171  REAL, SAVE, PROTECTED :: beta_pdf_lscp=1.E-3               ! [SI] tuning coefficient for the standard deviation of the PDF of water vapor in the clear sky region
[5204]172  !$OMP THREADPRIVATE(beta_pdf_lscp)
173 
[5406]174  REAL, SAVE, PROTECTED :: temp_thresh_pdf_lscp=189.         ! [K] factor for the PDF fit of water vapor in UTLS - below this temperature, water vapor is homogeneously distributed in the clear sky region
[5204]175  !$OMP THREADPRIVATE(temp_thresh_pdf_lscp)
176 
[5406]177  REAL, SAVE, PROTECTED :: k0_pdf_lscp=3.01                  ! [-] factor for the PDF fit of water vapor in UTLS
[5204]178  !$OMP THREADPRIVATE(k0_pdf_lscp)
179 
[5406]180  REAL, SAVE, PROTECTED :: kappa_pdf_lscp=0.0192             ! [] factor for the PDF fit of water vapor in UTLS
[5204]181  !$OMP THREADPRIVATE(kappa_pdf_lscp)
182 
[5406]183  REAL, SAVE, PROTECTED :: std100_pdf_lscp=4.08              ! [%] standard deviation at RHliq=100% of the PDF fit of water vapor in UTLS
184  !$OMP THREADPRIVATE(std100_pdf_lscp)
[5204]185 
186  REAL, SAVE, PROTECTED :: a_homofreez=2.349                 ! [-] factor for the Koop homogeneous freezing fit
187  !$OMP THREADPRIVATE(a_homofreez)
188 
189  REAL, SAVE, PROTECTED :: b_homofreez=259.                  ! [K] factor for the Koop homogeneous freezing fit
190  !$OMP THREADPRIVATE(b_homofreez)
191
192  REAL, SAVE, PROTECTED :: delta_hetfreez=1.                 ! [-] value between 0 and 1 to simulate for heterogeneous freezing.
193  !$OMP THREADPRIVATE(delta_hetfreez)
194 
[5406]195  REAL, SAVE, PROTECTED :: coef_mixing_lscp=9.E-8            ! [-] tuning coefficient for the mixing process
[5204]196  !$OMP THREADPRIVATE(coef_mixing_lscp)
197 
[5406]198  REAL, SAVE, PROTECTED :: coef_shear_lscp=0.72              ! [-] additional coefficient for the shearing process (subprocess of the mixing process)
[5204]199  !$OMP THREADPRIVATE(coef_shear_lscp)
200 
[5406]201  REAL, SAVE, PROTECTED :: chi_mixing_lscp=1.                ! [-] factor for the macro distribution of ISSRs wrt clouds in a gridbox
[5204]202  !$OMP THREADPRIVATE(chi_mixing_lscp)
203  !--End of the parameters for condensation and ice supersaturation
204
[4803]205  !--Parameters for poprecip
206  LOGICAL, SAVE, PROTECTED :: ok_poprecip=.FALSE.           ! use the processes-oriented formulation of precipitations
207  !$OMP THREADPRIVATE(ok_poprecip)
208
[4913]209  LOGICAL, SAVE, PROTECTED :: ok_corr_vap_evasub=.FALSE.    ! use the corrected version of clear-sky water vapor for the evap / subl processes
210  !$OMP THREADPRIVATE(ok_corr_vap_evasub)
211
[4898]212  REAL, SAVE, PROTECTED :: cld_lc_lsc_snow=2.e-5            ! snow autoconversion coefficient, stratiform. default from  Chaboureau and PInty 2006
[4830]213  !$OMP THREADPRIVATE(cld_lc_lsc_snow)
214
[4898]215  REAL, SAVE, PROTECTED :: cld_lc_con_snow=2.e-5            ! snow autoconversion coefficient, convective
[4830]216  !$OMP THREADPRIVATE(cld_lc_con_snow)
217
[4885]218  REAL, SAVE, PROTECTED :: rain_int_min=1.e-5               ! Minimum local rain intensity [mm/s] before the decrease in associated precipitation fraction
[4803]219  !$OMP THREADPRIVATE(rain_int_min)
220
[5383]221  REAL, SAVE, PROTECTED :: thresh_precip_frac=1.E-6         ! precipitation fraction threshold [-]
[4803]222  !$OMP THREADPRIVATE(thresh_precip_frac)
223
[5383]224  REAL, SAVE, PROTECTED :: capa_crystal=1.                  ! Crystal capacitance (shape factor) for lscp_icefrac_turb [-]
[5007]225  !$OMP THREADPRIVATE(capa_crystal)
226
227  REAL, SAVE, PROTECTED :: naero5=0.5                       ! Number concentration of aerosol larger than 0.5 microns [scm-3]
228  !$OMP THREADPRIVATE(naero5)
229
[5383]230  REAL, SAVE, PROTECTED :: gamma_snwretro = 0.              ! Proportion of snow taken into account in ice retroaction in lscp_icefrac_turb [-]
[5007]231  !$OMP THREADPRIVATE(gamma_snwretro)
232
[5406]233  REAL, SAVE, PROTECTED :: gamma_taud = 1.                  ! Tuning coeff for Lagrangian decorrelation timescale in lscp_icefrac_turb [-]
[5007]234  !$OMP THREADPRIVATE(gamma_taud)
235
[5383]236  REAL, SAVE, PROTECTED :: gamma_col=1.                     ! Tuning coefficient for rain collection efficiency (poprecip) [-]
[4803]237  !$OMP THREADPRIVATE(gamma_col)
238
[5383]239  REAL, SAVE, PROTECTED :: gamma_agg=1.                     ! Tuning coefficient for snow aggregation efficiency (poprecip) [-]
[4803]240  !$OMP THREADPRIVATE(gamma_agg)
241
[5383]242  REAL, SAVE, PROTECTED :: gamma_rim=1.                     ! Tuning coefficient for riming efficiency (poprecip) [-]
[4803]243  !$OMP THREADPRIVATE(gamma_rim)
[5406]244
[5383]245  REAL, SAVE, PROTECTED :: gamma_melt=1.                    ! Tuning coefficient for snow melting efficiency (poprecip) [-]
246  !$OMP THREADPRIVATE(gamma_melt)
247 
248  REAL, SAVE, PROTECTED :: gamma_freez=1.                   ! Tuning coefficient for rain collision freezing efficiency (poprecip) [-]
249  !$OMP THREADPRIVATE(gamma_freez)
[4803]250
[5007]251  REAL, SAVE, PROTECTED :: rho_rain=1000.                   ! Rain density [kg/m3]
[4803]252  !$OMP THREADPRIVATE(rho_rain)
253
[5007]254  REAL, SAVE, PROTECTED :: rho_ice=920.                     ! Ice density  [kg/m3]
[4832]255  !$OMP THREADPRIVATE(rho_ice)
256
[5383]257  REAL, SAVE, PROTECTED :: r_rain=500.E-6                   ! Rain droplets radius (poprecip) [m]
[4803]258  !$OMP THREADPRIVATE(r_rain)
259
[5383]260  REAL, SAVE, PROTECTED :: r_snow=1.E-3                     ! Ice crystals radius (poprecip) [m]
[4803]261  !$OMP THREADPRIVATE(r_snow)
262
[5383]263  REAL, SAVE, PROTECTED :: tau_auto_snow_min=100.           ! Snow autoconversion minimal timescale (when liquid) [s]
[4803]264  !$OMP THREADPRIVATE(tau_auto_snow_min)
265
[5383]266  REAL, SAVE, PROTECTED :: tau_auto_snow_max=1000.          ! Snow autoconversion minimal timescale (when only ice) [s]
[4803]267  !$OMP THREADPRIVATE(tau_auto_snow_max)
268
[5383]269  REAL, SAVE, PROTECTED :: eps=1.E-10                       ! Treshold 0 [-]
[4803]270  !$OMP THREADPRIVATE(eps)
[4818]271
[5383]272  REAL, SAVE, PROTECTED :: alpha_freez=4.                   ! Slope of exponential for immersion freezing timescale [-]
[4818]273  !$OMP THREADPRIVATE(alpha_freez)
274
[5383]275  REAL, SAVE, PROTECTED :: beta_freez=0.1                   ! Inv.time immersion freezing [s-1]
[4830]276  !$OMP THREADPRIVATE(beta_freez)
277
[5383]278  REAL, SAVE, PROTECTED :: rain_fallspeed=4.                ! Rain fall velocity [m/s]
[4830]279  !$OMP THREADPRIVATE(rain_fallspeed)
280
[5383]281  REAL, SAVE, PROTECTED :: rain_fallspeed_clr               ! Rain fall velocity in clear sky [m/s]
[4830]282  !$OMP THREADPRIVATE(rain_fallspeed_clr)
283
[5383]284  REAL, SAVE, PROTECTED :: rain_fallspeed_cld               ! Rain fall velocity in cloudy sky [m/s]
[4830]285  !$OMP THREADPRIVATE(rain_fallspeed_cld)
286
[5383]287  REAL, SAVE, PROTECTED :: snow_fallspeed=1.                ! Snow fall velocity [m/s]
[4830]288  !$OMP THREADPRIVATE(snow_fallspeed)
289
[5383]290  REAL, SAVE, PROTECTED :: snow_fallspeed_clr               ! Snow fall velocity in clear sky [m/s]
[4830]291  !$OMP THREADPRIVATE(snow_fallspeed_clr)
292
[5383]293  REAL, SAVE, PROTECTED :: snow_fallspeed_cld               ! Snow fall velocity in cloudy sky [m/s]
[4830]294  !$OMP THREADPRIVATE(snow_fallspeed_cld)
[4803]295  !--End of the parameters for poprecip
296
[4666]297! Two parameters used for lmdz_lscp_old only
[4803]298  INTEGER, SAVE, PROTECTED :: iflag_oldbug_fisrtilp=0, fl_cor_ebil
[4666]299  !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp,fl_cor_ebil)
300
[4380]301CONTAINS
302
[5204]303SUBROUTINE lscp_ini(dtime,lunout_in,prt_level_in,ok_ice_supersat_in, iflag_ratqs, fl_cor_ebil_in, &
304                    RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in, RVTMP2_in, &
305                    RTT_in, RD_in, RV_in, RG_in, RPI_in, EPS_W_in)
[4380]306
307
308   USE ioipsl_getin_p_mod, ONLY : getin_p
[4651]309   USE lmdz_cloudth_ini, ONLY : cloudth_ini
[4380]310
311   REAL, INTENT(IN)      :: dtime
[4666]312   INTEGER, INTENT(IN)   :: lunout_in,prt_level_in,iflag_ratqs,fl_cor_ebil_in
[5204]313   LOGICAL, INTENT(IN)   :: ok_ice_supersat_in
[4380]314
[4535]315   REAL, INTENT(IN)      :: RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in
[5204]316   REAL, INTENT(IN)      :: RVTMP2_in, RTT_in, RD_in, RV_in, RG_in, RPI_in, EPS_W_in
[4559]317   character (len=20) :: modname='lscp_ini_mod'
318   character (len=80) :: abort_message
[4535]319
320
[4666]321    lunout=lunout_in
322    prt_level=prt_level_in
323    fl_cor_ebil=fl_cor_ebil_in
324
[5204]325    ok_ice_supersat=ok_ice_supersat_in
326
[4535]327    RG=RG_in
328    RD=RD_in
[5204]329    RV=RV_in
[4535]330    RCPD=RCPD_in
331    RLVTT=RLVTT_in
332    RLSTT=RLSTT_in
333    RLMLT=RLMLT_in
334    RTT=RTT_in
[5007]335    RV=RV_in
[4535]336    RVTMP2=RVTMP2_in
[4818]337    RPI=RPI_in
[5204]338    EPS_W=EPS_W_in
[4535]339
340
341
[4559]342    CALL getin_p('niter_lscp',niter_lscp)
[4380]343    CALL getin_p('iflag_evap_prec',iflag_evap_prec)
344    CALL getin_p('seuil_neb',seuil_neb)
[4420]345    CALL getin_p('ok_radocond_snow',ok_radocond_snow)
[4535]346    CALL getin_p('t_glace_max',t_glace_max)
347    CALL getin_p('t_glace_min',t_glace_min)
348    CALL getin_p('exposant_glace',exposant_glace)
349    CALL getin_p('iflag_vice',iflag_vice)
350    CALL getin_p('iflag_t_glace',iflag_t_glace)
351    CALL getin_p('iflag_cloudth_vert',iflag_cloudth_vert)
352    CALL getin_p('iflag_gammasat',iflag_gammasat)
353    CALL getin_p('iflag_rain_incloud_vol',iflag_rain_incloud_vol)
354    CALL getin_p('iflag_bergeron',iflag_bergeron)
355    CALL getin_p('iflag_fisrtilp_qsat',iflag_fisrtilp_qsat)
356    CALL getin_p('iflag_pdf',iflag_pdf)
[5007]357    CALL getin_p('iflag_icefrac',iflag_icefrac)
[4535]358    CALL getin_p('reevap_ice',reevap_ice)
359    CALL getin_p('cld_lc_lsc',cld_lc_lsc)
360    CALL getin_p('cld_lc_con',cld_lc_con)
[4830]361    CALL getin_p('cld_lc_lsc_snow',cld_lc_lsc_snow)
362    CALL getin_p('cld_lc_con_snow',cld_lc_con_snow)
[4535]363    CALL getin_p('cld_tau_lsc',cld_tau_lsc)
364    CALL getin_p('cld_tau_con',cld_tau_con)
[4559]365    CALL getin_p('cld_expo_lsc',cld_expo_lsc)
366    CALL getin_p('cld_expo_con',cld_expo_con)
[4535]367    CALL getin_p('ffallv_lsc',ffallv_lsc)
368    CALL getin_p('ffallv_lsc',ffallv_con)
369    CALL getin_p('coef_eva',coef_eva)
[4830]370    coef_sub=coef_eva
371    CALL getin_p('coef_eva_i',coef_sub)
372    CALL getin_p('coef_sub',coef_sub)
[4803]373    CALL getin_p('expo_eva',expo_eva)
[4830]374    expo_sub=expo_eva
375    CALL getin_p('expo_sub',expo_sub)
[4559]376    CALL getin_p('iflag_autoconversion',iflag_autoconversion)
[4562]377    CALL getin_p('dist_liq',dist_liq)
378    CALL getin_p('tresh_cl',tresh_cl)
[5007]379    CALL getin_p('capa_crystal',capa_crystal)
380    CALL getin_p('naero5',naero5)
381    CALL getin_p('gamma_snwretro',gamma_snwretro)
382    CALL getin_p('gamma_taud',gamma_taud)
[4666]383    CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
[5204]384    CALL getin_p('temp_nowater',temp_nowater)
385    ! for poprecip
[4803]386    CALL getin_p('ok_poprecip',ok_poprecip)
[4913]387    CALL getin_p('ok_corr_vap_evasub',ok_corr_vap_evasub)
[4803]388    CALL getin_p('rain_int_min',rain_int_min)
389    CALL getin_p('gamma_agg',gamma_agg)
390    CALL getin_p('gamma_col',gamma_col)
[4818]391    CALL getin_p('gamma_rim',gamma_rim)
[4830]392    CALL getin_p('gamma_freez',gamma_freez)
[4895]393    CALL getin_p('gamma_melt',gamma_melt)
[5383]394    CALL getin_p('tau_auto_snow_max',tau_auto_snow_max)
395    CALL getin_p('tau_auto_snow_min',tau_auto_snow_min)
[4830]396    CALL getin_p('r_snow',r_snow)
397    CALL getin_p('rain_fallspeed',rain_fallspeed)
398    rain_fallspeed_clr=rain_fallspeed
399    rain_fallspeed_cld=rain_fallspeed
400    CALL getin_p('rain_fallspeed_clr',rain_fallspeed_clr)
401    CALL getin_p('rain_fallspeed_cld',rain_fallspeed_cld)
402    CALL getin_p('snow_fallspeed',snow_fallspeed)
403    snow_fallspeed_clr=snow_fallspeed
404    snow_fallspeed_cld=snow_fallspeed
405    CALL getin_p('snow_fallspeed_clr',snow_fallspeed_clr)
406    CALL getin_p('snow_fallspeed_cld',snow_fallspeed_cld)
[5204]407    ! for condensation and ice supersaturation
408    CALL getin_p('ok_unadjusted_clouds',ok_unadjusted_clouds)
409    CALL getin_p('ok_weibull_warm_clouds',ok_weibull_warm_clouds)
410    CALL getin_p('iflag_cloud_sublim_pdf',iflag_cloud_sublim_pdf)
411    CALL getin_p('depo_coef_cirrus',depo_coef_cirrus)
412    CALL getin_p('capa_cond_cirrus',capa_cond_cirrus)
[5406]413    CALL getin_p('std_subl_pdf_lscp',std_subl_pdf_lscp)
[5204]414    CALL getin_p('mu_subl_pdf_lscp',mu_subl_pdf_lscp)
415    CALL getin_p('beta_pdf_lscp',beta_pdf_lscp)
416    CALL getin_p('temp_thresh_pdf_lscp',temp_thresh_pdf_lscp)
417    CALL getin_p('k0_pdf_lscp',k0_pdf_lscp)
418    CALL getin_p('kappa_pdf_lscp',kappa_pdf_lscp)
[5406]419    CALL getin_p('std100_pdf_lscp',std100_pdf_lscp)
[5204]420    CALL getin_p('a_homofreez',a_homofreez)
421    CALL getin_p('b_homofreez',b_homofreez)
422    CALL getin_p('delta_hetfreez',delta_hetfreez)
423    CALL getin_p('coef_mixing_lscp',coef_mixing_lscp)
424    CALL getin_p('coef_shear_lscp',coef_shear_lscp)
425    CALL getin_p('chi_mixing_lscp',chi_mixing_lscp)
[4535]426
427
428
[4666]429    WRITE(lunout,*) 'lscp_ini, niter_lscp:', niter_lscp
430    WRITE(lunout,*) 'lscp_ini, iflag_evap_prec:', iflag_evap_prec
431    WRITE(lunout,*) 'lscp_ini, seuil_neb:', seuil_neb
432    WRITE(lunout,*) 'lscp_ini, ok_radocond_snow:', ok_radocond_snow
433    WRITE(lunout,*) 'lscp_ini, t_glace_max:', t_glace_max
434    WRITE(lunout,*) 'lscp_ini, t_glace_min:', t_glace_min
435    WRITE(lunout,*) 'lscp_ini, exposant_glace:', exposant_glace
436    WRITE(lunout,*) 'lscp_ini, iflag_vice:', iflag_vice
437    WRITE(lunout,*) 'lscp_ini, iflag_t_glace:', iflag_t_glace
438    WRITE(lunout,*) 'lscp_ini, iflag_cloudth_vert:', iflag_cloudth_vert
439    WRITE(lunout,*) 'lscp_ini, iflag_gammasat:', iflag_gammasat
440    WRITE(lunout,*) 'lscp_ini, iflag_rain_incloud_vol:', iflag_rain_incloud_vol
441    WRITE(lunout,*) 'lscp_ini, iflag_bergeron:', iflag_bergeron
442    WRITE(lunout,*) 'lscp_ini, iflag_fisrtilp_qsat:', iflag_fisrtilp_qsat
443    WRITE(lunout,*) 'lscp_ini, iflag_pdf', iflag_pdf
[5007]444    WRITE(lunout,*) 'lscp_ini, iflag_icefrac', iflag_icefrac
[4666]445    WRITE(lunout,*) 'lscp_ini, reevap_ice', reevap_ice
446    WRITE(lunout,*) 'lscp_ini, cld_lc_lsc', cld_lc_lsc
447    WRITE(lunout,*) 'lscp_ini, cld_lc_con', cld_lc_con
[4830]448    WRITE(lunout,*) 'lscp_ini, cld_lc_lsc_snow', cld_lc_lsc_snow
449    WRITE(lunout,*) 'lscp_ini, cld_lc_con_snow', cld_lc_con_snow
[4666]450    WRITE(lunout,*) 'lscp_ini, cld_tau_lsc', cld_tau_lsc
451    WRITE(lunout,*) 'lscp_ini, cld_tau_con', cld_tau_con
452    WRITE(lunout,*) 'lscp_ini, cld_expo_lsc', cld_expo_lsc
453    WRITE(lunout,*) 'lscp_ini, cld_expo_con', cld_expo_con
454    WRITE(lunout,*) 'lscp_ini, ffallv_lsc', ffallv_lsc
455    WRITE(lunout,*) 'lscp_ini, ffallv_con', ffallv_con
456    WRITE(lunout,*) 'lscp_ini, coef_eva', coef_eva
[4830]457    WRITE(lunout,*) 'lscp_ini, coef_sub', coef_sub
[4803]458    WRITE(lunout,*) 'lscp_ini, expo_eva', expo_eva
[4830]459    WRITE(lunout,*) 'lscp_ini, expo_sub', expo_sub
[4666]460    WRITE(lunout,*) 'lscp_ini, iflag_autoconversion', iflag_autoconversion
461    WRITE(lunout,*) 'lscp_ini, dist_liq', dist_liq
462    WRITE(lunout,*) 'lscp_ini, tresh_cl', tresh_cl
[5007]463    WRITE(lunout,*) 'lscp_ini, capa_crystal', capa_crystal
464    WRITE(lunout,*) 'lscp_ini, naero5', naero5
465    WRITE(lunout,*) 'lscp_ini, gamma_snwretro', gamma_snwretro
466    WRITE(lunout,*) 'lscp_ini, gamma_taud', gamma_taud
[4666]467    WRITE(lunout,*) 'lscp_ini, iflag_oldbug_fisrtilp', iflag_oldbug_fisrtilp
468    WRITE(lunout,*) 'lscp_ini, fl_cor_ebil', fl_cor_ebil
[5204]469    WRITE(lunout,*) 'lscp_ini, temp_nowater', temp_nowater
470    ! for poprecip
[4803]471    WRITE(lunout,*) 'lscp_ini, ok_poprecip', ok_poprecip
[4913]472    WRITE(lunout,*) 'lscp_ini, ok_corr_vap_evasub', ok_corr_vap_evasub
[4803]473    WRITE(lunout,*) 'lscp_ini, rain_int_min:', rain_int_min
474    WRITE(lunout,*) 'lscp_ini, gamma_agg:', gamma_agg
475    WRITE(lunout,*) 'lscp_ini, gamma_col:', gamma_col
[4818]476    WRITE(lunout,*) 'lscp_ini, gamma_rim:', gamma_rim
[4830]477    WRITE(lunout,*) 'lscp_ini, gamma_freez:', gamma_freez
[4895]478    WRITE(lunout,*) 'lscp_ini, gamma_melt:', gamma_melt
[5383]479    WRITE(lunout,*) 'lscp_ini, tau_auto_snow_max:',tau_auto_snow_max
480    WRITE(lunout,*) 'lscp_ini, tau_auto_snow_min:',tau_auto_snow_min
[4830]481    WRITE(lunout,*) 'lscp_ini, r_snow:', r_snow
482    WRITE(lunout,*) 'lscp_ini, rain_fallspeed_clr:', rain_fallspeed_clr
483    WRITE(lunout,*) 'lscp_ini, rain_fallspeed_cld:', rain_fallspeed_cld
484    WRITE(lunout,*) 'lscp_ini, snow_fallspeed_clr:', snow_fallspeed_clr
485    WRITE(lunout,*) 'lscp_ini, snow_fallspeed_cld:', snow_fallspeed_cld
[5204]486    ! for condensation and ice supersaturation
487    WRITE(lunout,*) 'lscp_ini, ok_ice_supersat:', ok_ice_supersat
488    WRITE(lunout,*) 'lscp_ini, ok_unadjusted_clouds:', ok_unadjusted_clouds
489    WRITE(lunout,*) 'lscp_ini, ok_weibull_warm_clouds:', ok_weibull_warm_clouds
490    WRITE(lunout,*) 'lscp_ini, iflag_cloud_sublim_pdf:', iflag_cloud_sublim_pdf
491    WRITE(lunout,*) 'lscp_ini, depo_coef_cirrus:', depo_coef_cirrus
492    WRITE(lunout,*) 'lscp_ini, capa_cond_cirrus:', capa_cond_cirrus
[5406]493    WRITE(lunout,*) 'lscp_ini, std_subl_pdf_lscp:', std_subl_pdf_lscp
[5204]494    WRITE(lunout,*) 'lscp_ini, mu_subl_pdf_lscp:', mu_subl_pdf_lscp
495    WRITE(lunout,*) 'lscp_ini, beta_pdf_lscp:', beta_pdf_lscp
496    WRITE(lunout,*) 'lscp_ini, temp_thresh_pdf_lscp:', temp_thresh_pdf_lscp
497    WRITE(lunout,*) 'lscp_ini, k0_pdf_lscp:', k0_pdf_lscp
498    WRITE(lunout,*) 'lscp_ini, kappa_pdf_lscp:', kappa_pdf_lscp
[5406]499    WRITE(lunout,*) 'lscp_ini, std100_pdf_lscp:', std100_pdf_lscp
[5204]500    WRITE(lunout,*) 'lscp_ini, a_homofreez:', a_homofreez
501    WRITE(lunout,*) 'lscp_ini, b_homofreez:', b_homofreez
502    WRITE(lunout,*) 'lscp_ini, delta_hetfreez', delta_hetfreez
503    WRITE(lunout,*) 'lscp_ini, coef_mixing_lscp:', coef_mixing_lscp
504    WRITE(lunout,*) 'lscp_ini, coef_shear_lscp:', coef_shear_lscp
505    WRITE(lunout,*) 'lscp_ini, chi_mixing_lscp:', chi_mixing_lscp
[4420]506
[4535]507
508
509
510
[4380]511    ! check for precipitation sub-time steps
[4559]512    IF (ABS(dtime/REAL(niter_lscp)-360.0).GT.0.001) THEN
[4380]513        WRITE(lunout,*) 'lscp: it is not expected, see Z.X.Li', dtime
514        WRITE(lunout,*) 'I would prefer a 6 min sub-timestep'
515    ENDIF
516
[4559]517    ! check consistency between numerical resolution of autoconversion
518    ! and other options
519   
520    IF (iflag_autoconversion .EQ. 2) THEN
521        IF ((iflag_vice .NE. 0) .OR. (niter_lscp .GT. 1)) THEN
522           abort_message = 'in lscp, iflag_autoconversion=2 requires iflag_vice=0 and niter_lscp=1'
523           CALL abort_physic (modname,abort_message,1)
524        ENDIF
525    ENDIF
[4380]526
[4559]527
[5204]528    IF ( ok_weibull_warm_clouds .AND. .NOT. ok_ice_supersat ) THEN
529      abort_message = 'in lscp, ok_weibull_warm_clouds=y needs ok_ice_supersat=y'
530      CALL abort_physic (modname,abort_message,1)
531    ENDIF
532
533    IF ( ok_unadjusted_clouds .AND. .NOT. ok_ice_supersat ) THEN
534      abort_message = 'in lscp, ok_unadjusted_clouds=y needs ok_ice_supersat=y'
535      CALL abort_physic (modname,abort_message,1)
536    ENDIF
537
538
[4380]539    !AA Temporary initialisation
540    a_tr_sca(1) = -0.5
541    a_tr_sca(2) = -0.5
542    a_tr_sca(3) = -0.5
543    a_tr_sca(4) = -0.5
544   
[4651]545    CALL cloudth_ini(iflag_cloudth_vert,iflag_ratqs)
[4380]546
[4654]547RETURN
[4380]548
[4654]549END SUBROUTINE lscp_ini
550
[4664]551END MODULE lmdz_lscp_ini
Note: See TracBrowser for help on using the repository browser.