Context Navigation

physiq_mod.F90 @ 4466

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

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

Download in other formats:

Original Format