Context Navigation

physiq_mod.F90 @ 5575

Last change on this file since 5575 was 5575, checked in by aborella, 4 months ago
Fixed the interpolation of aviation data + added the ok_no_issr_strato option + added additional outputs to compare ISSRs to Lamquin et al (2012)
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 217.4 KB

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

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

Download in other formats:

Original Format