Context Navigation

physiq_mod.F90 @ 5748

Last change on this file since 5748 was 5715, checked in by yann meurdesoif, 3 weeks ago

GPU porting : revert of reverted commit from rev5511 (initial commit) and rev5561 (reverted commit).
This commit imply a lost of convergence in production mode due to arithmetics rounding effects (possibly by changing order of operations)

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Id

File size: 217.3 KB

Line
1
2	! $Id: physiq_mod.F90 5715 2025-06-17 14:57:26Z dcugnet $
3	!
4	!#define IO_DEBUG
5	MODULE physiq_mod
6
7	IMPLICIT NONE
8
9	CONTAINS
10
11	SUBROUTINE physiq (nlon,nlev, &
12	debut,lafin,pdtphys_, &
13	paprs,pplay,pphi,pphis,presnivs, &
14	u,v,rot,t,qx, &
15	flxmass_w, &
16	d_u, d_v, d_t, d_qx, d_ps)
17
18	! For clarity, the "USE" section is now arranged in alphabetical order,
19	! with a separate section for CPP keys
20	! PLEASE try to follow this rule
21
22	USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando, ACAMA_GWD_rando_first
23	USE aero_mod
24	USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
25	& fl_ebil, fl_cor_ebil
26	USE assert_m, only: assert
27	USE change_srf_frac_mod
28	USE conf_phys_m, only: conf_phys
29	USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad
30	USE CFMIP_point_locations ! IM stations CFMIP
31	USE cmp_seri_mod
32	USE dimphy
33	USE etat0_limit_unstruct_mod
34	USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando, FLOTT_GWD_rando_first
35	USE fonte_neige_mod, ONLY : fonte_neige_get_vars
36	USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
37	USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
38	histwrite, ju2ymds, ymds2ju, getin
39	USE ioipsl_getin_p_mod, ONLY : getin_p
40	USE indice_sol_mod
41	USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, addPhase, ivap, iliq, isol, ibs, icf, irvc
42	USE strings_mod, ONLY: strIdx
43	USE iophy
44	USE limit_read_mod, ONLY : init_limit_read
45	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
46	USE mod_phys_lmdz_mpi_data, only: is_mpi_root
47	USE mod_phys_lmdz_para
48	USE netcdf95, only: nf95_close
49	USE netcdf, only: nf90_fill_real ! IM for NMC files
50	USE open_climoz_m, only: open_climoz ! ozone climatology from a file
51	USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
52	USE pbl_surface_mod, ONLY : pbl_surface
53	USE phyaqua_mod, only: zenang_an
54	USE phyetat0_mod, only: phyetat0
55	USE phystokenc_mod, ONLY: offline, phystokenc
56	USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
57	year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour, calend
58	!! USE phys_local_var_mod, ONLY : a long list of variables
59	!! ==> see below, after "CPP Keys" section
60	USE phys_state_var_mod ! Variables sauvegardees de la physique
61	USE phys_output_mod
62	USE phys_output_ctrlout_mod
63	USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level, &
64	alert_first_call, call_alert, prt_alerte
65	USE readaerosol_mod, ONLY : init_aero_fromfile
66	USE readaerosolstrato_m, ONLY : init_readaerosolstrato
67	USE radlwsw_m, only: radlwsw
68	USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
69	USE regr_pr_time_av_m, only: regr_pr_time_av
70	USE surface_data, ONLY : type_ocean, ok_veget
71	USE time_phylmdz_mod, only: current_time, itau_phy, pdtphys, raz_date, update_time
72	USE tracinca_mod, ONLY: config_inca
73	USE tropopause_m, ONLY: dyn_tropopause
74	USE vampir
75	USE write_field_phy
76	use wxios_mod, ONLY: g_ctx, wxios_set_context
77	USE lmdz_lscp_main, ONLY : lscp
78	USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
79	USE lmdz_lscp_old, ONLY : fisrtilp, fisrtilp_first
80	USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim
81	USE calwake_mod, ONLY : calwake, calwake_first
82	USE lmdz_wake_ini, ONLY : wake_ini
83	USE lmdz_surf_wind_ini, ONLY : surf_wind_ini
84	USE lmdz_surf_wind, ONLY : surf_wind
85	USE yamada_ini_mod, ONLY : yamada_ini
86	USE lmdz_atke_turbulence_ini, ONLY : atke_ini
87	USE lmdz_thermcell_ini, ONLY : thermcell_ini, iflag_thermals_tenv
88	USE calltherm_mod, ONLY : calltherm
89	USE lmdz_thermcell_dtke, ONLY : thermcell_dtke
90	USE lmdz_blowing_snow_ini, ONLY : blowing_snow_ini , qbst_bs
91	USE lmdz_lscp_ini, ONLY : lscp_ini
92	USE lmdz_ratqs_main, ONLY : ratqs_main
93	USE lmdz_ratqs_ini, ONLY : ratqs_ini
94	USE lmdz_cloud_optics_prop_ini, ONLY : cloud_optics_prop_ini
95	USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
96	USE phys_output_var_mod, ONLY : cloud_cover_sw, cloud_cover_sw_s2, ZFLUX_DIR, ZFLUX_DIR_CLEAR, &
97	& ZFLUX_DIR_s2, ZFLUX_DIR_CLEAR_s2, ZFLUX_DIR_SUN, ZFLUX_DIR_SUN_s2
98	USE phys_output_var_mod, ONLY : type_ecri
99
100
101	!USE cmp_seri_mod
102	! USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
103	! & fl_ebil, fl_cor_ebil
104
105
106	USE phytracr_spl_mod, ONLY: phytracr_spl, phytracr_spl_out_init
107	USE phys_output_write_spl_mod, ONLY: phys_output_write_spl
108	USE phytrac_mod, ONLY: phytrac_init, phytrac
109	USE phys_output_write_mod, ONLY: phys_output_write
110
111
112	USE geometry_mod, ONLY: longitude, latitude, boundslon, boundslat, ind_cell_glo
113	USE time_phylmdz_mod, ONLY: ndays
114	USE infotrac_phy, ONLY: nqCO2
115	USE lmdz_reprobus_wrappers, ONLY: init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, &
116	ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B
117	USE time_phylmdz_mod, ONLY: annee_ref, day_ini, day_ref, start_time
118	USE vertical_layers_mod, ONLY: aps, bps, ap, bp
119	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS, CPPKEY_STRATAER, CPPKEY_DUST, CPPKEY_COSP, CPPKEY_COSP2, CPPKEY_COSPV2
120
121	#ifdef CPP_RRTM
122	USE YOERAD, ONLY : NRADLP
123	! USE YOESW, ONLY : RSUN
124	#endif
125
126	USE phys_local_var_mod, ONLY: d_q_emiss
127	USE strataer_local_var_mod, ONLY: strataer_init,flag_emit,flh2o,ok_qemiss,flag_verbose_strataer, &
128	year_emit_vol,mth_emit_vol,day_emit_vol,nErupt,nAerErupt,injdur,m_H2O_emiss_vol_daily,m_H2O_emiss_vol, &
129	ponde_lonlat_vol,altemiss_vol,sigma_alt_vol,xlat_min_vol,xlat_max_vol,xlon_min_vol,xlon_max_vol
130	USE strataer_nuc_mod, ONLY: strataer_nuc_init
131	USE strataer_emiss_mod, ONLY: strataer_emiss_init
132
133	USE lmdz_xios, ONLY: xios_update_calendar, xios_context_finalize
134	USE lmdz_xios, ONLY: xios_get_field_attr, xios_field_is_active, xios_context
135	USE lmdz_xios, ONLY: xios_set_current_context
136	USE wxios_mod, ONLY: missing_val, using_xios
137	USE lmdz_spla_ini, ONLY : spla_ini
138
139	#ifndef CPP_XIOS
140	USE paramLMDZ_phy_mod
141	#endif
142	!
143	!
144	!!!!!!!!!!!!!!!!!! END "USE" for CPP keys !!!!!!!!!!!!!!!!!!!!!!
145
146	USE physiqex_mod, ONLY : physiqex
147	USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
148	! [Variables internes non sauvegardees de la physique]
149	! Variables locales pour effectuer les appels en serie
150	t_seri,q_seri,ql_seri,qs_seri,qbs_seri, &
151	u_seri,v_seri,cf_seri,rvc_seri,tr_seri, &
152	rhcl, &
153	! Dynamic tendencies (diagnostics)
154	d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn, &
155	d_u_dyn,d_v_dyn,d_cf_dyn,d_rvc_dyn,d_tr_dyn, &
156	d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, &
157	! Physic tendencies
158	d_t_con,d_q_con,d_u_con,d_v_con, &
159	d_t_con_zmasse,d_q_con_zmasse,d_u_con_zmasse,d_v_con_zmasse, &
160	d_tr, & !! to be removed?? (jyg)
161	d_t_wake,d_q_wake, &
162	d_t_lwr,d_t_lw0,d_t_swr,d_t_sw0, &
163	d_t_ajsb,d_q_ajsb, &
164	d_t_ajs,d_q_ajs,d_u_ajs,d_v_ajs, &
165	! d_t_ajs_w,d_q_ajs_w, &
166	! d_t_ajs_x,d_q_ajs_x, &
167	!
168	d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, &
169	d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc, &
170	d_t_lscst,d_q_lscst, &
171	d_t_lscth,d_q_lscth, &
172	plul_st,plul_th, &
173	!
174	d_t_vdf,d_q_vdf, d_qbs_vdf, d_u_vdf,d_v_vdf,d_t_diss, &
175	d_t_vdf_x, d_t_vdf_w, &
176	d_q_vdf_x, d_q_vdf_w, &
177	d_ts, &
178	!
179	d_t_bsss,d_q_bsss,d_qbs_bsss, &
180	!
181	! d_t_oli,d_u_oli,d_v_oli, &
182	d_t_oro,d_u_oro,d_v_oro, &
183	d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, &
184	d_t_lif,d_u_lif,d_v_lif, &
185	d_t_ec, &
186	!
187	du_gwd_hines,dv_gwd_hines,d_t_hin, &
188	dv_gwd_rando,dv_gwd_front, &
189	east_gwstress,west_gwstress, &
190	d_q_ch4, &
191	! proprecip
192	qraindiag, qsnowdiag, &
193	dqreva, dqssub, &
194	dqrauto,dqrcol,dqrmelt,dqrfreez, &
195	dqsauto,dqsagg,dqsrim,dqsmelt,dqsfreez, &
196	! Special RRTM
197	ZLWFT0_i,ZSWFT0_i,ZFLDN0, &
198	ZFLUP0,ZFSDN0,ZFSUP0, &
199	!
200	topswad_aero,solswad_aero, &
201	topswai_aero,solswai_aero, &
202	topswad0_aero,solswad0_aero, &
203	!LW additional
204	toplwad_aero,sollwad_aero, &
205	toplwai_aero,sollwai_aero, &
206	toplwad0_aero,sollwad0_aero, &
207	!pour Ecrad
208	topswad_aero_s2, solswad_aero_s2, &
209	topswai_aero_s2, solswai_aero_s2, &
210	topswad0_aero_s2, solswad0_aero_s2, &
211	topsw_aero_s2, topsw0_aero_s2, &
212	solsw_aero_s2, solsw0_aero_s2, &
213	topswcf_aero_s2, solswcf_aero_s2, &
214	!LW diagnostics
215	toplwad_aero_s2, sollwad_aero_s2, &
216	toplwai_aero_s2, sollwai_aero_s2, &
217	toplwad0_aero_s2, sollwad0_aero_s2, &
218	!
219	topsw_aero,solsw_aero, &
220	topsw0_aero,solsw0_aero, &
221	topswcf_aero,solswcf_aero, &
222	tausum_aero,tau3d_aero, &
223	drytausum_aero, &
224	!
225	!variables CFMIP2/CMIP5
226	topswad_aerop, solswad_aerop, &
227	topswai_aerop, solswai_aerop, &
228	topswad0_aerop, solswad0_aerop, &
229	topsw_aerop, topsw0_aerop, &
230	solsw_aerop, solsw0_aerop, &
231	topswcf_aerop, solswcf_aerop, &
232	!LW diagnostics
233	toplwad_aerop, sollwad_aerop, &
234	toplwai_aerop, sollwai_aerop, &
235	toplwad0_aerop, sollwad0_aerop, &
236	!pour Ecrad
237	topswad_aero_s2, solswad_aero_s2, &
238	topswai_aero_s2, solswai_aero_s2, &
239	topswad0_aero_s2, solswad0_aero_s2, &
240	topsw_aero_s2, topsw0_aero_s2, &
241	solsw_aero_s2, solsw0_aero_s2, &
242	topswcf_aero_s2, solswcf_aero_s2, &
243	!LW diagnostics
244	toplwad_aero_s2, sollwad_aero_s2, &
245	toplwai_aero_s2, sollwai_aero_s2, &
246	toplwad0_aero_s2, sollwad0_aero_s2, &
247	!
248	ptstar, pt0, slp, &
249	!
250	bils, &
251	!
252	cldh, cldl,cldm, cldq, cldt, &
253	JrNt, &
254	dthmin, evap, snowerosion, icesub_lic, fder, plcl, plfc, &
255	prw, prlw, prsw, prbsw, water_budget, &
256	s_lcl, s_pblh, s_pblt, s_therm, &
257	cdragm, cdragh, &
258	zustar, zu10m, zv10m, rh2m, qsat2m, &
259	zq2m, zt2m, zn2mout, weak_inversion, &
260	!
261	s_pblh_x, s_pblh_w, &
262	s_lcl_x, s_lcl_w, &
263	!
264	slab_wfbils, tpot, tpote, &
265	ue, uq, ve, vq, zxffonte, &
266	uwat, vwat, &
267	zxfqcalving, zxfluxlat, &
268	zxrunofflic, &
269	zxtsol, snow_lsc, zxfqfonte, zxqsurf, &
270	delta_qsurf, &
271	rain_lsc, rain_num, &
272	!
273	sens_x, sens_w, &
274	zxfluxlat_x, zxfluxlat_w, &
275	!
276	pbl_tke_input, pbl_eps, l_mix, wprime,&
277	t_therm, q_therm, u_therm, v_therm, &
278	cdragh_x, cdragh_w, &
279	cdragm_x, cdragm_w, &
280	kh, kh_x, kh_w, &
281	!
282	wake_k, &
283	alp_wake, &
284	wake_h, wake_omg, &
285	! tendencies of delta T and delta q:
286	d_deltat_wk, d_deltaq_wk, & ! due to wakes
287	d_deltat_wk_gw, d_deltaq_wk_gw, & ! due to wake induced gravity waves
288	d_deltat_vdf, d_deltaq_vdf, & ! due to vertical diffusion
289	d_deltat_the, d_deltaq_the, & ! due to thermals
290	d_deltat_ajs_cv, d_deltaq_ajs_cv, & ! due to dry adjustment of (w) before convection
291	! tendencies of wake fractional area and wake number per unit area:
292	d_s_wk, d_s_a_wk, d_dens_wk, d_dens_a_wk, & ! due to wakes
293	!!! d_s_vdf, d_dens_a_vdf, d_dens_vdf, & ! due to vertical diffusion
294	!!! d_s_the, d_dens_a_the, d_dens_the, & ! due to thermals
295	!
296	ptconv, ratqsc, &
297	wbeff, convoccur, zmax_th, &
298	sens, flwp, fiwp, &
299	alp_bl_conv,alp_bl_det, &
300	alp_bl_fluct_m,alp_bl_fluct_tke, &
301	alp_bl_stat, n2, s2, strig, zcong, zlcl_th, &
302	proba_notrig, random_notrig, &
303	!! cv_gen, & !moved to phys_state_var_mod
304	!
305	dnwd0, &
306	omega, &
307	epmax_diag, &
308	! Deep convective variables used in phytrac
309	pmflxr, pmflxs, &
310	coef_clos, coef_clos_eff, &
311	wdtrainA, wdtrainS, wdtrainM, wdtrainAS, &
312	upwd, dnwd, &
313	ep, &
314	da, mp, &
315	phi, &
316	wght_cvfd, &
317	phi2, &
318	d1a, dam, &
319	ev, &
320	elij, &
321	qtaa, &
322	clw, &
323	epmlmMm, eplaMm, &
324	sij, &
325	!
326	rneblsvol, &
327	pfraclr, pfracld, &
328	cldfraliq, sigma2_icefracturb, mean_icefracturb, &
329	cldfraliqth, sigma2_icefracturbth, mean_icefracturbth, &
330	distcltop, temp_cltop, &
331	!-- LSCP - condensation and ice supersaturation variables
332	qsub, qissr, qcld, subfra, issrfra, gamma_cond, &
333	ql_seri_lscp, ratio_ql_qtot, qi_seri_lscp, ratio_qi_qtot, &
334	dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
335	dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, &
336	!-- LSCP - aviation and contrails variables
337	Tcontr, qcontr, qcontr2, fcontrN, fcontrP, &
338	dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, &
339	!
340	cldemi, &
341	cldfra, cldtau, fiwc, &
342	fl, re, flwc, &
343	ref_liq, ref_ice, theta, &
344	ref_liq_pi, ref_ice_pi, &
345	zphi, zx_rh, zx_rhl, zx_rhi, &
346	pmfd, pmfu, &
347	!
348	t2m, fluxlat, &
349	fsollw, evap_pot, &
350	fsolsw, wfbils, wfevap, &
351	prfl, psfl,bsfl, fraca, Vprecip, &
352	zw2, &
353	!
354	fluxu, fluxv, &
355	fluxt, &
356	!
357	uwriteSTD, vwriteSTD, & !pour calcul_STDlev.h
358	wwriteSTD, phiwriteSTD, & !pour calcul_STDlev.h
359	qwriteSTD, twriteSTD, rhwriteSTD, & !pour calcul_STDlev.h
360	!
361	beta_prec, &
362	rneb, &
363	zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic, &
364	!GG zxfluxt,zxfluxq
365	zxfluxt,zxfluxq, &
366	fcds, fcdi, dh_basal_growth, dh_basal_melt, &
367	dh_top_melt, dh_snow2sic, &
368	dtice_melt, dtice_snow2sic
369	!GG
370	!
371	USE phys_local_var_mod, ONLY: zfice, dNovrN, ptconv
372	USE phys_output_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
373	reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra
374	USE output_physiqex_mod, ONLY: output_physiqex
375	USE yomcst_mod_h
376	USE clesphys_mod_h
377	USE conema3_mod_h
378	USE alpale_mod
379	USE yoethf_mod_h
380	USE calcul_divers_mod_h, ONLY: calcul_divers
381	USE compbl_mod_h
382	USE nuage_params_mod_h
383	USE dimpft_mod_h, ONLY: nvm_lmdz
384	USE radepsi_mod_h
385	USE radopt_mod_h
386	USE regdim_mod_h
387	USE phys_output_write_spl_mod, ONLY: phys_output_write_spl
388	USE phytracr_spl_mod, ONLY: phytracr_spl_out_init, phytracr_spl
389	USE s2s, ONLY : s2s_initialize
390	IMPLICIT NONE
391	!>======================================================================
392	!!
393	!! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
394	!!
395	!! Objet: Moniteur general de la physique du modele
396	!!AA Modifications quant aux traceurs :
397	!!AA - uniformisation des parametrisations ds phytrac
398	!!AA - stockage des moyennes des champs necessaires
399	!!AA en mode traceur off-line
400	!!======================================================================
401	!! CLEFS CPP POUR LES IO
402	!! =====================
403	#define histNMC
404	!!======================================================================
405	!! modif ( P. Le Van , 12/10/98 )
406	!!
407	!! Arguments:
408	!!
409	!! nlon----input-I-nombre de points horizontaux
410	!! nlev----input-I-nombre de couches verticales, doit etre egale a klev
411	!! debut---input-L-variable logique indiquant le premier passage
412	!! lafin---input-L-variable logique indiquant le dernier passage
413	!! jD_cur -R-jour courant a l'appel de la physique (jour julien)
414	!! jH_cur -R-heure courante a l'appel de la physique (jour julien)
415	!! pdtphys-input-R-pas d'integration pour la physique (seconde)
416	!! paprs---input-R-pression pour chaque inter-couche (en Pa)
417	!! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
418	!! pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
419	!! pphis---input-R-geopotentiel du sol
420	!! presnivs-input_R_pressions approximat. des milieux couches ( en PA)
421	!! u-------input-R-vitesse dans la direction X (de O a E) en m/s
422	!! v-------input-R-vitesse Y (de S a N) en m/s
423	!! t-------input-R-temperature (K)
424	!! qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
425	!! d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
426	!! d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
427	!! d_ql_dyn-input-R-tendance dynamique pour "ql" (kg/kg/s)
428	!! d_qs_dyn-input-R-tendance dynamique pour "qs" (kg/kg/s)
429	!! flxmass_w -input-R- flux de masse verticale
430	!! d_u-----output-R-tendance physique de "u" (m/s/s)
431	!! d_v-----output-R-tendance physique de "v" (m/s/s)
432	!! d_t-----output-R-tendance physique de "t" (K/s)
433	!! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
434	!! d_ps----output-R-tendance physique de la pression au sol
435	!!======================================================================
436	integer jjmp1
437	! parameter (jjmp1=jjm+1-1/jjm) ! => (jjmp1=nbp_lat-1/(nbp_lat-1))
438	! integer iip1
439	! parameter (iip1=iim+1)
440
441	!======================================================================
442	LOGICAL, SAVE :: ok_volcan ! pour activer les diagnostics volcaniques
443	!$OMP THREADPRIVATE(ok_volcan)
444	INTEGER, SAVE :: flag_volc_surfstrat ! pour imposer le cool/heat rate à la surf/strato
445	!$OMP THREADPRIVATE(flag_volc_surfstrat)
446	LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
447	PARAMETER (ok_cvl=.TRUE.)
448	LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
449	PARAMETER (ok_gust=.FALSE.)
450	INTEGER, SAVE :: iflag_radia ! active ou non le rayonnement (MPL)
451	!$OMP THREADPRIVATE(iflag_radia)
452	!======================================================================
453	LOGICAL check ! Verifier la conservation du modele en eau
454	PARAMETER (check=.FALSE.)
455	LOGICAL ok_stratus ! Ajouter artificiellement les stratus
456	PARAMETER (ok_stratus=.FALSE.)
457	!======================================================================
458	REAL amn, amx
459	INTEGER igout
460	!======================================================================
461	! Clef iflag_cycle_diurne controlant l'activation du cycle diurne:
462	! en attente du codage des cles par Fred
463	! iflag_cycle_diurne est initialise par conf_phys et se trouve
464	! dans clesphys.h (IM)
465	!======================================================================
466	! Modele thermique du sol, a activer pour le cycle diurne:
467	!cc LOGICAL soil_model
468	!cc PARAMETER (soil_model=.FALSE.)
469	!======================================================================
470	! Clefs controlant deux parametrisations de l'orographie:
471	!c LOGICAL ok_orodr
472	!cc PARAMETER (ok_orodr=.FALSE.)
473	!cc LOGICAL ok_orolf
474	!cc PARAMETER (ok_orolf=.FALSE.)
475	!======================================================================
476	LOGICAL ok_journe ! sortir le fichier journalier
477	SAVE ok_journe
478	!$OMP THREADPRIVATE(ok_journe)
479	!
480	LOGICAL ok_mensuel ! sortir le fichier mensuel
481	SAVE ok_mensuel
482	!$OMP THREADPRIVATE(ok_mensuel)
483	!
484	LOGICAL ok_instan ! sortir le fichier instantane
485	SAVE ok_instan
486	!$OMP THREADPRIVATE(ok_instan)
487	!
488	LOGICAL ok_LES ! sortir le fichier LES
489	SAVE ok_LES
490	!$OMP THREADPRIVATE(ok_LES)
491	!
492	LOGICAL callstats ! sortir le fichier stats
493	SAVE callstats
494	!$OMP THREADPRIVATE(callstats)
495	!
496	LOGICAL ok_region ! sortir le fichier regional
497	PARAMETER (ok_region=.FALSE.)
498	!======================================================================
499	REAL seuil_inversion
500	SAVE seuil_inversion
501	!$OMP THREADPRIVATE(seuil_inversion)
502
503
504
505	real facteur
506
507	REAL wmax_th(klon)
508	REAL tau_overturning_th(klon)
509
510	INTEGER lmax_th(klon)
511	INTEGER limbas(klon)
512	REAL ratqscth(klon,klev)
513	REAL ratqsdiff(klon,klev)
514	REAL zqsatth(klon,klev)
515
516	!======================================================================
517	!
518	!
519	! Variables argument:
520	!
521	INTEGER nlon
522	INTEGER nlev
523	REAL,INTENT(IN) :: pdtphys_
524	! NB: pdtphys to be used in physics is in time_phylmdz_mod
525	LOGICAL debut, lafin
526	REAL paprs(klon,klev+1)
527	REAL pplay(klon,klev)
528	REAL pphi(klon,klev)
529	REAL pphis(klon)
530	REAL presnivs(klev)
531	!JLD REAL znivsig(klev)
532	!JLD real pir
533
534	REAL u(klon,klev)
535	REAL v(klon,klev)
536
537	REAL, intent(in):: rot(klon, klev)
538	! relative vorticity, in s-1, needed for frontal waves
539
540	REAL t(klon,klev),thetal(klon,klev)
541	! thetal: ligne suivante a decommenter si vous avez les fichiers
542	! MPL 20130625
543	! fth_fonctions.F90 et parkind1.F90
544	! sinon thetal=theta
545	! REAL fth_thetae,fth_thetav,fth_thetal
546	REAL qx(klon,klev,nqtot)
547	REAL flxmass_w(klon,klev)
548	REAL d_u(klon,klev)
549	REAL d_v(klon,klev)
550	REAL d_t(klon,klev)
551	REAL d_qx(klon,klev,nqtot)
552	REAL d_ps(klon)
553	! variables pour tend_to_tke
554	REAL duadd(klon,klev)
555	REAL dvadd(klon,klev)
556	REAL dtadd(klon,klev)
557
558	!! Variables moved to phys_local_var_mod
559	!! ! Variables pour le transport convectif
560	!! real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
561	!! real wght_cvfd(klon,klev)
562	!! ! Variables pour le lessivage convectif
563	!! ! RomP >>>
564	!! real phi2(klon,klev,klev)
565	!! real d1a(klon,klev),dam(klon,klev)
566	!! real ev(klon,klev)
567	!! real clw(klon,klev),elij(klon,klev,klev)
568	!! real epmlmMm(klon,klev,klev),eplaMm(klon,klev)
569	!! ! RomP <<<
570	!IM definition dynamique o_trac dans phys_output_open
571	! type(ctrl_out) :: o_trac(nqtot)
572
573	! variables a une pression donnee
574	!
575	include "declare_STDlev.h"
576
577	INTEGER n
578	!ym INTEGER npoints
579	!ym PARAMETER(npoints=klon)
580	!
581	INTEGER nregISCtot
582	PARAMETER(nregISCtot=1)
583	!
584	! imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties
585	! sur 1 region rectangulaire y compris pour 1 point
586	! imin_debut : indice minimum de i; nbpti : nombre de points en
587	! direction i (longitude)
588	! jmin_debut : indice minimum de j; nbptj : nombre de points en
589	! direction j (latitude)
590	!JLD INTEGER imin_debut, nbpti
591	!JLD INTEGER jmin_debut, nbptj
592	!IM: region='3d' <==> sorties en global
593	CHARACTER*3 region
594	PARAMETER(region='3d')
595	LOGICAL ok_hf
596	!
597	SAVE ok_hf
598	!$OMP THREADPRIVATE(ok_hf)
599
600	INTEGER, PARAMETER :: longcles=20
601	REAL, SAVE :: clesphy0(longcles)
602	!$OMP THREADPRIVATE(clesphy0)
603	!
604	! Variables propres a la physique
605	INTEGER, SAVE :: itap ! compteur pour la physique
606	!$OMP THREADPRIVATE(itap)
607
608	INTEGER, SAVE :: abortphy=0 ! Reprere si on doit arreter en fin de phys
609	!$OMP THREADPRIVATE(abortphy)
610	!
611	REAL,SAVE :: solarlong0
612	!$OMP THREADPRIVATE(solarlong0)
613
614	!
615	! Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
616	!
617	!IM 141004 REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
618	REAL zulow(klon),zvlow(klon)
619	!
620	INTEGER igwd,idx(klon),itest(klon)
621	!
622	! REAL,allocatable,save :: run_off_lic_0(:)
623	! !$OMP THREADPRIVATE(run_off_lic_0)
624	!ym SAVE run_off_lic_0
625	!KE43
626	! Variables liees a la convection de K. Emanuel (sb):
627	!
628	REAL, SAVE :: bas, top ! cloud base and top levels
629	!$OMP THREADPRIVATE(bas, top)
630	!------------------------------------------------------------------
631	! Upmost level reached by deep convection and related variable (jyg)
632	!
633	! INTEGER izero
634	INTEGER k_upper_cv
635	!------------------------------------------------------------------
636	! Compteur de l'occurence de cvpas=1
637	INTEGER Ncvpaseq1
638	SAVE Ncvpaseq1
639	!$OMP THREADPRIVATE(Ncvpaseq1)
640	!
641	!==========================================================================
642	!CR04.12.07: on ajoute les nouvelles variables du nouveau schema
643	!de convection avec poches froides
644	! Variables li\'ees \`a la poche froide (jyg)
645
646	!! REAL mipsh(klon,klev) ! mass flux shed by the adiab ascent at each level
647	!! Moved to phys_state_var_mod
648	!
649	REAL wape_prescr, fip_prescr
650	INTEGER it_wape_prescr
651	SAVE wape_prescr, fip_prescr, it_wape_prescr
652	!$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr)
653	!
654	! variables supplementaires de concvl
655	REAL Tconv(klon,klev)
656	!! variable moved to phys_local_var_mod
657	!! REAL sij(klon,klev,klev)
658	!! !
659	!! ! variables pour tester la conservation de l'energie dans concvl
660	!! REAL, DIMENSION(klon,klev) :: d_t_con_sat
661	!! REAL, DIMENSION(klon,klev) :: d_q_con_sat
662	!! REAL, DIMENSION(klon,klev) :: dql_sat
663
664	REAL, SAVE :: alp_bl_prescr=0.
665	REAL, SAVE :: ale_bl_prescr=0.
666	REAL, SAVE :: wake_s_min_lsp=0.1
667	!$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)
668	!$OMP THREADPRIVATE(wake_s_min_lsp)
669
670	REAL ok_wk_lsp(klon)
671
672	!RC
673	! Variables li\'ees \`a la poche froide (jyg et rr)
674
675	INTEGER, SAVE :: iflag_wake_tend ! wake: if =0, then wake state variables are
676	! updated within calwake
677	!$OMP THREADPRIVATE(iflag_wake_tend)
678	INTEGER, SAVE :: iflag_alp_wk_cond=0 ! wake: if =0, then Alp_wk is the average lifting
679	! power provided by the wakes; else, Alp_wk is the
680	! lifting power conditionned on the presence of a
681	! gust-front in the grid cell.
682	!$OMP THREADPRIVATE(iflag_alp_wk_cond)
683
684	REAL t_w(klon,klev),q_w(klon,klev) ! temperature and moisture profiles in the wake region
685	REAL t_x(klon,klev),q_x(klon,klev) ! temperature and moisture profiles in the off-wake region
686
687	REAL wake_dth(klon,klev) ! wake : temp pot difference
688
689	REAL wake_omgbdth(klon,klev) ! Wake : flux of Delta_Theta
690	! transported by LS omega
691	REAL wake_dp_omgb(klon,klev) ! Wake : vertical gradient of
692	! large scale omega
693	REAL wake_dtKE(klon,klev) ! Wake : differential heating
694	! (wake - unpertubed) CONV
695	REAL wake_dqKE(klon,klev) ! Wake : differential moistening
696	! (wake - unpertubed) CONV
697	REAL wake_dp_deltomg(klon,klev) ! Wake : gradient vertical de wake_omg
698	REAL wake_spread(klon,klev) ! spreading term in wake_delt
699	!
700	!pourquoi y'a pas de save??
701	!
702	!!! INTEGER, SAVE, DIMENSION(klon) :: wake_k
703	!!! !$OMP THREADPRIVATE(wake_k)
704	!
705	!jyg<
706	!cc REAL wake_pe(klon) ! Wake potential energy - WAPE
707	!>jyg
708
709	REAL wake_fip_0(klon) ! Average Front Incoming Power (unconditionned)
710	REAL wake_gfl(klon) ! Gust Front Length
711	!!! REAL wake_dens(klon) ! moved to phys_state_var_mod
712	!
713	!
714	REAL dt_dwn(klon,klev)
715	REAL dq_dwn(klon,klev)
716	REAL M_dwn(klon,klev)
717	REAL M_up(klon,klev)
718	REAL dt_a(klon,klev)
719	REAL dq_a(klon,klev)
720	REAL d_t_adjwk(klon,klev) !jyg
721	REAL d_q_adjwk(klon,klev) !jyg
722	LOGICAL,SAVE :: ok_adjwk=.FALSE.
723	!$OMP THREADPRIVATE(ok_adjwk)
724	INTEGER,SAVE :: iflag_adjwk=0 !jyg
725	!$OMP THREADPRIVATE(iflag_adjwk) !jyg
726	REAL,SAVE :: oliqmax=999.,oicemax=999.
727	!$OMP THREADPRIVATE(oliqmax,oicemax)
728	REAL, SAVE :: alp_offset
729	!$OMP THREADPRIVATE(alp_offset)
730	REAL, SAVE :: dtcon_multistep_max=1.e6
731	!$OMP THREADPRIVATE(dtcon_multistep_max)
732	REAL, SAVE :: dqcon_multistep_max=1.e6
733	!$OMP THREADPRIVATE(dqcon_multistep_max)
734
735
736	!
737	!RR:fin declarations poches froides
738	!==========================================================================
739
740	REAL ztv(klon,klev),ztva(klon,klev)
741	REAL zpspsk(klon,klev)
742	REAL ztla(klon,klev),zqla(klon,klev)
743	REAL zthl(klon,klev)
744
745	!cc nrlmd le 10/04/2012
746
747	!--------Stochastic Boundary Layer Triggering: ALE_BL--------
748	!---Propri\'et\'es du thermiques au LCL
749	! real zlcl_th(klon) ! Altitude du LCL calcul\'e
750	! continument (pcon dans
751	! thermcell_main.F90)
752	real fraca0(klon) ! Fraction des thermiques au LCL
753	real w0(klon) ! Vitesse des thermiques au LCL
754	real w_conv(klon) ! Vitesse verticale de grande \'echelle au LCL
755	real tke0(klon,klev+1) ! TKE au d\'ebut du pas de temps
756	real therm_tke_max0(klon) ! TKE dans les thermiques au LCL
757	real env_tke_max0(klon) ! TKE dans l'environnement au LCL
758	INTEGER, SAVE :: iflag_thermcell_tke ! transtport TKE by thermals
759	!$OMP THREADPRIVATE(iflag_thermcell_tke)
760
761	!JLD !---D\'eclenchement stochastique
762	!JLD integer :: tau_trig(klon)
763
764	REAL,SAVE :: random_notrig_max=1.
765	!$OMP THREADPRIVATE(random_notrig_max)
766
767	!--------Statistical Boundary Layer Closure: ALP_BL--------
768	!---Profils de TKE dans et hors du thermique
769	real therm_tke_max(klon,klev) ! Profil de TKE dans les thermiques
770	real env_tke_max(klon,klev) ! Profil de TKE dans l'environnement
771
772	!-------Activer les tendances de TKE due a l'orograp??ie---------
773	INTEGER, SAVE :: addtkeoro
774	!$OMP THREADPRIVATE(addtkeoro)
775	REAL, SAVE :: alphatkeoro
776	!$OMP THREADPRIVATE(alphatkeoro)
777	LOGICAL, SAVE :: smallscales_tkeoro
778	!$OMP THREADPRIVATE(smallscales_tkeoro)
779
780
781
782	!cc fin nrlmd le 10/04/2012
783
784	! Variables locales pour la couche limite (al1):
785	!
786	!Al1 REAL pblh(klon) ! Hauteur de couche limite
787	!Al1 SAVE pblh
788	!34EK
789	!
790	! Variables locales:
791	!
792	!AA
793	!AA Pour phytrac
794	REAL u1(klon) ! vents dans la premiere couche U
795	REAL v1(klon) ! vents dans la premiere couche V
796
797	!@$$ LOGICAL offline ! Controle du stockage ds "physique"
798	!@$$ PARAMETER (offline=.false.)
799	!@$$ INTEGER physid
800	REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
801	REAL frac_nucl(klon,klev) ! idem (nucleation)
802	! RomP >>>
803	REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
804	! RomP <<<
805
806	!IM cf FH pour Tiedtke 080604
807	REAL rain_tiedtke(klon),snow_tiedtke(klon)
808	!
809	!IM 050204 END
810	REAL devap(klon) ! evaporation et sa derivee
811	REAL dsens(klon) ! chaleur sensible et sa derivee
812
813	!
814	! Conditions aux limites
815	!
816	!
817	REAL :: day_since_equinox
818	! Date de l'equinoxe de printemps
819	INTEGER, parameter :: mth_eq=3, day_eq=21
820	REAL :: jD_eq
821
822	LOGICAL, parameter :: new_orbit = .TRUE.
823
824	!
825	INTEGER lmt_pas
826	SAVE lmt_pas ! frequence de mise a jour
827	!$OMP THREADPRIVATE(lmt_pas)
828	real zmasse(klon, nbp_lev),exner(klon, nbp_lev)
829	! (column-density of mass of air in a cell, in kg m-2)
830	real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
831
832	!IM sorties
833	REAL un_jour
834	PARAMETER(un_jour=86400.)
835	INTEGER itapm1 !pas de temps de la physique du(es) mois precedents
836	SAVE itapm1 !mis a jour le dernier pas de temps du mois en cours
837	!$OMP THREADPRIVATE(itapm1)
838	!======================================================================
839	!
840	! Declaration des procedures appelees
841	!
842	EXTERNAL angle ! calculer angle zenithal du soleil
843	EXTERNAL alboc ! calculer l'albedo sur ocean
844	EXTERNAL ajsec ! ajustement sec
845	EXTERNAL conlmd ! convection (schema LMD)
846	EXTERNAL conema3 ! convect4.3
847	EXTERNAL hgardfou ! verifier les temperatures
848	EXTERNAL nuage ! calculer les proprietes radiatives
849	!C EXTERNAL o3cm ! initialiser l'ozone
850	EXTERNAL orbite ! calculer l'orbite terrestre
851	EXTERNAL phyredem ! ecrire l'etat de redemarrage de la physique
852	EXTERNAL suphel ! initialiser certaines constantes
853	EXTERNAL transp ! transport total de l'eau et de l'energie
854	!IM
855	EXTERNAL haut2bas !variables de haut en bas
856	EXTERNAL ini_undefSTD !initialise a 0 une variable a 1 niveau de pression
857	EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression
858	! EXTERNAL moy_undefSTD !moyenne d'1 var a 1 niveau de pression
859	! EXTERNAL moyglo_aire
860	! moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire)
861	! par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass)
862	!
863	!
864	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
865	! Local variables
866	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
867	!
868	! REAL rhcl(klon,klev) ! humiditi relative ciel clair
869	REAL dialiq(klon,klev) ! eau liquide nuageuse
870	REAL diafra(klon,klev) ! fraction nuageuse
871	REAL radocond(klon,klev) ! eau condensee nuageuse
872	!
873	!XXX PB
874	REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite
875	REAL fluxqbs(klon,klev, nbsrf) ! flux turbulent de neige soufflee
876	!
877	!FC REAL zxfluxt(klon, klev)
878	!FC REAL zxfluxq(klon, klev)
879	REAL zxfluxqbs(klon,klev)
880	REAL zxfluxu(klon, klev)
881	REAL zxfluxv(klon, klev)
882
883	! Le rayonnement n'est pas calcule tous les pas, il faut donc
884	! sauvegarder les sorties du rayonnement
885	!ym SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
886	!ym SAVE sollwdownclr, toplwdown, toplwdownclr
887	!ym SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0
888	!
889	INTEGER itaprad
890	SAVE itaprad
891	!$OMP THREADPRIVATE(itaprad)
892	!
893	REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
894	REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
895	!
896	REAL zsav_tsol(klon)
897	!
898	REAL dist, rmu0(klon), fract(klon)
899	REAL zrmu0(klon), zfract(klon)
900	REAL zdtime, zdtime1, zdtime2, zlongi
901	!
902	REAL z_avant(klon), z_apres(klon), z_factor(klon)
903	LOGICAL zx_ajustq
904	!
905	REAL za
906	REAL zx_t, zx_qs, zdelta, zcor
907	real zqsat(klon,klev)
908	!
909	INTEGER i, k, iq, nsrf, l, itr
910	!
911	REAL t_coup
912	PARAMETER (t_coup=234.0)
913
914	!ym A voir plus tard !!
915	!ym REAL zx_relief(iim,jjmp1)
916	!ym REAL zx_aire(iim,jjmp1)
917	!
918	! Grandeurs de sorties
919	REAL s_capCL(klon)
920	REAL s_oliqCL(klon), s_cteiCL(klon)
921	REAL s_trmb1(klon), s_trmb2(klon)
922	REAL s_trmb3(klon)
923
924	! La convection n'est pas calculee tous les pas, il faut donc
925	! sauvegarder les sorties de la convection
926	!ym SAVE
927	!ym SAVE
928	!ym SAVE
929	!
930	INTEGER itapcv, itapwk
931	SAVE itapcv, itapwk
932	!$OMP THREADPRIVATE(itapcv, itapwk)
933
934	!KE43
935	! Variables locales pour la convection de K. Emanuel (sb):
936
937	REAL tvp(klon,klev) ! virtual temp of lifted parcel
938	CHARACTER*40 capemaxcels !max(CAPE)
939
940	REAL rflag(klon) ! flag fonctionnement de convect
941	INTEGER iflagctrl(klon) ! flag fonctionnement de convect
942
943	! -- convect43:
944	INTEGER ntra ! nb traceurs pour convect4.3
945	REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
946	REAL dplcldt(klon), dplcldr(klon)
947	!? . condm_con(klon,klev),conda_con(klon,klev),
948	!? . mr_con(klon,klev),ep_con(klon,klev)
949	!? . ,sadiab(klon,klev),wadiab(klon,klev)
950	! --
951	!34EK
952	!
953	! Variables du changement
954	!
955	! con: convection
956	! lsc: condensation a grande echelle (Large-Scale-Condensation)
957	! ajs: ajustement sec
958	! eva: evaporation de l'eau liquide nuageuse
959	! vdf: couche limite (Vertical DiFfusion)
960	!
961	! tendance nulles
962	REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0
963	REAL, dimension(klon) :: dsig0, ddens0
964	INTEGER, dimension(klon) :: wkoccur1
965	! tendance buffer pour appel de add_phys_tend
966	REAL, DIMENSION(klon,klev) :: d_q_ch4_dtime
967	!
968	! Flag pour pouvoir ne pas ajouter les tendances.
969	! Par defaut, les tendances doivente etre ajoutees et
970	! flag_inhib_tend = 0
971	! flag_inhib_tend > 0 : tendances non ajoutees, avec un nombre
972	! croissant de print quand la valeur du flag augmente
973	!!! attention, ce flag doit etre change avec prudence !!!
974	INTEGER :: flag_inhib_tend = 0 ! 0 is the default value
975	!! INTEGER :: flag_inhib_tend = 2
976	!
977	! Logical switch to a bug : reseting to 0 convective variables at the
978	! begining of physiq.
979	LOGICAL, SAVE :: ok_bug_cv_trac = .TRUE.
980	!$OMP THREADPRIVATE(ok_bug_cv_trac)
981	!
982	! Logical switch to a bug : changing wake_deltat when thermals are active
983	! even when there are no wakes.
984	LOGICAL, SAVE :: ok_bug_split_th = .TRUE.
985	!$OMP THREADPRIVATE(ok_bug_split_th)
986
987	! Logical switch to a bug : modifying directly wake_deltat by adding
988	! the (w) dry adjustment tendency to wake_deltat
989	LOGICAL, SAVE :: ok_bug_ajs_cv = .TRUE.
990	!$OMP THREADPRIVATE(ok_bug_ajs_cv)
991
992	!
993	!********************************************************
994	! declarations
995
996	!********************************************************
997	!IM 081204 END
998	!
999	REAL pen_u(klon,klev), pen_d(klon,klev)
1000	REAL pde_u(klon,klev), pde_d(klon,klev)
1001	INTEGER kcbot(klon), kctop(klon), kdtop(klon)
1002	!
1003	REAL ratqsbas,ratqshaut,tau_ratqs
1004	SAVE ratqsbas,ratqshaut,tau_ratqs
1005	!$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs)
1006	REAL, SAVE :: ratqsp0=50000., ratqsdp=20000.
1007	!$OMP THREADPRIVATE(ratqsp0, ratqsdp)
1008
1009	! Parametres lies au nouveau schema de nuages (SB, PDF)
1010	REAL, SAVE :: fact_cldcon
1011	REAL, SAVE :: facttemps
1012	!$OMP THREADPRIVATE(fact_cldcon,facttemps)
1013	LOGICAL, SAVE :: ok_newmicro
1014	!$OMP THREADPRIVATE(ok_newmicro)
1015
1016	INTEGER, SAVE :: iflag_cld_th
1017	!$OMP THREADPRIVATE(iflag_cld_th)
1018	!IM logical ptconv(klon,klev) !passe dans phys_local_var_mod
1019	!IM cf. AM 081204 BEG
1020	LOGICAL ptconvth(klon,klev)
1021
1022	REAL picefra(klon,klev)
1023	REAL nm_oro(klon)
1024	!IM cf. AM 081204 END
1025	!
1026	! Variables liees a l'ecriture de la bande histoire physique
1027	!
1028	!======================================================================
1029	!
1030	!
1031	!JLD integer itau_w ! pas de temps ecriture = itap + itau_phy
1032	!
1033	!
1034	! Variables locales pour effectuer les appels en serie
1035	!
1036	!IM RH a 2m (la surface)
1037	REAL Lheat
1038
1039	INTEGER length
1040	PARAMETER ( length = 100 )
1041	REAL tabcntr0( length )
1042	!
1043	!JLD INTEGER ndex2d(nbp_lon*nbp_lat)
1044	!IM
1045	!
1046	!IM AMIP2 BEG
1047	!JLD REAL moyglo, mountor
1048	!IM 141004 BEG
1049	REAL zustrdr(klon), zvstrdr(klon)
1050	REAL zustrli(klon), zvstrli(klon)
1051	REAL zustrph(klon), zvstrph(klon)
1052	REAL aam, torsfc
1053	!IM 141004 END
1054	!IM 190504 BEG
1055	! INTEGER imp1jmp1
1056	! PARAMETER(imp1jmp1=(iim+1)*jjmp1)
1057	!ym A voir plus tard
1058	! REAL zx_tmp((nbp_lon+1)*nbp_lat)
1059	! REAL airedyn(nbp_lon+1,nbp_lat)
1060	!IM 190504 END
1061	!JLD LOGICAL ok_msk
1062	!JLD REAL msk(klon)
1063	!ym A voir plus tard
1064	!ym REAL zm_wo(jjmp1, klev)
1065	!IM AMIP2 END
1066	!
1067	REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
1068	REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
1069	!JLD REAL zx_tmp_2d(nbp_lon,nbp_lat)
1070	!JLD REAL zx_lon(nbp_lon,nbp_lat)
1071	!JLD REAL zx_lat(nbp_lon,nbp_lat)
1072	!
1073	INTEGER nid_ctesGCM
1074	SAVE nid_ctesGCM
1075	!$OMP THREADPRIVATE(nid_ctesGCM)
1076	!
1077	!IM 280405 BEG
1078	! INTEGER nid_bilKPins, nid_bilKPave
1079	! SAVE nid_bilKPins, nid_bilKPave
1080	! !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)
1081	!
1082	REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert.
1083	REAL vq_lay(klon,klev) ! transport meri. de l'eau a chaque niveau vert.
1084	REAL ue_lay(klon,klev) ! transport zonal de l'energie a chaque niveau vert.
1085	REAL uq_lay(klon,klev) ! transport zonal de l'eau a chaque niveau vert.
1086	!
1087	!JLD REAL zjulian
1088	!JLD SAVE zjulian
1089	!JLD!$OMP THREADPRIVATE(zjulian)
1090
1091	!JLD INTEGER nhori, nvert
1092	!JLD REAL zsto
1093	!JLD REAL zstophy, zout
1094
1095	CHARACTER (LEN=20) :: modname='physiq_mod'
1096	CHARACTER*80 abort_message
1097	LOGICAL, SAVE :: ok_sync, ok_sync_omp
1098	!$OMP THREADPRIVATE(ok_sync)
1099	! ok_sync_omp should not be in a THREADPRIVATE statement
1100	REAL date0
1101
1102	! essai writephys
1103	INTEGER fid_day, fid_mth, fid_ins
1104	PARAMETER (fid_ins = 1, fid_day = 2, fid_mth = 3)
1105	INTEGER prof2d_on, prof3d_on, prof2d_av, prof3d_av
1106	PARAMETER (prof2d_on = 1, prof3d_on = 2, prof2d_av = 3, prof3d_av = 4)
1107	REAL ztsol(klon)
1108	REAL q2m(klon,nbsrf) ! humidite a 2m
1109	REAL qbsfra ! blowing snow fraction
1110	!IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
1111	CHARACTER*40 t2mincels, t2maxcels !t2m min., t2m max
1112	CHARACTER*40 tinst, tave
1113	REAL cldtaupi(klon,klev) ! Cloud optical thickness for
1114	! pre-industrial (pi) aerosols
1115
1116	INTEGER :: naero
1117	! Aerosol optical properties
1118	CHARACTER*4, DIMENSION(naero_grp) :: rfname
1119	REAL, DIMENSION(klon,klev) :: mass_solu_aero ! total mass
1120	! concentration
1121	! for all soluble
1122	! aerosols[ug/m3]
1123	REAL, DIMENSION(klon,klev) :: mass_solu_aero_pi
1124	! - " - (pre-industrial value)
1125	REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
1126
1127	! Parameters
1128	LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not
1129	LOGICAL ok_alw ! Apply aerosol LW effect or not
1130	LOGICAL ok_cdnc ! ok cloud droplet number concentration (O. Boucher 01-2013)
1131	REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
1132	SAVE ok_ade, ok_aie, ok_alw, ok_cdnc, bl95_b0, bl95_b1
1133	!$OMP THREADPRIVATE(ok_ade, ok_aie, ok_alw, ok_cdnc, bl95_b0, bl95_b1)
1134	LOGICAL, SAVE :: aerosol_couple ! true : calcul des aerosols dans INCA
1135	! false : lecture des aerosol dans un fichier
1136	!$OMP THREADPRIVATE(aerosol_couple)
1137	LOGICAL, SAVE :: chemistry_couple ! true : use INCA chemistry O3
1138	! false : use offline chemistry O3
1139	!$OMP THREADPRIVATE(chemistry_couple)
1140	INTEGER, SAVE :: flag_aerosol
1141	!$OMP THREADPRIVATE(flag_aerosol)
1142	LOGICAL, SAVE :: flag_bc_internal_mixture
1143	!$OMP THREADPRIVATE(flag_bc_internal_mixture)
1144	!
1145	!--STRAT AEROSOL
1146	INTEGER, SAVE :: flag_aerosol_strat
1147	!$OMP THREADPRIVATE(flag_aerosol_strat)
1148	!
1149	!--INTERACTIVE AEROSOL FEEDBACK ON RADIATION
1150	LOGICAL, SAVE :: flag_aer_feedback
1151	!$OMP THREADPRIVATE(flag_aer_feedback)
1152
1153	!c-fin STRAT AEROSOL
1154	!
1155	! Declaration des constantes et des fonctions thermodynamiques
1156	!
1157	LOGICAL,SAVE :: first=.TRUE.
1158	!$OMP THREADPRIVATE(first)
1159
1160	! VARIABLES RELATED TO OZONE CLIMATOLOGIES ; all are OpenMP shared
1161	! Note that pressure vectors are in Pa and in stricly ascending order
1162	INTEGER,SAVE :: read_climoz ! Read ozone climatology
1163	! (let it keep the default OpenMP shared attribute)
1164	! Allowed values are 0, 1 and 2
1165	! 0: do not read an ozone climatology
1166	! 1: read a single ozone climatology that will be used day and night
1167	! 2: read two ozone climatologies, the average day and night
1168	! climatology and the daylight climatology
1169	INTEGER,SAVE :: ncid_climoz ! NetCDF file identifier
1170	REAL, ALLOCATABLE, SAVE :: press_cen_climoz(:) ! Pressure levels
1171	REAL, ALLOCATABLE, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
1172	REAL, ALLOCATABLE, SAVE :: time_climoz(:) ! Time vector
1173
1174	CHARACTER(LEN=13), PARAMETER :: vars_climoz(2) &
1175	= ["tro3 ","tro3_daylight"]
1176	! vars_climoz(1:read_climoz): variables names in climoz file.
1177	! vars_climoz(1:read_climoz-2) if read_climoz>2 (temporary)
1178	REAL :: ro3i ! 0<=ro3i<=360 ; required time index in NetCDF file for
1179	! the ozone fields, old method.
1180
1181	include "FCTTRE.h"
1182	!IM 100106 END : pouvoir sortir les ctes de la physique
1183	!
1184	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1185	! Declarations pour Simulateur COSP
1186	!============================================================
1187	! AI 10-22
1188	include "ini_COSP.h"
1189	real :: mr_ozone(klon,klev), phicosp(klon,klev)
1190
1191	!IM stations CFMIP
1192	INTEGER, SAVE :: nCFMIP
1193	!$OMP THREADPRIVATE(nCFMIP)
1194	INTEGER, PARAMETER :: npCFMIP=120
1195	INTEGER, ALLOCATABLE, SAVE :: tabCFMIP(:)
1196	REAL, ALLOCATABLE, SAVE :: lonCFMIP(:), latCFMIP(:)
1197	!$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP)
1198	INTEGER, ALLOCATABLE, SAVE :: tabijGCM(:)
1199	REAL, ALLOCATABLE, SAVE :: lonGCM(:), latGCM(:)
1200	!$OMP THREADPRIVATE(tabijGCM, lonGCM, latGCM)
1201	INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:)
1202	!$OMP THREADPRIVATE(iGCM, jGCM)
1203	logical, dimension(nfiles) :: phys_out_filestations
1204	logical, parameter :: lNMC=.FALSE.
1205
1206	!IM betaCRF
1207	REAL, SAVE :: pfree, beta_pbl, beta_free
1208	!$OMP THREADPRIVATE(pfree, beta_pbl, beta_free)
1209	REAL, SAVE :: lon1_beta, lon2_beta, lat1_beta, lat2_beta
1210	!$OMP THREADPRIVATE(lon1_beta, lon2_beta, lat1_beta, lat2_beta)
1211	LOGICAL, SAVE :: mskocean_beta
1212	!$OMP THREADPRIVATE(mskocean_beta)
1213	REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et
1214	! cldemirad pour evaluer les
1215	! retros liees aux CRF
1216	REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique
1217	! pour radlwsw pour
1218	! tester "CRF off"
1219	REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique
1220	! pour radlwsw pour
1221	! tester "CRF off"
1222	REAL, dimension(klon, klev) :: cldemirad ! emissivite pour
1223	! radlwsw pour tester
1224	! "CRF off"
1225	REAL, dimension(klon, klev) :: cldfrarad ! fraction nuageuse
1226
1227	REAL :: calday, zxsnow_dummy(klon)
1228	! set de variables utilisees pour l'initialisation des valeurs provenant de INCA
1229	REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_tauinca
1230	REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_pizinca
1231	REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_cginca
1232	REAL, DIMENSION(klon,klev,nbands) :: init_ccminca
1233	REAL, DIMENSION(klon,nbtr) :: init_source
1234
1235	!lwoff=y : offset LW CRE for radiation code and other schemes
1236	REAL, SAVE :: betalwoff
1237	!$OMP THREADPRIVATE(betalwoff)
1238	!
1239	INTEGER :: nbtr_tmp ! Number of tracer inside concvl
1240	REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac
1241	REAL, dimension(klon,klev) :: ch_in ! Condensed humidity entering in phytrac (eau liquide)
1242	integer iostat
1243
1244	REAL, dimension(klon,klev+1) :: l_mix_ave, wprime_ave
1245	REAL zzz
1246	!albedo SB >>>
1247	REAL,DIMENSION(6), SAVE :: SFRWL
1248	!$OMP THREADPRIVATE(SFRWL)
1249	!albedo SB <<<
1250
1251	!--OB variables for mass fixer (hard coded for now)
1252	REAL qql1(klon),qql2(klon),corrqql
1253
1254	REAL, dimension(klon,klev) :: t_env,q_env
1255
1256	REAL, dimension(klon) :: pr_et
1257	REAL, dimension(klon) :: w_et, jlr_g_c, jlr_g_s
1258
1259	REAL pi
1260	REAL viscom, viscoh
1261	INTEGER ieru
1262
1263	!AI namelist pour gerer le double appel de Ecrad
1264	CHARACTER(len=512) :: namelist_ecrad_file
1265
1266
1267	! Subgrid scale wind :
1268	! Need to be allocatable/save because the number of bin is not known (provided by surf_wind_ini)
1269	integer, save :: nsurfwind=1
1270	real, dimension(:,:), allocatable, save :: surf_wind_value, surf_wind_proba ! module and probability of sugrdi wind wind sample
1271	!$OMP THREADPRIVATE(nsurfwind,surf_wind_value, surf_wind_proba)
1272
1273
1274
1275	!======================================================================!
1276	! Bifurcation vers un nouveau moniteur physique pour experimenter !
1277	! des solutions et préparer le couplage avec la physique de MesoNH !
1278	! 14 mai 2023 !
1279	!======================================================================!
1280	if (debut) then !
1281	iflag_physiq=0
1282	call getin_p('iflag_physiq', iflag_physiq) !
1283	endif !
1284	if ( iflag_physiq == 2 ) then !
1285	call physiqex (nlon,nlev, & !
1286	debut,lafin,pdtphys_, & !
1287	paprs,pplay,pphi,pphis,presnivs, & !
1288	u,v,rot,t,qx, & !
1289	flxmass_w, & !
1290	d_u, d_v, d_t, d_qx, d_ps) !
1291	return !
1292	endif !
1293	!======================================================================!
1294
1295
1296	pi = 4. * ATAN(1.)
1297
1298	! set-up call to alerte function
1299	call_alert = (alert_first_call .AND. is_master)
1300
1301	! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter"
1302	jjmp1=nbp_lat
1303
1304	!======================================================================
1305	! Gestion calendrier : mise a jour du module phys_cal_mod
1306	!
1307	pdtphys=pdtphys_
1308	CALL update_time(pdtphys)
1309	phys_tstep=NINT(pdtphys)
1310	IF (.NOT. using_xios) missing_val=nf90_fill_real
1311
1312	IF (using_xios) THEN
1313	! switch to XIOS LMDZ physics context
1314	IF (.NOT. debut .AND. is_omp_master) THEN
1315	CALL wxios_set_context()
1316	CALL xios_update_calendar(itap+1)
1317	ENDIF
1318	ENDIF
1319
1320	!======================================================================
1321	! Ecriture eventuelle d'un profil verticale en entree de la physique.
1322	! Utilise notamment en 1D mais peut etre active egalement en 3D
1323	! en imposant la valeur de igout.
1324	!======================================================================
1325	IF (prt_level.ge.1) THEN
1326	igout=klon/2+1/klon
1327	write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
1328	write(lunout,*) 'igout, lat, lon ',igout, latitude_deg(igout), &
1329	longitude_deg(igout)
1330	write(lunout,*) &
1331	'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
1332	write(lunout,*) &
1333	nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys
1334
1335	write(lunout,*) 'paprs, play, phi, u, v, t'
1336	DO k=1,klev
1337	write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
1338	u(igout,k),v(igout,k),t(igout,k)
1339	ENDDO
1340	write(lunout,*) 'ovap (g/kg), oliq (g/kg)'
1341	DO k=1,klev
1342	write(lunout,) qx(igout,k,1)1000,qx(igout,k,2)*1000.
1343	ENDDO
1344	ENDIF
1345
1346	! Quick check on pressure levels:
1347	CALL assert(paprs(:, nbp_lev + 1) < paprs(:, nbp_lev), &
1348	"physiq_mod paprs bad order")
1349
1350	IF (first) THEN
1351
1352	CALL s2s_initialize ! initialization of source to source tools
1353
1354	! CALL init_etat0_limit_unstruct
1355	! IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
1356	!CR:nvelles variables convection/poches froides
1357
1358	WRITE(lunout,*) '================================================='
1359	WRITE(lunout,*) 'Allocation des variables locales et sauvegardees'
1360	WRITE(lunout,*) '================================================='
1361	CALL phys_local_var_init
1362	!
1363	! appel a la lecture du run.def physique
1364	CALL conf_phys(ok_journe, ok_mensuel, &
1365	ok_instan, ok_hf, &
1366	ok_LES, &
1367	callstats, &
1368	solarlong0,seuil_inversion, &
1369	fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
1370	iflag_cld_th,ratqsbas,ratqshaut,tau_ratqs, &
1371	ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat, aerosol_couple, &
1372	chemistry_couple, flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
1373	flag_bc_internal_mixture, bl95_b0, bl95_b1, &
1374	! nv flags pour la convection et les
1375	! poches froides
1376	read_climoz, &
1377	alp_offset)
1378	CALL init_etat0_limit_unstruct
1379	IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
1380	CALL phys_state_var_init(read_climoz)
1381	CALL phys_output_var_init
1382	IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) &
1383	CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
1384
1385	print*, '================================================='
1386	!
1387	!CR: check sur le nb de traceurs de l eau
1388	IF ((iflag_ice_thermo.gt.0).and.(nqo==2)) THEN
1389	WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
1390	'(H2O_g, H2O_l, H2O_s) but nqo=', nqo, '. Might as well stop here.'
1391	abort_message='see above'
1392	CALL abort_physic(modname,abort_message,1)
1393	ENDIF
1394
1395	IF (ok_ice_supersat.AND.(iflag_ice_thermo.EQ.0)) THEN
1396	WRITE (lunout, *) ' ok_ice_supersat=y requires iflag_ice_thermo=1 as well'
1397	abort_message='see above'
1398	CALL abort_physic(modname,abort_message,1)
1399	ENDIF
1400
1401	IF (ok_ice_supersat.AND.(nqo.LT.5)) THEN
1402	WRITE (lunout, *) ' ok_ice_supersat=y requires 5 H2O tracers ', &
1403	'(H2O_g, H2O_l, H2O_s, H2O_f, H2O_c) but nqo=', nqo, '. Might as well stop here.'
1404	abort_message='see above'
1405	CALL abort_physic(modname,abort_message,1)
1406	ENDIF
1407
1408	IF (ok_plane_h2o.AND..NOT.ok_ice_supersat) THEN
1409	WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_supersat=y '
1410	abort_message='see above'
1411	CALL abort_physic(modname,abort_message,1)
1412	ENDIF
1413
1414	IF (ok_plane_contrail.AND..NOT.ok_ice_supersat) THEN
1415	WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_supersat=y '
1416	abort_message='see above'
1417	CALL abort_physic(modname,abort_message,1)
1418	ENDIF
1419
1420	IF (ok_bs) THEN
1421	IF ((ok_ice_supersat.AND.nqo .LT.6).OR.(.NOT.ok_ice_supersat.AND.nqo.LT.4)) THEN
1422	WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', &
1423	'but nqo=', nqo
1424	abort_message='see above'
1425	CALL abort_physic(modname,abort_message, 1)
1426	ENDIF
1427	ENDIF
1428
1429	Ncvpaseq1 = 0
1430	dnwd0=0.0
1431	ftd=0.0
1432	fqd=0.0
1433	cin=0.
1434	!ym Attention pbase pas initialise dans concvl !!!!
1435	pbase=0
1436	!IM 180608
1437
1438	itau_con=0
1439	first=.FALSE.
1440
1441	ENDIF ! first
1442
1443	!ym => necessaire pour iflag_con != 2
1444	pmfd(:,:) = 0.
1445	pen_u(:,:) = 0.
1446	pen_d(:,:) = 0.
1447	pde_d(:,:) = 0.
1448	pde_u(:,:) = 0.
1449	aam=0.
1450	d_t_adjwk(:,:)=0
1451	d_q_adjwk(:,:)=0
1452
1453	alp_bl_conv(:)=0.
1454
1455	torsfc=0.
1456	forall (k=1: nbp_lev) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
1457
1458
1459	IF (debut) THEN
1460	CALL suphel ! initialiser constantes et parametres phys.
1461	! tau_gl : constante de rappel de la temperature a la surface de la glace - en
1462	tau_gl=5.
1463	CALL getin_p('tau_gl', tau_gl)
1464	! tau_gl : constante de rappel de la temperature a la surface de la glace - en
1465	! secondes
1466	tau_gl=86400.*tau_gl
1467	WRITE(lunout,*) 'debut physiq_mod tau_gl=',tau_gl
1468	iflag_thermcell_tke=0
1469	call getin_p('iflag_thermcell_tke', iflag_thermcell_tke) !
1470
1471	CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond)
1472	CALL getin_p('random_notrig_max',random_notrig_max)
1473	CALL getin_p('ok_adjwk',ok_adjwk)
1474	IF (ok_adjwk) iflag_adjwk=2 ! for compatibility with older versions
1475	! iflag_adjwk: ! 0 = Default: no convective adjustment of w-region
1476	! 1 => convective adjustment but state variables are unchanged
1477	! 2 => convective adjustment and state variables are changed
1478	CALL getin_p('iflag_adjwk',iflag_adjwk)
1479	CALL getin_p('dtcon_multistep_max',dtcon_multistep_max)
1480	CALL getin_p('dqcon_multistep_max',dqcon_multistep_max)
1481	CALL getin_p('oliqmax',oliqmax)
1482	CALL getin_p('oicemax',oicemax)
1483	CALL getin_p('ratqsp0',ratqsp0)
1484	CALL getin_p('ratqsdp',ratqsdp)
1485	iflag_wake_tend = 0
1486	CALL getin_p('iflag_wake_tend',iflag_wake_tend)
1487	ok_bad_ecmwf_thermo=.TRUE. ! By default thermodynamical constants are set
1488	! in rrtm/suphec.F90 (and rvtmp2 is set to 0).
1489	CALL getin_p('ok_bad_ecmwf_thermo',ok_bad_ecmwf_thermo)
1490	CALL getin_p('ok_bug_cv_trac',ok_bug_cv_trac)
1491	CALL getin_p('ok_bug_split_th',ok_bug_split_th)
1492	CALL getin_p('ok_bug_ajs_cv',ok_bug_ajs_cv)
1493	fl_ebil = 0 ! by default, conservation diagnostics are desactivated
1494	CALL getin_p('fl_ebil',fl_ebil)
1495	fl_cor_ebil = 0 ! by default, no correction to ensure energy conservation
1496	CALL getin_p('fl_cor_ebil',fl_cor_ebil)
1497	iflag_phytrac = 1 ! by default we do want to call phytrac
1498	CALL getin_p('iflag_phytrac',iflag_phytrac)
1499
1500	ok_water_mass_fixer=.FALSE. ! OB: by default we do not apply the mass fixer
1501	CALL getin_p('ok_water_mass_fixer',ok_water_mass_fixer)
1502	IF (CPPKEY_DUST) THEN
1503	IF (iflag_phytrac.EQ.0) THEN
1504	WRITE(lunout,*) 'In order to run with SPLA, iflag_phytrac will be forced to 1'
1505	iflag_phytrac = 1
1506	ENDIF
1507	END IF
1508	nvm_lmdz = 13
1509	CALL getin_p('NVM',nvm_lmdz)
1510
1511	WRITE(lunout,*) 'iflag_alp_wk_cond=', iflag_alp_wk_cond
1512	WRITE(lunout,*) 'random_ntrig_max=', random_notrig_max
1513	WRITE(lunout,*) 'ok_adjwk=', ok_adjwk
1514	WRITE(lunout,*) 'iflag_adjwk=', iflag_adjwk
1515	WRITE(lunout,*) 'qtcon_multistep_max=',dtcon_multistep_max
1516	WRITE(lunout,*) 'qdcon_multistep_max=',dqcon_multistep_max
1517	WRITE(lunout,*) 'ratqsp0=', ratqsp0
1518	WRITE(lunout,*) 'ratqsdp=', ratqsdp
1519	WRITE(lunout,*) 'iflag_wake_tend=', iflag_wake_tend
1520	WRITE(lunout,*) 'ok_bad_ecmwf_thermo=',ok_bad_ecmwf_thermo
1521	WRITE(lunout,*) 'ok_bug_cv_trac=', ok_bug_cv_trac
1522	WRITE(lunout,*) 'ok_bug_split_th=', ok_bug_split_th
1523	WRITE(lunout,*) 'fl_ebil=', fl_ebil
1524	WRITE(lunout,*) 'fl_cor_ebil=', fl_cor_ebil
1525	WRITE(lunout,*) 'iflag_phytrac=', iflag_phytrac
1526	WRITE(lunout,*) 'ok_water_mass_fixer=',ok_water_mass_fixer
1527	WRITE(lunout,*) 'NVM=', nvm_lmdz
1528
1529	!--PC: defining fields to be exchanged between LMDz, ORCHIDEE and NEMO
1530	WRITE(lunout,*) 'Call to infocfields from physiq'
1531	CALL infocfields_init
1532
1533	!AI 08 2023
1534	#ifdef CPP_ECRAD
1535	ok_3Deffect=.false.
1536	CALL getin_p('ok_3Deffect',ok_3Deffect)
1537	namelist_ecrad_file='namelist_ecrad'
1538	#endif
1539
1540	ENDIF
1541
1542	IF (prt_level.ge.1) print *,'CONVERGENCE PHYSIQUE THERM 1 '
1543
1544	!======================================================================
1545	! Gestion calendrier : mise a jour du module phys_cal_mod
1546	!
1547	! CALL phys_cal_update(jD_cur,jH_cur)
1548
1549	!
1550	! Si c'est le debut, il faut initialiser plusieurs choses
1551	! ********
1552	!
1553	IF (debut) THEN
1554	!rv CRinitialisation de wght_th et lalim_conv pour la
1555	!definition de la couche alimentation de la convection a partir
1556	!des caracteristiques du thermique
1557	wght_th(:,:)=1.
1558	lalim_conv(:)=1
1559	!RC
1560	ustar(:,:)=0.
1561	! u10m(:,:)=0.
1562	! v10m(:,:)=0.
1563	rain_con(:)=0.
1564	snow_con(:)=0.
1565	topswai(:)=0.
1566	topswad(:)=0.
1567	solswai(:)=0.
1568	solswad(:)=0.
1569
1570	wmax_th(:)=0.
1571	tau_overturning_th(:)=0.
1572
1573	IF (ANY(type_trac == ['inca','inco'])) THEN
1574	! jg : initialisation jusqu'au ces variables sont dans restart
1575	ccm(:,:,:) = 0.
1576	tau_aero(:,:,:,:) = 0.
1577	piz_aero(:,:,:,:) = 0.
1578	cg_aero(:,:,:,:) = 0.
1579	d_q_ch4(:,:) = 0.
1580
1581	config_inca='none' ! default
1582	CALL getin_p('config_inca',config_inca)
1583
1584	ELSE
1585	config_inca='none' ! default
1586	ENDIF
1587
1588	tau_aero(:,:,:,:) = 1.e-15
1589	piz_aero(:,:,:,:) = 1.
1590	cg_aero(:,:,:,:) = 0.
1591	d_q_ch4(:,:) = 0.
1592
1593	IF (aerosol_couple .AND. (config_inca /= "aero" &
1594	.AND. config_inca /= "aeNP ")) THEN
1595	abort_message &
1596	= 'if aerosol_couple is activated, config_inca need to be ' &
1597	// 'aero or aeNP'
1598	CALL abort_physic (modname,abort_message,1)
1599	ENDIF
1600
1601	rnebcon0(:,:) = 0.0
1602	clwcon0(:,:) = 0.0
1603	rnebcon(:,:) = 0.0
1604	clwcon(:,:) = 0.0
1605
1606	!
1607	print*,'iflag_coupl,iflag_clos,iflag_wake', &
1608	iflag_coupl,iflag_clos,iflag_wake
1609	print*,'iflag_cycle_diurne', iflag_cycle_diurne
1610	!
1611	IF (iflag_con.EQ.2.AND.iflag_cld_th.GT.-1) THEN
1612	abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1'
1613	CALL abort_physic (modname,abort_message,1)
1614	ENDIF
1615	!
1616	!
1617	! Initialiser les compteurs:
1618	!
1619	itap = 0
1620	itaprad = 0
1621	itapcv = 0
1622	itapwk = 0
1623
1624	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1625	!! Un petit travail \`a faire ici.
1626	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1627
1628	IF (iflag_pbl>1) THEN
1629	PRINT*, "Using method MELLOR&YAMADA"
1630	ENDIF
1631
1632	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1633	! FH 2008/05/02 changement lie a la lecture de nbapp_rad dans
1634	! phylmd plutot que dyn3d
1635	! Attention : la version precedente n'etait pas tres propre.
1636	! Il se peut qu'il faille prendre une valeur differente de nbapp_rad
1637	! pour obtenir le meme resultat.
1638	!jyg for fh<
1639	WRITE(lunout,*) 'Pas de temps phys_tstep pdtphys ',phys_tstep,pdtphys
1640	IF (abs(phys_tstep-pdtphys)>1.e-10) THEN
1641	abort_message='pas de temps doit etre entier en seconde pour orchidee et XIOS'
1642	CALL abort_physic(modname,abort_message,1)
1643	ENDIF
1644	!>jyg
1645	IF (MOD(NINT(86400./phys_tstep),nbapp_rad).EQ.0) THEN
1646	radpas = NINT( 86400./phys_tstep)/nbapp_rad
1647	ELSE
1648	WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
1649	'multiple de nbapp_rad'
1650	WRITE(lunout,*) 'changer nbapp_rad ou alors commenter ce test ', &
1651	'mais 1+1<>2'
1652	abort_message='nbre de pas de temps physique n est pas multiple ' &
1653	// 'de nbapp_rad'
1654	CALL abort_physic(modname,abort_message,1)
1655	ENDIF
1656	IF (nbapp_cv .EQ. 0) nbapp_cv=86400./phys_tstep
1657	IF (nbapp_wk .EQ. 0) nbapp_wk=86400./phys_tstep
1658	print *,'physiq, nbapp_cv, nbapp_wk ',nbapp_cv,nbapp_wk
1659	IF (MOD(NINT(86400./phys_tstep),nbapp_cv).EQ.0) THEN
1660	cvpas_0 = NINT( 86400./phys_tstep)/nbapp_cv
1661	cvpas = cvpas_0
1662	print *,'physiq, cvpas ',cvpas
1663	ELSE
1664	WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
1665	'multiple de nbapp_cv'
1666	WRITE(lunout,*) 'changer nbapp_cv ou alors commenter ce test ', &
1667	'mais 1+1<>2'
1668	abort_message='nbre de pas de temps physique n est pas multiple ' &
1669	// 'de nbapp_cv'
1670	CALL abort_physic(modname,abort_message,1)
1671	ENDIF
1672	IF (MOD(NINT(86400./phys_tstep),nbapp_wk).EQ.0) THEN
1673	wkpas = NINT( 86400./phys_tstep)/nbapp_wk
1674	! print *,'physiq, wkpas ',wkpas
1675	ELSE
1676	WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
1677	'multiple de nbapp_wk'
1678	WRITE(lunout,*) 'changer nbapp_wk ou alors commenter ce test ', &
1679	'mais 1+1<>2'
1680	abort_message='nbre de pas de temps physique n est pas multiple ' &
1681	// 'de nbapp_wk'
1682	CALL abort_physic(modname,abort_message,1)
1683	ENDIF
1684	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1685	CALL init_iophy_new(latitude_deg,longitude_deg)
1686
1687	!===================================================================
1688	!IM stations CFMIP
1689	nCFMIP=npCFMIP
1690	OPEN(98,file='npCFMIP_param.data',status='old', &
1691	form='formatted',iostat=iostat)
1692	IF (iostat == 0) THEN
1693	READ(98,*,end=998) nCFMIP
1694	998 CONTINUE
1695	CLOSE(98)
1696	CONTINUE
1697	IF(nCFMIP.GT.npCFMIP) THEN
1698	print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
1699	CALL abort_physic("physiq", "", 1)
1700	ELSE
1701	print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
1702	ENDIF
1703
1704	!
1705	ALLOCATE(tabCFMIP(nCFMIP))
1706	ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP))
1707	ALLOCATE(tabijGCM(nCFMIP))
1708	ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP))
1709	ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP))
1710	!
1711	! lecture des nCFMIP stations CFMIP, de leur numero
1712	! et des coordonnees geographiques lonCFMIP, latCFMIP
1713	!
1714	CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, &
1715	lonCFMIP, latCFMIP)
1716	!
1717	! identification des
1718	! 1) coordonnees lonGCM, latGCM des points CFMIP dans la
1719	! grille de LMDZ
1720	! 2) indices points tabijGCM de la grille physique 1d sur
1721	! klon points
1722	! 3) indices iGCM, jGCM de la grille physique 2d
1723	!
1724	CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, &
1725	tabijGCM, lonGCM, latGCM, iGCM, jGCM)
1726	!
1727	ELSE
1728	ALLOCATE(tabijGCM(0))
1729	ALLOCATE(lonGCM(0), latGCM(0))
1730	ALLOCATE(iGCM(0), jGCM(0))
1731	ENDIF
1732
1733	!$OMP MASTER
1734	! FH : if ok_sync=.true. , the time axis is written at each time step
1735	! in the output files. Only at the end in the opposite case
1736	ok_sync_omp=.FALSE.
1737	CALL getin('ok_sync',ok_sync_omp)
1738	CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
1739	iGCM,jGCM,lonGCM,latGCM, &
1740	jjmp1,nlevSTD,clevSTD,rlevSTD, phys_tstep,ok_veget, &
1741	type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
1742	ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, &
1743	read_climoz, phys_out_filestations, &
1744	aerosol_couple, &
1745	flag_aerosol_strat, pdtphys, paprs, pphis, &
1746	pplay, lmax_th, ptconv, ptconvth, ivap, &
1747	d_u, d_t, qx, d_qx, zmasse, ok_sync_omp)
1748	!$OMP END MASTER
1749	!$OMP BARRIER
1750	ok_sync=ok_sync_omp
1751
1752	! freq_outNMC(1) = ecrit_files(7)
1753	! freq_outNMC(2) = ecrit_files(8)
1754	! freq_outNMC(3) = ecrit_files(9)
1755	! WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1)
1756	! WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2)
1757	! WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3)
1758
1759	#ifndef CPP_XIOS
1760	CALL ini_paramLMDZ_phy(phys_tstep,nid_ctesGCM)
1761	#endif
1762
1763	ecrit_reg = ecrit_reg * un_jour
1764	ecrit_tra = ecrit_tra * un_jour
1765
1766	!XXXPB Positionner date0 pour initialisation de ORCHIDEE
1767	date0 = jD_ref
1768	WRITE(,) 'physiq date0 : ',date0
1769	!
1770
1771	! CALL create_climoz(read_climoz)
1772	IF (.NOT. create_etat0_limit) CALL init_aero_fromfile(flag_aerosol, aerosol_couple) !! initialise aero from file for XIOS interpolation (unstructured_grid)
1773	IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat) !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
1774
1775	! A.I : Initialisations pour le 1er passage a Cosp
1776	if (ok_cosp) then
1777
1778	IF (CPPKEY_COSP) THEN
1779	CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
1780	zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
1781	fiwc_cosp0,prfl_cosp0,psfl_cosp0,pmflxr_cosp0,pmflxs_cosp0, &
1782	mr_ozone_cosp0,cldtau_cosp0,cldemi_cosp0,JrNt_cosp0)
1783
1784	CALL phys_cosp(itap,phys_tstep,freq_cosp, &
1785	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
1786	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
1787	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
1788	JrNt_cosp0,ref_liq_cosp0,ref_ice_cosp0, &
1789	pctsrf_cosp0, &
1790	zu10m_cosp0,zv10m_cosp0,pphis, &
1791	pphi,paprs(:,1:klev),pplay,zxtsol_cosp0,t, &
1792	qx(:,:,ivap),zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0,fiwc_cosp0, &
1793	prfl_cosp0(:,1:klev),psfl_cosp0(:,1:klev), &
1794	pmflxr_cosp0(:,1:klev),pmflxs_cosp0(:,1:klev), &
1795	mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0)
1796	END IF
1797
1798	IF (CPPKEY_COSPV2) THEN
1799	CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
1800	zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
1801	fiwc_cosp0,prfl_cosp0,psfl_cosp0,pmflxr_cosp0,pmflxs_cosp0, &
1802	mr_ozone_cosp0,cldtau_cosp0,cldemi_cosp0,JrNt_cosp0)
1803
1804	CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
1805	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
1806	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
1807	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
1808	JrNt_cosp0,ref_liq_cosp0,ref_ice_cosp0, &
1809	pctsrf_cosp0, &
1810	zu10m_cosp0,zv10m_cosp0,pphis, &
1811	pphi,paprs(:,1:klev),pplay,zxtsol_cosp0,t, &
1812	qx(:,:,ivap),zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0,fiwc_cosp0, &
1813	prfl_cosp0(:,1:klev),psfl_cosp0(:,1:klev), &
1814	pmflxr_cosp0(:,1:klev),pmflxs_cosp0(:,1:klev), &
1815	mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0)
1816	END IF
1817	ENDIF
1818
1819	!
1820	!
1821	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1822	! Nouvelle initialisation pour le rayonnement RRTM
1823	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1824
1825	CALL iniradia(klon,klev,paprs(1,1:klev+1))
1826
1827	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1828	CALL surf_wind_ini(klon,lunout)
1829	CALL getin_p('nsurfwind',nsurfwind)
1830	allocate(surf_wind_value(klon,nsurfwind),surf_wind_proba(klon,nsurfwind))
1831
1832	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1833	CALL wake_ini(rg,rd,rv,prt_level)
1834	CALL yamada_ini(klon,lunout,prt_level)
1835	viscom=1.46E-5
1836	viscoh=2.06E-5
1837	CALL atke_ini(RG, RD, RPI, RCPD, RV, viscom, viscoh)
1838	CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, &
1839	& RG,RD,RCPD,RKAPPA,RLVTT,RETV)
1840	CALL ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT)
1841	CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_supersat,iflag_ratqs,fl_cor_ebil, &
1842	RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RV,RG,RPI,EPS_W)
1843	CALL blowing_snow_ini(RCPD, RLSTT, RLVTT, RLMLT, &
1844	RVTMP2, RTT,RD,RG, RV, RPI)
1845	! Test de coherence sur oc_cdnc utilisé uniquement par cloud_optics_prop
1846	IF (ok_newmicro) then
1847	IF (iflag_rrtm.EQ.1) THEN
1848	#ifdef CPP_RRTM
1849	IF (ok_cdnc.AND.NRADLP.NE.3) THEN
1850	abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
1851	// 'pour ok_cdnc'
1852	CALL abort_physic(modname,abort_message,1)
1853	ENDIF
1854	#else
1855
1856	abort_message='You should compile with -rrtm if running with '//'iflag_rrtm=1'
1857	CALL abort_physic(modname,abort_message,1)
1858	#endif
1859	ENDIF
1860	ENDIF
1861	CALL cloud_optics_prop_ini(klon, prt_level, lunout, flag_aerosol, &
1862	& ok_cdnc, bl95_b0, &
1863	& bl95_b1, latitude_deg, rpi, rg, rd, &
1864	& zepsec, novlp, iflag_ice_thermo, ok_new_lscp)
1865	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1866
1867	!
1868	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1869	! Initialisation des champs dans phytrac* qui sont utilises par phys_output_write*
1870	!
1871	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1872	IF (CPPKEY_REPROBUS) THEN
1873	CALL strataer_init
1874	CALL strataer_emiss_init
1875	END IF
1876
1877	IF (CPPKEY_STRATAER) THEN
1878	CALL strataer_init
1879	CALL strataer_nuc_init
1880	CALL strataer_emiss_init
1881	END IF
1882
1883	IF (CPPKEY_DUST) THEN
1884	! Quand on utilise SPLA, on force iflag_phytrac=1
1885	CALL spla_ini(is_oce,RNAVO,RG,RD,RCPD,RLVTT,RLSTT,RETV,RTT, &
1886	R2ES,R3LES,R3IES,R4LES,R4IES,R5LES,R5IES,RVTMP2)
1887	CALL phytracr_spl_out_init()
1888	CALL phys_output_write_spl(itap, pdtphys, paprs, pphis, &
1889	pplay, lmax_th, aerosol_couple, &
1890	ok_ade, ok_aie, ivap, ok_sync, &
1891	ptconv, read_climoz, clevSTD, &
1892	ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse, &
1893	flag_aerosol, flag_aerosol_strat, ok_cdnc)
1894	ELSE
1895	! phys_output_write écrit des variables traceurs seulement si iflag_phytrac == 1
1896	! donc seulement dans ce cas on doit appeler phytrac_init()
1897	IF (iflag_phytrac == 1 ) THEN
1898	CALL phytrac_init()
1899	ENDIF
1900	CALL phys_output_write(itap, pdtphys, paprs, pphis, &
1901	pplay, lmax_th, aerosol_couple, &
1902	ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs, ok_sync,&
1903	ptconv, read_climoz, clevSTD, &
1904	ptconvth, d_u, d_t, qx, d_qx, zmasse, &
1905	flag_aerosol, flag_aerosol_strat, ok_cdnc, t, u1, v1)
1906	END IF
1907
1908
1909	IF (using_xios) THEN
1910	IF (is_omp_master) CALL xios_update_calendar(1)
1911	ENDIF
1912
1913	IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
1914	CALL create_etat0_limit_unstruct
1915	CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
1916
1917	!jyg<
1918	IF (iflag_pbl<=1) THEN
1919	! No TKE for Standard Physics
1920	pbl_tke(:,:,:)=0.
1921
1922	ELSE IF (klon_glo==1) THEN
1923	pbl_tke(:,:,is_ave) = 0.
1924	pbl_eps(:,:,is_ave) = 0.
1925	DO nsrf=1,nbsrf
1926	DO k = 1,klev+1
1927	pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
1928	+pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
1929	pbl_eps(:,k,is_ave) = pbl_eps(:,k,is_ave) &
1930	+pctsrf(:,nsrf)*pbl_eps(:,k,nsrf)
1931	ENDDO
1932	ENDDO
1933	ELSE
1934	pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
1935	!>jyg
1936	pbl_eps(:,:,is_ave) = 0.
1937	ENDIF
1938	!IM begin
1939	print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) &
1940	,ratqs(1,1)
1941	!IM end
1942
1943
1944	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1945	!
1946	! on remet le calendrier a zero
1947	!
1948	IF (raz_date .eq. 1) THEN
1949	itau_phy = 0
1950	ENDIF
1951
1952	! IF (ABS(phys_tstep-pdtphys).GT.0.001) THEN
1953	! WRITE(lunout,*) 'Pas physique n est pas correct',phys_tstep, &
1954	! pdtphys
1955	! abort_message='Pas physique n est pas correct '
1956	! ! call abort_physic(modname,abort_message,1)
1957	! phys_tstep=pdtphys
1958	! ENDIF
1959	IF (nlon .NE. klon) THEN
1960	WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, &
1961	klon
1962	abort_message='nlon et klon ne sont pas coherents'
1963	CALL abort_physic(modname,abort_message,1)
1964	ENDIF
1965	IF (nlev .NE. klev) THEN
1966	WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, &
1967	klev
1968	abort_message='nlev et klev ne sont pas coherents'
1969	CALL abort_physic(modname,abort_message,1)
1970	ENDIF
1971	!
1972	IF (phys_tstep*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN
1973	WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
1974	WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
1975	abort_message='Nbre d appels au rayonnement insuffisant'
1976	CALL abort_physic(modname,abort_message,1)
1977	ENDIF
1978
1979	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1980	! Initialisation pour la convection de K.E. et pour les poches froides
1981	!
1982	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1983
1984	WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
1985	WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", ok_cvl
1986	!
1987	!KE43
1988	! Initialisation pour la convection de K.E. (sb):
1989	IF (iflag_con.GE.3) THEN
1990
1991	WRITE(lunout,)"** Convection de Kerry Emanuel 4.3 "
1992	WRITE(lunout,*) &
1993	"On va utiliser le melange convectif des traceurs qui"
1994	WRITE(lunout,*)"est calcule dans convect4.3"
1995	WRITE(lunout,*)" !!! penser aux logical flags de phytrac"
1996
1997	DO i = 1, klon
1998	ema_cbmf(i) = 0.
1999	ema_pcb(i) = 0.
2000	ema_pct(i) = 0.
2001	! ema_workcbmf(i) = 0.
2002	ENDDO
2003	!IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG
2004	DO i = 1, klon
2005	ibas_con(i) = 1
2006	itop_con(i) = 1
2007	ENDDO
2008	!IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END
2009	!================================================================
2010	!CR:04.12.07: initialisations poches froides
2011	! Controle de ALE et ALP pour la fermeture convective (jyg)
2012	IF (iflag_wake>=1) THEN
2013	CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr &
2014	,alp_bl_prescr, ale_bl_prescr)
2015	! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
2016	! print*,'apres ini_wake iflag_cld_th=', iflag_cld_th
2017	!
2018	! Initialize tendencies of wake state variables (for some flag values
2019	! they are not computed).
2020	d_deltat_wk(:,:) = 0.
2021	d_deltaq_wk(:,:) = 0.
2022	d_deltat_wk_gw(:,:) = 0.
2023	d_deltaq_wk_gw(:,:) = 0.
2024	d_deltat_vdf(:,:) = 0.
2025	d_deltaq_vdf(:,:) = 0.
2026	d_deltat_the(:,:) = 0.
2027	d_deltaq_the(:,:) = 0.
2028	d_deltat_ajs_cv(:,:) = 0.
2029	d_deltaq_ajs_cv(:,:) = 0.
2030	d_s_wk(:) = 0.
2031	d_s_a_wk(:) = 0.
2032	d_dens_wk(:) = 0.
2033	d_dens_a_wk(:) = 0.
2034	ENDIF ! (iflag_wake>=1)
2035
2036	! do i = 1,klon
2037	! Ale_bl(i)=0.
2038	! Alp_bl(i)=0.
2039	! enddo
2040
2041	!ELSE
2042	! ALLOCATE(tabijGCM(0))
2043	! ALLOCATE(lonGCM(0), latGCM(0))
2044	! ALLOCATE(iGCM(0), jGCM(0))
2045	ENDIF ! (iflag_con.GE.3)
2046	!
2047	DO i=1,klon
2048	rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
2049	ENDDO
2050
2051	!34EK
2052	IF (ok_orodr) THEN
2053
2054	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2055	! FH sans doute a enlever de finitivement ou, si on le
2056	! garde, l'activer justement quand ok_orodr = false.
2057	! ce rugoro est utilise par la couche limite et fait double emploi
2058	! avec les param\'etrisations sp\'ecifiques de Francois Lott.
2059	! DO i=1,klon
2060	! rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
2061	! ENDDO
2062	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2063	IF (ok_strato) THEN
2064	CALL SUGWD_strato(klon,klev,paprs,pplay)
2065	ELSE
2066	CALL SUGWD(klon,klev,paprs,pplay)
2067	ENDIF
2068
2069	DO i=1,klon
2070	zuthe(i)=0.
2071	zvthe(i)=0.
2072	IF (zstd(i).gt.10.) THEN
2073	zuthe(i)=(1.-zgam(i))*cos(zthe(i))
2074	zvthe(i)=(1.-zgam(i))*sin(zthe(i))
2075	ENDIF
2076	ENDDO
2077	ENDIF
2078	!
2079	!
2080	lmt_pas = NINT(86400./phys_tstep * 1.0) ! tous les jours
2081	WRITE(lunout,*)'La frequence de lecture surface est de ', &
2082	lmt_pas
2083	!
2084	capemaxcels = 't_max(X)'
2085	t2mincels = 't_min(X)'
2086	t2maxcels = 't_max(X)'
2087	tinst = 'inst(X)'
2088	tave = 'ave(X)'
2089	!IM cf. AM 081204 BEG
2090	write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
2091	!IM cf. AM 081204 END
2092	!
2093	!=============================================================
2094	! Initialisation des sorties
2095	!=============================================================
2096
2097	IF (using_xios) THEN
2098	! Get "missing_val" value from XML files (from temperature variable)
2099	IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val)
2100	CALL bcast_omp(missing_val)
2101	ENDIF
2102
2103	IF (using_xios) THEN
2104	! Need to put this initialisation after phyetat0 as in the coupled model the XIOS context is only
2105	! initialised at that moment
2106	! Get "missing_val" value from XML files (from temperature variable)
2107	IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val)
2108	CALL bcast_omp(missing_val)
2109	!
2110	! Now we activate some double radiation call flags only if some
2111	! diagnostics are requested, otherwise there is no point in doing this
2112	IF (is_master) THEN
2113	!--setting up swaero_diag to TRUE in XIOS case
2114	IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. &
2115	xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. &
2116	xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR. &
2117	(iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. &
2118	xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0")))) &
2119	!!!--for now these fields are not in the XML files so they are omitted
2120	!!! xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) &
2121	swaero_diag=.TRUE.
2122
2123	!--setting up swaerofree_diag to TRUE in XIOS case
2124	IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
2125	xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR. &
2126	xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
2127	xios_field_is_active("LWupTOAcleanclr")) &
2128	swaerofree_diag=.TRUE.
2129
2130	!--setting up dryaod_diag to TRUE in XIOS case
2131	DO naero = 1, naero_tot-1
2132	IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE.
2133	ENDDO
2134	!
2135	!--setting up ok_4xCO2atm to TRUE in XIOS case
2136	IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. &
2137	xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
2138	xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
2139	xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
2140	xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
2141	xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
2142	ok_4xCO2atm=.TRUE.
2143	ENDIF
2144	!$OMP BARRIER
2145	CALL bcast(swaero_diag)
2146	CALL bcast(swaerofree_diag)
2147	CALL bcast(dryaod_diag)
2148	CALL bcast(ok_4xCO2atm)
2149	ENDIF !using_xios
2150	!
2151	CALL printflag( tabcntr0,radpas,ok_journe, &
2152	ok_instan, ok_region )
2153	!
2154	!
2155	! Prescrire l'ozone dans l'atmosphere
2156	!
2157	!c DO i = 1, klon
2158	!c DO k = 1, klev
2159	!c CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
2160	!c ENDDO
2161	!c ENDDO
2162	!
2163	IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL
2164	IF (CPPKEY_INCA) THEN
2165	CALL VTe(VTphysiq)
2166	CALL VTb(VTinca)
2167	calday = REAL(days_elapsed) + jH_cur
2168	WRITE(lunout,*) 'initial time chemini', days_elapsed, calday
2169
2170	call init_const_lmdz( &
2171	ndays, nbsrf, is_oce,is_sic, is_ter,is_lic, calend, &
2172	config_inca)
2173
2174	CALL init_inca_geometry( &
2175	longitude, latitude, &
2176	boundslon, boundslat, &
2177	cell_area, ind_cell_glo)
2178
2179	if (grid_type==unstructured) THEN
2180	CALL chemini( pplay, &
2181	nbp_lon, nbp_lat, &
2182	latitude_deg, &
2183	longitude_deg, &
2184	presnivs, &
2185	calday, &
2186	klon, &
2187	nqtot, &
2188	nqo+nqCO2, &
2189	pdtphys, &
2190	annee_ref, &
2191	year_cur, &
2192	day_ref, &
2193	day_ini, &
2194	start_time, &
2195	itau_phy, &
2196	date0, &
2197	chemistry_couple, &
2198	init_source, &
2199	init_tauinca, &
2200	init_pizinca, &
2201	init_cginca, &
2202	init_ccminca)
2203	ELSE
2204	CALL chemini( pplay, &
2205	nbp_lon, nbp_lat, &
2206	latitude_deg, &
2207	longitude_deg, &
2208	presnivs, &
2209	calday, &
2210	klon, &
2211	nqtot, &
2212	nqo+nqCO2, &
2213	pdtphys, &
2214	annee_ref, &
2215	year_cur, &
2216	day_ref, &
2217	day_ini, &
2218	start_time, &
2219	itau_phy, &
2220	date0, &
2221	chemistry_couple, &
2222	init_source, &
2223	init_tauinca, &
2224	init_pizinca, &
2225	init_cginca, &
2226	init_ccminca, &
2227	io_lon, &
2228	io_lat)
2229	ENDIF
2230
2231
2232	! initialisation des variables depuis le restart de inca
2233	ccm(:,:,:) = init_ccminca
2234	tau_aero(:,:,:,:) = init_tauinca
2235	piz_aero(:,:,:,:) = init_pizinca
2236	cg_aero(:,:,:,:) = init_cginca
2237	!
2238
2239
2240	CALL VTe(VTinca)
2241	CALL VTb(VTphysiq)
2242	END IF
2243	ENDIF
2244	!
2245	IF (type_trac == 'repr') THEN
2246	IF (CPPKEY_REPROBUS) THEN
2247	CALL chemini_rep( &
2248	presnivs, &
2249	pdtphys, &
2250	annee_ref, &
2251	day_ref, &
2252	day_ini, &
2253	start_time, &
2254	itau_phy, &
2255	io_lon, &
2256	io_lat)
2257	END IF
2258	ENDIF
2259
2260	!$omp single
2261	IF (read_climoz >= 1) CALL open_climoz(ncid_climoz, press_cen_climoz, &
2262	press_edg_climoz, time_climoz, ok_daily_climoz, adjust_tropopause)
2263	!$omp end single
2264	!
2265	!IM betaCRF
2266	pfree=70000. !Pa
2267	beta_pbl=1.
2268	beta_free=1.
2269	lon1_beta=-180.
2270	lon2_beta=+180.
2271	lat1_beta=90.
2272	lat2_beta=-90.
2273	mskocean_beta=.FALSE.
2274
2275	!albedo SB >>>
2276	SELECT CASE(nsw)
2277	CASE(2)
2278	SFRWL(1)=0.45538747
2279	SFRWL(2)=0.54461211
2280	CASE(4)
2281	SFRWL(1)=0.45538747
2282	SFRWL(2)=0.32870591
2283	SFRWL(3)=0.18568763
2284	SFRWL(4)=3.02191470E-02
2285	CASE(6)
2286	SFRWL(1)=1.28432794E-03
2287	SFRWL(2)=0.12304168
2288	SFRWL(3)=0.33106142
2289	SFRWL(4)=0.32870591
2290	SFRWL(5)=0.18568763
2291	SFRWL(6)=3.02191470E-02
2292	END SELECT
2293	!albedo SB <<<
2294
2295	OPEN(99,file='beta_crf.data',status='old', &
2296	form='formatted',err=9999)
2297	READ(99,*,end=9998) pfree
2298	READ(99,*,end=9998) beta_pbl
2299	READ(99,*,end=9998) beta_free
2300	READ(99,*,end=9998) lon1_beta
2301	READ(99,*,end=9998) lon2_beta
2302	READ(99,*,end=9998) lat1_beta
2303	READ(99,*,end=9998) lat2_beta
2304	READ(99,*,end=9998) mskocean_beta
2305	9998 Continue
2306	CLOSE(99)
2307	9999 Continue
2308	WRITE(,)'pfree=',pfree
2309	WRITE(,)'beta_pbl=',beta_pbl
2310	WRITE(,)'beta_free=',beta_free
2311	WRITE(,)'lon1_beta=',lon1_beta
2312	WRITE(,)'lon2_beta=',lon2_beta
2313	WRITE(,)'lat1_beta=',lat1_beta
2314	WRITE(,)'lat2_beta=',lat2_beta
2315	WRITE(,)'mskocean_beta=',mskocean_beta
2316
2317	!lwoff=y : offset LW CRE for radiation code and other schemes
2318	!lwoff=y : betalwoff=1.
2319	betalwoff=0.
2320	IF (ok_lwoff) THEN
2321	betalwoff=1.
2322	ENDIF
2323	WRITE(,)'ok_lwoff=',ok_lwoff
2324	!
2325	!lwoff=y to begin only sollw and sollwdown are set up to CS values
2326	sollw = sollw + betalwoff * (sollw0 - sollw)
2327	sollwdown(:)= sollwdown(:) + betalwoff (-1.ZFLDN0(:,1) - &
2328	sollwdown(:))
2329
2330	!--Init for LSCP - condensation
2331	ratio_ql_qtot(:,:) = 0.
2332	ratio_qi_qtot(:,:) = 0.
2333
2334
2335	ENDIF
2336	!
2337	! ************** Fin de IF ( debut ) *************
2338	!
2339	!
2340	! Incrementer le compteur de la physique
2341	!
2342	itap = itap + 1
2343	IF (is_master .OR. prt_level > 9) THEN
2344	IF (prt_level > 5 .or. MOD(itap,5) == 0) THEN
2345	WRITE(LUNOUT,*)'Entering physics elapsed seconds since start ', current_time
2346	WRITE(LUNOUT,100)year_cur,mth_cur,day_cur,hour/3600.
2347	100 FORMAT('Date = ',i4.4,' / ',i2.2, ' / ',i2.2,' : ',f20.17)
2348	ENDIF
2349	ENDIF
2350	!
2351	!
2352	! Update fraction of the sub-surfaces (pctsrf) and
2353	! initialize, where a new fraction has appeared, all variables depending
2354	! on the surface fraction.
2355	!
2356	CALL change_srf_frac(itap, phys_tstep, days_elapsed+1, &
2357	pctsrf, fevap, z0m, z0h, agesno, &
2358	falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
2359
2360	! Update time and other variables in Reprobus
2361	IF (type_trac == 'repr') THEN
2362	IF (CPPKEY_REPROBUS) THEN
2363	CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
2364	print*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
2365	CALL Rtime(debut)
2366	END IF
2367	ENDIF
2368
2369	! Tendances bidons pour les processus qui n'affectent pas certaines
2370	! variables.
2371	du0(:,:)=0.
2372	dv0(:,:)=0.
2373	dt0 = 0.
2374	dq0(:,:)=0.
2375	dql0(:,:)=0.
2376	dqi0(:,:)=0.
2377	dqbs0(:,:)=0.
2378	dsig0(:) = 0.
2379	ddens0(:) = 0.
2380	wkoccur1(:)=1
2381	!
2382	! Mettre a zero des variables de sortie (pour securite)
2383	!
2384	DO i = 1, klon
2385	d_ps(i) = 0.0
2386	ENDDO
2387	DO k = 1, klev
2388	DO i = 1, klon
2389	d_t(i,k) = 0.0
2390	d_u(i,k) = 0.0
2391	d_v(i,k) = 0.0
2392	ENDDO
2393	ENDDO
2394	DO iq = 1, nqtot
2395	DO k = 1, klev
2396	DO i = 1, klon
2397	d_qx(i,k,iq) = 0.0
2398	ENDDO
2399	ENDDO
2400	ENDDO
2401	beta_prec_fisrt(:,:)=0.
2402	beta_prec(:,:)=0.
2403	!
2404	! Output variables from the convective scheme should not be set to 0
2405	! since convection is not always called at every time step.
2406	IF (ok_bug_cv_trac) THEN
2407	da(:,:)=0.
2408	mp(:,:)=0.
2409	phi(:,:,:)=0.
2410	! RomP >>>
2411	phi2(:,:,:)=0.
2412	epmlmMm(:,:,:)=0.
2413	eplaMm(:,:)=0.
2414	d1a(:,:)=0.
2415	dam(:,:)=0.
2416	pmflxr(:,:)=0.
2417	pmflxs(:,:)=0.
2418	! RomP <<<
2419	ENDIF
2420	!
2421	! Ne pas affecter les valeurs entrees de u, v, h, et q
2422	!
2423	DO k = 1, klev
2424	DO i = 1, klon
2425	t_seri(i,k) = t(i,k)
2426	u_seri(i,k) = u(i,k)
2427	v_seri(i,k) = v(i,k)
2428	q_seri(i,k) = qx(i,k,ivap)
2429	ql_seri(i,k) = qx(i,k,iliq)
2430	qbs_seri(i,k)= 0.
2431	cf_seri(i,k) = 0.
2432	rvc_seri(i,k)= 0.
2433	!CR: ATTENTION, on rajoute la variable glace
2434	IF (nqo.EQ.2) THEN !--vapour and liquid only
2435	qs_seri(i,k) = 0.
2436	ELSE IF (nqo.EQ.3) THEN !--vapour, liquid and ice
2437	qs_seri(i,k) = qx(i,k,isol)
2438	ELSE IF (nqo.GE.4) THEN !--vapour, liquid, ice, blowing snow, cloud fraction and cloudy water vapor to total water vapor ratio
2439	qs_seri(i,k) = qx(i,k,isol)
2440	IF (ok_ice_supersat) THEN
2441	cf_seri(i,k) = qx(i,k,icf)
2442	rvc_seri(i,k) = qx(i,k,irvc)
2443	ENDIF
2444	IF (ok_bs) THEN
2445	qbs_seri(i,k)= qx(i,k,ibs)
2446	ENDIF
2447	ENDIF
2448	ENDDO
2449	ENDDO
2450	!
2451	!--OB water mass fixer
2452	IF (ok_water_mass_fixer) THEN
2453	!--store initial water burden
2454	qql1(:)=0.0
2455	DO k = 1, klev
2456	qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k))*zmasse(:,k)
2457	IF (nqo >= 3) THEN
2458	qql1(:)=qql1(:)+qs_seri(:,k)*zmasse(:,k)
2459	ENDIF
2460	IF (ok_bs) THEN
2461	qql1(:)=qql1(:)+qbs_seri(:,k)*zmasse(:,k)
2462	ENDIF
2463	ENDDO
2464	ENDIF
2465	!--fin mass fixer
2466
2467	tke0(:,:)=pbl_tke(:,:,is_ave)
2468	IF (nqtot > nqo) THEN
2469	! water isotopes are not included in tr_seri
2470	itr = 0
2471	DO iq = 1, nqtot
2472	IF(.NOT.tracers(iq)%isInPhysics) CYCLE
2473	itr = itr+1
2474	DO k = 1, klev
2475	DO i = 1, klon
2476	tr_seri(i,k,itr) = qx(i,k,iq)
2477	ENDDO
2478	ENDDO
2479	ENDDO
2480	ELSE
2481	! DC: make sure the final "1" index was meant for 1st H2O phase (vapor) !!!
2482	tr_seri(:,:,strIdx(tracers(:)%name,addPhase('H2O','g'))) = 0.0
2483	ENDIF
2484	!
2485	! Temporary solutions adressing ticket #104 and the non initialisation of tr_ancien
2486	! LF
2487	IF (debut) THEN
2488	WRITE(lunout,*)' WARNING: tr_ancien initialised to tr_seri'
2489	itr = 0
2490	do iq = 1, nqtot
2491	IF(.NOT.tracers(iq)%isInPhysics) CYCLE
2492	itr = itr+1
2493	tr_ancien(:,:,itr)=tr_seri(:,:,itr)
2494	enddo
2495	ENDIF
2496	!
2497	DO i = 1, klon
2498	ztsol(i) = 0.
2499	ENDDO
2500	DO nsrf = 1, nbsrf
2501	DO i = 1, klon
2502	ztsol(i) = ztsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
2503	ENDDO
2504	ENDDO
2505	! Initialize variables used for diagnostic purpose
2506	IF (flag_inhib_tend .ne. 0) CALL init_cmp_seri
2507
2508	! Diagnostiquer la tendance dynamique
2509	!
2510	IF (ancien_ok) THEN
2511	!
2512	d_u_dyn(:,:) = (u_seri(:,:)-u_ancien(:,:))/phys_tstep
2513	d_v_dyn(:,:) = (v_seri(:,:)-v_ancien(:,:))/phys_tstep
2514	d_t_dyn(:,:) = (t_seri(:,:)-t_ancien(:,:))/phys_tstep
2515	d_q_dyn(:,:) = (q_seri(:,:)-q_ancien(:,:))/phys_tstep
2516	d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep
2517	d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep
2518	d_qbs_dyn(:,:)= (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep
2519	d_cf_dyn(:,:) = (cf_seri(:,:)-cf_ancien(:,:))/phys_tstep
2520	d_rvc_dyn(:,:)= (rvc_seri(:,:)-rvc_ancien(:,:))/phys_tstep
2521	CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d)
2522	d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep
2523	CALL water_int(klon,klev,ql_seri,zmasse,zx_tmp_fi2d)
2524	d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/phys_tstep
2525	CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d)
2526	d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep
2527	CALL water_int(klon,klev,qbs_seri,zmasse,zx_tmp_fi2d)
2528	d_qbs_dyn2d(:)=(zx_tmp_fi2d(:)-prbsw_ancien(:))/phys_tstep
2529	! !! RomP >>> td dyn traceur
2530	IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep
2531	! !! RomP <<<
2532	ELSE
2533	d_u_dyn(:,:) = 0.0
2534	d_v_dyn(:,:) = 0.0
2535	d_t_dyn(:,:) = 0.0
2536	d_q_dyn(:,:) = 0.0
2537	d_ql_dyn(:,:) = 0.0
2538	d_qs_dyn(:,:) = 0.0
2539	d_qbs_dyn(:,:)= 0.0
2540	d_cf_dyn(:,:) = 0.0
2541	d_rvc_dyn(:,:)= 0.0
2542	d_q_dyn2d(:) = 0.0
2543	d_ql_dyn2d(:) = 0.0
2544	d_qs_dyn2d(:) = 0.0
2545	d_qbs_dyn2d(:)= 0.0
2546	! !! RomP >>> td dyn traceur
2547	IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0
2548	! !! RomP <<<
2549	ancien_ok = .TRUE.
2550	ENDIF
2551	!
2552	! Ajouter le geopotentiel du sol:
2553	!
2554	DO k = 1, klev
2555	DO i = 1, klon
2556	zphi(i,k) = pphi(i,k) + pphis(i)
2557	ENDDO
2558	ENDDO
2559	!
2560	! Verifier les temperatures
2561	!
2562	!IM BEG
2563	IF (check) THEN
2564	amn=MIN(ftsol(1,is_ter),1000.)
2565	amx=MAX(ftsol(1,is_ter),-1000.)
2566	DO i=2, klon
2567	amn=MIN(ftsol(i,is_ter),amn)
2568	amx=MAX(ftsol(i,is_ter),amx)
2569	ENDDO
2570	!
2571	PRINT*,' debut avant hgardfou min max ftsol',itap,amn,amx
2572	ENDIF !(check) THEN
2573	!IM END
2574	!
2575	CALL hgardfou(t_seri,ftsol,'debutphy',abortphy)
2576	IF (abortphy==1) Print*,'ERROR ABORT hgardfou debutphy'
2577
2578	!
2579	!IM BEG
2580	IF (check) THEN
2581	amn=MIN(ftsol(1,is_ter),1000.)
2582	amx=MAX(ftsol(1,is_ter),-1000.)
2583	DO i=2, klon
2584	amn=MIN(ftsol(i,is_ter),amn)
2585	amx=MAX(ftsol(i,is_ter),amx)
2586	ENDDO
2587	!
2588	PRINT*,' debut apres hgardfou min max ftsol',itap,amn,amx
2589	ENDIF !(check) THEN
2590	!IM END
2591	!
2592	! Mettre en action les conditions aux limites (albedo, sst, etc.).
2593	! Prescrire l'ozone et calculer l'albedo sur l'ocean.
2594	!
2595	! Update ozone if day change
2596	IF (MOD(itap-1,lmt_pas) == 0) THEN
2597	IF (read_climoz <= 0) THEN
2598	! Once per day, update ozone from Royer:
2599	IF (solarlong0<-999.) then
2600	! Generic case with evolvoing season
2601	zzz=real(days_elapsed+1)
2602	ELSE IF (abs(solarlong0-1000.)<1.e-4) then
2603	! Particular case with annual mean insolation
2604	zzz=real(90) ! could be revisited
2605	IF (read_climoz/=-1) THEN
2606	abort_message ='read_climoz=-1 is recommended when ' &
2607	// 'solarlong0=1000.'
2608	CALL abort_physic (modname,abort_message,1)
2609	ENDIF
2610	ELSE
2611	! Case where the season is imposed with solarlong0
2612	zzz=real(90) ! could be revisited
2613	ENDIF
2614
2615	wo(:,:,1)=ozonecm(latitude_deg, paprs,read_climoz,rjour=zzz)
2616	IF (CPPKEY_REPROBUS) THEN
2617	ptrop=dyn_tropopause(t_seri, ztsol, paprs, pplay, rot)/100.
2618	DO i = 1, klon
2619	Z1=t_seri(i,itroprep(i)+1)
2620	Z2=t_seri(i,itroprep(i))
2621	fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
2622	B=Z2-fac*alog(pplay(i,itroprep(i)))
2623	ttrop(i)= fac*alog(ptrop(i))+B
2624	!
2625	Z1= 1.e-3 * ( pphi(i,itroprep(i)+1)+pphis(i) ) / gravit
2626	Z2= 1.e-3 * ( pphi(i,itroprep(i)) +pphis(i) ) / gravit
2627	fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
2628	B=Z2-fac*alog(pplay(i,itroprep(i)))
2629	ztrop(i)=fac*alog(ptrop(i))+B
2630	ENDDO
2631	END IF
2632	ELSE
2633	!--- ro3i = elapsed days number since current year 1st january, 0h
2634	ro3i=days_elapsed+jh_cur-jh_1jan
2635	!--- scaling for old style files (360 records)
2636	IF(SIZE(time_climoz)==360.AND..NOT.ok_daily_climoz) ro3i=ro3i*360./year_len
2637	IF(adjust_tropopause) THEN
2638	CALL regr_pr_time_av(ncid_climoz, vars_climoz(1:read_climoz), &
2639	ro3i, 'C', press_cen_climoz, pplay, wo, paprs(:,1), &
2640	time_climoz , longitude_deg, latitude_deg, &
2641	dyn_tropopause(t_seri, ztsol, paprs, pplay, rot))
2642	ELSE
2643	CALL regr_pr_time_av(ncid_climoz, vars_climoz(1:read_climoz), &
2644	ro3i, 'C', press_cen_climoz, pplay, wo, paprs(:,1), &
2645	time_climoz )
2646	ENDIF
2647	! Convert from mole fraction of ozone to column density of ozone in a
2648	! cell, in kDU:
2649	FORALL (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
2650	* zmasse / dobson_u / 1e3
2651	! (By regridding ozone values for LMDZ only once a day, we
2652	! have already neglected the variation of pressure in one
2653	! day. So do not recompute "wo" at each time step even if
2654	! "zmasse" changes a little.)
2655	ENDIF
2656	ENDIF
2657
2658	!-- Needed for LSCP - condensation and ice supersaturation
2659	IF (ok_ice_supersat) THEN
2660	DO k = 1, klev
2661	DO i = 1, klon
2662	IF ( ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) .GT. 0. ) THEN
2663	ratio_ql_qtot(i,k) = ql_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
2664	ratio_qi_qtot(i,k) = qs_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
2665	rvc_seri(i,k) = rvc_seri(i,k) * q_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
2666	ELSE
2667	ratio_ql_qtot(i,k) = 0.
2668	ratio_qi_qtot(i,k) = 0.
2669	rvc_seri(i,k) = 0.
2670	ENDIF
2671	ENDDO
2672	ENDDO
2673	ELSE
2674	DO k = 1, klev
2675	DO i = 1, klon
2676	IF ( ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) .GT. 0. ) THEN
2677	ratio_ql_qtot(i,k) = ql_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
2678	ratio_qi_qtot(i,k) = qs_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
2679	ELSE
2680	ratio_ql_qtot(i,k) = 0.
2681	ratio_qi_qtot(i,k) = 0.
2682	ENDIF
2683	ENDDO
2684	ENDDO
2685	ENDIF
2686
2687	!
2688	! Re-evaporer l'eau liquide nuageuse
2689	!
2690	CALL reevap (klon,klev,iflag_ice_thermo,t_seri,q_seri,ql_seri,qs_seri, &
2691	& d_t_eva,d_q_eva,d_ql_eva,d_qi_eva)
2692
2693	CALL add_phys_tend &
2694	(du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva,dqbs0,paprs,&
2695	'eva',abortphy,flag_inhib_tend,itap,0)
2696	CALL prt_enerbil('eva',itap)
2697
2698	!=========================================================================
2699	! Calculs de l'orbite.
2700	! Necessaires pour le rayonnement et la surface (calcul de l'albedo).
2701	! doit donc etre plac\'e avant radlwsw et pbl_surface
2702
2703	! !! jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2704	CALL ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
2705	day_since_equinox = (jD_cur + jH_cur) - jD_eq
2706	!
2707	! choix entre calcul de la longitude solaire vraie ou valeur fixee a
2708	! solarlong0
2709	IF (solarlong0<-999.) THEN
2710	IF (new_orbit) THEN
2711	! calcul selon la routine utilisee pour les planetes
2712	CALL solarlong(day_since_equinox, zlongi, dist)
2713	ELSE
2714	! calcul selon la routine utilisee pour l'AR4
2715	CALL orbite(REAL(days_elapsed+1),zlongi,dist)
2716	ENDIF
2717	ELSE
2718	zlongi=solarlong0 ! longitude solaire vraie
2719	dist=1. ! distance au soleil / moyenne
2720	ENDIF
2721
2722	IF (prt_level.ge.1) write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
2723
2724
2725	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2726	! Calcul de l'ensoleillement :
2727	! ============================
2728	! Pour une solarlong0=1000., on calcule un ensoleillement moyen sur
2729	! l'annee a partir d'une formule analytique.
2730	! Cet ensoleillement est sym\'etrique autour de l'\'equateur et
2731	! non nul aux poles.
2732	IF (abs(solarlong0-1000.)<1.e-4) THEN
2733	CALL zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
2734	latitude_deg,longitude_deg,rmu0,fract)
2735	swradcorr(:) = 1.0
2736	JrNt(:) = 1.0
2737	zrmu0(:) = rmu0(:)
2738	ELSE
2739	! recode par Olivier Boucher en sept 2015
2740	SELECT CASE (iflag_cycle_diurne)
2741	CASE(0)
2742	! Sans cycle diurne
2743	CALL angle(zlongi, latitude_deg, fract, rmu0)
2744	swradcorr = 1.0
2745	JrNt = 1.0
2746	zrmu0 = rmu0
2747	CASE(1)
2748	! Avec cycle diurne sans application des poids
2749	! bit comparable a l ancienne formulation cycle_diurne=true
2750	! on integre entre gmtime et gmtime+radpas
2751	zdtime=phys_tstep*REAL(radpas) ! pas de temps du rayonnement (s)
2752	CALL zenang(zlongi,jH_cur,0.0,zdtime, &
2753	latitude_deg,longitude_deg,rmu0,fract)
2754	zrmu0 = rmu0
2755	swradcorr = 1.0
2756	! Calcul du flag jour-nuit
2757	JrNt = 0.0
2758	WHERE (fract.GT.0.0) JrNt = 1.0
2759	CASE(2)
2760	! Avec cycle diurne sans application des poids
2761	! On integre entre gmtime-pdtphys et gmtime+pdtphys*(radpas-1)
2762	! Comme cette routine est appele a tous les pas de temps de
2763	! la physique meme si le rayonnement n'est pas appele je
2764	! remonte en arriere les radpas-1 pas de temps
2765	! suivant. Petite ruse avec MOD pour prendre en compte le
2766	! premier pas de temps de la physique pendant lequel
2767	! itaprad=0
2768	zdtime1=phys_tstep*REAL(-MOD(itaprad,radpas)-1)
2769	zdtime2=phys_tstep*REAL(radpas-MOD(itaprad,radpas)-1)
2770	CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
2771	latitude_deg,longitude_deg,rmu0,fract)
2772	!
2773	! Calcul des poids
2774	!
2775	zdtime1=-phys_tstep !--on corrige le rayonnement pour representer le
2776	zdtime2=0.0 !--pas de temps de la physique qui se termine
2777	CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
2778	latitude_deg,longitude_deg,zrmu0,zfract)
2779	swradcorr = 0.0
2780	WHERE (rmu0.GE.1.e-10 .OR. fract.GE.1.e-10) &
2781	swradcorr=zfract/fract*zrmu0/rmu0
2782	! Calcul du flag jour-nuit
2783	JrNt = 0.0
2784	WHERE (zfract.GT.0.0) JrNt = 1.0
2785	END SELECT
2786	ENDIF
2787	sza_o = ACOS (rmu0) *180./pi
2788
2789	IF (mydebug) THEN
2790	CALL writefield_phy('u_seri',u_seri,nbp_lev)
2791	CALL writefield_phy('v_seri',v_seri,nbp_lev)
2792	CALL writefield_phy('t_seri',t_seri,nbp_lev)
2793	CALL writefield_phy('q_seri',q_seri,nbp_lev)
2794	ENDIF
2795
2796	!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
2797	! Appel au pbl_surface : Planetary Boudary Layer et Surface
2798	! Cela implique tous les interactions des sous-surfaces et la
2799	! partie diffusion turbulent du couche limit.
2800	!
2801	! Certains varibales de sorties de pbl_surface sont utiliser que pour
2802	! ecriture des fihiers hist_XXXX.nc, ces sont :
2803	! qsol, zq2m, s_pblh, s_lcl,
2804	! s_capCL, s_oliqCL, s_cteiCL,s_pblT,
2805	! s_therm, s_trmb1, s_trmb2, s_trmb3,
2806	! zu10m, zv10m, fder,
2807	! zxqsurf, delta_qsurf,
2808	! rh2m, zxfluxu, zxfluxv,
2809	! frugs, agesno, fsollw, fsolsw,
2810	! d_ts, fevap, fluxlat, t2m,
2811	! wfbils, fluxt, fluxu, fluxv,
2812	!
2813	! Certains ne sont pas utiliser du tout :
2814	! dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq
2815	!
2816
2817	! Calcul de l'humidite de saturation au niveau du sol
2818
2819	! Tests Fredho, instensibilite au pas de temps -------------------------------
2820	! A detruire en 2024 une fois les tests documentes et les choix faits !
2821	! Conservation des variables avant l'appel à l a diffusion pour les tehrmic !
2822	if (iflag_thermals_tenv / 10 == 1 ) then !
2823	do k=1,klev !
2824	do i=1,klon !
2825	t_env(i,k)=t_seri(i,k) !
2826	q_env(i,k)=q_seri(i,k) !
2827	enddo !
2828	enddo !
2829	else if (iflag_thermals_tenv / 10 == 2 ) then !
2830	do k=1,klev !
2831	do i=1,klon !
2832	t_env(i,k)=t_seri(i,k) !
2833	enddo !
2834	enddo !
2835	endif !
2836	! Tests Fredho, instensibilite au pas de temps -------------------------------
2837
2838
2839	IF (iflag_pbl/=0) THEN
2840
2841	!jyg+nrlmd<
2842	!!jyg IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
2843	IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,10) .ge. 1) THEN
2844	print *,'debut du splitting de la PBL, wake_s = ', wake_s(:)
2845	print *,'debut du splitting de la PBL, wake_deltat = ', wake_deltat(:,1)
2846	print *,'debut du splitting de la PBL, wake_deltaq = ', wake_deltaq(:,1)
2847	ENDIF
2848	! !!
2849	!>jyg+nrlmd
2850	!
2851	!-------gustiness calculation-------!
2852	!ym : Warning gustiness non inialized for iflag_gusts=2 & iflag_gusts=3
2853	gustiness=0 !ym missing init
2854
2855	IF (iflag_gusts==0) THEN
2856	gustiness(1:klon)=0
2857	ELSE IF (iflag_gusts==1) THEN
2858	gustiness(1:klon)=f_gust_blale_bl(1:klon)+f_gust_wkale_wake(1:klon)
2859	ELSE IF (iflag_gusts==2) THEN
2860	gustiness(1:klon)=f_gust_blale_bl_stat(1:klon)+f_gust_wkale_wake(1:klon)
2861	!!!! modif olivier torres
2862	ELSE IF (iflag_gusts==3) THEN
2863	w_et=wstar(1,3)
2864	jlr_g_s=(0.65w_et)*2
2865	pr_et=rain_con*8640
2866	jlr_g_c = (((19.8(pr_et(1:klon)2))/(1.5+pr_et(1:klon)+pr_et(1:klon)2))(0.4))*2
2867	gustiness(1:klon)=jlr_g_c+jlr_g_s
2868	!! write(,) "rain ",pr_et
2869	!! write(,) "jlr_g_c",jlr_g_c
2870	!! write(,) "wstar",wstar(1,3)
2871	!! write(,) "jlr_g_s",jlr_g_s
2872	! ELSE IF (iflag_gusts==2) THEN
2873	! do i = 1, klon
2874	! gustiness(i)=f_gust_blale_bl(i)+sigma_wk(i)f_gust_wk&
2875	! *ale_wake(i) !! need to make sigma_wk accessible here
2876	! enddo
2877	! ELSE IF (iflag_gusts==3) THEN
2878	! do i = 1, klon
2879	! gustiness(i)=f_gust_blalp_bl(i)+f_gust_wkalp_wake(i)
2880	! enddo
2881	ENDIF
2882
2883	CALL pbl_surface( &
2884	phys_tstep, date0, itap, days_elapsed+1, &
2885	debut, lafin, &
2886	longitude_deg, latitude_deg, rugoro, zrmu0, &
2887	!GG sollwdown, cldt, &
2888	sollwdown, pphi, cldt, &
2889	!GG
2890	rain_fall, snow_fall, bs_fall, solsw, solswfdiff, sollw, &
2891	gustiness, &
2892	t_seri, q_seri, qbs_seri, u_seri, v_seri, &
2893	!nrlmd+jyg<
2894	wake_deltat, wake_deltaq, wake_cstar, wake_s, &
2895	!>nrlmd+jyg
2896	pplay, paprs, pctsrf, &
2897	ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
2898	!albedo SB <<<
2899	cdragh, cdragm, u1, v1, &
2900	beta_aridity, &
2901	albsol_dir, albsol_dif, sens, evap, snowerosion, icesub_lic, &
2902	albsol3_lic,runoff, snowhgt, qsnow, to_ice, sissnow, &
2903	zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
2904	d_t_vdf, d_q_vdf, d_qbs_vdf, d_u_vdf, d_v_vdf, d_t_diss, &
2905	!nrlmd<
2906	!jyg<
2907	d_t_vdf_w, d_q_vdf_w, &
2908	d_t_vdf_x, d_q_vdf_x, &
2909	sens_x, zxfluxlat_x, sens_w, zxfluxlat_w, &
2910	!>jyg
2911	delta_tsurf,wake_dens, &
2912	cdragh_x,cdragh_w,cdragm_x,cdragm_w, &
2913	kh,kh_x,kh_w, &
2914	!>nrlmd
2915	coefh(1:klon,1:klev,1:nbsrf+1), coefm(1:klon,1:klev,1:nbsrf+1), &
2916	slab_wfbils, &
2917	qsol, zq2m, s_pblh, s_lcl, &
2918	!jyg<
2919	s_pblh_x, s_lcl_x, s_pblh_w, s_lcl_w, &
2920	!>jyg
2921	s_capCL, s_oliqCL, s_cteiCL,s_pblT, &
2922	s_therm, s_trmb1, s_trmb2, s_trmb3, &
2923	zustar, zu10m, zv10m, fder, &
2924	zxqsurf, delta_qsurf, rh2m, zxfluxu, zxfluxv, &
2925	z0m, z0h, agesno, fsollw, fsolsw, &
2926	d_ts, fevap, fluxlat, t2m, &
2927	wfbils, wfevap, &
2928	fluxt, fluxu, fluxv, &
2929	dsens, devap, zxsnow, &
2930	zxfluxt, zxfluxq, zxfluxqbs, q2m, fluxq, fluxqbs, pbl_tke, pbl_eps, &
2931	!nrlmd+jyg<
2932	wake_delta_pbl_TKE, &
2933	!>nrlmd+jyg
2934	!GG treedrg )
2935	treedrg,hice, tice, bilg_cumul, &
2936	fcds, fcdi, dh_basal_growth, dh_basal_melt, &
2937	dh_top_melt, dh_snow2sic, &
2938	dtice_melt, dtice_snow2sic , &
2939	!GG
2940	!FC
2941	!AM
2942	tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
2943	cdragm_tersrf, cdragh_tersrf, &
2944	swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf)
2945	!
2946	! Add turbulent diffusion tendency to the wake difference variables
2947	!!jyg IF (mod(iflag_pbl_split,2) .NE. 0) THEN
2948	IF (mod(iflag_pbl_split,10) .NE. 0) THEN
2949	!jyg<
2950	d_deltat_vdf(:,:) = d_t_vdf_w(:,:)-d_t_vdf_x(:,:)
2951	d_deltaq_vdf(:,:) = d_q_vdf_w(:,:)-d_q_vdf_x(:,:)
2952	CALL add_wake_tend &
2953	(d_deltat_vdf, d_deltaq_vdf, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'vdf', abortphy)
2954	ELSE
2955	d_deltat_vdf(:,:) = 0.
2956	d_deltaq_vdf(:,:) = 0.
2957	!>jyg
2958	ENDIF
2959
2960	!---------------------------------------------------------------------
2961	! ajout des tendances de la diffusion turbulente
2962	IF (klon_glo==1) THEN
2963	CALL add_pbl_tend &
2964	(d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,d_qbs_vdf,paprs,&
2965	'vdf',abortphy,flag_inhib_tend,itap)
2966	ELSE
2967	CALL add_phys_tend &
2968	(d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,d_qbs_vdf,paprs,&
2969	'vdf',abortphy,flag_inhib_tend,itap,0)
2970	ENDIF
2971	CALL prt_enerbil('vdf',itap)
2972
2973	!--------------------------------------------------------------------
2974
2975	IF (mydebug) THEN
2976	CALL writefield_phy('u_seri',u_seri,nbp_lev)
2977	CALL writefield_phy('v_seri',v_seri,nbp_lev)
2978	CALL writefield_phy('t_seri',t_seri,nbp_lev)
2979	CALL writefield_phy('q_seri',q_seri,nbp_lev)
2980	ENDIF
2981
2982	!albedo SB >>>
2983	albsol1=0.
2984	albsol2=0.
2985	falb1=0.
2986	falb2=0.
2987	SELECT CASE(nsw)
2988	CASE(2)
2989	albsol1=albsol_dir(:,1)
2990	albsol2=albsol_dir(:,2)
2991	falb1=falb_dir(:,1,:)
2992	falb2=falb_dir(:,2,:)
2993	CASE(4)
2994	albsol1=albsol_dir(:,1)
2995	albsol2=albsol_dir(:,2)SFRWL(2)+albsol_dir(:,3)SFRWL(3) &
2996	+albsol_dir(:,4)*SFRWL(4)
2997	albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
2998	falb1=falb_dir(:,1,:)
2999	falb2=falb_dir(:,2,:)SFRWL(2)+falb_dir(:,3,:)SFRWL(3) &
3000	+falb_dir(:,4,:)*SFRWL(4)
3001	falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
3002	CASE(6)
3003	albsol1=albsol_dir(:,1)SFRWL(1)+albsol_dir(:,2)SFRWL(2) &
3004	+albsol_dir(:,3)*SFRWL(3)
3005	albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
3006	albsol2=albsol_dir(:,4)SFRWL(4)+albsol_dir(:,5)SFRWL(5) &
3007	+albsol_dir(:,6)*SFRWL(6)
3008	albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
3009	falb1=falb_dir(:,1,:)SFRWL(1)+falb_dir(:,2,:)SFRWL(2) &
3010	+falb_dir(:,3,:)*SFRWL(3)
3011	falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
3012	falb2=falb_dir(:,4,:)SFRWL(4)+falb_dir(:,5,:)SFRWL(5) &
3013	+falb_dir(:,6,:)*SFRWL(6)
3014	falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
3015	END SELECt
3016	!albedo SB <<<
3017
3018
3019	CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
3020	t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot)
3021
3022	ENDIF
3023
3024	! ==================================================================
3025	! Blowing snow sublimation and sedimentation
3026
3027	d_t_bsss(:,:)=0.
3028	d_q_bsss(:,:)=0.
3029	d_qbs_bsss(:,:)=0.
3030	bsfl(:,:)=0.
3031	bs_fall(:)=0.
3032	IF (ok_bs) THEN
3033
3034	CALL call_blowing_snow_sublim_sedim(klon,klev,phys_tstep,t_seri,q_seri,qbs_seri,pplay,paprs, &
3035	d_t_bsss,d_q_bsss,d_qbs_bsss,bsfl,bs_fall)
3036
3037	CALL add_phys_tend &
3038	(du0,dv0,d_t_bsss,d_q_bsss,dql0,dqi0,d_qbs_bsss,paprs,&
3039	'bsss',abortphy,flag_inhib_tend,itap,0)
3040
3041	ENDIF
3042
3043	! =================================================================== c
3044	! Calcul de Qsat
3045
3046	DO k = 1, klev
3047	DO i = 1, klon
3048	zx_t = t_seri(i,k)
3049	IF (thermcep) THEN
3050	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
3051	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
3052	zx_qs = MIN(0.5,zx_qs)
3053	zcor = 1./(1.-retv*zx_qs)
3054	zx_qs = zx_qs*zcor
3055	ELSE
3056	!! IF (zx_t.LT.t_coup) THEN !jyg
3057	IF (zx_t.LT.rtt) THEN !jyg
3058	zx_qs = qsats(zx_t)/pplay(i,k)
3059	ELSE
3060	zx_qs = qsatl(zx_t)/pplay(i,k)
3061	ENDIF
3062	ENDIF
3063	zqsat(i,k)=zx_qs
3064	ENDDO
3065	ENDDO
3066
3067	IF (prt_level.ge.1) THEN
3068	write(lunout,*) 'L qsat (g/kg) avant clouds_gno'
3069	write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
3070	ENDIF
3071	!
3072	! Appeler la convection (au choix)
3073	!
3074	DO k = 1, klev
3075	DO i = 1, klon
3076	conv_q(i,k) = d_q_dyn(i,k) &
3077	+ d_q_vdf(i,k)/phys_tstep
3078	conv_t(i,k) = d_t_dyn(i,k) &
3079	+ d_t_vdf(i,k)/phys_tstep
3080	ENDDO
3081	ENDDO
3082
3083	! Calcule de vitesse verticale a partir de flux de masse verticale
3084	DO k = 1, klev
3085	DO i = 1, klon
3086	omega(i,k) = RG*flxmass_w(i,k) / cell_area(i)
3087	ENDDO
3088	ENDDO
3089
3090	IF (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
3091	omega(igout, :)
3092	!
3093	! Appel de la convection tous les "cvpas"
3094	!
3095	!!jyg IF (MOD(itapcv,cvpas).EQ.0) THEN
3096	!! print *,' physiq : itapcv, cvpas, itap-1, cvpas_0 ', &
3097	!! itapcv, cvpas, itap-1, cvpas_0
3098	IF (MOD(itapcv,cvpas).EQ.0 .OR. MOD(itap-1,cvpas_0).EQ.0) THEN
3099
3100	!
3101	! Mettre a zero des variables de sortie (pour securite)
3102	!
3103	pmflxr(:,:) = 0.
3104	pmflxs(:,:) = 0.
3105	wdtrainA(:,:) = 0.
3106	wdtrainS(:,:) = 0.
3107	wdtrainM(:,:) = 0.
3108	wdtrainAS(:,:) = 0.
3109	upwd(:,:) = 0.
3110	dnwd(:,:) = 0.
3111	ep(:,:) = 0.
3112	da(:,:)=0.
3113	mp(:,:)=0.
3114	wght_cvfd(:,:)=0.
3115	phi(:,:,:)=0.
3116	phi2(:,:,:)=0.
3117	epmlmMm(:,:,:)=0.
3118	eplaMm(:,:)=0.
3119	d1a(:,:)=0.
3120	dam(:,:)=0.
3121	elij(:,:,:)=0.
3122	ev(:,:)=0.
3123	qtaa(:,:)=0.
3124	clw(:,:)=0.
3125	sij(:,:,:)=0.
3126	!
3127	IF (iflag_con.EQ.1) THEN
3128	abort_message ='reactiver le call conlmd dans physiq.F'
3129	CALL abort_physic (modname,abort_message,1)
3130	! CALL conlmd (phys_tstep, paprs, pplay, t_seri, q_seri, conv_q,
3131	! . d_t_con, d_q_con,
3132	! . rain_con, snow_con, ibas_con, itop_con)
3133	ELSE IF (iflag_con.EQ.2) THEN
3134	CALL conflx(phys_tstep, paprs, pplay, t_seri, q_seri, &
3135	conv_t, conv_q, -evap, omega, &
3136	d_t_con, d_q_con, rain_con, snow_con, &
3137	pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
3138	kcbot, kctop, kdtop, pmflxr, pmflxs)
3139	d_u_con = 0.
3140	d_v_con = 0.
3141
3142	WHERE (rain_con < 0.) rain_con = 0.
3143	WHERE (snow_con < 0.) snow_con = 0.
3144	DO i = 1, klon
3145	ibas_con(i) = klev+1 - kcbot(i)
3146	itop_con(i) = klev+1 - kctop(i)
3147	ENDDO
3148	ELSE IF (iflag_con.GE.3) THEN
3149	! nb of tracers for the KE convection:
3150	! MAF la partie traceurs est faite dans phytrac
3151	! on met ntra=1 pour limiter les appels mais on peut
3152	! supprimer les calculs / ftra.
3153	ntra = 1
3154
3155	!=======================================================================
3156	!ajout pour la parametrisation des poches froides: calcul de
3157	!t_w et t_x: si pas de poches froides, t_w=t_x=t_seri
3158	IF (iflag_wake>=1) THEN
3159	DO k=1,klev
3160	DO i=1,klon
3161	t_w(i,k) = t_seri(i,k) + (1-wake_s(i))*wake_deltat(i,k)
3162	q_w(i,k) = q_seri(i,k) + (1-wake_s(i))*wake_deltaq(i,k)
3163	t_x(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
3164	q_x(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
3165	ENDDO
3166	ENDDO
3167	ELSE
3168	t_w(:,:) = t_seri(:,:)
3169	q_w(:,:) = q_seri(:,:)
3170	t_x(:,:) = t_seri(:,:)
3171	q_x(:,:) = q_seri(:,:)
3172	ENDIF
3173	!
3174	!jyg<
3175	! Perform dry adiabatic adjustment on wake profile
3176	! The corresponding tendencies are added to the convective tendencies
3177	! after the call to the convective scheme.
3178	IF (iflag_wake>=1) then
3179	IF (iflag_adjwk >= 1) THEN
3180	limbas(:) = 1
3181	CALL ajsec(paprs, pplay, t_w, q_w, limbas, &
3182	d_t_adjwk, d_q_adjwk)
3183	!
3184	DO k=1,klev
3185	DO i=1,klon
3186	IF (wake_s(i) .GT. 1.e-3) THEN
3187	t_w(i,k) = t_w(i,k) + d_t_adjwk(i,k)
3188	q_w(i,k) = q_w(i,k) + d_q_adjwk(i,k)
3189	d_deltat_ajs_cv(i,k) = d_t_adjwk(i,k)
3190	d_deltaq_ajs_cv(i,k) = d_q_adjwk(i,k)
3191	ELSE
3192	d_deltat_ajs_cv(i,k) = 0.
3193	d_deltaq_ajs_cv(i,k) = 0.
3194	ENDIF
3195	ENDDO
3196	ENDDO
3197	IF (iflag_adjwk == 2 .AND. OK_bug_ajs_cv) THEN
3198	CALL add_wake_tend &
3199	(d_deltat_ajs_cv, d_deltaq_ajs_cv, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'ajs_cv', abortphy)
3200	ENDIF ! (iflag_adjwk == 2 .AND. OK_bug_ajs_cv)
3201	ENDIF ! (iflag_adjwk >= 1)
3202	ENDIF ! (iflag_wake>=1)
3203	!>jyg
3204	!
3205
3206	!! print *,'physiq. q_w(1,k), q_x(1,k) ', &
3207	!! (k, q_w(1,k), q_x(1,k),k=1,25)
3208
3209	!jyg<
3210	CALL alpale( debut, itap, phys_tstep, paprs, omega, t_seri, &
3211	alp_offset, it_wape_prescr, wape_prescr, fip_prescr, &
3212	ale_bl_prescr, alp_bl_prescr, &
3213	wake_pe, wake_fip, &
3214	Ale_bl, Ale_bl_trig, Alp_bl, &
3215	Ale, Alp , Ale_wake, Alp_wake)
3216	!>jyg
3217	!
3218	! sb, oct02:
3219	! Schema de convection modularise et vectorise:
3220	! (driver commun aux versions 3 et 4)
3221	!
3222	IF (ok_cvl) THEN ! new driver for convectL
3223	!
3224	!jyg<
3225	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3226	! Calculate the upmost level of deep convection loops: k_upper_cv
3227	! (near 22 km)
3228	k_upper_cv = klev
3229	!izero = klon/2+1/klon
3230	!DO k = klev,1,-1
3231	! IF (pphi(izero,k) > 22.e4) k_upper_cv = k
3232	!ENDDO
3233	! FH : nouveau calcul base sur un profil global sans quoi
3234	! le modele etait sensible au decoupage de domaines
3235	DO k = klev,1,-1
3236	IF (-7*log(presnivs(k)/presnivs(1)) > 25.) k_upper_cv = k
3237	ENDDO
3238	IF (prt_level .ge. 5) THEN
3239	Print *, 'upmost level of deep convection loops: k_upper_cv = ', &
3240	k_upper_cv
3241	ENDIF
3242	!
3243	!>jyg
3244	IF (type_trac == 'repr') THEN
3245	nbtr_tmp=ntra
3246	ELSE
3247	nbtr_tmp=nbtr
3248	ENDIF
3249	!jyg iflag_con est dans clesphys
3250	!c CALL concvl (iflag_con,iflag_clos,
3251	CALL concvl (iflag_clos, &
3252	phys_tstep, paprs, pplay, k_upper_cv, t_x,q_x, &
3253	t_w,q_w,wake_s, &
3254	u_seri,v_seri,tr_seri,nbtr_tmp, &
3255	ALE,ALP, &
3256	sig1,w01, &
3257	d_t_con,d_q_con,fqcomp,d_u_con,d_v_con,d_tr, &
3258	rain_con, snow_con, ibas_con, itop_con, sigd, &
3259	ema_cbmf,plcl,plfc,wbeff,convoccur,upwd,dnwd,dnwd0, &
3260	Ma,mipsh,Vprecip,cape,cin,tvp,Tconv,iflagctrl, &
3261	pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &
3262	! RomP >>>
3263	!! . pmflxr,pmflxs,da,phi,mp,
3264	!! . ftd,fqd,lalim_conv,wght_th)
3265	pmflxr,pmflxs, &
3266	coef_clos, coef_clos_eff, &
3267	da,phi,mp,phi2,d1a,dam,sij,qtaa,clw,elij, &
3268	ftd,fqd,lalim_conv,wght_th, &
3269	ev, ep,epmlmMm,eplaMm, &
3270	wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv,detrain_cv, &
3271	tau_cld_cv,coefw_cld_cv,epmax_diag)
3272
3273	! RomP <<<
3274
3275	!IM begin
3276	! print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
3277	! .dnwd0(1,1),ftd(1,1),fqd(1,1)
3278	!IM end
3279	!IM cf. FH
3280	clwcon0=qcondc
3281	pmfu(:,:)=upwd(:,:)+dnwd(:,:)
3282	fm_cv(:,:)=upwd(:,:)+dnwd(:,:)+dnwd0(:,:)
3283	!
3284	!jyg<
3285	! If convective tendencies are too large, then call convection
3286	! every time step
3287	cvpas = cvpas_0
3288	DO k=1,k_upper_cv
3289	DO i=1,klon
3290	IF (d_t_con(i,k) > 6.721 .AND. d_t_con(i,k) < 6.722 .AND.&
3291	d_q_con(i,k) > -.0002171 .AND. d_q_con(i,k) < -.0002170) THEN
3292	dtcon_multistep_max = 3.
3293	dqcon_multistep_max = 0.02
3294	ENDIF
3295	ENDDO
3296	ENDDO
3297	!
3298	DO k=1,k_upper_cv
3299	DO i=1,klon
3300	!! IF (abs(d_t_con(i,k)) > 0.24 .OR. &
3301	!! abs(d_q_con(i,k)) > 2.e-2) THEN
3302	IF (abs(d_t_con(i,k)) > dtcon_multistep_max .OR. &
3303	abs(d_q_con(i,k)) > dqcon_multistep_max) THEN
3304	cvpas = 1
3305	!! print *,'physiq1, i,k,d_t_con(i,k),d_q_con(i,k) ', &
3306	!! i,k,d_t_con(i,k),d_q_con(i,k)
3307	ENDIF
3308	ENDDO
3309	ENDDO
3310	!!! Ligne a ne surtout pas remettre sans avoir murement reflechi (jyg)
3311	!!! call bcast(cvpas)
3312	!!! ------------------------------------------------------------
3313	!>jyg
3314	!
3315	DO i = 1, klon
3316	IF (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+cvpas
3317	ENDDO
3318	!
3319	!jyg<
3320	! Add the tendency due to the dry adjustment of the wake profile
3321	IF (iflag_wake>=1) THEN
3322	IF (iflag_adjwk == 2) THEN
3323	DO k=1,klev
3324	DO i=1,klon
3325	ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/phys_tstep
3326	fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/phys_tstep
3327	d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k)
3328	d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k)
3329	ENDDO
3330	ENDDO
3331	ENDIF ! (iflag_adjwk = 2)
3332	ENDIF ! (iflag_wake>=1)
3333	!>jyg
3334	!
3335	ELSE ! ok_cvl
3336
3337	! MAF conema3 ne contient pas les traceurs
3338	CALL conema3 (phys_tstep, &
3339	paprs,pplay,t_seri,q_seri, &
3340	u_seri,v_seri,tr_seri,ntra, &
3341	sig1,w01, &
3342	d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
3343	rain_con, snow_con, ibas_con, itop_con, &
3344	upwd,dnwd,dnwd0,bas,top, &
3345	Ma,cape,tvp,rflag, &
3346	pbase &
3347	,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr &
3348	,clwcon0)
3349
3350	ENDIF ! ok_cvl
3351
3352	!
3353	! Correction precip
3354	rain_con = rain_con * cvl_corr
3355	snow_con = snow_con * cvl_corr
3356	!
3357
3358	IF (.NOT. ok_gust) THEN
3359	do i = 1, klon
3360	wd(i)=0.0
3361	enddo
3362	ENDIF
3363
3364	! =================================================================== c
3365	! Calcul des proprietes des nuages convectifs
3366	!
3367
3368	! calcul des proprietes des nuages convectifs
3369	clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
3370	IF (iflag_cld_cv == 0) THEN
3371	CALL clouds_gno &
3372	(klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
3373	ELSE
3374	CALL clouds_bigauss &
3375	(klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
3376	ENDIF
3377
3378
3379	! =================================================================== c
3380
3381	DO i = 1, klon
3382	itop_con(i) = min(max(itop_con(i),1),klev)
3383	ibas_con(i) = min(max(ibas_con(i),1),itop_con(i))
3384	ENDDO
3385
3386	DO i = 1, klon
3387	! C Risi modif: pour éviter pb de dépassement d'indice dans les cas
3388	! où i n'est pas un point convectif et donc ibas_con(i)=0
3389	! c'est un pb indépendant des isotopes
3390	if (ibas_con(i) > 0) then
3391	ema_pcb(i) = paprs(i,ibas_con(i))
3392	else
3393	ema_pcb(i) = 0.0
3394	endif
3395	ENDDO
3396	DO i = 1, klon
3397	! L'idicage de itop_con peut cacher un pb potentiel
3398	! FH sous la dictee de JYG, CR
3399	ema_pct(i) = paprs(i,itop_con(i)+1)
3400
3401	IF (itop_con(i).gt.klev-3) THEN
3402	IF (prt_level >= 9) THEN
3403	write(lunout,*)'La convection monte trop haut '
3404	write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
3405	ENDIF
3406	ENDIF
3407	ENDDO
3408	ELSE IF (iflag_con.eq.0) THEN
3409	write(lunout,*) 'On n appelle pas la convection'
3410	clwcon0=0.
3411	rnebcon0=0.
3412	d_t_con=0.
3413	d_q_con=0.
3414	d_u_con=0.
3415	d_v_con=0.
3416	rain_con=0.
3417	snow_con=0.
3418	bas=1
3419	top=1
3420	ELSE
3421	WRITE(lunout,*) "iflag_con non-prevu", iflag_con
3422	CALL abort_physic("physiq", "", 1)
3423	ENDIF
3424
3425	!--saving d_X_con * zmass for next timestep if convection is not called every timestep
3426	IF (ok_mass_dqcon) THEN
3427	d_q_con_zmasse(:,:) = d_q_con(:,:) * zmasse(:,:)
3428	ENDIF
3429
3430	IF (ok_mass_dtcon) THEN
3431	d_t_con_zmasse(:,:) = d_t_con(:,:) * zmasse(:,:)
3432	ENDIF
3433
3434	IF (ok_mass_duvcon) THEN
3435	d_u_con_zmasse(:,:) = d_u_con(:,:) * zmasse(:,:)
3436	d_v_con_zmasse(:,:) = d_v_con(:,:) * zmasse(:,:)
3437	ENDIF
3438
3439
3440	! CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
3441	! . d_u_con, d_v_con)
3442
3443	!jyg Reinitialize proba_notrig and itapcv when convection has been called
3444	proba_notrig(:) = 1.
3445	itapcv = 0
3446	ENDIF ! (MOD(itapcv,cvpas).EQ.0 .OR. MOD(itapcv,cvpas_0).EQ.0)
3447	!
3448	itapcv = itapcv+1
3449	!
3450	! Compter les steps ou cvpas=1
3451	IF (cvpas == 1) THEN
3452	Ncvpaseq1 = Ncvpaseq1+1
3453	ENDIF
3454	IF (mod(itap,1000) == 0) THEN
3455	print *,' physiq, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
3456	ENDIF
3457
3458	!!!jyg Appel diagnostique a add_phys_tend pour tester la conservation de
3459	!!! l'energie dans les courants satures.
3460	!! d_t_con_sat(:,:) = d_t_con(:,:) - ftd(:,:)*dtime
3461	!! d_q_con_sat(:,:) = d_q_con(:,:) - fqd(:,:)*dtime
3462	!! dql_sat(:,:) = (wdtrainA(:,:)+wdtrainM(:,:))*dtime/zmasse(:,:)
3463	!! CALL add_phys_tend(d_u_con, d_v_con, d_t_con_sat, d_q_con_sat, dql_sat, &
3464	!! dqi0, paprs, 'convection_sat', abortphy, flag_inhib_tend,&
3465	!! itap, 1)
3466	!! call prt_enerbil('convection_sat',itap)
3467	!!
3468	!!
3469
3470	!--recompute d_X_con with zmasse from new timestep
3471	IF (ok_mass_dqcon) THEN
3472	d_q_con(:,:)=d_q_con_zmasse(:,:)/zmasse(:,:)
3473	ENDIF
3474
3475	IF (ok_mass_dtcon) THEN
3476	d_t_con(:,:)=d_t_con_zmasse(:,:)/zmasse(:,:)
3477	ENDIF
3478
3479	IF (ok_mass_duvcon) THEN
3480	d_u_con(:,:)=d_u_con_zmasse(:,:)/zmasse(:,:)
3481	d_v_con(:,:)=d_v_con_zmasse(:,:)/zmasse(:,:)
3482	ENDIF
3483
3484
3485
3486	CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, dqbs0, paprs, &
3487	'convection',abortphy,flag_inhib_tend,itap,0)
3488	CALL prt_enerbil('convection',itap)
3489
3490	!-------------------------------------------------------------------------
3491
3492	IF (mydebug) THEN
3493	CALL writefield_phy('u_seri',u_seri,nbp_lev)
3494	CALL writefield_phy('v_seri',v_seri,nbp_lev)
3495	CALL writefield_phy('t_seri',t_seri,nbp_lev)
3496	CALL writefield_phy('q_seri',q_seri,nbp_lev)
3497	ENDIF
3498
3499	!
3500	!==========================================================================
3501	!RR:Evolution de la poche froide: on ne fait pas de separation wake/env
3502	!pour la couche limite diffuse pour l instant
3503	!
3504	!
3505	! nrlmd le 22/03/2011---Si on met les poches hors des thermiques
3506	! il faut rajouter cette tendance calcul\'ee hors des poches
3507	! froides
3508	!
3509	IF (iflag_wake>=1) THEN
3510	!
3511	!
3512	! Call wakes every "wkpas" step
3513	!
3514	IF (MOD(itapwk,wkpas).EQ.0) THEN
3515	!
3516	DO k=1,klev
3517	DO i=1,klon
3518	dt_dwn(i,k) = ftd(i,k)
3519	dq_dwn(i,k) = fqd(i,k)
3520	M_dwn(i,k) = dnwd0(i,k)
3521	M_up(i,k) = upwd(i,k)
3522	dt_a(i,k) = d_t_con(i,k)/phys_tstep - ftd(i,k)
3523	dq_a(i,k) = d_q_con(i,k)/phys_tstep - fqd(i,k)
3524	ENDDO
3525	ENDDO
3526
3527	IF (iflag_wake==2) THEN
3528	ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
3529	DO k = 1,klev
3530	dt_dwn(:,k)= dt_dwn(:,k)+ &
3531	ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/phys_tstep
3532	dq_dwn(:,k)= dq_dwn(:,k)+ &
3533	ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/phys_tstep
3534	ENDDO
3535	ELSEIF (iflag_wake==3) THEN
3536	ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
3537	DO k = 1,klev
3538	DO i=1,klon
3539	IF (rneb(i,k)==0.) THEN
3540	! On ne tient compte des tendances qu'en dehors des
3541	! nuages (c'est-\`a-dire a priri dans une region ou
3542	! l'eau se reevapore).
3543	dt_dwn(i,k)= dt_dwn(i,k)+ &
3544	ok_wk_lsp(i)*d_t_lsc(i,k)/phys_tstep
3545	dq_dwn(i,k)= dq_dwn(i,k)+ &
3546	ok_wk_lsp(i)*d_q_lsc(i,k)/phys_tstep
3547	ENDIF
3548	ENDDO
3549	ENDDO
3550	ENDIF
3551
3552	!
3553	!calcul caracteristiques de la poche froide
3554	CALL calWAKE_first(phys_tstep)
3555	CALL calWAKE (iflag_wake_tend, paprs, pplay, phys_tstep, &
3556	t_seri, q_seri, omega, &
3557	dt_dwn, dq_dwn, M_dwn, M_up, &
3558	dt_a, dq_a, cv_gen, &
3559	sigd, cin, &
3560	wake_deltat, wake_deltaq, wake_s, awake_s, wake_dens, awake_dens, &
3561	wake_dth, wake_h, &
3562	!! wake_pe, wake_fip, wake_gfl, &
3563	wake_pe, wake_fip_0, wake_gfl, & !! jyg
3564	d_t_wake, d_q_wake, &
3565	wake_k, t_x, q_x, &
3566	wake_omgbdth, wake_dp_omgb, &
3567	wake_dtKE, wake_dqKE, &
3568	wake_omg, wake_dp_deltomg, &
3569	wake_spread, wake_Cstar, d_deltat_wk_gw, &
3570	d_deltat_wk, d_deltaq_wk, d_s_wk, d_s_a_wk, d_dens_wk, d_dens_a_wk)
3571	!
3572	!jyg Reinitialize itapwk when wakes have been called
3573	itapwk = 0
3574	ENDIF ! (MOD(itapwk,wkpas).EQ.0)
3575	!
3576	itapwk = itapwk+1
3577	!
3578	!-----------------------------------------------------------------------
3579	! ajout des tendances des poches froides
3580	CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,dqbs0,paprs,'wake', &
3581	abortphy,flag_inhib_tend,itap,0)
3582	CALL prt_enerbil('wake',itap)
3583	!------------------------------------------------------------------------
3584
3585	! Increment Wake state variables
3586	IF (iflag_wake_tend .GT. 0.) THEN
3587
3588	CALL add_wake_tend &
3589	(d_deltat_wk, d_deltaq_wk, d_s_wk, d_s_a_wk, d_dens_wk, d_dens_a_wk, wake_k, &
3590	'wake', abortphy)
3591	CALL prt_enerbil('wake',itap)
3592	ENDIF ! (iflag_wake_tend .GT. 0.)
3593	!
3594	IF (prt_level .GE. 10) THEN
3595	print *,' physiq, after calwake, wake_s: ',wake_s(:)
3596	print *,' physiq, after calwake, wake_deltat: ',wake_deltat(:,1)
3597	print *,' physiq, after calwake, wake_deltaq: ',wake_deltaq(:,1)
3598	ENDIF
3599
3600	IF (iflag_alp_wk_cond .GT. 0.) THEN
3601
3602	CALL alpale_wk(phys_tstep, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, &
3603	wake_fip)
3604	ELSE
3605	wake_fip(:) = wake_fip_0(:)
3606	ENDIF ! (iflag_alp_wk_cond .GT. 0.)
3607
3608	ENDIF ! (iflag_wake>=1)
3609	!
3610	!===================================================================
3611	! Convection seche (thermiques ou ajustement)
3612	!===================================================================
3613	!
3614	CALL stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
3615	,seuil_inversion,weak_inversion,dthmin)
3616
3617
3618
3619	d_t_ajsb(:,:)=0.
3620	d_q_ajsb(:,:)=0.
3621	d_t_ajs(:,:)=0.
3622	d_u_ajs(:,:)=0.
3623	d_v_ajs(:,:)=0.
3624	d_q_ajs(:,:)=0.
3625	clwcon0th(:,:)=0.
3626	!
3627	! fm_therm(:,:)=0.
3628	! entr_therm(:,:)=0.
3629	! detr_therm(:,:)=0.
3630	!
3631	IF (prt_level>9) WRITE(lunout,*) &
3632	'AVANT LA CONVECTION SECHE , iflag_thermals=' &
3633	,iflag_thermals,' nsplit_thermals=',nsplit_thermals
3634	IF (iflag_thermals<0) THEN
3635	! Rien
3636	! ====
3637	IF (prt_level>9) WRITE(lunout,*)'pas de convection seche'
3638	WRITE(lunout,*) 'WARNING : running without dry convection. Somme intermediate variables are not properly defined in physiq_mod.F90'
3639	! Reprendre proprement les initialisation ci dessouds si on veut vraiment utiliser l'option (FH)
3640	fraca(:,:)=0.
3641	fm_therm(:,:)=0.
3642	ztv(:,:)=t_seri(:,:)
3643	zqasc(:,:)=q_seri(:,:)
3644	ztla(:,:)=0.
3645	zthl(:,:)=0.
3646	zpspsk(:,:)=(pplay(:,:)/100000.)**RKAPPA
3647
3648
3649
3650	ELSE
3651
3652	! Thermiques
3653	! ==========
3654	IF (prt_level>9) WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
3655	,iflag_thermals,' nsplit_thermals=',nsplit_thermals
3656
3657
3658	!cc nrlmd le 10/04/2012
3659	DO k=1,klev+1
3660	DO i=1,klon
3661	pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce)
3662	pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter)
3663	pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic)
3664	pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic)
3665	ENDDO
3666	ENDDO
3667	!cc fin nrlmd le 10/04/2012
3668
3669	IF (iflag_thermals>=1) THEN
3670
3671	! Tests Fredho, instensibilite au pas de temps -------------------------------
3672	! A detruire en 2024 une fois les tests documentes et les choix faits !
3673	if (iflag_thermals_tenv /10 == 0 ) then !
3674	do k=1,klev !
3675	do i=1,klon !
3676	t_env(i,k)=t_seri(i,k) !
3677	q_env(i,k)=q_seri(i,k) !
3678	enddo !
3679	enddo !
3680	else if (iflag_thermals_tenv / 10 == 2 ) then !
3681	do k=1,klev !
3682	do i=1,klon !
3683	q_env(i,k)=q_seri(i,k) !
3684	enddo !
3685	enddo !
3686	else if (iflag_thermals_tenv / 10 == 3 ) then !
3687	do k=1,klev !
3688	do i=1,klon !
3689	t_env(i,k)=t(i,k) !
3690	q_env(i,k)=qx(i,k,1) !
3691	enddo !
3692	enddo !
3693	endif !
3694	! Tests Fredho, instensibilite au pas de temps ------------------------------
3695
3696	!jyg<
3697	!! IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
3698	IF (mod(iflag_pbl_split/10,10) .GE. 1) THEN
3699	! Appel des thermiques avec les profils exterieurs aux poches
3700	DO k=1,klev
3701	DO i=1,klon
3702	t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
3703	q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
3704	t_env(i,k) = t_env(i,k) - wake_s(i)*wake_deltat(i,k)
3705	q_env(i,k) = q_env(i,k) - wake_s(i)*wake_deltaq(i,k)
3706	u_therm(i,k) = u_seri(i,k)
3707	v_therm(i,k) = v_seri(i,k)
3708	ENDDO
3709	ENDDO
3710	ELSE
3711	! Appel des thermiques avec les profils moyens
3712	DO k=1,klev
3713	DO i=1,klon
3714	t_therm(i,k) = t_seri(i,k)
3715	q_therm(i,k) = q_seri(i,k)
3716	u_therm(i,k) = u_seri(i,k)
3717	v_therm(i,k) = v_seri(i,k)
3718	ENDDO
3719	ENDDO
3720	ENDIF
3721	!>jyg
3722	CALL calltherm(itap, pdtphys &
3723	,pplay,paprs,pphi,weak_inversion &
3724	! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
3725	,u_therm,v_therm,t_therm,q_therm,t_env,q_env,zqsat,debut & !jyg
3726	,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
3727	,fm_therm,entr_therm,detr_therm &
3728	,zqasc,clwcon0th,lmax_th,ratqscth &
3729	,ratqsdiff,zqsatth &
3730	!on rajoute ale et alp, et les
3731	!caracteristiques de la couche alim
3732	,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca &
3733	,ztv,zpspsk,ztla,zthl &
3734	!cc nrlmd le 10/04/2012
3735	,pbl_tke_input,pctsrf,omega,cell_area &
3736	,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
3737	,n2,s2,strig,zcong,ale_bl_stat &
3738	,therm_tke_max,env_tke_max &
3739	,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
3740	,alp_bl_conv,alp_bl_stat &
3741	!cc fin nrlmd le 10/04/2012
3742	,zqla,ztva )
3743	!
3744	!jyg<
3745	!!jyg IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
3746	IF (mod(iflag_pbl_split/10,10) .GE. 1) THEN
3747	! Si les thermiques ne sont presents que hors des
3748	! poches, la tendance moyenne associ\'ee doit etre
3749	! multipliee par la fraction surfacique qu'ils couvrent.
3750	IF (mod(iflag_pbl_split/10,10) == 1) THEN
3751	! On tient compte du splitting pour modifier les profils deltatq/T des poches
3752	DO k=1,klev
3753	DO i=1,klon
3754	d_deltat_the(i,k) = - d_t_ajs(i,k)
3755	d_deltaq_the(i,k) = - d_q_ajs(i,k)
3756	ENDDO
3757	ENDDO
3758	ELSE
3759	d_deltat_the(:,:) = 0.
3760	d_deltaq_the(:,:) = 0.
3761	ENDIF
3762
3763	DO k=1,klev
3764	DO i=1,klon
3765	d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i))
3766	d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i))
3767	d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i))
3768	d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i))
3769	ENDDO
3770	ENDDO
3771	!
3772	IF (ok_bug_split_th) THEN
3773	CALL add_wake_tend &
3774	(d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'the', abortphy)
3775	ELSE
3776	CALL add_wake_tend &
3777	(d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wake_k, 'the', abortphy)
3778	ENDIF
3779	CALL prt_enerbil('the',itap)
3780	!
3781	ENDIF ! (mod(iflag_pbl_split/10,10) .GE. 1)
3782	!
3783	CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs, &
3784	dql0,dqi0,dqbs0,paprs,'thermals', abortphy,flag_inhib_tend,itap,0)
3785	CALL prt_enerbil('thermals',itap)
3786	!
3787	!
3788	CALL alpale_th( phys_tstep, lmax_th, t_seri, cell_area, &
3789	cin, s2, n2, strig, &
3790	ale_bl_trig, ale_bl_stat, ale_bl, &
3791	alp_bl, alp_bl_stat, &
3792	proba_notrig, random_notrig, cv_gen)
3793	!>jyg
3794
3795	! ------------------------------------------------------------------
3796	! Transport de la TKE par les panaches thermiques.
3797	! FH : 2010/02/01
3798	if (iflag_thermcell_tke==1) then
3799	call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,rg,paprs,pbl_tke)
3800	endif
3801	! -------------------------------------------------------------------
3802
3803	DO i=1,klon
3804	! zmax_th(i)=pphi(i,lmax_th(i))/rg
3805	!CR:04/05/12:correction calcul zmax
3806	zmax_th(i)=zmax0(i)
3807	ENDDO
3808
3809	ENDIF
3810
3811	! Ajustement sec
3812	! ==============
3813
3814	! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
3815	! a partir du sommet des thermiques.
3816	! Dans le cas contraire, on demarre au niveau 1.
3817
3818	IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN
3819
3820	IF (iflag_thermals.eq.0) THEN
3821	IF (prt_level>9) WRITE(lunout,*)'ajsec'
3822	limbas(:)=1
3823	ELSE
3824	limbas(:)=lmax_th(:)
3825	ENDIF
3826
3827	! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
3828	! pour des test de convergence numerique.
3829	! Le nouveau ajsec est a priori mieux, meme pour le cas
3830	! iflag_thermals = 0 (l'ancienne version peut faire des tendances
3831	! non nulles numeriquement pour des mailles non concernees.
3832
3833	IF (iflag_thermals==0) THEN
3834	! Calling adjustment alone (but not the thermal plume model)
3835	CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
3836	, d_t_ajsb, d_q_ajsb)
3837	ELSE IF (iflag_thermals>0) THEN
3838	! Calling adjustment above the top of thermal plumes
3839	CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
3840	, d_t_ajsb, d_q_ajsb)
3841	ENDIF
3842
3843	!--------------------------------------------------------------------
3844	! ajout des tendances de l'ajustement sec ou des thermiques
3845	CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,dqbs0,paprs, &
3846	'ajsb',abortphy,flag_inhib_tend,itap,0)
3847	CALL prt_enerbil('ajsb',itap)
3848	d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
3849	d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
3850
3851	!---------------------------------------------------------------------
3852
3853	ENDIF
3854
3855	ENDIF
3856	!
3857	!===================================================================
3858	! Computation of subrgid scale near-surface wind distribution
3859	! Developed for dust lifting. Could be extended to coupling with ocean and others
3860	! by default : 1 bin equal to the mean wind
3861
3862	call surf_wind(klon,nsurfwind,zu10m,zv10m,wake_s,wake_Cstar,zustar,ale_bl,surf_wind_value,surf_wind_proba)
3863
3864	!===================================================================
3865	! Computation of ratqs, the width (normalized) of the subrid scale
3866	! water distribution
3867
3868	l_mix_ave(:,:)=0.
3869	wprime_ave(:,:)=0.
3870
3871	DO nsrf = 1, nbsrf
3872	DO i = 1, klon
3873	l_mix_ave(i,:) = l_mix_ave(i,:) + l_mix(i,:,nsrf)*pctsrf(i,nsrf)
3874	wprime_ave(i,:) = wprime_ave(i,:) + wprime(i,:,nsrf)*pctsrf(i,nsrf)
3875	ENDDO
3876	ENDDO
3877
3878	CALL ratqs_main(klon,klev,nbsrf,prt_level,lunout, &
3879	iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
3880	ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
3881	pctsrf,s_pblh,zstd, &
3882	tau_ratqs,fact_cldcon,wake_s, wake_deltaq, &
3883	ptconv,ptconvth,clwcon0th, rnebcon0th, &
3884	paprs,pplay,t_seri,q_seri, &
3885	qtc_cv, sigt_cv,detrain_cv,fm_cv,fqd,fqcomp,sigd,zqsat, &
3886	omega,pbl_tke(:,:,is_ave),pbl_eps(:,:,is_ave),l_mix_ave,wprime_ave, &
3887	t2m,q2m,fm_therm,entr_therm,detr_therm,cell_area, &
3888	ratqs,ratqsc,ratqs_inter_,sigma_qtherm)
3889
3890	!
3891	! Appeler le processus de condensation a grande echelle
3892	! et le processus de precipitation
3893	!-------------------------------------------------------------------------
3894	IF (prt_level .GE.10) THEN
3895	print *,'itap, ->fisrtilp ',itap
3896	ENDIF
3897	!
3898
3899	picefra(:,:)=0.
3900
3901	IF (ok_new_lscp) THEN
3902
3903
3904	DO k = 1, klev
3905	DO i = 1, klon
3906	ql_seri_lscp(i,k) = ratio_ql_qtot(i,k) * q_seri(i,k)
3907	qi_seri_lscp(i,k) = ratio_qi_qtot(i,k) * q_seri(i,k)
3908	ENDDO
3909	ENDDO
3910
3911
3912	!--mise à jour de flight_m et flight_h2o dans leur module
3913	!IF (ok_plane_h2o .OR. ok_plane_contrail) THEN
3914	! CALL airplane(debut,pphis,pplay,paprs,t_seri)
3915	!ENDIF
3916
3917	CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay,omega, &
3918	t_seri, q_seri, ql_seri_lscp, qi_seri_lscp, ptconv, ratqs, sigma_qtherm, &
3919	d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, &
3920	pfraclr, pfracld, cldfraliq, cldfraliqth, &
3921	sigma2_icefracturb, sigma2_icefracturbth, &
3922	mean_icefracturb, mean_icefracturbth, &
3923	radocond, picefra, rain_lsc, snow_lsc, &
3924	frac_impa, frac_nucl, beta_prec_fisrt, &
3925	prfl, psfl, rhcl, &
3926	zqasc, fraca,ztv,zpspsk,ztla,zthl,zw2,iflag_cld_th, &
3927	iflag_ice_thermo, distcltop, temp_cltop, &
3928	pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), &
3929	entr_therm, detr_therm, &
3930	cell_area, &
3931	cf_seri, rvc_seri, u_seri, v_seri, &
3932	qsub, qissr, qcld, subfra, issrfra, gamma_cond, &
3933	dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
3934	dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, &
3935	Tcontr, qcontr, qcontr2, fcontrN, fcontrP, &
3936	dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, &
3937	cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, &
3938	qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, &
3939	dqrfreez, dqsauto, dqsagg, dqsrim, dqsmelt, dqsfreez)
3940
3941
3942	ELSE
3943
3944	CALL fisrtilp_first(klon, klev, phys_tstep, pfrac_impa, pfrac_nucl, pfrac_1nucl)
3945	CALL fisrtilp(klon,klev,phys_tstep,paprs,pplay, &
3946	t_seri, q_seri,ptconv,ratqs,sigma_qtherm, &
3947	d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, radocond, &
3948	rain_lsc, snow_lsc, &
3949	pfrac_impa, pfrac_nucl, pfrac_1nucl, &
3950	frac_impa, frac_nucl, beta_prec_fisrt, &
3951	prfl, psfl, rhcl, &
3952	zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
3953	iflag_ice_thermo, &
3954	cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
3955
3956	ENDIF
3957	!
3958	WHERE (rain_lsc < 0) rain_lsc = 0.
3959	WHERE (snow_lsc < 0) snow_lsc = 0.
3960
3961	!+JLD
3962	! write(*,9000) 'phys lsc',"enerbil: bil_q, bil_e,",rain_lsc+snow_lsc &
3963	! & ,((rcw-rcpd)rain_lsc + (rcs-rcpd)snow_lsc)t_seri(1,1)-rlvttrain_lsc+rlstt*snow_lsc &
3964	! & ,rain_lsc,snow_lsc
3965	! write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
3966	!-JLD
3967	CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,dqbs0,paprs, &
3968	'lsc',abortphy,flag_inhib_tend,itap,0)
3969	CALL prt_enerbil('lsc',itap)
3970	rain_num(:)=0.
3971	DO k = 1, klev
3972	DO i = 1, klon
3973	IF (ql_seri(i,k)>oliqmax) THEN
3974	rain_num(i)=rain_num(i)+(ql_seri(i,k)-oliqmax)*zmasse(i,k)/pdtphys
3975	ql_seri(i,k)=oliqmax
3976	ENDIF
3977	ENDDO
3978	ENDDO
3979	IF (nqo >= 3) THEN
3980	DO k = 1, klev
3981	DO i = 1, klon
3982	IF (qs_seri(i,k)>oicemax) THEN
3983	rain_num(i)=rain_num(i)+(qs_seri(i,k)-oicemax)*zmasse(i,k)/pdtphys
3984	qs_seri(i,k)=oicemax
3985	ENDIF
3986	ENDDO
3987	ENDDO
3988	ENDIF
3989
3990
3991	!---------------------------------------------------------------------------
3992	DO k = 1, klev
3993	DO i = 1, klon
3994	cldfra(i,k) = rneb(i,k)
3995	! keep only liquid droplets in radocond if not liqice_in_radocond
3996	IF (.NOT.liqice_in_radocond) radocond(i,k) = ql_seri(i,k)
3997	ENDDO
3998	ENDDO
3999
4000
4001	! Option to activate the radiative effect of blowing snow (ok_rad_bs)
4002	! makes sense only if the new large scale condensation scheme is active
4003	! with the ok_icefra_lscp flag active as well
4004
4005	IF (ok_bs .AND. ok_rad_bs) THEN
4006	IF (ok_new_lscp .AND. ok_icefra_lscp) THEN
4007	DO k=1,klev
4008	DO i=1,klon
4009	radocond(i,k)=radocond(i,k)+qbs_seri(i,k)
4010	picefra(i,k)=(radocond(i,k)*picefra(i,k)+qbs_seri(i,k))/(radocond(i,k))
4011	qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0)
4012	cldfra(i,k)=max(cldfra(i,k),qbsfra)
4013	ENDDO
4014	ENDDO
4015	ELSE
4016	WRITE(lunout,*)"PAY ATTENTION, you try to activate the radiative effect of blowing snow"
4017	WRITE(lunout,*)"with ok_new_lscp=false and/or ok_icefra_lscp=false"
4018	abort_message='inconsistency in cloud phase for blowing snow'
4019	CALL abort_physic(modname,abort_message,1)
4020	ENDIF
4021
4022	ENDIF
4023
4024	IF (mydebug) THEN
4025	CALL writefield_phy('u_seri',u_seri,nbp_lev)
4026	CALL writefield_phy('v_seri',v_seri,nbp_lev)
4027	CALL writefield_phy('t_seri',t_seri,nbp_lev)
4028	CALL writefield_phy('q_seri',q_seri,nbp_lev)
4029	ENDIF
4030
4031	!
4032	!-------------------------------------------------------------------
4033	! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
4034	!-------------------------------------------------------------------
4035
4036	! 1. NUAGES CONVECTIFS
4037	!
4038	!IM cf FH
4039	! IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
4040	IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
4041	snow_tiedtke=0.
4042	! print*,'avant calcul de la pseudo precip '
4043	! print*,'iflag_cld_th',iflag_cld_th
4044	IF (iflag_cld_th.eq.-1) THEN
4045	rain_tiedtke=rain_con
4046	ELSE
4047	! print*,'calcul de la pseudo precip '
4048	rain_tiedtke=0.
4049	! print*,'calcul de la pseudo precip 0'
4050	DO k=1,klev
4051	DO i=1,klon
4052	IF (d_q_con(i,k).lt.0.) THEN
4053	rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
4054	*(paprs(i,k)-paprs(i,k+1))/rg
4055	ENDIF
4056	ENDDO
4057	ENDDO
4058	ENDIF
4059	!
4060	! call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
4061	!
4062
4063	! Nuages diagnostiques pour Tiedtke
4064	CALL diagcld1(paprs,pplay, &
4065	!IM cf FH. rain_con,snow_con,ibas_con,itop_con,
4066	rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
4067	diafra,dialiq)
4068	DO k = 1, klev
4069	DO i = 1, klon
4070	IF (diafra(i,k).GT.cldfra(i,k)) THEN
4071	radocond(i,k) = dialiq(i,k)
4072	cldfra(i,k) = diafra(i,k)
4073	ENDIF
4074	ENDDO
4075	ENDDO
4076
4077	ELSE IF (iflag_cld_th.ge.3) THEN
4078	! On prend pour les nuages convectifs le max du calcul de la
4079	! convection et du calcul du pas de temps precedent diminue d'un facteur
4080	! facttemps
4081	facteur = pdtphys *facttemps
4082	DO k=1,klev
4083	DO i=1,klon
4084	rnebcon(i,k)=rnebcon(i,k)*facteur
4085	IF (rnebcon0(i,k)clwcon0(i,k).GT.rnebcon(i,k)clwcon(i,k)) THEN
4086	rnebcon(i,k)=rnebcon0(i,k)
4087	clwcon(i,k)=clwcon0(i,k)
4088	ENDIF
4089	ENDDO
4090	ENDDO
4091
4092	! On prend la somme des fractions nuageuses et des contenus en eau
4093
4094	IF (iflag_cld_th>=5) THEN
4095
4096	DO k=1,klev
4097	ptconvth(:,k)=fm_therm(:,k+1)>0.
4098	ENDDO
4099
4100	IF (iflag_coupl==4) THEN
4101
4102	! Dans le cas iflag_coupl==4, on prend la somme des convertures
4103	! convectives et lsc dans la partie des thermiques
4104	! Le controle par iflag_coupl est peut etre provisoire.
4105	DO k=1,klev
4106	DO i=1,klon
4107	IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
4108	radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
4109	cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
4110	ELSE IF (ptconv(i,k)) THEN
4111	cldfra(i,k)=rnebcon(i,k)
4112	radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
4113	ENDIF
4114	ENDDO
4115	ENDDO
4116
4117	ELSE IF (iflag_coupl==5) THEN
4118	DO k=1,klev
4119	DO i=1,klon
4120	cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
4121	radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
4122	ENDDO
4123	ENDDO
4124
4125	ELSE
4126
4127	! Si on est sur un point touche par la convection
4128	! profonde et pas par les thermiques, on prend la
4129	! couverture nuageuse et l'eau nuageuse de la convection
4130	! profonde.
4131
4132	!IM/FH: 2011/02/23
4133	! definition des points sur lesquels ls thermiques sont actifs
4134
4135	DO k=1,klev
4136	DO i=1,klon
4137	IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
4138	cldfra(i,k)=rnebcon(i,k)
4139	radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
4140	ENDIF
4141	ENDDO
4142	ENDDO
4143
4144	ENDIF
4145
4146	ELSE
4147
4148	! Ancienne version
4149	cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
4150	radocond(:,:)=radocond(:,:)+rnebcon(:,:)*clwcon(:,:)
4151	ENDIF
4152
4153	ENDIF
4154
4155	! plulsc(:)=0.
4156	! do k=1,klev,-1
4157	! do i=1,klon
4158	! zzz=prfl(:,k)+psfl(:,k)
4159	! if (.not.ptconvth.zzz.gt.0.)
4160	! enddo prfl, psfl,
4161	! enddo
4162	!
4163	! 2. NUAGES STARTIFORMES
4164	!
4165	IF (ok_stratus) THEN
4166	CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
4167	DO k = 1, klev
4168	DO i = 1, klon
4169	IF (diafra(i,k).GT.cldfra(i,k)) THEN
4170	radocond(i,k) = dialiq(i,k)
4171	cldfra(i,k) = diafra(i,k)
4172	ENDIF
4173	ENDDO
4174	ENDDO
4175	ENDIF
4176	!
4177	! Precipitation totale
4178	!
4179	DO i = 1, klon
4180	rain_fall(i) = rain_con(i) + rain_lsc(i)
4181	snow_fall(i) = snow_con(i) + snow_lsc(i)
4182	ENDDO
4183	!
4184	! Calculer l'humidite relative pour diagnostique
4185	!
4186	DO k = 1, klev
4187	DO i = 1, klon
4188	zx_t = t_seri(i,k)
4189	IF (thermcep) THEN
4190	!! if (iflag_ice_thermo.eq.0) then !jyg
4191	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
4192	!! else !jyg
4193	!! zdelta = MAX(0.,SIGN(1.,t_glace_min-zx_t)) !jyg
4194	!! endif !jyg
4195	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
4196	zx_qs = MIN(0.5,zx_qs)
4197	zcor = 1./(1.-retv*zx_qs)
4198	zx_qs = zx_qs*zcor
4199	ELSE
4200	!! IF (zx_t.LT.t_coup) THEN !jyg
4201	IF (zx_t.LT.rtt) THEN !jyg
4202	zx_qs = qsats(zx_t)/pplay(i,k)
4203	ELSE
4204	zx_qs = qsatl(zx_t)/pplay(i,k)
4205	ENDIF
4206	ENDIF
4207	zx_rh(i,k) = q_seri(i,k)/zx_qs
4208	IF (iflag_ice_thermo .GT. 0) THEN
4209	zx_rhl(i,k) = q_seri(i,k)/(qsatl(zx_t)/pplay(i,k))
4210	zx_rhi(i,k) = q_seri(i,k)/(qsats(zx_t)/pplay(i,k))
4211	ENDIF
4212	zqsat(i,k)=zx_qs
4213	ENDDO
4214	ENDDO
4215
4216	!IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle
4217	! equivalente a 2m (tpote) pour diagnostique
4218	!
4219	DO i = 1, klon
4220	tpot(i)=zt2m(i)(100000./paprs(i,1))*RKAPPA
4221	IF (thermcep) THEN
4222	IF(zt2m(i).LT.RTT) then
4223	Lheat=RLSTT
4224	ELSE
4225	Lheat=RLVTT
4226	ENDIF
4227	ELSE
4228	IF (zt2m(i).LT.RTT) THEN
4229	Lheat=RLSTT
4230	ELSE
4231	Lheat=RLVTT
4232	ENDIF
4233	ENDIF
4234	tpote(i) = tpot(i)* &
4235	EXP((Lheat qsat2m(i))/(RCPDzt2m(i)))
4236	ENDDO
4237
4238	IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL
4239	IF (CPPKEY_INCA) THEN
4240	CALL VTe(VTphysiq)
4241	CALL VTb(VTinca)
4242	calday = REAL(days_elapsed + 1) + jH_cur
4243
4244	CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)
4245	CALL AEROSOL_METEO_CALC( &
4246	calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
4247	prfl,psfl,pctsrf,cell_area, &
4248	latitude_deg,longitude_deg,u10m,v10m)
4249
4250	zxsnow_dummy(:) = 0.0
4251
4252	CALL chemhook_begin (calday, &
4253	days_elapsed+1, &
4254	jH_cur, &
4255	pctsrf(1,1), &
4256	latitude_deg, &
4257	longitude_deg, &
4258	cell_area, &
4259	paprs, &
4260	pplay, &
4261	coefh(1:klon,1:klev,is_ave), &
4262	pphi, &
4263	t_seri, &
4264	u, &
4265	v, &
4266	rot, &
4267	wo(:, :, 1), &
4268	q_seri, &
4269	zxtsol, &
4270	zt2m, &
4271	zxsnow_dummy, &
4272	solsw, &
4273	albsol1, &
4274	rain_fall, &
4275	snow_fall, &
4276	itop_con, &
4277	ibas_con, &
4278	cldfra, &
4279	nbp_lon, &
4280	nbp_lat-1, &
4281	tr_seri(:,:,1+nqCO2:nbtr), &
4282	ftsol, &
4283	paprs, &
4284	cdragh, &
4285	cdragm, &
4286	pctsrf, &
4287	pdtphys, &
4288	itap)
4289
4290	CALL VTe(VTinca)
4291	CALL VTb(VTphysiq)
4292	END IF
4293	ENDIF !type_trac = inca or inco
4294	IF (type_trac == 'repr') THEN
4295	IF (CPPKEY_REPROBUS) THEN
4296	!CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
4297	CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
4298	END IF
4299	ENDIF
4300
4301	!
4302	! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
4303	!
4304	IF (MOD(itaprad,radpas).EQ.0) THEN
4305
4306	!
4307	!jq - introduce the aerosol direct and first indirect radiative forcings
4308	!jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
4309	IF (flag_aerosol .GT. 0) THEN
4310	IF (iflag_rrtm .EQ. 0) THEN !--old radiation
4311	IF (.NOT. aerosol_couple) THEN
4312	!
4313	CALL readaerosol_optic( &
4314	debut, flag_aerosol, itap, jD_cur-jD_ref, &
4315	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
4316	mass_solu_aero, mass_solu_aero_pi, &
4317	tau_aero, piz_aero, cg_aero, &
4318	tausum_aero, tau3d_aero)
4319	ENDIF
4320	ELSE IF (iflag_rrtm .EQ.1) THEN ! RRTM radiation
4321	IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
4322	abort_message='config_inca=aero et rrtm=1 impossible'
4323	CALL abort_physic(modname,abort_message,1)
4324	ELSE
4325	!
4326	#ifdef CPP_RRTM
4327	IF (NSW.EQ.6) THEN
4328	!--new aerosol properties SW and LW
4329	!
4330	IF (CPPKEY_DUST) THEN
4331	!--SPL aerosol model
4332	CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &
4333	tr_seri, mass_solu_aero, mass_solu_aero_pi, &
4334	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
4335	tausum_aero, tau3d_aero)
4336	ELSE
4337	!--climatologies or INCA aerosols
4338	CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &
4339	flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
4340	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
4341	tr_seri, mass_solu_aero, mass_solu_aero_pi, &
4342	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
4343	tausum_aero, drytausum_aero, tau3d_aero)
4344	END IF
4345
4346	IF (flag_aerosol .EQ. 7) THEN
4347	CALL MACv2SP(pphis,pplay,paprs,longitude_deg,latitude_deg, &
4348	tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm)
4349	ENDIF
4350
4351	!
4352	ELSE IF (NSW.EQ.2) THEN
4353	!--for now we use the old aerosol properties
4354	!
4355	CALL readaerosol_optic( &
4356	debut, flag_aerosol, itap, jD_cur-jD_ref, &
4357	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
4358	mass_solu_aero, mass_solu_aero_pi, &
4359	tau_aero, piz_aero, cg_aero, &
4360	tausum_aero, tau3d_aero)
4361	!
4362	!--natural aerosols
4363	tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
4364	piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
4365	cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
4366	!--all aerosols
4367	tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
4368	piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
4369	cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
4370	!
4371	!--no LW optics
4372	tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
4373	!
4374	ELSE
4375	abort_message='Only NSW=2 or 6 are possible with ' &
4376	// 'aerosols and iflag_rrtm=1'
4377	CALL abort_physic(modname,abort_message,1)
4378	ENDIF
4379	#else
4380	abort_message='You should compile with -rrtm if running ' &
4381	// 'with iflag_rrtm=1'
4382	CALL abort_physic(modname,abort_message,1)
4383	#endif
4384	!
4385	ENDIF
4386	ELSE IF (iflag_rrtm .EQ.2) THEN ! ecrad RADIATION
4387	#ifdef CPP_ECRAD
4388	!--climatologies or INCA aerosols
4389	CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &
4390	flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
4391	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
4392	tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)
4393	#else
4394	abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
4395	CALL abort_physic(modname,abort_message,1)
4396	#endif
4397	ENDIF
4398
4399	ELSE !--flag_aerosol = 0
4400	tausum_aero(:,:,:) = 0.
4401	drytausum_aero(:,:) = 0.
4402	mass_solu_aero(:,:) = 0.
4403	mass_solu_aero_pi(:,:) = 0.
4404	IF (iflag_rrtm .EQ. 0) THEN !--old radiation
4405	tau_aero(:,:,:,:) = 1.e-15
4406	piz_aero(:,:,:,:) = 1.
4407	cg_aero(:,:,:,:) = 0.
4408	ELSE
4409	tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
4410	tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
4411	piz_aero_sw_rrtm(:,:,:,:) = 1.0
4412	cg_aero_sw_rrtm(:,:,:,:) = 0.0
4413	ENDIF
4414	ENDIF
4415	!
4416	!--WMO criterion to determine tropopause
4417	CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
4418	!
4419	!--STRAT AEROSOL
4420	!--updates tausum_aero,tau_aero,piz_aero,cg_aero
4421	IF (flag_aerosol_strat.GT.0) THEN
4422	IF (prt_level .GE.10) THEN
4423	PRINT *,'appel a readaerosolstrat', mth_cur
4424	ENDIF
4425	IF (iflag_rrtm.EQ.0) THEN
4426	IF (flag_aerosol_strat.EQ.1) THEN
4427	CALL readaerosolstrato(debut)
4428	ELSE
4429	abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
4430	CALL abort_physic(modname,abort_message,1)
4431	ENDIF
4432	ELSE
4433	#ifdef CPP_RRTM
4434	IF (.NOT. CPPKEY_STRATAER) THEN
4435	!--prescribed strat aerosols
4436	!--only in the case of non-interactive strat aerosols
4437	IF (flag_aerosol_strat.EQ.1) THEN
4438	CALL readaerosolstrato1_rrtm(debut)
4439	ELSEIF (flag_aerosol_strat.EQ.2) THEN
4440	CALL readaerosolstrato2_rrtm(debut, ok_volcan)
4441	ELSE
4442	abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
4443	CALL abort_physic(modname,abort_message,1)
4444	ENDIF
4445	END IF
4446	#else
4447	abort_message='You should compile with -rrtm if running ' &
4448	// 'with iflag_rrtm=1'
4449	CALL abort_physic(modname,abort_message,1)
4450	#endif
4451	ENDIF
4452	ELSE
4453	tausum_aero(:,:,id_STRAT_phy) = 0.
4454	ENDIF
4455	!
4456	#ifdef CPP_RRTM
4457	IF (CPPKEY_STRATAER) THEN
4458	!--compute stratospheric mask
4459	CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
4460	!--interactive strat aerosols
4461	CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
4462	END IF
4463	#endif
4464	!--fin STRAT AEROSOL
4465	!
4466
4467	! Calculer les parametres optiques des nuages et quelques
4468	! parametres pour diagnostiques:
4469	!
4470	IF (aerosol_couple.AND.config_inca=='aero') THEN
4471	mass_solu_aero(:,:) = ccm(:,:,1)
4472	mass_solu_aero_pi(:,:) = ccm(:,:,2)
4473	ENDIF
4474
4475	!Rajout appel a interface calcul proprietes optiques des nuages
4476	CALL call_cloud_optics_prop(klon, klev, ok_newmicro, &
4477	paprs, pplay, t_seri, radocond, picefra, cldfra, &
4478	cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
4479	flwp, fiwp, flwc, fiwc, ok_aie, &
4480	mass_solu_aero, mass_solu_aero_pi, &
4481	cldtaupi, distcltop, temp_cltop, re, fl, ref_liq, ref_ice, &
4482	ref_liq_pi, ref_ice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
4483	reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra, &
4484	zfice, dNovrN, ptconv, rnebcon, clwcon)
4485
4486	!
4487	!IM betaCRF
4488	!
4489	cldtaurad = cldtau
4490	cldtaupirad = cldtaupi
4491	cldemirad = cldemi
4492	cldfrarad = cldfra
4493
4494	!
4495	IF (lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. &
4496	lat1_beta.EQ.90..AND.lat2_beta.EQ.-90.) THEN
4497	!
4498	! global
4499	!
4500	!IM 251017 begin
4501	! print*,'physiq betaCRF global zdtime=',zdtime
4502	!IM 251017 end
4503	DO k=1, klev
4504	DO i=1, klon
4505	IF (pplay(i,k).GE.pfree) THEN
4506	beta(i,k) = beta_pbl
4507	ELSE
4508	beta(i,k) = beta_free
4509	ENDIF
4510	IF (mskocean_beta) THEN
4511	beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
4512	ENDIF
4513	cldtaurad(i,k) = cldtau(i,k) * beta(i,k)
4514	cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
4515	cldemirad(i,k) = cldemi(i,k) * beta(i,k)
4516	cldfrarad(i,k) = cldfra(i,k) * beta(i,k)
4517	ENDDO
4518	ENDDO
4519	!
4520	ELSE
4521	!
4522	! regional
4523	!
4524	DO k=1, klev
4525	DO i=1,klon
4526	!
4527	IF (longitude_deg(i).ge.lon1_beta.AND. &
4528	longitude_deg(i).le.lon2_beta.AND. &
4529	latitude_deg(i).le.lat1_beta.AND. &
4530	latitude_deg(i).ge.lat2_beta) THEN
4531	IF (pplay(i,k).GE.pfree) THEN
4532	beta(i,k) = beta_pbl
4533	ELSE
4534	beta(i,k) = beta_free
4535	ENDIF
4536	IF (mskocean_beta) THEN
4537	beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
4538	ENDIF
4539	cldtaurad(i,k) = cldtau(i,k) * beta(i,k)
4540	cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
4541	cldemirad(i,k) = cldemi(i,k) * beta(i,k)
4542	cldfrarad(i,k) = cldfra(i,k) * beta(i,k)
4543	ENDIF
4544	!
4545	ENDDO
4546	ENDDO
4547	!
4548	ENDIF
4549
4550	!lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek
4551	IF (ok_chlorophyll) THEN
4552	print*,"-- reading chlorophyll"
4553	CALL readchlorophyll(debut)
4554	ENDIF
4555
4556	!--if ok_suntime_rrtm we use ancillay data for RSUN
4557	!--previous values are therefore overwritten
4558	!--this is needed for CMIP6 runs
4559	!--and only possible for new radiation scheme
4560	IF (iflag_rrtm.EQ.1.AND.ok_suntime_rrtm) THEN
4561	#ifdef CPP_RRTM
4562	CALL read_rsun_rrtm(debut)
4563	#endif
4564	ENDIF
4565
4566	IF (mydebug) THEN
4567	CALL writefield_phy('u_seri',u_seri,nbp_lev)
4568	CALL writefield_phy('v_seri',v_seri,nbp_lev)
4569	CALL writefield_phy('t_seri',t_seri,nbp_lev)
4570	CALL writefield_phy('q_seri',q_seri,nbp_lev)
4571	ENDIF
4572
4573	!
4574	!sonia : If Iflag_radia >=2, pertubation of some variables
4575	!input to radiation (DICE)
4576	!
4577	IF (iflag_radia .ge. 2) THEN
4578	zsav_tsol (:) = zxtsol(:)
4579	CALL perturb_radlwsw(zxtsol,iflag_radia)
4580	ENDIF
4581
4582	IF (aerosol_couple.AND.config_inca=='aero') THEN
4583	IF (CPPKEY_INCA) THEN
4584	CALL radlwsw_inca &
4585	(chemistry_couple, kdlon,kflev,dist, rmu0, fract, solaire, &
4586	paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, &
4587	size(wo,3), wo, &
4588	cldfrarad, cldemirad, cldtaurad, &
4589	heat,heat0,cool,cool0,albpla, &
4590	topsw,toplw,solsw,sollw, &
4591	sollwdown, &
4592	topsw0,toplw0,solsw0,sollw0, &
4593	lwdn0, lwdn, lwup0, lwup, &
4594	swdn0, swdn, swup0, swup, &
4595	ok_ade, ok_aie, &
4596	tau_aero, piz_aero, cg_aero, &
4597	topswad_aero, solswad_aero, &
4598	topswad0_aero, solswad0_aero, &
4599	topsw_aero, topsw0_aero, &
4600	solsw_aero, solsw0_aero, &
4601	cldtaupirad, &
4602	topswai_aero, solswai_aero)
4603	END IF
4604	ELSE
4605	!
4606	!IM calcul radiatif pour le cas actuel
4607	!
4608	RCO2 = RCO2_act
4609	RCH4 = RCH4_act
4610	RN2O = RN2O_act
4611	RCFC11 = RCFC11_act
4612	RCFC12 = RCFC12_act
4613	!
4614	!--interactive CO2 in ppm from carbon cycle
4615	IF (carbon_cycle_rad) RCO2=RCO2_glo
4616	!
4617	IF (prt_level .GE.10) THEN
4618	print *,' ->radlwsw, number 1 '
4619	ENDIF
4620	!
4621	! AI namelist utilise pour l appel principal de radlwsw (ecrad)
4622	namelist_ecrad_file='namelist_ecrad'
4623	!
4624	CALL radlwsw &
4625	(debut, dist, rmu0, fract, &
4626	!albedo SB >>>
4627	! paprs, pplay,zxtsol,albsol1, albsol2, &
4628	paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
4629	!albedo SB <<<
4630	t_seri,q_seri,wo, &
4631	cldfrarad, cldemirad, cldtaurad, &
4632	ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &
4633	flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
4634	tau_aero, piz_aero, cg_aero, &
4635	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
4636	! Rajoute par OB pour RRTM
4637	tau_aero_lw_rrtm, &
4638	cldtaupirad, m_allaer, &
4639	! zqsat, flwcrad, fiwcrad, &
4640	zqsat, flwc, fiwc, &
4641	ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
4642	namelist_ecrad_file, &
4643	heat,heat0,cool,cool0,albpla, &
4644	heat_volc,cool_volc, &
4645	topsw,toplw,solsw,solswfdiff,sollw, &
4646	sollwdown, &
4647	topsw0,toplw0,solsw0,sollw0, &
4648	lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup, &
4649	lwtoa0b, lwtoab , & !FC
4650	swdnc0, swdn0, swdn, swupc0, swup0, swup, &
4651	topswad_aero, solswad_aero, &
4652	topswai_aero, solswai_aero, &
4653	topswad0_aero, solswad0_aero, &
4654	topsw_aero, topsw0_aero, &
4655	solsw_aero, solsw0_aero, &
4656	topswcf_aero, solswcf_aero, &
4657	!-C. Kleinschmitt for LW diagnostics
4658	toplwad_aero, sollwad_aero,&
4659	toplwai_aero, sollwai_aero, &
4660	toplwad0_aero, sollwad0_aero,&
4661	!-end
4662	ZLWFT0_i, ZFLDN0, ZFLUP0, &
4663	ZSWFT0_i, ZFSDN0, ZFSUP0, &
4664	ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_SUN, &
4665	cloud_cover_sw)
4666
4667	!lwoff=y, betalwoff=1. : offset LW CRE for radiation code and other
4668	!schemes
4669	toplw = toplw + betalwoff * (toplw0 - toplw)
4670	sollw = sollw + betalwoff * (sollw0 - sollw)
4671	lwdn = lwdn + betalwoff * (lwdn0 - lwdn)
4672	lwup = lwup + betalwoff * (lwup0 - lwup)
4673	sollwdown(:)= sollwdown(:) + betalwoff (-1.ZFLDN0(:,1) - &
4674	sollwdown(:))
4675	cool = cool + betalwoff * (cool0 - cool)
4676
4677	IF (.NOT. using_xios) THEN
4678	!
4679	!IM 2eme calcul radiatif pour le cas perturbe ou au moins un
4680	!IM des taux doit etre different du taux actuel
4681	!IM Par defaut on a les taux perturbes egaux aux taux actuels
4682	!
4683	IF (RCO2_per.NE.RCO2_act.OR. &
4684	RCH4_per.NE.RCH4_act.OR. &
4685	RN2O_per.NE.RN2O_act.OR. &
4686	RCFC11_per.NE.RCFC11_act.OR. &
4687	RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE.
4688	ENDIF
4689	!
4690	IF (ok_4xCO2atm) THEN
4691	!
4692	RCO2 = RCO2_per
4693	RCH4 = RCH4_per
4694	RN2O = RN2O_per
4695	RCFC11 = RCFC11_per
4696	RCFC12 = RCFC12_per
4697	!
4698	IF (prt_level .GE.10) THEN
4699	print *,' ->radlwsw, number 2 '
4700	ENDIF
4701	!
4702	namelist_ecrad_file='namelist_ecrad'
4703	!
4704	CALL radlwsw &
4705	(debut, dist, rmu0, fract, &
4706	!albedo SB >>>
4707	! paprs, pplay,zxtsol,albsol1, albsol2, &
4708	paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
4709	!albedo SB <<<
4710	t_seri,q_seri,wo, &
4711	cldfrarad, cldemirad, cldtaurad, &
4712	ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &
4713	flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
4714	tau_aero, piz_aero, cg_aero, &
4715	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
4716	! Rajoute par OB pour RRTM
4717	tau_aero_lw_rrtm, &
4718	cldtaupi, m_allaer, &
4719	! zqsat, flwcrad, fiwcrad, &
4720	zqsat, flwc, fiwc, &
4721	ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
4722	namelist_ecrad_file, &
4723	heatp,heat0p,coolp,cool0p,albplap, &
4724	heat_volc,cool_volc, &
4725	topswp,toplwp,solswp,solswfdiffp,sollwp, &
4726	sollwdownp, &
4727	topsw0p,toplw0p,solsw0p,sollw0p, &
4728	lwdnc0p, lwdn0p, lwdnp, lwupc0p, lwup0p, lwupp, &
4729	lwtoa0bp, lwtoabp , & !FC
4730	swdnc0p, swdn0p, swdnp, swupc0p, swup0p, swupp, &
4731	topswad_aerop, solswad_aerop, &
4732	topswai_aerop, solswai_aerop, &
4733	topswad0_aerop, solswad0_aerop, &
4734	topsw_aerop, topsw0_aerop, &
4735	solsw_aerop, solsw0_aerop, &
4736	topswcf_aerop, solswcf_aerop, &
4737	!-C. Kleinschmitt for LW diagnostics
4738	toplwad_aerop, sollwad_aerop,&
4739	toplwai_aerop, sollwai_aerop, &
4740	toplwad0_aerop, sollwad0_aerop,&
4741	!-end
4742	ZLWFT0_i, ZFLDN0, ZFLUP0, &
4743	ZSWFT0_i, ZFSDN0, ZFSUP0, &
4744	ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_SUN, &
4745	cloud_cover_sw)
4746	ENDIF !ok_4xCO2atm
4747
4748	! A.I aout 2023
4749	! Effet 3D des nuages Ecrad
4750	! a passer : nom du ficher namelist et cles ok_3Deffect
4751	! a declarer comme iflag_rrtm et a lire dans physiq.def
4752	#ifdef CPP_ECRAD
4753	IF (ok_3Deffect) then
4754	! print*,'ok_3Deffect = ',ok_3Deffect
4755	namelist_ecrad_file='namelist_ecrad_s2'
4756	CALL radlwsw &
4757	(debut, dist, rmu0, fract, &
4758	paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
4759	t_seri,q_seri,wo, &
4760	cldfrarad, cldemirad, cldtaurad, &
4761	ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &
4762	flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
4763	tau_aero, piz_aero, cg_aero, &
4764	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
4765	tau_aero_lw_rrtm, &
4766	cldtaupi, m_allaer, &
4767	zqsat, flwc, fiwc, &
4768	ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
4769	namelist_ecrad_file, &
4770	! A modifier
4771	heat_s2,heat0_s2,cool_s2,cool0_s2,albpla_s2, &
4772	heat_volc,cool_volc, &
4773	topsw_s2,toplw_s2,solsw_s2,solswfdiff_s2,sollw_s2, &
4774	sollwdown_s2, &
4775	topsw0_s2,toplw0_s2,solsw0_s2,sollw0_s2, &
4776	lwdnc0_s2, lwdn0_s2, lwdn_s2, lwupc0_s2, lwup0_s2, lwup_s2, &
4777	lwtoa0b_s2, lwtoab_s2 , & !FC
4778	swdnc0_s2, swdn0_s2, swdn_s2, swupc0_s2, swup0_s2, swup_s2, &
4779	topswad_aero_s2, solswad_aero_s2, &
4780	topswai_aero_s2, solswai_aero_s2, &
4781	topswad0_aero_s2, solswad0_aero_s2, &
4782	topsw_aero_s2, topsw0_aero_s2, &
4783	solsw_aero_s2, solsw0_aero_s2, &
4784	topswcf_aero_s2, solswcf_aero_s2, &
4785	!-C. Kleinschmitt for LW diagnostics
4786	toplwad_aero_s2, sollwad_aero_s2,&
4787	toplwai_aero_s2, sollwai_aero_s2, &
4788	toplwad0_aero_s2, sollwad0_aero_s2,&
4789	!-end
4790	ZLWFT0_i, ZFLDN0, ZFLUP0, &
4791	ZSWFT0_i, ZFSDN0, ZFSUP0, &
4792	ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_SUN, &
4793	cloud_cover_sw_s2)
4794	ENDIF ! ok_3Deffect
4795	#endif
4796
4797	ENDIF ! aerosol_couple
4798	itaprad = 0
4799	!
4800	! If Iflag_radia >=2, reset pertubed variables
4801	!
4802	IF (iflag_radia .ge. 2) THEN
4803	zxtsol(:) = zsav_tsol (:)
4804	ENDIF
4805	ENDIF ! MOD(itaprad,radpas)
4806	itaprad = itaprad + 1
4807
4808	IF (iflag_radia.eq.0) THEN
4809	IF (prt_level.ge.9) THEN
4810	PRINT *,'--------------------------------------------------'
4811	PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas'
4812	PRINT *,'>>>> heat et cool mis a zero '
4813	PRINT *,'--------------------------------------------------'
4814	ENDIF
4815	heat=0.
4816	cool=0.
4817	sollw=0. ! MPL 01032011
4818	solsw=0.
4819	radsol=0.
4820	swup=0. ! MPL 27102011 pour les fichiers AMMA_profiles et AMMA_scalars
4821	swup0=0.
4822	lwup=0.
4823	lwup0=0.
4824	lwdn=0.
4825	lwdn0=0.
4826	ENDIF
4827
4828	!
4829	! Calculer radsol a l'exterieur de radlwsw
4830	! pour prendre en compte le cycle diurne
4831	! recode par Olivier Boucher en sept 2015
4832	!
4833	radsol=solsw*swradcorr+sollw
4834
4835	IF (ok_4xCO2atm) THEN
4836	radsolp=solswp*swradcorr+sollwp
4837	ENDIF
4838
4839	!
4840	! Ajouter la tendance des rayonnements (tous les pas)
4841	! avec une correction pour le cycle diurne dans le SW
4842	!
4843
4844	DO k=1, klev
4845	d_t_swr(:,k)=swradcorr(:)heat(:,k)phys_tstep/RDAY
4846	d_t_sw0(:,k)=swradcorr(:)heat0(:,k)phys_tstep/RDAY
4847	d_t_lwr(:,k)=-cool(:,k)*phys_tstep/RDAY
4848	d_t_lw0(:,k)=-cool0(:,k)*phys_tstep/RDAY
4849	ENDDO
4850
4851	CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,dqbs0,paprs,'SW',abortphy,flag_inhib_tend,itap,0)
4852	CALL prt_enerbil('SW',itap)
4853	CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,dqbs0,paprs,'LW',abortphy,flag_inhib_tend,itap,0)
4854	CALL prt_enerbil('LW',itap)
4855
4856	!
4857	IF (mydebug) THEN
4858	CALL writefield_phy('u_seri',u_seri,nbp_lev)
4859	CALL writefield_phy('v_seri',v_seri,nbp_lev)
4860	CALL writefield_phy('t_seri',t_seri,nbp_lev)
4861	CALL writefield_phy('q_seri',q_seri,nbp_lev)
4862	ENDIF
4863
4864	! Calculer l'hydrologie de la surface
4865	!
4866	! CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
4867	! . agesno, ftsol,fqsurf,fsnow, ruis)
4868	!
4869
4870	!
4871	! Calculer le bilan du sol et la derive de temperature (couplage)
4872	!
4873	DO i = 1, klon
4874	! bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
4875	! a la demande de JLD
4876	bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
4877	ENDDO
4878	!
4879	!moddeblott(jan95)
4880	! Appeler le programme de parametrisation de l'orographie
4881	! a l'echelle sous-maille:
4882	!
4883
4884	! calculation of nm_oro
4885	DO i=1,klon
4886	! nm_oro is a proxy for the number of subgrid scale mountains
4887	! -> condition on nm_oro can deactivate the lifting on tilted planar terrains
4888	! such as ice sheets (work by V. Wiener)
4889	! in such a case, the SSO scheme should activate only where nm_oro>0 i.e. by setting
4890	! nm_oro_t=0.
4891	nm_oro(i)=zsig(i)sqrt(cell_area(i)(pctsrf(i,is_ter)+pctsrf(i,is_lic)))/(4.*MAX(zstd(i),1.e-8))-1.
4892	ENDDO
4893
4894	IF (prt_level .GE.10) THEN
4895	print *,' call orography ? ', ok_orodr
4896	ENDIF
4897	!
4898	IF (ok_orodr) THEN
4899	!
4900	! selection des points pour lesquels le shema est actif:
4901	igwd=0
4902	DO i=1,klon
4903	itest(i)=0
4904	! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to
4905	! earn computation time but they are not physical.
4906	IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
4907	itest(i)=1
4908	igwd=igwd+1
4909	idx(igwd)=i
4910	ENDIF
4911	ENDDO
4912	! igwdim=MAX(1,igwd)
4913	!
4914	IF (ok_strato) THEN
4915
4916	CALL drag_noro_strato(0,klon,klev,phys_tstep,paprs,pplay, &
4917	zmea,zstd, zsig, zgam, zthe,zpic,zval, &
4918	igwd,idx,itest, &
4919	t_seri, u_seri, v_seri, &
4920	zulow, zvlow, zustrdr, zvstrdr, &
4921	d_t_oro, d_u_oro, d_v_oro)
4922
4923	ELSE
4924	CALL drag_noro(klon,klev,phys_tstep,paprs,pplay, &
4925	zmea,zstd, zsig, zgam, zthe,zpic,zval, &
4926	igwd,idx,itest, &
4927	t_seri, u_seri, v_seri, &
4928	zulow, zvlow, zustrdr, zvstrdr, &
4929	d_t_oro, d_u_oro, d_v_oro)
4930	ENDIF
4931	!
4932	! ajout des tendances
4933	!-----------------------------------------------------------------------
4934	! ajout des tendances de la trainee de l'orographie
4935	CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,dqbs0,paprs,'oro', &
4936	abortphy,flag_inhib_tend,itap,0)
4937	CALL prt_enerbil('oro',itap)
4938	!----------------------------------------------------------------------
4939	!
4940	ENDIF ! fin de test sur ok_orodr
4941	!
4942	IF (mydebug) THEN
4943	CALL writefield_phy('u_seri',u_seri,nbp_lev)
4944	CALL writefield_phy('v_seri',v_seri,nbp_lev)
4945	CALL writefield_phy('t_seri',t_seri,nbp_lev)
4946	CALL writefield_phy('q_seri',q_seri,nbp_lev)
4947	ENDIF
4948
4949	IF (ok_orolf) THEN
4950	!
4951	! selection des points pour lesquels le shema est actif:
4952	igwd=0
4953	DO i=1,klon
4954	itest(i)=0
4955	IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
4956	itest(i)=1
4957	igwd=igwd+1
4958	idx(igwd)=i
4959	ENDIF
4960	ENDDO
4961	! igwdim=MAX(1,igwd)
4962	!
4963	IF (ok_strato) THEN
4964
4965	CALL lift_noro_strato(klon,klev,phys_tstep,paprs,pplay, &
4966	latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, &
4967	igwd,idx,itest, &
4968	t_seri, u_seri, v_seri, &
4969	zulow, zvlow, zustrli, zvstrli, &
4970	d_t_lif, d_u_lif, d_v_lif )
4971
4972	ELSE
4973	CALL lift_noro(klon,klev,phys_tstep,paprs,pplay, &
4974	latitude_deg,zmea,zstd,zpic, &
4975	itest, &
4976	t_seri, u_seri, v_seri, &
4977	zulow, zvlow, zustrli, zvstrli, &
4978	d_t_lif, d_u_lif, d_v_lif)
4979	ENDIF
4980
4981	! ajout des tendances de la portance de l'orographie
4982	CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, dqbs0,paprs, &
4983	'lif', abortphy,flag_inhib_tend,itap,0)
4984	CALL prt_enerbil('lif',itap)
4985	ENDIF ! fin de test sur ok_orolf
4986
4987	IF (ok_hines) then
4988	! HINES GWD PARAMETRIZATION
4989	east_gwstress=0.
4990	west_gwstress=0.
4991	du_gwd_hines=0.
4992	dv_gwd_hines=0.
4993	CALL hines_gwd(klon, klev, phys_tstep, paprs, pplay, latitude_deg, t_seri, &
4994	u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, &
4995	du_gwd_hines, dv_gwd_hines)
4996	zustr_gwd_hines=0.
4997	zvstr_gwd_hines=0.
4998	DO k = 1, klev
4999	zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/phys_tstep &
5000	* (paprs(:, k)-paprs(:, k+1))/rg
5001	zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/phys_tstep &
5002	* (paprs(:, k)-paprs(:, k+1))/rg
5003	ENDDO
5004
5005	d_t_hin(:, :)=0.
5006	CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, &
5007	dqi0, dqbs0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0)
5008	CALL prt_enerbil('hin',itap)
5009	ENDIF
5010
5011	IF (.not. ok_hines .and. ok_gwd_rando) then
5012	! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod
5013	CALL acama_GWD_rando_first()
5014	CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, &
5015	v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, &
5016	dv_gwd_front, east_gwstress, west_gwstress)
5017	zustr_gwd_front=0.
5018	zvstr_gwd_front=0.
5019	DO k = 1, klev
5020	zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/phys_tstep &
5021	* (paprs(:, k)-paprs(:, k+1))/rg
5022	zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/phys_tstep &
5023	* (paprs(:, k)-paprs(:, k+1))/rg
5024	ENDDO
5025
5026	CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, dqbs0, &
5027	paprs, 'front_gwd_rando', abortphy,flag_inhib_tend,itap,0)
5028	CALL prt_enerbil('front_gwd_rando',itap)
5029	ENDIF
5030
5031	IF (ok_gwd_rando) THEN
5032	CALL FLOTT_GWD_rando_first()
5033	CALL FLOTT_GWD_rando(PHYS_TSTEP, pplay, t_seri, u_seri, v_seri, &
5034	rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
5035	du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
5036	CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, dqbs0, &
5037	paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend,itap,0)
5038	CALL prt_enerbil('flott_gwd_rando',itap)
5039	zustr_gwd_rando=0.
5040	zvstr_gwd_rando=0.
5041	DO k = 1, klev
5042	zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/phys_tstep &
5043	* (paprs(:, k)-paprs(:, k+1))/rg
5044	zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/phys_tstep &
5045	* (paprs(:, k)-paprs(:, k+1))/rg
5046	ENDDO
5047	ENDIF
5048
5049	! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
5050
5051	IF (mydebug) THEN
5052	CALL writefield_phy('u_seri',u_seri,nbp_lev)
5053	CALL writefield_phy('v_seri',v_seri,nbp_lev)
5054	CALL writefield_phy('t_seri',t_seri,nbp_lev)
5055	CALL writefield_phy('q_seri',q_seri,nbp_lev)
5056	ENDIF
5057
5058	DO i = 1, klon
5059	zustrph(i)=0.
5060	zvstrph(i)=0.
5061	ENDDO
5062	DO k = 1, klev
5063	DO i = 1, klon
5064	zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/phys_tstep* &
5065	(paprs(i,k)-paprs(i,k+1))/rg
5066	zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/phys_tstep* &
5067	(paprs(i,k)-paprs(i,k+1))/rg
5068	ENDDO
5069	ENDDO
5070	!
5071	!IM calcul composantes axiales du moment angulaire et couple des montagnes
5072	!
5073	IF (is_sequential .and. ok_orodr) THEN
5074	CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, &
5075	ra,rg,romega, &
5076	latitude_deg,longitude_deg,pphis, &
5077	zustrdr,zustrli,zustrph, &
5078	zvstrdr,zvstrli,zvstrph, &
5079	paprs,u,v, &
5080	aam, torsfc)
5081	ENDIF
5082	!IM cf. FLott END
5083	!DC Calcul de la tendance due au methane
5084	IF (ok_qch4) THEN
5085	! d_q_ch4: H2O source from CH4 in MMR/s (mass mixing ratio/s or kg H2O/kg air/s)
5086	IF (CPPKEY_STRATAER) THEN
5087
5088	CALL stratH2O_methox(debut,paprs,d_q_ch4)
5089	ELSE
5090	! ECMWF routine METHOX
5091	CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
5092	END IF
5093	! add humidity tendency due to methane
5094	d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep
5095	CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, dqbs0, paprs, &
5096	'q_ch4', abortphy,flag_inhib_tend,itap,0)
5097	d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/phys_tstep ! update with H2O conserv done in add_phys_tend
5098	ENDIF
5099	!
5100	!
5101	IF (CPPKEY_STRATAER) THEN
5102	IF (ok_qemiss) THEN
5103	flh2o=1
5104	IF(flag_verbose_strataer) THEN
5105	print *,'IN physiq_mod: ok_qemiss =yes (',ok_qemiss,'), flh2o=',flh2o
5106	print *,'IN physiq_mod: flag_emit=',flag_emit,', nErupt=',nErupt
5107	print *,'IN physiq_mod: nAerErupt=',nAerErupt
5108	ENDIF
5109
5110	SELECT CASE(flag_emit)
5111	CASE(1) ! emission volc H2O in LMDZ
5112	DO ieru=1, nErupt
5113	IF (year_cur==year_emit_vol(ieru).AND.&
5114	mth_cur==mth_emit_vol(ieru).AND.&
5115	day_cur>=day_emit_vol(ieru).AND.&
5116	day_cur<(day_emit_vol(ieru)+injdur)) THEN
5117
5118	IF(flag_verbose_strataer) print *,'IN physiq_mod: date=',year_cur,mth_cur,day_cur
5119	! initialisation of q tendency emission
5120	d_q_emiss(:,:)=0.
5121	! daily injection mass emission - NL
5122	m_H2O_emiss_vol_daily = m_H2O_emiss_vol(ieru)/(REAL(injdur)&
5123	*REAL(ponde_lonlat_vol(ieru)))
5124	!
5125	CALL STRATEMIT(pdtphys,pdtphys,latitude_deg,longitude_deg,t_seri,&
5126	pplay,paprs,tr_seri,&
5127	m_H2O_emiss_vol_daily,&
5128	xlat_min_vol(ieru),xlat_max_vol(ieru),&
5129	xlon_min_vol(ieru),xlon_max_vol(ieru),&
5130	altemiss_vol(ieru),sigma_alt_vol(ieru),1,1.,&
5131	nAerErupt+1,0)
5132
5133	IF(flag_verbose_strataer) print *,'IN physiq_mod: min max d_q_emiss=',&
5134	minval(d_q_emiss),maxval(d_q_emiss)
5135
5136	CALL add_phys_tend(du0, dv0, dt0, d_q_emiss, dql0, dqi0, dqbs0, paprs, &
5137	'q_emiss',abortphy,flag_inhib_tend,itap,0)
5138	IF (abortphy==1) Print*,'ERROR ABORT TEND EMISS'
5139	ENDIF
5140	ENDDO
5141	flh2o=0
5142	END SELECT ! emission scenario (flag_emit)
5143	ENDIF
5144	END IF
5145
5146	!===============================================================
5147	! Additional tendency of TKE due to orography
5148	!===============================================================
5149	!
5150	! Inititialization
5151	!------------------
5152
5153	addtkeoro=0
5154	CALL getin_p('addtkeoro',addtkeoro)
5155
5156	IF (prt_level.ge.5) &
5157	print*,'addtkeoro', addtkeoro
5158
5159	alphatkeoro=1.
5160	CALL getin_p('alphatkeoro',alphatkeoro)
5161	alphatkeoro=min(max(0.,alphatkeoro),1.)
5162
5163	smallscales_tkeoro=.FALSE.
5164	CALL getin_p('smallscales_tkeoro',smallscales_tkeoro)
5165
5166
5167	dtadd(:,:)=0.
5168	duadd(:,:)=0.
5169	dvadd(:,:)=0.
5170
5171	! Choices for addtkeoro:
5172	! ** 0 no TKE tendency from orography
5173	! ** 1 we include a fraction alphatkeoro of the whole tendency duoro
5174	! ** 2 we include a fraction alphatkeoro of the gravity wave part of duoro
5175	!
5176
5177	IF (addtkeoro .GT. 0 .AND. ok_orodr ) THEN
5178	! -------------------------------------------
5179
5180
5181	! selection des points pour lesquels le schema est actif:
5182
5183
5184	IF (addtkeoro .EQ. 1 ) THEN
5185
5186	duadd(:,:)=alphatkeoro*d_u_oro(:,:)
5187	dvadd(:,:)=alphatkeoro*d_v_oro(:,:)
5188
5189	ELSE IF (addtkeoro .EQ. 2) THEN
5190
5191	IF (smallscales_tkeoro) THEN
5192	igwd=0
5193	DO i=1,klon
5194	itest(i)=0
5195	! Etienne: ici je prends en compte plus de relief que la routine drag_noro_strato
5196	! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
5197	! Mais attention, cela ne va pas dans le sens de la conservation de l'energie!
5198	IF ((zstd(i).GT.1.0) .AND.(nm_oro(i).GT.nm_oro_t)) THEN
5199	itest(i)=1
5200	igwd=igwd+1
5201	idx(igwd)=i
5202	ENDIF
5203	ENDDO
5204
5205	ELSE
5206
5207	igwd=0
5208	DO i=1,klon
5209	itest(i)=0
5210	IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
5211	itest(i)=1
5212	igwd=igwd+1
5213	idx(igwd)=i
5214	ENDIF
5215	ENDDO
5216
5217	ENDIF
5218
5219	CALL drag_noro_strato(addtkeoro,klon,klev,phys_tstep,paprs,pplay, &
5220	zmea,zstd, zsig, zgam, zthe,zpic,zval, &
5221	igwd,idx,itest, &
5222	t_seri, u_seri, v_seri, &
5223	zulow, zvlow, zustrdr, zvstrdr, &
5224	d_t_oro_gw, d_u_oro_gw, d_v_oro_gw)
5225
5226	zustrdr(:)=0.
5227	zvstrdr(:)=0.
5228	zulow(:)=0.
5229	zvlow(:)=0.
5230
5231	duadd(:,:)=alphatkeoro*d_u_oro_gw(:,:)
5232	dvadd(:,:)=alphatkeoro*d_v_oro_gw(:,:)
5233	ENDIF
5234
5235
5236	! TKE update from subgrid temperature and wind tendencies
5237	!----------------------------------------------------------
5238	forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
5239
5240
5241	CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pctsrf,pbl_tke)
5242	!
5243	! Prevent pbl_tke_w from becoming negative
5244	wake_delta_pbl_tke(:,:,:) = max(wake_delta_pbl_tke(:,:,:), -pbl_tke(:,:,:))
5245	!
5246
5247	ENDIF
5248	! -----
5249	!===============================================================
5250
5251
5252	!====================================================================
5253	! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
5254	!====================================================================
5255	! Abderrahmane 24.08.09
5256
5257	IF (ok_cosp) THEN
5258	! adeclarer
5259	IF (CPPKEY_COSP) THEN
5260	IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
5261
5262	IF (prt_level .GE.10) THEN
5263	print*,'freq_cosp',freq_cosp
5264	ENDIF
5265	mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
5266	! print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
5267	! s ref_liq,ref_ice
5268	CALL phys_cosp(itap,phys_tstep,freq_cosp, &
5269	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
5270	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
5271	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
5272	JrNt,ref_liq,ref_ice, &
5273	pctsrf(:,is_ter)+pctsrf(:,is_lic), &
5274	zu10m,zv10m,pphis, &
5275	zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
5276	qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
5277	prfl(:,1:klev),psfl(:,1:klev), &
5278	pmflxr(:,1:klev),pmflxs(:,1:klev), &
5279	mr_ozone,cldtau, cldemi)
5280
5281	! L calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol,
5282	! L cfaddbze,clcalipso2,dbze,cltlidarradar,
5283	! M clMISR,
5284	! R clisccp2,boxtauisccp,boxptopisccp,tclisccp,ctpisccp,
5285	! I tauisccp,albisccp,meantbisccp,meantbclrisccp)
5286
5287	ENDIF
5288	END IF
5289
5290	IF (CPPKEY_COSP2) THEN
5291	IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
5292
5293	IF (prt_level .GE.10) THEN
5294	print*,'freq_cosp',freq_cosp
5295	ENDIF
5296	mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
5297	print*,'Dans physiq.F avant appel '
5298	! s ref_liq,ref_ice
5299	CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
5300	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
5301	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
5302	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
5303	JrNt,ref_liq,ref_ice, &
5304	pctsrf(:,is_ter)+pctsrf(:,is_lic), &
5305	zu10m,zv10m,pphis, &
5306	zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
5307	qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
5308	prfl(:,1:klev),psfl(:,1:klev), &
5309	pmflxr(:,1:klev),pmflxs(:,1:klev), &
5310	mr_ozone,cldtau, cldemi)
5311	ENDIF
5312	END IF
5313
5314	IF (CPPKEY_COSPV2) THEN
5315	IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
5316	! IF (MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
5317
5318	IF (prt_level .GE.10) THEN
5319	print*,'freq_cosp',freq_cosp
5320	ENDIF
5321	DO k = 1, klev
5322	DO i = 1, klon
5323	phicosp(i,k) = pphi(i,k) + pphis(i)
5324	ENDDO
5325	ENDDO
5326	mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
5327	print*,'Dans physiq.F avant appel '
5328	! s ref_liq,ref_ice
5329	CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
5330	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
5331	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
5332	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
5333	JrNt,ref_liq,ref_ice, &
5334	pctsrf(:,is_ter)+pctsrf(:,is_lic), &
5335	zu10m,zv10m,pphis, &
5336	zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
5337	qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
5338	prfl(:,1:klev),psfl(:,1:klev), &
5339	pmflxr(:,1:klev),pmflxs(:,1:klev), &
5340	mr_ozone,cldtau, cldemi)
5341	ENDIF
5342	END IF
5343
5344	ENDIF !ok_cosp
5345
5346
5347	! Marine
5348
5349	IF (ok_airs) then
5350
5351	IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/phys_tstep)).EQ.0) THEN
5352	write(,) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
5353	CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
5354	& map_prop_hc,map_prop_hist,&
5355	& map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
5356	& map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
5357	& map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
5358	& map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
5359	& map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
5360	& map_ntot,map_hc,map_hist,&
5361	& map_Cb,map_ThCi,map_Anv,&
5362	& alt_tropo )
5363	ENDIF
5364
5365	ENDIF ! ok_airs
5366
5367
5368	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5369	!AA
5370	!AA Installation de l'interface online-offline pour traceurs
5371	!AA
5372	!====================================================================
5373	! Calcul des tendances traceurs
5374	!====================================================================
5375	!
5376
5377	IF (type_trac == 'repr') THEN
5378	!MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod
5379	!MM dans Reprobus
5380	sh_in(:,:) = q_seri(:,:)
5381	IF (CPPKEY_REPROBUS) THEN
5382	d_q_rep(:,:) = 0.
5383	d_ql_rep(:,:) = 0.
5384	d_qi_rep(:,:) = 0.
5385	END IF
5386	ELSE
5387	sh_in(:,:) = qx(:,:,ivap)
5388	IF (nqo >= 3) THEN
5389	ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol)
5390	ELSE
5391	ch_in(:,:) = qx(:,:,iliq)
5392	ENDIF
5393	ENDIF
5394
5395	! Merge wdtrainA and wdtrainS in the total source of precipitation due to
5396	! adiabatic updraughts.
5397	!
5398	wdtrainAS(:,:) = wdtrainA(:,:) + wdtrainS(:,:)
5399
5400	IF (CPPKEY_DUST) THEN
5401	! Avec SPLA, iflag_phytrac est forcé =1
5402
5403	CALL phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con, &
5404	pdtphys,ftsol, &
5405	t,q_seri,paprs,pplay,RHcl, &
5406	pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
5407	coefh(1:klon,1:klev,is_ave), cdragh, cdragm, u1, v1, &
5408	u_seri, v_seri, latitude_deg, longitude_deg, &
5409	pphis,pctsrf,pmflxr,pmflxs,prfl,psfl, &
5410	da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij, &
5411	epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con, &
5412	ev,wdtrainAS, wdtrainM,wght_cvfd, &
5413	fm_therm, entr_therm, rneb, &
5414	beta_prec_fisrt,beta_prec, &
5415	zu10m,zv10m,wstar,ale_bl,ale_wake, &
5416	nsurfwind,surf_wind_value, surf_wind_proba, &
5417	d_tr_dyn,tr_seri)
5418
5419	ELSE
5420	IF (iflag_phytrac == 1 ) THEN
5421	CALL phytrac ( &
5422	itap, days_elapsed+1, jH_cur, debut, &
5423	lafin, phys_tstep, u, v, t, &
5424	paprs, pplay, pmfu, pmfd, &
5425	pen_u, pde_u, pen_d, pde_d, &
5426	cdragh, coefh(1:klon,1:klev,is_ave), fm_therm, entr_therm, &
5427	u1, v1, ftsol, pctsrf, &
5428	zustar, zu10m, zv10m, &
5429	wstar(:,is_ave), ale_bl, ale_wake, &
5430	latitude_deg, longitude_deg, &
5431	frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, &
5432	presnivs, pphis, pphi, albsol1, &
5433	sh_in, ch_in, rhcl, cldfra, rneb, &
5434	diafra, radocond, itop_con, ibas_con, &
5435	pmflxr, pmflxs, prfl, psfl, &
5436	da, phi, mp, upwd, &
5437	phi2, d1a, dam, sij, wght_cvfd, & !<<RomP+RL
5438	wdtrainAS, wdtrainM, sigd, clw,elij, & !<<RomP
5439	ev, ep, epmlmMm, eplaMm, & !<<RomP
5440	dnwd, aerosol_couple, flxmass_w, &
5441	tau_aero, piz_aero, cg_aero, ccm, &
5442	rfname, &
5443	d_tr_dyn, & !<<RomP
5444	tr_seri, init_source)
5445	IF (CPPKEY_REPROBUS) THEN
5446
5447
5448	print*,'avt add phys rep',abortphy
5449
5450	CALL add_phys_tend &
5451	(du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,dqbs0,paprs,&
5452	'rep',abortphy,flag_inhib_tend,itap,0)
5453	IF (abortphy==1) Print*,'ERROR ABORT REP'
5454
5455	print*,'apr add phys rep',abortphy
5456
5457	END IF
5458	ENDIF ! (iflag_phytrac=1)
5459
5460	END IF
5461	!ENDIF ! (iflag_phytrac=1)
5462
5463	IF (offline) THEN
5464
5465	IF (prt_level.ge.9) &
5466	print*,'Attention on met a 0 les thermiques pour phystoke'
5467	CALL phystokenc ( &
5468	nlon,klev,pdtphys,longitude_deg,latitude_deg, &
5469	t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
5470	fm_therm,entr_therm, &
5471	cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, &
5472	frac_impa, frac_nucl, &
5473	pphis,cell_area,phys_tstep,itap, &
5474	qx(:,:,ivap),da,phi,mp,upwd,dnwd)
5475
5476
5477	ENDIF
5478
5479	!
5480	! Calculer le transport de l'eau et de l'energie (diagnostique)
5481	!
5482	CALL transp (paprs,zxtsol, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, &
5483	ue, ve, uq, vq, uwat, vwat)
5484	!
5485	!IM global posePB BEG
5486	IF(1.EQ.0) THEN
5487	!
5488	CALL transp_lay (paprs,zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
5489	ve_lay, vq_lay, ue_lay, uq_lay)
5490	!
5491	ENDIF !(1.EQ.0) THEN
5492	!IM global posePB END
5493	!
5494	! Accumuler les variables a stocker dans les fichiers histoire:
5495	!
5496
5497	!================================================================
5498	! Conversion of kinetic and potential energy into heat, for
5499	! parameterisation of subgrid-scale motions
5500	!================================================================
5501
5502	d_t_ec(:,:)=0.
5503	forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
5504	CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx,ivap,iliq,isol, &
5505	u_seri,v_seri,t_seri,q_seri,ql_seri,qs_seri,pbl_tke(:,:,is_ave)-tke0(:,:), &
5506	zmasse,exner,d_t_ec)
5507	t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
5508
5509	!==================================================================
5510	!--OB water mass fixer for the physics
5511	!--water profiles are corrected to force mass conservation of water
5512	!--currently flag is turned off
5513	!==================================================================
5514	IF (ok_water_mass_fixer) THEN
5515	qql2(:)=0.0
5516	DO k = 1, klev
5517	qql2(:)=qql2(:)+(q_seri(:,k)+ql_seri(:,k))*zmasse(:,k)
5518	IF (nqo >= 3) THEN
5519	qql2(:)=qql2(:)+qs_seri(:,k)*zmasse(:,k)
5520	ENDIF
5521	IF (ok_bs) THEN
5522	qql2(:)=qql2(:)+qbs_seri(:,k)*zmasse(:,k)
5523	ENDIF
5524	ENDDO
5525
5526	IF (CPPKEY_STRATAER) THEN
5527	IF (ok_qemiss) THEN
5528	DO k = 1, klev
5529	qql1(:) = qql1(:)+d_q_emiss(:,k)*zmasse(:,k)
5530	ENDDO
5531	ENDIF
5532	END IF
5533	IF (ok_qch4) THEN
5534	DO k = 1, klev
5535	qql1(:) = qql1(:)+d_q_ch4_dtime(:,k)*zmasse(:,k)
5536	ENDDO
5537	ENDIF
5538
5539	DO i = 1, klon
5540	!--compute ratio of what q+ql should be with conservation to what it is
5541	IF (ok_bs) THEN
5542	corrqql=(qql1(i)+(evap(i)-snowerosion(i)-rain_fall(i)-snow_fall(i)-bs_fall(i))*pdtphys)/qql2(i)
5543	ELSE
5544	corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
5545	ENDIF
5546	DO k = 1, klev
5547	q_seri(i,k) =q_seri(i,k)*corrqql
5548	ql_seri(i,k)=ql_seri(i,k)*corrqql
5549	IF (nqo >= 3) THEN
5550	qs_seri(i,k)=qs_seri(i,k)*corrqql
5551	ENDIF
5552	IF (ok_bs) THEN
5553	qbs_seri(i,k)=qbs_seri(i,k)*corrqql
5554	ENDIF
5555	ENDDO
5556	ENDDO
5557	ENDIF
5558	!--fin mass fixer
5559
5560	!cc prw = eau precipitable
5561	! prlw = colonne eau liquide
5562	! prlw = colonne eau solide
5563	! prbsw = colonne neige soufflee
5564	! water_budget = non-conservation residual from the LMDZ physics
5565	! (should be equal to machine precision if mass fixer is activated)
5566	prw(:) = 0.
5567	prlw(:) = 0.
5568	prsw(:) = 0.
5569	prbsw(:) = 0.
5570	water_budget(:) = 0.0
5571	DO k = 1, klev
5572	prw(:) = prw(:) + q_seri(:,k)*zmasse(:,k)
5573	prlw(:) = prlw(:) + ql_seri(:,k)*zmasse(:,k)
5574	water_budget(:) = water_budget(:) + (q_seri(:,k)-qx(:,k,ivap)+ql_seri(:,k)-qx(:,k,iliq))*zmasse(:,k)
5575	IF (nqo >= 3) THEN
5576	prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k)
5577	water_budget(:) = water_budget(:) + (qs_seri(:,k)-qx(:,k,isol))*zmasse(:,k)
5578	ENDIF
5579	IF (nqo >= 4 .AND. ok_bs) THEN
5580	prbsw(:)= prbsw(:) + qbs_seri(:,k)*zmasse(:,k)
5581	water_budget(:) = water_budget(:) + (qbs_seri(:,k)-qx(:,k,ibs))*zmasse(:,k)
5582	ENDIF
5583	ENDDO
5584	water_budget(:)=water_budget(:)+(rain_fall(:)+snow_fall(:)-evap(:))*pdtphys
5585	IF (ok_bs) THEN
5586	water_budget(:)=water_budget(:)+bs_fall(:)*pdtphys
5587	ENDIF
5588
5589	!=======================================================================
5590	! SORTIES
5591	!=======================================================================
5592	!
5593	!IM initialisation + calculs divers diag AMIP2
5594	CALL calcul_divers(itap, itapm1, un_jour)
5595	!
5596	!IM Interpolation sur les niveaux de pression du NMC
5597	! -------------------------------------------------
5598	!
5599	include "calcul_STDlev.h"
5600	!
5601	! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
5602	CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)
5603	!
5604	!
5605	IF (ANY(type_trac == ['inca','inco'])) THEN
5606	IF (CPPKEY_INCA) THEN
5607	CALL VTe(VTphysiq)
5608	CALL VTb(VTinca)
5609
5610	CALL chemhook_end ( &
5611	phys_tstep, &
5612	pplay, &
5613	t_seri, &
5614	tr_seri(:,:,1+nqCO2:nbtr), &
5615	nbtr, &
5616	paprs, &
5617	q_seri, &
5618	cell_area, &
5619	pphi, &
5620	pphis, &
5621	zx_rh, &
5622	aps, bps, ap, bp, lafin)
5623
5624	CALL VTe(VTinca)
5625	CALL VTb(VTphysiq)
5626	END IF
5627	ENDIF
5628
5629	IF (type_trac == 'repr') THEN
5630	IF (CPPKEY_REPROBUS) THEN
5631	CALL coord_hyb_rep(paprs, pplay, aps, bps, ap, bp, cell_area)
5632	END IF
5633	ENDIF
5634
5635	!
5636	! Convertir les incrementations en tendances
5637	!
5638	IF (prt_level .GE.10) THEN
5639	print *,'Convertir les incrementations en tendances '
5640	ENDIF
5641	!
5642	IF (mydebug) THEN
5643	CALL writefield_phy('u_seri',u_seri,nbp_lev)
5644	CALL writefield_phy('v_seri',v_seri,nbp_lev)
5645	CALL writefield_phy('t_seri',t_seri,nbp_lev)
5646	CALL writefield_phy('q_seri',q_seri,nbp_lev)
5647	ENDIF
5648
5649	DO k = 1, klev
5650	DO i = 1, klon
5651	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / phys_tstep
5652	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / phys_tstep
5653	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / phys_tstep
5654	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / phys_tstep
5655	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep
5656	!CR: on ajoute le contenu en glace
5657	IF (nqo >= 3) THEN
5658	d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
5659	ENDIF
5660	!--ice_supersat: nqo=5, we add cloud fraction and cloudy water vapor to total water vapor ratio
5661	IF (nqo.ge.5 .and. ok_ice_supersat) THEN
5662	d_qx(i,k,icf) = ( cf_seri(i,k) - qx(i,k,icf) ) / phys_tstep
5663	d_qx(i,k,irvc) = ( rvc_seri(i,k) - qx(i,k,irvc) ) / phys_tstep
5664	ENDIF
5665
5666	IF (nqo.ge.4 .and. ok_bs) THEN
5667	d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep
5668	ENDIF
5669
5670	ENDDO
5671	ENDDO
5672	!
5673	! DC: All iterations are cycled if nqtot==nqo, so no nqtot>nqo condition required
5674	itr = 0
5675	DO iq = 1, nqtot
5676	IF(.NOT.tracers(iq)%isInPhysics) CYCLE
5677	itr = itr+1
5678	DO k = 1, klev
5679	DO i = 1, klon
5680	d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / phys_tstep
5681	ENDDO
5682	ENDDO
5683	ENDDO
5684	!
5685	!IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
5686	!IM global posePB include "write_bilKP_ins.h"
5687	!IM global posePB include "write_bilKP_ave.h"
5688	!
5689	! Sauvegarder les valeurs de t et q a la fin de la physique:
5690	!
5691	u_ancien(:,:) = u_seri(:,:)
5692	v_ancien(:,:) = v_seri(:,:)
5693	t_ancien(:,:) = t_seri(:,:)
5694	q_ancien(:,:) = q_seri(:,:)
5695	ql_ancien(:,:) = ql_seri(:,:)
5696	qs_ancien(:,:) = qs_seri(:,:)
5697	qbs_ancien(:,:)= qbs_seri(:,:)
5698	cf_ancien(:,:) = cf_seri(:,:)
5699	rvc_ancien(:,:)= rvc_seri(:,:)
5700	CALL water_int(klon,klev,q_ancien,zmasse,prw_ancien)
5701	CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien)
5702	CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien)
5703	CALL water_int(klon,klev,qbs_ancien,zmasse,prbsw_ancien)
5704	! !! RomP >>>
5705	IF (nqtot > nqo) tr_ancien(:,:,:) = tr_seri(:,:,:)
5706	! !! RomP <<<
5707	!==========================================================================
5708	! Sorties des tendances pour un point particulier
5709	! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
5710	! pour le debug
5711	! La valeur de igout est attribuee plus haut dans le programme
5712	!==========================================================================
5713
5714	IF (prt_level.ge.1) THEN
5715	write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
5716	write(lunout,*) &
5717	'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
5718	write(lunout,*) &
5719	nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
5720	pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
5721	pctsrf(igout,is_sic)
5722	write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
5723	DO k=1,klev
5724	write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
5725	d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
5726	d_t_eva(igout,k)
5727	ENDDO
5728	write(lunout,*) 'cool,heat'
5729	DO k=1,klev
5730	write(lunout,*) cool(igout,k),heat(igout,k)
5731	ENDDO
5732
5733	!jyg< (En attendant de statuer sur le sort de d_t_oli)
5734	!jyg! write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
5735	!jyg! do k=1,klev
5736	!jyg! write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
5737	!jyg! d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
5738	!jyg! enddo
5739	write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
5740	DO k=1,klev
5741	write(lunout,*) d_t_vdf(igout,k), &
5742	d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
5743	ENDDO
5744	!>jyg
5745
5746	write(lunout,*) 'd_ps ',d_ps(igout)
5747	write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
5748	DO k=1,klev
5749	write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
5750	d_qx(igout,k,1),d_qx(igout,k,2)
5751	ENDDO
5752	ENDIF
5753
5754	!============================================================
5755	! Calcul de la temperature potentielle
5756	!============================================================
5757	DO k = 1, klev
5758	DO i = 1, klon
5759	!JYG/IM theta en debut du pas de temps
5760	!JYG/IM theta(i,k)=t(i,k)(100000./pplay(i,k))*(RD/RCPD)
5761	!JYG/IM theta en fin de pas de temps de physique
5762	theta(i,k)=t_seri(i,k)(100000./pplay(i,k))*(RD/RCPD)
5763	! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
5764	! MPL 20130625
5765	! fth_fonctions.F90 et parkind1.F90
5766	! sinon thetal=theta
5767	! thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
5768	! : ql_seri(i,k))
5769	thetal(i,k)=theta(i,k)
5770	ENDDO
5771	ENDDO
5772	!
5773
5774	! 22.03.04 BEG
5775	!=============================================================
5776	! Ecriture des sorties
5777	!=============================================================
5778
5779	! Recupere des varibles calcule dans differents modules
5780	! pour ecriture dans histxxx.nc
5781
5782	! Get some variables from module fonte_neige_mod
5783	CALL fonte_neige_get_vars(pctsrf, &
5784	zxfqcalving, zxfqfonte, zxffonte, zxrunofflic)
5785
5786
5787	!=============================================================
5788	! Separation entre thermiques et non thermiques dans les sorties
5789	! de fisrtilp
5790	!=============================================================
5791
5792	IF (iflag_thermals>=1) THEN
5793	d_t_lscth=0.
5794	d_t_lscst=0.
5795	d_q_lscth=0.
5796	d_q_lscst=0.
5797	DO k=1,klev
5798	DO i=1,klon
5799	IF (ptconvth(i,k)) THEN
5800	d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
5801	d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
5802	ELSE
5803	d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
5804	d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
5805	ENDIF
5806	ENDDO
5807	ENDDO
5808
5809	DO i=1,klon
5810	plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
5811	plul_th(i)=prfl(i,1)+psfl(i,1)
5812	ENDDO
5813	ENDIF
5814
5815	!On effectue les sorties:
5816
5817	IF (CPPKEY_DUST) THEN
5818	CALL phys_output_write_spl(itap, pdtphys, paprs, pphis, &
5819	pplay, lmax_th, aerosol_couple, &
5820	ok_ade, ok_aie, ivap, ok_sync, &
5821	ptconv, read_climoz, clevSTD, &
5822	ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse, &
5823	flag_aerosol, flag_aerosol_strat, ok_cdnc)
5824	ELSE
5825	CALL phys_output_write(itap, pdtphys, paprs, pphis, &
5826	pplay, lmax_th, aerosol_couple, &
5827	ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs, &
5828	ok_sync, ptconv, read_climoz, clevSTD, &
5829	ptconvth, d_u, d_t, qx, d_qx, zmasse, &
5830	flag_aerosol, flag_aerosol_strat, ok_cdnc,t, u1, v1)
5831	END IF
5832
5833	#ifndef CPP_XIOS
5834	CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
5835	#endif
5836
5837	! Petit appelle de sorties pour accompagner le travail sur phyex
5838	if ( iflag_physiq == 1 ) then
5839	call output_physiqex(debut,jD_eq,pdtphys,presnivs,paprs,u,v,t,qx,cldfra,0.t,0.t,0.*t,pbl_tke,theta)
5840	endif
5841
5842	!====================================================================
5843	! Arret du modele apres hgardfou en cas de detection d'un
5844	! plantage par hgardfou
5845	!====================================================================
5846
5847	IF (abortphy==1) THEN
5848	abort_message ='Plantage hgardfou'
5849	CALL abort_physic (modname,abort_message,1)
5850	ENDIF
5851
5852	! 22.03.04 END
5853	!
5854	!====================================================================
5855	! Si c'est la fin, il faut conserver l'etat de redemarrage
5856	!====================================================================
5857	!
5858
5859	! Disabling calls to the prt_alerte function
5860	alert_first_call = .FALSE.
5861
5862
5863	IF (lafin) THEN
5864	itau_phy = itau_phy + itap
5865	CALL phyredem ("restartphy.nc")
5866	! open(97,form="unformatted",file="finbin")
5867	! write(97) u_seri,v_seri,t_seri,q_seri
5868	! close(97)
5869
5870	IF (is_omp_master) THEN
5871
5872	IF (read_climoz >= 1) THEN
5873	IF (is_mpi_root) CALL nf95_close(ncid_climoz)
5874	DEALLOCATE(press_edg_climoz)
5875	DEALLOCATE(press_cen_climoz)
5876	ENDIF
5877
5878	ENDIF
5879
5880	IF (using_xios) THEN
5881
5882	IF (CPPKEY_INCA) THEN
5883	IF (ANY(type_trac == ['inca','inco'])) THEN
5884	IF (is_omp_master) THEN
5885	CALL finalize_inca
5886	ENDIF
5887	ENDIF
5888	END IF
5889
5890	! close xios physiq context (call LMDZ)
5891	IF (is_omp_master) CALL xios_context_finalize
5892	ENDIF
5893
5894	WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
5895
5896	ENDIF
5897
5898	! first=.false.
5899
5900	END SUBROUTINE physiq
5901
5902	END MODULE physiq_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format