Context Navigation

physiq_mod.F90 @ 4065

Last change on this file since 4065 was 4065, checked in by Laurent Fairhead, 2 years ago
Corrections to r4059/r4062 so that phylmdiso compiles LF
File size: 242.0 KB

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

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

Download in other formats:

Original Format