Context Navigation

physiq_mod.F90 @ 5456

Last change on this file since 5456 was 5456, checked in by aborella, 2 days ago
Added diagnostics for contrails fraction
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.1 KB

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

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

Download in other formats:

Original Format