Context Navigation

physiq_mod.F90 @ 4668

Last change on this file since 4668 was 4664, checked in by fhourdin, 15 months ago

standardisatio des noms pour lscp et fisrtilp

fisrtilp passe dans le module lmdz_lscp_old.F90
Prepartation de la replaysation de fisrtilp (deja fait pour lscp)

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

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

Download in other formats:

Original Format