Context Navigation

physiq_mod.F90 @ 5028

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

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

Download in other formats:

Original Format