Context Navigation

physiq_mod.F90 @ 4040

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

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

Download in other formats:

Original Format