Context Navigation

physiq_mod.F90 @ 5420

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

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

Download in other formats:

Original Format