Context Navigation

physiq_mod.F90 @ 4707

Last change on this file since 4707 was 4707, checked in by Laurent Fairhead, 12 months ago
Continuing on from the morning's poihl workshop: getting rid of the includes in the routine
File size: 255.6 KB

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

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

Download in other formats:

Original Format