Context Navigation

physiq_mod.F90 @ 4446

Last change on this file since 4446 was 4446, checked in by Laurent Fairhead, 16 months ago
Merged trunk revisions from 4127 to 4443 (HEAD) into branch
File size: 244.6 KB

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

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

Download in other formats:

Original Format