Context Navigation

physiq_mod.F90 @ 4061

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

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

Download in other formats:

Original Format