Context Navigation

physiq_mod.F90 @ 5778

Last change on this file since 5778 was 5778, checked in by evignon, 8 days ago
deplacement de l'initialisation des parametres tkeoro dans physiq_mod
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: 218.7 KB

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

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

Download in other formats:

Original Format