Context Navigation

physiq_mod.F90 @ 5821

Last change on this file since 5821 was 5820, checked in by rkazeroni, 2 months ago

For GPU porting of ratqs_main routine:

Add "horizontal" comment to specify possible names of horizontal variables
Move computation of maxval into an initialization routine as this cannot be GPU ported
Fix wrong dimensionality of wake_s in the argument declaration
Change problematic variable initializations at declaration (SAVE attribute implied) by either adding a PARAMETER attribute or moving the initialization

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: 219.4 KB

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

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

Download in other formats:

Original Format