Context Navigation

physiq_mod.F90 @ 4113

Last change on this file since 4113 was 4009, checked in by evignon, 3 years ago
! Prise en compte de l'orographie sous maille, des heterogeneites de surface ! sur le ratqs + nouvelle version des ratqs interactifs de Louis ! Le tout est dan un module: calcratqs_multi_mod. ! Pour l'instant, les nouvelles contributions peuvent s'activer ! uniquement de facon separee
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, &
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	if (iso_eau.gt.0) then
3529	i=1
3530	k=1
3531	write(,) 'physic 2376: xt_seri(iso_eau,i,k),q_seri(i,k)=',xt_seri(iso_eau,i,k),q_seri(i,k)
3532	write(,) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
3533	write(,) 'physic 2376: xt_x(iso_eau,i,k),q_x(i,k)=',xt_x(iso_eau,i,k),q_x(i,k)
3534	write(,) 'xt_x(:,i,k)=',xt_x(:,i,k)
3535	endif
3536	#endif
3537	!ISOVERIF
3538	if ((bidouille_anti_divergence).and. &
3539	& (iso_eau.gt.0)) then
3540	do k=1,klev
3541	do i=1,klon
3542	xt_seri(iso_eau,i,k)= q_seri(i,k)
3543	xt_x(iso_eau,i,k)= q_x(i,k)
3544	xt_w(iso_eau,i,k)= q_w(i,k)
3545	enddo !do i=1,klon
3546	enddo !do k=1,klev
3547	endif !if ((bidouille_anti_divergence).and. &
3548	#endif
3549	!jyg<
3550	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3551	! Calculate the upmost level of deep convection loops: k_upper_cv
3552	! (near 22 km)
3553	k_upper_cv = klev
3554	!izero = klon/2+1/klon
3555	!DO k = klev,1,-1
3556	! IF (pphi(izero,k) > 22.e4) k_upper_cv = k
3557	!ENDDO
3558	! FH : nouveau calcul base sur un profil global sans quoi
3559	! le modele etait sensible au decoupage de domaines
3560	DO k = klev,1,-1
3561	IF (-7*log(presnivs(k)/presnivs(1)) > 25.) k_upper_cv = k
3562	ENDDO
3563	IF (prt_level .ge. 5) THEN
3564	Print *, 'upmost level of deep convection loops: k_upper_cv = ', &
3565	k_upper_cv
3566	ENDIF
3567	!
3568	!>jyg
3569	IF (type_trac == 'repr') THEN
3570	nbtr_tmp=ntra
3571	ELSE
3572	nbtr_tmp=nbtr
3573	ENDIF
3574	!jyg iflag_con est dans clesphys
3575	!c CALL concvl (iflag_con,iflag_clos,
3576	CALL concvl (iflag_clos, &
3577	phys_tstep, paprs, pplay, k_upper_cv, t_x,q_x, &
3578	t_w,q_w,wake_s, &
3579	u_seri,v_seri,tr_seri,nbtr_tmp, &
3580	ALE,ALP, &
3581	sig1,w01, &
3582	d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
3583	rain_con, snow_con, ibas_con, itop_con, sigd, &
3584	ema_cbmf,plcl,plfc,wbeff,convoccur,upwd,dnwd,dnwd0, &
3585	Ma,mipsh,Vprecip,cape,cin,tvp,Tconv,iflagctrl, &
3586	pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &
3587	! RomP >>>
3588	!! . pmflxr,pmflxs,da,phi,mp,
3589	!! . ftd,fqd,lalim_conv,wght_th)
3590	pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,qtaa,clw,elij, &
3591	ftd,fqd,lalim_conv,wght_th, &
3592	ev, ep,epmlmMm,eplaMm, &
3593	wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv, &
3594	tau_cld_cv,coefw_cld_cv,epmax_diag &
3595	#ifdef ISO
3596	& ,xt_x,xt_w,d_xt_con,xtrain_con,xtsnow_con &
3597	& ,xtVprecip,xtVprecipi &
3598	& ,xtclw,fxtd,xtev,xtwdtrainA &
3599	#ifdef DIAGISO
3600	& , qlp,xtlp,qvp,xtvp & ! juste diagnostique
3601	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
3602	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
3603	& , f_detrainement,q_detrainement,xt_detrainement &
3604	#endif
3605	#endif
3606	& )
3607	! RomP <<<
3608
3609	#ifdef ISO
3610	#ifdef ISOVERIF
3611	! write(,) 'q_detrainement(1,:)=',q_detrainement(1,:)
3612	call iso_verif_noNaN_vect2D(d_xt_con, &
3613	& 'physiq 3203a apres conv',ntraciso,klon,klev)
3614	call iso_verif_noNaN_vect2D(xt_seri, &
3615	& 'physiq 3203b apres conv',ntraciso,klon,klev)
3616	#endif
3617	#ifdef ISOVERIF
3618	#ifdef ISOTRAC
3619	call iso_verif_trac_masse_vect(d_xt_con,klon,klev, &
3620	& 'physiq 3003 apres tend concvl', &
3621	& errmax,errmaxrel)
3622	call iso_verif_traceur_vect(xt_seri,klon,klev, &
3623	& 'physiq 3005 apres tend concvl')
3624	#endif
3625	#endif
3626	#endif
3627
3628	!IM begin
3629	! print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
3630	! .dnwd0(1,1),ftd(1,1),fqd(1,1)
3631	!IM end
3632	!IM cf. FH
3633	clwcon0=qcondc
3634	pmfu(:,:)=upwd(:,:)+dnwd(:,:)
3635	!
3636	!jyg<
3637	! If convective tendencies are too large, then call convection
3638	! every time step
3639	cvpas = cvpas_0
3640	DO k=1,k_upper_cv
3641	DO i=1,klon
3642	IF (d_t_con(i,k) > 6.721 .AND. d_t_con(i,k) < 6.722 .AND.&
3643	d_q_con(i,k) > -.0002171 .AND. d_q_con(i,k) < -.0002170) THEN
3644	dtcon_multistep_max = 3.
3645	dqcon_multistep_max = 0.02
3646	ENDIF
3647	ENDDO
3648	ENDDO
3649	!
3650	DO k=1,k_upper_cv
3651	DO i=1,klon
3652	!! IF (abs(d_t_con(i,k)) > 0.24 .OR. &
3653	!! abs(d_q_con(i,k)) > 2.e-2) THEN
3654	IF (abs(d_t_con(i,k)) > dtcon_multistep_max .OR. &
3655	abs(d_q_con(i,k)) > dqcon_multistep_max) THEN
3656	cvpas = 1
3657	!! print *,'physiq1, i,k,d_t_con(i,k),d_q_con(i,k) ', &
3658	!! i,k,d_t_con(i,k),d_q_con(i,k)
3659	ENDIF
3660	ENDDO
3661	ENDDO
3662	!!! Ligne a ne surtout pas remettre sans avoir murement reflechi (jyg)
3663	!!! call bcast(cvpas)
3664	!!! ------------------------------------------------------------
3665	!>jyg
3666	!
3667	DO i = 1, klon
3668	IF (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+cvpas
3669	ENDDO
3670	!
3671	!jyg<
3672	! Add the tendency due to the dry adjustment of the wake profile
3673	IF (iflag_wake>=1) THEN
3674	IF (iflag_adjwk == 2) THEN
3675	DO k=1,klev
3676	DO i=1,klon
3677	ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/phys_tstep
3678	fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/phys_tstep
3679	d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k)
3680	d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k)
3681	#ifdef ISO
3682	do ixt=1,ntraciso
3683	fxtd(ixt,i,k) = fxtd(ixt,i,k) + wake_s(i)*d_xt_adjwk(ixt,i,k)/phys_tstep
3684	d_xt_con(ixt,i,k) = d_xt_con(ixt,i,k) + wake_s(i)*d_xt_adjwk(ixt,i,k)
3685	enddo
3686	#endif
3687	ENDDO
3688	ENDDO
3689	ENDIF ! (iflag_adjwk = 2)
3690	ENDIF ! (iflag_wake>=1)
3691	!>jyg
3692	!
3693	ELSE ! ok_cvl
3694
3695	! MAF conema3 ne contient pas les traceurs
3696	CALL conema3 (phys_tstep, &
3697	paprs,pplay,t_seri,q_seri, &
3698	u_seri,v_seri,tr_seri,ntra, &
3699	sig1,w01, &
3700	d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
3701	rain_con, snow_con, ibas_con, itop_con, &
3702	upwd,dnwd,dnwd0,bas,top, &
3703	Ma,cape,tvp,rflag, &
3704	pbase &
3705	,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr &
3706	,clwcon0)
3707
3708	ENDIF ! ok_cvl
3709
3710	!
3711	! Correction precip
3712	rain_con = rain_con * cvl_corr
3713	snow_con = snow_con * cvl_corr
3714	#ifdef ISO
3715	xtrain_con = xtrain_con * cvl_corr
3716	xtsnow_con = xtsnow_con * cvl_corr
3717	#endif
3718	!
3719
3720	IF (.NOT. ok_gust) THEN
3721	do i = 1, klon
3722	wd(i)=0.0
3723	enddo
3724	ENDIF
3725
3726	! =================================================================== c
3727	! Calcul des proprietes des nuages convectifs
3728	!
3729
3730	! calcul des proprietes des nuages convectifs
3731	clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
3732	IF (iflag_cld_cv == 0) THEN
3733	CALL clouds_gno &
3734	(klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
3735	ELSE
3736	CALL clouds_bigauss &
3737	(klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
3738	ENDIF
3739
3740
3741	! =================================================================== c
3742
3743	DO i = 1, klon
3744	itop_con(i) = min(max(itop_con(i),1),klev)
3745	ibas_con(i) = min(max(ibas_con(i),1),itop_con(i))
3746	ENDDO
3747
3748	DO i = 1, klon
3749	! C Risi modif: pour éviter pb de dépassement d'indice dans les cas
3750	! où i n'est pas un point convectif et donc ibas_con(i)=0
3751	! c'est un pb indépendant des isotopes
3752	if (ibas_con(i).gt.0) then
3753	ema_pcb(i) = paprs(i,ibas_con(i))
3754	else ! if (ibas_con(i).gt.0) then
3755	ema_pcb(i) = 0.0
3756	endif ! if (ibas_con(i).gt.0) then
3757
3758	ENDDO
3759	DO i = 1, klon
3760	! L'idicage de itop_con peut cacher un pb potentiel
3761	! FH sous la dictee de JYG, CR
3762	ema_pct(i) = paprs(i,itop_con(i)+1)
3763
3764	IF (itop_con(i).gt.klev-3) THEN
3765	IF (prt_level >= 9) THEN
3766	write(lunout,*)'La convection monte trop haut '
3767	write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
3768	ENDIF
3769	ENDIF
3770	ENDDO
3771	ELSE IF (iflag_con.eq.0) THEN
3772	write(lunout,*) 'On n appelle pas la convection'
3773	clwcon0=0.
3774	rnebcon0=0.
3775	d_t_con=0.
3776	d_q_con=0.
3777	d_u_con=0.
3778	d_v_con=0.
3779	rain_con=0.
3780	snow_con=0.
3781	bas=1
3782	top=1
3783	#ifdef ISO
3784	d_xt_con=0.
3785	xtrain_con=0.
3786	xtsnow_con=0.
3787	#endif
3788	ELSE
3789	WRITE(lunout,*) "iflag_con non-prevu", iflag_con
3790	CALL abort_physic("physiq", "", 1)
3791	ENDIF
3792
3793	! CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
3794	! . d_u_con, d_v_con)
3795
3796	!jyg Reinitialize proba_notrig and itapcv when convection has been called
3797	proba_notrig(:) = 1.
3798	itapcv = 0
3799	ENDIF ! (MOD(itapcv,cvpas).EQ.0 .OR. MOD(itapcv,cvpas_0).EQ.0)
3800	!
3801	itapcv = itapcv+1
3802	!
3803	! Compter les steps ou cvpas=1
3804	IF (cvpas == 1) THEN
3805	Ncvpaseq1 = Ncvpaseq1+1
3806	ENDIF
3807	IF (mod(itap,1000) == 0) THEN
3808	print *,' physiq, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
3809	ENDIF
3810
3811	!!!jyg Appel diagnostique a add_phys_tend pour tester la conservation de
3812	!!! l'energie dans les courants satures.
3813	!! d_t_con_sat(:,:) = d_t_con(:,:) - ftd(:,:)*dtime
3814	!! d_q_con_sat(:,:) = d_q_con(:,:) - fqd(:,:)*dtime
3815	!! dql_sat(:,:) = (wdtrainA(:,:)+wdtrainM(:,:))*dtime/zmasse(:,:)
3816	!! CALL add_phys_tend(d_u_con, d_v_con, d_t_con_sat, d_q_con_sat, dql_sat, &
3817	!! dqi0, paprs, 'convection_sat', abortphy, flag_inhib_tend,&
3818	!! itap, 1)
3819	!! call prt_enerbil('convection_sat',itap)
3820	!!
3821	!!
3822	CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
3823	'convection',abortphy,flag_inhib_tend,itap,0 &
3824	#ifdef ISO
3825	& ,d_xt_con,dxtl0,dxti0 &
3826	#endif
3827	& )
3828	CALL prt_enerbil('convection',itap)
3829
3830	!-------------------------------------------------------------------------
3831
3832	IF (mydebug) THEN
3833	CALL writefield_phy('u_seri',u_seri,nbp_lev)
3834	CALL writefield_phy('v_seri',v_seri,nbp_lev)
3835	CALL writefield_phy('t_seri',t_seri,nbp_lev)
3836	CALL writefield_phy('q_seri',q_seri,nbp_lev)
3837	ENDIF
3838
3839	IF (check) THEN
3840	za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
3841	WRITE(lunout,*)"aprescon=", za
3842	zx_t = 0.0
3843	za = 0.0
3844	DO i = 1, klon
3845	za = za + cell_area(i)/REAL(klon)
3846	zx_t = zx_t + (rain_con(i)+ &
3847	snow_con(i))*cell_area(i)/REAL(klon)
3848	ENDDO
3849	zx_t = zx_t/za*phys_tstep
3850	WRITE(lunout,*)"Precip=", zx_t
3851	ENDIF
3852	IF (zx_ajustq) THEN
3853	DO i = 1, klon
3854	z_apres(i) = 0.0
3855	#ifdef ISO
3856	do ixt=1,ntraciso
3857	zxt_apres(ixt,i) = 0.0
3858	enddo !do ixt=1,ntraciso
3859	#endif
3860	ENDDO
3861	DO k = 1, klev
3862	DO i = 1, klon
3863	z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
3864	*(paprs(i,k)-paprs(i,k+1))/RG
3865	ENDDO
3866	ENDDO
3867	#ifdef ISO
3868	DO k = 1, klev
3869	DO i = 1, klon
3870	do ixt=1,ntraciso
3871	zxt_apres(ixt,i) = zxt_apres(ixt,i) &
3872	& + (xt_seri(ixt,i,k)+xtl_seri(ixt,i,k)) &
3873	& *(paprs(i,k)-paprs(i,k+1))/RG
3874	enddo ! do ixt=1,ntraciso
3875	ENDDO
3876	ENDDO
3877	#endif
3878	DO i = 1, klon
3879	z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) &
3880	/z_apres(i)
3881	ENDDO
3882	#ifdef ISO
3883	DO i = 1, klon
3884	do ixt=1,ntraciso
3885	zxt_factor(ixt,i) = (zxt_avant(ixt,i)-(xtrain_con(ixt,i) &
3886	& +xtsnow_con(ixt,i))*phys_tstep)/zxt_apres(ixt,i)
3887	enddo ! do ixt=1,ntraciso
3888	ENDDO
3889	#endif
3890	DO k = 1, klev
3891	DO i = 1, klon
3892	IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
3893	z_factor(i).LT.(1.0-1.0E-08)) THEN
3894	q_seri(i,k) = q_seri(i,k) * z_factor(i)
3895	#ifdef ISO
3896	do ixt=1,ntraciso
3897	xt_seri(ixt,i,k)=xt_seri(ixt,i,k)*zxt_factor(ixt,i)
3898	enddo ! do ixt=1,ntraciso
3899	#endif
3900	ENDIF
3901	ENDDO
3902	ENDDO
3903	ENDIF
3904	zx_ajustq=.FALSE.
3905
3906	#ifdef ISO
3907	#ifdef ISOVERIF
3908	write(,) 'physiq 3425'
3909	if (iso_HDO.gt.0) then
3910	call iso_verif_aberrant_enc_vect2D( &
3911	& xt_seri,q_seri, &
3912	& 'physiq 3691a',ntraciso,klon,klev)
3913	endif
3914	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
3915	call iso_verif_O18_aberrant_enc_vect2D( &
3916	& xt_seri,q_seri, &
3917	& 'physiq 3691a',ntraciso,klon,klev)
3918	endif
3919	#ifdef ISOTRAC
3920	call iso_verif_traceur_vect(xt_seri,klon,klev, &
3921	& 'physiq 3386 avant wakes')
3922	#endif
3923	#endif
3924	#endif
3925
3926	!
3927	!==========================================================================
3928	!RR:Evolution de la poche froide: on ne fait pas de separation wake/env
3929	!pour la couche limite diffuse pour l instant
3930	!
3931	!
3932	! nrlmd le 22/03/2011---Si on met les poches hors des thermiques
3933	! il faut rajouter cette tendance calcul\'ee hors des poches
3934	! froides
3935	!
3936	IF (iflag_wake>=1) THEN
3937	!
3938	!
3939	! Call wakes every "wkpas" step
3940	!
3941	IF (MOD(itapwk,wkpas).EQ.0) THEN
3942	!
3943	DO k=1,klev
3944	DO i=1,klon
3945	dt_dwn(i,k) = ftd(i,k)
3946	dq_dwn(i,k) = fqd(i,k)
3947	M_dwn(i,k) = dnwd0(i,k)
3948	M_up(i,k) = upwd(i,k)
3949	dt_a(i,k) = d_t_con(i,k)/phys_tstep - ftd(i,k)
3950	dq_a(i,k) = d_q_con(i,k)/phys_tstep - fqd(i,k)
3951	#ifdef ISO
3952	do ixt=1,ntraciso
3953	dxt_dwn(ixt,i,k) = fxtd(ixt,i,k)
3954	dxt_a(ixt,i,k) = d_xt_con(ixt,i,k)/phys_tstep - fxtd(ixt,i,k)
3955	enddo !do ixt=1,ntraciso
3956	#endif
3957	ENDDO
3958	ENDDO
3959
3960	IF (iflag_wake==2) THEN
3961	ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
3962	DO k = 1,klev
3963	dt_dwn(:,k)= dt_dwn(:,k)+ &
3964	ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/phys_tstep
3965	dq_dwn(:,k)= dq_dwn(:,k)+ &
3966	ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/phys_tstep
3967	#ifdef ISO
3968	do ixt=1,ntraciso
3969	dxt_dwn(:,k,ixt)= dxt_dwn(:,k,ixt)+ &
3970	ok_wk_lsp(:)*(d_xt_eva(:,k,ixt)+d_xt_lsc(:,k,ixt))/phys_tstep
3971	enddo
3972	#endif
3973	ENDDO
3974	ELSEIF (iflag_wake==3) THEN
3975	ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
3976	DO k = 1,klev
3977	DO i=1,klon
3978	IF (rneb(i,k)==0.) THEN
3979	! On ne tient compte des tendances qu'en dehors des
3980	! nuages (c'est-\`a-dire a priri dans une region ou
3981	! l'eau se reevapore).
3982	dt_dwn(i,k)= dt_dwn(i,k)+ &
3983	ok_wk_lsp(i)*d_t_lsc(i,k)/phys_tstep
3984	dq_dwn(i,k)= dq_dwn(i,k)+ &
3985	ok_wk_lsp(i)*d_q_lsc(i,k)/phys_tstep
3986	#ifdef ISO
3987	do ixt=1,ntraciso
3988	dxt_dwn(:,k,ixt)= dxt_dwn(:,k,ixt)+ &
3989	ok_wk_lsp(:)*d_xt_lsc(:,k,ixt)/phys_tstep
3990	enddo
3991	#endif
3992	ENDIF
3993	ENDDO
3994	ENDDO
3995	ENDIF
3996
3997	#ifdef ISOVERIF
3998	write(,) 'physiq 3977: verif des inputs de calwake'
3999	DO k = 1,klev
4000	DO i=1,klon
4001	if (iso_eau.gt.0) then
4002	call iso_verif_egalite(q_seri(i,k),xt_seri(iso_eau,i,k),'physiq 3981a')
4003	call iso_verif_egalite(dq_dwn(i,k),dxt_dwn(iso_eau,i,k),'physiq 3981b')
4004	call iso_verif_egalite(dq_a(i,k),dxt_a(iso_eau,i,k),'physiq 3981c')
4005	call iso_verif_egalite(wake_deltaq(i,k),wake_deltaxt(iso_eau,i,k),'physiq 3981d')
4006	endif
4007	enddo
4008	enddo
4009	#endif
4010	!
4011	!calcul caracteristiques de la poche froide
4012	CALL calWAKE (iflag_wake_tend, paprs, pplay, phys_tstep, &
4013	t_seri, q_seri, omega, &
4014	dt_dwn, dq_dwn, M_dwn, M_up, &
4015	dt_a, dq_a, cv_gen, &
4016	sigd, cin, &
4017	wake_deltat, wake_deltaq, wake_s, awake_dens, wake_dens, &
4018	wake_dth, wake_h, &
4019	!! wake_pe, wake_fip, wake_gfl, &
4020	wake_pe, wake_fip_0, wake_gfl, & !! jyg
4021	d_t_wake, d_q_wake, &
4022	wake_k, t_x, q_x, &
4023	wake_omgbdth, wake_dp_omgb, &
4024	wake_dtKE, wake_dqKE, &
4025	wake_omg, wake_dp_deltomg, &
4026	wake_spread, wake_Cstar, d_deltat_wk_gw, &
4027	d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_a_wk, d_dens_wk &
4028	#ifdef ISO
4029	& ,xt_seri,dxt_dwn,dxt_a &
4030	& ,wake_deltaxt,d_xt_wake,xt_x,d_deltaxt_wk &
4031	#endif
4032	& )
4033	!
4034	!jyg Reinitialize itapwk when wakes have been called
4035	itapwk = 0
4036	ENDIF ! (MOD(itapwk,wkpas).EQ.0)
4037	!
4038	itapwk = itapwk+1
4039	#ifdef ISOVERIF
4040	write(,) 'physiq 4020: verif des outputs de calwake'
4041	DO k = 1,klev
4042	DO i=1,klon
4043	if (iso_eau.gt.0) then
4044	call iso_verif_egalite(d_q_wake(i,k),d_xt_wake(iso_eau,i,k),'physiq 4023a')
4045	call iso_verif_egalite(q_x(i,k),xt_x(iso_eau,i,k),'physiq 4023b')
4046	call iso_verif_egalite(d_deltaq_wk(i,k),d_deltaxt_wk(iso_eau,i,k),'physiq 4023c')
4047	endif
4048	enddo
4049	enddo
4050	#endif
4051	!
4052	!-----------------------------------------------------------------------
4053	! ajout des tendances des poches froides
4054	CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake', &
4055	abortphy,flag_inhib_tend,itap,0 &
4056	#ifdef ISO
4057	& ,d_xt_wake,dxtl0,dxti0 &
4058	#endif
4059	& )
4060	CALL prt_enerbil('wake',itap)
4061	!------------------------------------------------------------------------
4062
4063	! Increment Wake state variables
4064	IF (iflag_wake_tend .GT. 0.) THEN
4065
4066	CALL add_wake_tend &
4067	(d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_a_wk, d_dens_wk, wake_k, &
4068	'wake', abortphy &
4069	#ifdef ISO
4070	,d_deltaxt_wk &
4071	#endif
4072	)
4073	CALL prt_enerbil('wake',itap)
4074	ENDIF ! (iflag_wake_tend .GT. 0.)
4075	!
4076	IF (prt_level .GE. 10) THEN
4077	print *,' physiq, after calwake, wake_s: ',wake_s(:)
4078	print *,' physiq, after calwake, wake_deltat: ',wake_deltat(:,1)
4079	print *,' physiq, after calwake, wake_deltaq: ',wake_deltaq(:,1)
4080	ENDIF
4081
4082	IF (iflag_alp_wk_cond .GT. 0.) THEN
4083
4084	CALL alpale_wk(phys_tstep, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, &
4085	wake_fip)
4086	ELSE
4087	wake_fip(:) = wake_fip_0(:)
4088	ENDIF ! (iflag_alp_wk_cond .GT. 0.)
4089
4090	ENDIF ! (iflag_wake>=1)
4091	!
4092	!===================================================================
4093	! Convection seche (thermiques ou ajustement)
4094	!===================================================================
4095	!
4096	CALL stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
4097	,seuil_inversion,weak_inversion,dthmin)
4098
4099
4100
4101	d_t_ajsb(:,:)=0.
4102	d_q_ajsb(:,:)=0.
4103	d_t_ajs(:,:)=0.
4104	d_u_ajs(:,:)=0.
4105	d_v_ajs(:,:)=0.
4106	d_q_ajs(:,:)=0.
4107	clwcon0th(:,:)=0.
4108	#ifdef ISO
4109	d_xt_ajs(:,:,:)=0.0
4110	d_xt_ajsb(:,:,:)=0.0
4111	#endif
4112	!
4113	! fm_therm(:,:)=0.
4114	! entr_therm(:,:)=0.
4115	! detr_therm(:,:)=0.
4116	!
4117	IF (prt_level>9) WRITE(lunout,*) &
4118	'AVANT LA CONVECTION SECHE , iflag_thermals=' &
4119	,iflag_thermals,' nsplit_thermals=',nsplit_thermals
4120	IF (iflag_thermals<0) THEN
4121	! Rien
4122	! ====
4123	IF (prt_level>9) WRITE(lunout,*)'pas de convection seche'
4124
4125
4126	#ifdef ISO
4127	#ifdef ISOVERIF
4128	call iso_verif_noNaN_vect2D(xt_seri,'physiq 3971', &
4129	& ntraciso,klon,klev)
4130	#endif
4131	#ifdef ISOVERIF
4132	write(,) 'physiq 3570'
4133	do k=1,klev
4134	do i=1,klon
4135	if (iso_eau.gt.0) then
4136	call iso_verif_egalite_choix(xt_seri(iso_eau,i,k), &
4137	& q_seri(i,k),'physiq 2765',errmax,errmaxrel)
4138	endif !if (iso_eau.gt.0) then
4139	if (iso_HDO.gt.0) then
4140	if (q_seri(i,k).gt.ridicule) then
4141	call iso_verif_aberrant_encadre(xt_seri(iso_HDO,i,k)/ &
4142	& q_seri(i,k),'physiq 2770')
4143	endif !if (abs(d_q_ajs(i,k)).gt.ridicule) then
4144	endif !if (iso_HDO.gt.0) then
4145	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
4146	if (q_seri(i,k).gt.ridicule) then
4147	if (iso_verif_o18_aberrant_nostop( &
4148	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
4149	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
4150	& 'physiq 3978, avant calltherm').eq.1) then
4151	write(,) 'physic 4115: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
4152	stop
4153	endif ! if (iso_verif_o18_aberrant_nostop
4154	endif !if (q_seri(i,k).gt.errmax) then
4155	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
4156	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
4157	if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
4158	call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
4159	& /q_seri(i,k),xt_seri(iso_o18,i,k) &
4160	& /q_seri(i,k),'physiq 3178: avant clmain')
4161	endif !if (q_seri(i,k).gt.ridicule) then
4162	endif !if (iso_O17.gt.0) then
4163	#ifdef ISOTRAC
4164	call iso_verif_traceur(xt_seri(1,i,k),'physiq 3389')
4165	if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
4166	& 'physiq 3481, avant ajsec',1e-5) &
4167	& .eq.1) then
4168	write(,) 'i,k=',i,k
4169	#ifdef ISOVERIF
4170	stop
4171	#endif
4172	!#ifdef ISOVERIF
4173	endif !if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k),
4174	#endif
4175	!#ifdef ISOTRAC
4176	enddo !do i=1,klon
4177	enddo !do k=1,klev
4178	#endif
4179	!#ifdef ISOVERIF
4180	if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
4181	do k=1,klev
4182	do i=1,klon
4183	xt_seri(iso_eau,i,k)=q_seri(i,k)
4184	enddo !do i=1,klon
4185	enddo !do k=1,klev
4186	#ifdef ISOTRAC
4187	call iso_verif_traceur_jbid_vect(xt_seri, &
4188	& klon,klev)
4189	#endif
4190	endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
4191	#endif
4192	!#ifdef ISO
4193
4194
4195	ELSE
4196
4197	! Thermiques
4198	! ==========
4199	IF (prt_level>9) WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
4200	,iflag_thermals,' nsplit_thermals=',nsplit_thermals
4201
4202
4203	!cc nrlmd le 10/04/2012
4204	DO k=1,klev+1
4205	DO i=1,klon
4206	pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce)
4207	pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter)
4208	pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic)
4209	pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic)
4210	ENDDO
4211	ENDDO
4212	!cc fin nrlmd le 10/04/2012
4213
4214	IF (iflag_thermals>=1) THEN
4215	!jyg<
4216	!! IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
4217	IF (mod(iflag_pbl_split/10,10) .GE. 1) THEN
4218	! Appel des thermiques avec les profils exterieurs aux poches
4219	DO k=1,klev
4220	DO i=1,klon
4221	t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
4222	q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
4223	u_therm(i,k) = u_seri(i,k)
4224	v_therm(i,k) = v_seri(i,k)
4225	#ifdef ISO
4226	do ixt=1,ntraciso
4227	xt_therm(ixt,i,k) = xt_seri(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k)
4228	enddo !do ixt=1,ntraciso
4229	#endif
4230	ENDDO
4231	ENDDO
4232	ELSE
4233	! Appel des thermiques avec les profils moyens
4234	DO k=1,klev
4235	DO i=1,klon
4236	t_therm(i,k) = t_seri(i,k)
4237	q_therm(i,k) = q_seri(i,k)
4238	u_therm(i,k) = u_seri(i,k)
4239	v_therm(i,k) = v_seri(i,k)
4240	#ifdef ISO
4241	do ixt=1,ntraciso
4242	xt_therm(ixt,i,k) = xt_seri(ixt,i,k)
4243	enddo !do ixt=1,ntraciso
4244	#endif
4245	ENDDO
4246	ENDDO
4247	ENDIF
4248
4249
4250	#ifdef ISO
4251	#ifdef ISOTRAC
4252	! ajout C Risi juillet 2020: pas sure de ce que je fais...
4253	call iso_verif_traceur_jbid_pos_vect(klon,klev,xt_seri)
4254	call iso_verif_traceur_jbid_pos_vect(klon,klev,xt_therm)
4255	#endif
4256	#endif
4257	!>jyg
4258	CALL calltherm(pdtphys &
4259	,pplay,paprs,pphi,weak_inversion &
4260	! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
4261	,u_therm,v_therm,t_therm,q_therm,zqsat,debut & !jyg
4262	,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
4263	,fm_therm,entr_therm,detr_therm &
4264	,zqasc,clwcon0th,lmax_th,ratqscth &
4265	,ratqsdiff,zqsatth &
4266	!on rajoute ale et alp, et les
4267	!caracteristiques de la couche alim
4268	,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca &
4269	,ztv,zpspsk,ztla,zthl &
4270	!cc nrlmd le 10/04/2012
4271	,pbl_tke_input,pctsrf,omega,cell_area &
4272	,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
4273	,n2,s2,ale_bl_stat &
4274	,therm_tke_max,env_tke_max &
4275	,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
4276	,alp_bl_conv,alp_bl_stat &
4277	!cc fin nrlmd le 10/04/2012
4278	,zqla,ztva &
4279	#ifdef ISO
4280	& ,xt_therm,d_xt_ajs &
4281	#ifdef DIAGISO
4282	& ,q_the,xt_the &
4283	#endif
4284	#endif
4285	& )
4286	!
4287	!jyg<
4288	!!jyg IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
4289	IF (mod(iflag_pbl_split/10,10) .GE. 1) THEN
4290	! Si les thermiques ne sont presents que hors des
4291	! poches, la tendance moyenne associ\'ee doit etre
4292	! multipliee par la fraction surfacique qu'ils couvrent.
4293	DO k=1,klev
4294	DO i=1,klon
4295	!
4296	d_deltat_the(i,k) = - d_t_ajs(i,k)
4297	d_deltaq_the(i,k) = - d_q_ajs(i,k)
4298	!
4299	d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i))
4300	d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i))
4301	d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i))
4302	d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i))
4303	#ifdef ISO
4304	do ixt=1,ntraciso
4305	d_deltaxt_the(ixt,i,k) = - d_xt_ajs(ixt,i,k)
4306	d_xt_ajs(ixt,i,k) = d_xt_ajs(ixt,i,k)*(1.-wake_s(i))
4307	enddo
4308	#endif
4309	!
4310	ENDDO
4311	ENDDO
4312	!
4313	IF (ok_bug_split_th) THEN
4314	CALL add_wake_tend &
4315	(d_deltat_the, d_deltaq_the, dsig0, ddens0, ddens0, wkoccur1, 'the', abortphy &
4316	#ifdef ISO
4317	,d_deltaxt_the &
4318	#endif
4319	&)
4320	ELSE
4321	CALL add_wake_tend &
4322	(d_deltat_the, d_deltaq_the, dsig0, ddens0, ddens0, wake_k, 'the', abortphy &
4323	#ifdef ISO
4324	,d_deltaxt_the &
4325	#endif
4326	&)
4327	ENDIF
4328	CALL prt_enerbil('the',itap)
4329	!
4330	ENDIF ! (mod(iflag_pbl_split/10,10) .GE. 1)
4331	!
4332	CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs, &
4333	dql0,dqi0,paprs,'thermals', abortphy,flag_inhib_tend,itap,0 &
4334	#ifdef ISO
4335	& ,d_xt_ajs,dxtl0,dxti0 &
4336	#endif
4337	& )
4338	CALL prt_enerbil('thermals',itap)
4339	!
4340	!
4341	CALL alpale_th( phys_tstep, lmax_th, t_seri, cell_area, &
4342	cin, s2, n2, &
4343	ale_bl_trig, ale_bl_stat, ale_bl, &
4344	alp_bl, alp_bl_stat, &
4345	proba_notrig, random_notrig, cv_gen)
4346	!>jyg
4347
4348	! ------------------------------------------------------------------
4349	! Transport de la TKE par les panaches thermiques.
4350	! FH : 2010/02/01
4351	! if (iflag_pbl.eq.10) then
4352	! call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
4353	! s rg,paprs,pbl_tke)
4354	! endif
4355	! -------------------------------------------------------------------
4356
4357	DO i=1,klon
4358	! zmax_th(i)=pphi(i,lmax_th(i))/rg
4359	!CR:04/05/12:correction calcul zmax
4360	zmax_th(i)=zmax0(i)
4361	ENDDO
4362
4363	ENDIF
4364
4365	! Ajustement sec
4366	! ==============
4367
4368	! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
4369	! a partir du sommet des thermiques.
4370	! Dans le cas contraire, on demarre au niveau 1.
4371
4372	IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN
4373
4374	IF (iflag_thermals.eq.0) THEN
4375	IF (prt_level>9) WRITE(lunout,*)'ajsec'
4376	limbas(:)=1
4377	ELSE
4378	limbas(:)=lmax_th(:)
4379	ENDIF
4380
4381	! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
4382	! pour des test de convergence numerique.
4383	! Le nouveau ajsec est a priori mieux, meme pour le cas
4384	! iflag_thermals = 0 (l'ancienne version peut faire des tendances
4385	! non nulles numeriquement pour des mailles non concernees.
4386
4387	#ifdef ISO
4388	#ifdef ISOVERIF
4389	call iso_verif_noNaN_vect2D(xt_seri,'physiq 4112', &
4390	& ntraciso,klon,klev)
4391	#endif
4392	#ifdef ISOVERIF
4393	write(,) 'physiq 3691b: avant call ajsec'
4394	if (iso_eau.gt.0) then
4395	call iso_verif_egalite_vect2D( &
4396	& xt_seri,q_seri, &
4397	& 'physiq 3727, avant ajsec',ntraciso,klon,klev)
4398	endif
4399	if (iso_HDO.gt.0) then
4400	call iso_verif_aberrant_enc_vect2D( &
4401	& xt_seri,q_seri, &
4402	& 'physiq 3732, avant ajsec',ntraciso,klon,klev)
4403	endif
4404	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
4405	do k = 1, klev
4406	do i = 1, klon
4407	if (q_seri(i,k).gt.ridicule) then
4408	if (iso_verif_o18_aberrant_nostop( &
4409	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
4410	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
4411	& 'physiq 4051, avant ajsec').eq.1) then
4412	write(,) 'physiq 4367: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
4413	stop
4414	endif ! if (iso_verif_o18_aberrant_nostop
4415	endif !if (q_seri(i,k).gt.errmax) then
4416	enddo !do i = 1, klon
4417	enddo !do k = 1, klev
4418	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
4419	#ifdef ISOTRAC
4420	call iso_verif_traceur_vect(xt_seri,klon,klev, &
4421	& 'physiq 3600 avant ajsec')
4422	#endif
4423	!#ifdef ISOTRAC
4424	#endif
4425	!#ifdef ISOVERIF
4426	#endif
4427	!#ifdef ISO
4428
4429	IF (iflag_thermals==0) THEN
4430	! Calling adjustment alone (but not the thermal plume model)
4431	CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
4432	, d_t_ajsb, d_q_ajsb &
4433	#ifdef ISO
4434	& ,xt_seri,d_xt_ajsb &
4435	#endif
4436	& )
4437	ELSE IF (iflag_thermals>0) THEN
4438	! Calling adjustment above the top of thermal plumes
4439	CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
4440	, d_t_ajsb, d_q_ajsb &
4441	#ifdef ISO
4442	& ,xt_seri,d_xt_ajsb &
4443	#endif
4444	& )
4445	ENDIF
4446
4447	!--------------------------------------------------------------------
4448	! ajout des tendances de l'ajustement sec ou des thermiques
4449	CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs, &
4450	'ajsb',abortphy,flag_inhib_tend,itap,0 &
4451	#ifdef ISO
4452	& ,d_xt_ajsb,dxtl0,dxti0 &
4453	#endif
4454	& )
4455	CALL prt_enerbil('ajsb',itap)
4456	d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
4457	d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
4458	#ifdef ISO
4459	d_xt_ajs(:,:,:)=d_xt_ajs(:,:,:)+d_xt_ajsb(:,:,:)
4460	#endif
4461
4462	!---------------------------------------------------------------------
4463
4464	ENDIF
4465
4466	ENDIF
4467	!
4468	!===================================================================
4469	! Computation of ratqs, the width (normalized) of the subrid scale
4470	! water distribution
4471
4472	tke_dissip_ave(:,:)=0.
4473	l_mix_ave(:,:)=0.
4474	wprime_ave(:,:)=0.
4475
4476	DO nsrf = 1, nbsrf
4477	DO i = 1, klon
4478	tke_dissip_ave(i,:) = tke_dissip_ave(i,:) + tke_dissip(i,:,nsrf)*pctsrf(i,nsrf)
4479	l_mix_ave(i,:) = l_mix_ave(i,:) + l_mix(i,:,nsrf)*pctsrf(i,nsrf)
4480	wprime_ave(i,:) = wprime_ave(i,:) + wprime(i,:,nsrf)*pctsrf(i,nsrf)
4481	ENDDO
4482	ENDDO
4483
4484	CALL calcratqs(klon,klev,prt_level,lunout, &
4485	iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
4486	ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
4487	tau_ratqs,fact_cldcon,wake_s, wake_deltaq, &
4488	ptconv,ptconvth,clwcon0th, rnebcon0th, &
4489	paprs,pplay,t_seri,q_seri, qtc_cv, sigt_cv, zqsat, &
4490	pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave,t2m,q2m,fm_therm, &
4491	ratqs,ratqsc,ratqs_inter)
4492
4493
4494	!
4495	! Appeler le processus de condensation a grande echelle
4496	! et le processus de precipitation
4497	!-------------------------------------------------------------------------
4498	IF (prt_level .GE.10) THEN
4499	print *,'itap, ->fisrtilp ',itap
4500	ENDIF
4501	!
4502	#ifdef ISO
4503	#ifdef ISOVERIF
4504	write(,) 'physiq 3837: verif avant ilp'
4505	#endif
4506	#ifdef ISOVERIF
4507	if (iso_eau.gt.0) then
4508	call iso_verif_egalite_vect2D( &
4509	& xt_seri,q_seri, &
4510	& 'physiq 3709, avant ilp',ntraciso,klon,klev)
4511	endif
4512	if (iso_HDO.gt.0) then
4513	call iso_verif_aberrant_enc_vect2D( &
4514	& xt_seri,q_seri, &
4515	& 'physiq 3714, avant ilp',ntraciso,klon,klev)
4516	endif
4517	#endif
4518	#ifdef ISOVERIF
4519	do k=1,klev
4520	do i=1,klon
4521	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
4522	if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
4523	call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
4524	& /q_seri(i,k),xt_seri(iso_o18,i,k) &
4525	& /q_seri(i,k),'physiq 3389')
4526	endif !if (q_seri(i,k).gt.ridicule) then
4527	endif !if (iso_O17.gt.0) then
4528	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
4529	if (q_seri(i,k).gt.ridicule) then
4530	if (iso_verif_o18_aberrant_nostop( &
4531	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
4532	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
4533	& 'physiq 4177, avant il pleut').eq.1) then
4534	write(,) 'physic 4475: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
4535	stop
4536	endif ! if (iso_verif_o18_aberrant_nostop
4537	endif !if (q_seri(i,k).gt.errmax) then
4538	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
4539	#ifdef ISOTRAC
4540	call iso_verif_traceur(xt_seri(1,i,k),'physiq 3609')
4541	call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
4542	& 'physiq 3609')
4543	if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
4544	& 'physiq 3707, avant fisrtilp',1e-5) &
4545	& .eq.1) then
4546	write(,) 'i,k=',i,k
4547	#ifdef ISOVERIF
4548	stop
4549	#endif
4550	endif
4551	if (option_tmin.eq.1) then
4552	call iso_verif_trac17_q_deltaD(xt_seri(1,i,k), &
4553	& 'physiq 3905, avant ilp')
4554	endif
4555	#endif
4556	!ISOTRAC
4557	enddo !do i=1,klon
4558	enddo !do k=1,klev
4559
4560	! verif température
4561	do k=1,klev
4562	do i=1,klon
4563	call iso_verif_positif(370.0-t_seri(i,k), &
4564	& 'physiq 3535, avant il pleut')
4565	call iso_verif_positif(t_seri(i,k)-100.0, &
4566	& 'physiq 3537, avant il pleut')
4567	enddo
4568	enddo
4569	write(,) 'physiq 3113: appel de fisrtilp'
4570	#endif
4571	!ISOVERIF
4572	if ((bidouille_anti_divergence).and. &
4573	& (iso_eau.gt.0)) then
4574	do k=1,klev
4575	do i=1,klon
4576	xt_seri(iso_eau,i,k)= q_seri(i,k)
4577	enddo !do i=1,klon
4578	enddo !do k=1,klev
4579	endif !if ((bidouille_anti_divergence).and. &
4580	#endif
4581	!ISO
4582
4583	picefra(:,:)=0.
4584
4585	IF (ok_new_lscp) THEN
4586
4587	CALL lscp(phys_tstep,paprs,pplay, &
4588	t_seri, q_seri,ptconv,ratqs, &
4589	d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, picefra, &
4590	rain_lsc, snow_lsc, &
4591	pfrac_impa, pfrac_nucl, pfrac_1nucl, &
4592	frac_impa, frac_nucl, beta_prec_fisrt, &
4593	prfl, psfl, rhcl, &
4594	zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
4595	iflag_ice_thermo)
4596
4597	ELSE
4598	CALL fisrtilp(phys_tstep,paprs,pplay, &
4599	t_seri, q_seri,ptconv,ratqs, &
4600	d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &
4601	rain_lsc, snow_lsc, &
4602	pfrac_impa, pfrac_nucl, pfrac_1nucl, &
4603	frac_impa, frac_nucl, beta_prec_fisrt, &
4604	prfl, psfl, rhcl, &
4605	zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
4606	iflag_ice_thermo &
4607	#ifdef ISO
4608	& ,xt_seri,xtrain_lsc,xtsnow_lsc &
4609	& ,d_xt_lsc,d_xtl_lsc,d_xti_lsc,pxtrfl,pxtsfl &
4610	#endif
4611	& )
4612	ENDIF
4613	!
4614	WHERE (rain_lsc < 0) rain_lsc = 0.
4615	WHERE (snow_lsc < 0) snow_lsc = 0.
4616	#ifdef ISO
4617	WHERE (xtrain_lsc < 0) xtrain_lsc = 0.
4618	WHERE (xtsnow_lsc < 0) xtsnow_lsc = 0.
4619	#endif
4620
4621	#ifdef ISO
4622	#ifdef ISOVERIF
4623	DO k = 1, klev
4624	do i=1,klon
4625	if (iso_O18.gt.0.and.iso_HDO.gt.0) then
4626	if (ql_seri(i,k).gt.ridicule) then
4627	call iso_verif_aberrant( &
4628	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k),'physiq 4330')
4629	if (iso_O18.gt.0) then
4630	call iso_verif_o18_aberrant( &
4631	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
4632	& xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
4633	& 'physiq 4335, avant il pleut')
4634	endif ! if (iso_O18.gt.0) then
4635	endif !if (ql_seri(i,k).gt.errmax) then
4636	endif !if (iso_HDO.gt.0) then
4637	ENDDO ! i=1,klon
4638	ENDDO !DO k = 1, klev
4639	#endif
4640	#endif
4641
4642	!+JLD
4643	! write(*,9000) 'phys lsc',"enerbil: bil_q, bil_e,",rain_lsc+snow_lsc &
4644	! & ,((rcw-rcpd)rain_lsc + (rcs-rcpd)snow_lsc)t_seri(1,1)-rlvttrain_lsc+rlstt*snow_lsc &
4645	! & ,rain_lsc,snow_lsc
4646	! write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
4647	!-JLD
4648	CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs, &
4649	'lsc',abortphy,flag_inhib_tend,itap,0 &
4650	#ifdef ISO
4651	& ,d_xt_lsc,d_xtl_lsc,d_xti_lsc &
4652	#endif
4653	& )
4654	CALL prt_enerbil('lsc',itap)
4655	rain_num(:)=0.
4656	DO k = 1, klev
4657	DO i = 1, klon
4658	IF (ql_seri(i,k)>oliqmax) THEN
4659	rain_num(i)=rain_num(i)+(ql_seri(i,k)-oliqmax)*zmasse(i,k)/pdtphys
4660	#ifdef ISO
4661	do ixt=1,ntraciso
4662	xtl_seri(ixt,i,k)=xtl_seri(ixt,i,k)/ql_seri(i,k)*oliqmax
4663	enddo
4664	#endif
4665	ql_seri(i,k)=oliqmax
4666	ENDIF
4667	ENDDO
4668	ENDDO
4669	IF (nqo==3) THEN
4670	DO k = 1, klev
4671	DO i = 1, klon
4672	IF (qs_seri(i,k)>oicemax) THEN
4673	rain_num(i)=rain_num(i)+(qs_seri(i,k)-oicemax)*zmasse(i,k)/pdtphys
4674	#ifdef ISO
4675	do ixt=1,ntraciso
4676	xts_seri(ixt,i,k)=xts_seri(ixt,i,k)/qs_seri(i,k)*oliqmax
4677	enddo
4678	#endif
4679	qs_seri(i,k)=oicemax
4680	ENDIF
4681	ENDDO
4682	ENDDO
4683	ENDIF
4684
4685	!---------------------------------------------------------------------------
4686	DO k = 1, klev
4687	DO i = 1, klon
4688	cldfra(i,k) = rneb(i,k)
4689	!CR: a quoi ca sert? Faut-il ajouter qs_seri?
4690	IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
4691	ENDDO
4692	ENDDO
4693
4694
4695
4696	#ifdef ISO
4697	!#ifdef ISOVERIF
4698	! write(,) 'physiq 4030: verif apres ajout lsc'
4699	!#endif
4700	#ifdef ISOVERIF
4701	call iso_verif_noNaN_vect2D(xt_seri,'physiq 4565', &
4702	& ntraciso,klon,klev)
4703	#endif
4704	#ifdef ISOVERIF
4705	if (iso_eau.gt.0) then
4706	call iso_verif_egalite_vect2D( &
4707	& xt_seri,q_seri, &
4708	& 'physiq 2599, apres ajout lsc',ntraciso,klon,klev)
4709	endif
4710	if (iso_HDO.gt.0) then
4711	call iso_verif_aberrant_enc_vect2D( &
4712	& xt_seri,q_seri, &
4713	& 'physiq 2866, apres ajout lsc',ntraciso,klon,klev)
4714	endif
4715	#endif
4716	#ifdef ISOVERIF
4717	DO k = 1, klev
4718	DO i = 1, klon
4719	if (iso_eau.gt.0) then
4720	call iso_verif_egalite_choix( &
4721	& xtl_seri(iso_eau,i,k),ql_seri(i,k), &
4722	& 'physiq 2601',errmax,errmaxrel)
4723	endif !if (iso_eau.gt.0) then
4724	if (iso_HDO.gt.0) then
4725	if (q_seri(i,k).gt.ridicule) then
4726	if (iso_O18.gt.0) then
4727	if (iso_verif_o18_aberrant_nostop( &
4728	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
4729	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
4730	& 'physiq 2863, after il pleut').eq.1) then
4731	write(,) 'physic 4656: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
4732	stop
4733	endif
4734	endif ! if (iso_O18.gt.0) then
4735	endif !if (q_seri(i,k).gt.errmax) then
4736	if (ql_seri(i,k).gt.ridicule) then
4737	call iso_verif_aberrant( &
4738	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k),'physiq 2871')
4739	if (iso_O18.gt.0) then
4740	if (iso_verif_o18_aberrant_nostop( &
4741	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
4742	& xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
4743	& 'physiq 2872, after il pleut').eq.1) then
4744	write(,) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
4745	write(,) 'd_ql_lsc(i,k)=',d_ql_lsc(i,k)
4746	write(,) 'deltaD(d_ql_lsc(i,k))=',deltaD( &
4747	& d_xtl_lsc(iso_HDO,i,k)/d_ql_lsc(i,k))
4748	write(,) 'deltaO(d_ql_lsc(i,k))=',deltaO( &
4749	& d_xtl_lsc(iso_O18,i,k)/d_ql_lsc(i,k))
4750	stop
4751	endif
4752	endif ! if (iso_O18.gt.0) then
4753	endif !if (ql_seri(i,k).gt.errmax) then
4754	endif !if (iso_HDO.gt.0) then
4755	ENDDO ! i=1,klon
4756	ENDDO !DO k = 1, klev
4757	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
4758	do i=1,klon
4759	do k=1,nlev
4760	if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
4761	call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
4762	& /q_seri(i,k),xt_seri(iso_o18,i,k) &
4763	& /q_seri(i,k),'physiq 3549')
4764	endif !if (q_seri(i,k).gt.ridicule) then
4765	enddo !do k=1,nlev
4766	enddo !do i=1,klon
4767	endif !if (iso_O17.gt.0) then
4768	#endif
4769	!#ifdef ISOVERIF
4770	#ifdef ISOTRAC
4771	#ifdef ISOVERIF
4772	call iso_verif_traceur_vect(xt_seri,klon,klev,'physiq 3794')
4773	if (option_tmin.eq.1) then
4774	if (nzone_temp.ge.5) then
4775	call iso_verif_tag17_q_deltaD_vect(xt_seri,klon,klev, &
4776	& 'physiq 3385: apres ilp')
4777	endif ! if (nzone_temp.ge.5) then
4778	endif !if (option_tmin.eq.1) then
4779	#endif
4780	!#ifdef ISOVERIF
4781	if (bidouille_anti_divergence) then
4782	call iso_verif_traceur_jbid_vect(xt_seri, &
4783	& klon,klev)
4784	endif
4785
4786	! si tag 22, on recolorise les zones très convectives dans les
4787	! tropiques
4788	if (option_traceurs.eq.22) then
4789	call isotrac_recolorise_conv(xt_seri,latitude_deg,presnivs,rain_con)
4790	endif
4791
4792	#endif
4793	!#ifdef ISOTRAC
4794	#endif
4795	!#ifdef ISO
4796
4797	IF (check) THEN
4798	za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
4799	WRITE(lunout,*)"apresilp=", za
4800	zx_t = 0.0
4801	za = 0.0
4802	DO i = 1, klon
4803	za = za + cell_area(i)/REAL(klon)
4804	zx_t = zx_t + (rain_lsc(i) &
4805	+ snow_lsc(i))*cell_area(i)/REAL(klon)
4806	ENDDO
4807	zx_t = zx_t/za*phys_tstep
4808	WRITE(lunout,*)"Precip=", zx_t
4809	ENDIF
4810
4811	IF (mydebug) THEN
4812	CALL writefield_phy('u_seri',u_seri,nbp_lev)
4813	CALL writefield_phy('v_seri',v_seri,nbp_lev)
4814	CALL writefield_phy('t_seri',t_seri,nbp_lev)
4815	CALL writefield_phy('q_seri',q_seri,nbp_lev)
4816	ENDIF
4817
4818	!
4819	!-------------------------------------------------------------------
4820	! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
4821	!-------------------------------------------------------------------
4822
4823	! 1. NUAGES CONVECTIFS
4824	!
4825	!IM cf FH
4826	! IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
4827	IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
4828	snow_tiedtke=0.
4829	! print*,'avant calcul de la pseudo precip '
4830	! print*,'iflag_cld_th',iflag_cld_th
4831	IF (iflag_cld_th.eq.-1) THEN
4832	rain_tiedtke=rain_con
4833	ELSE
4834	! print*,'calcul de la pseudo precip '
4835	rain_tiedtke=0.
4836	! print*,'calcul de la pseudo precip 0'
4837	DO k=1,klev
4838	DO i=1,klon
4839	IF (d_q_con(i,k).lt.0.) THEN
4840	rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
4841	*(paprs(i,k)-paprs(i,k+1))/rg
4842	ENDIF
4843	ENDDO
4844	ENDDO
4845	ENDIF
4846	!
4847	! call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
4848	!
4849
4850	! Nuages diagnostiques pour Tiedtke
4851	CALL diagcld1(paprs,pplay, &
4852	!IM cf FH. rain_con,snow_con,ibas_con,itop_con,
4853	rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
4854	diafra,dialiq)
4855	DO k = 1, klev
4856	DO i = 1, klon
4857	IF (diafra(i,k).GT.cldfra(i,k)) THEN
4858	cldliq(i,k) = dialiq(i,k)
4859	cldfra(i,k) = diafra(i,k)
4860	ENDIF
4861	ENDDO
4862	ENDDO
4863
4864	ELSE IF (iflag_cld_th.ge.3) THEN
4865	! On prend pour les nuages convectifs le max du calcul de la
4866	! convection et du calcul du pas de temps precedent diminue d'un facteur
4867	! facttemps
4868	facteur = pdtphys *facttemps
4869	DO k=1,klev
4870	DO i=1,klon
4871	rnebcon(i,k)=rnebcon(i,k)*facteur
4872	IF (rnebcon0(i,k)clwcon0(i,k).GT.rnebcon(i,k)clwcon(i,k)) THEN
4873	rnebcon(i,k)=rnebcon0(i,k)
4874	clwcon(i,k)=clwcon0(i,k)
4875	ENDIF
4876	ENDDO
4877	ENDDO
4878
4879	! On prend la somme des fractions nuageuses et des contenus en eau
4880
4881	IF (iflag_cld_th>=5) THEN
4882
4883	DO k=1,klev
4884	ptconvth(:,k)=fm_therm(:,k+1)>0.
4885	ENDDO
4886
4887	IF (iflag_coupl==4) THEN
4888
4889	! Dans le cas iflag_coupl==4, on prend la somme des convertures
4890	! convectives et lsc dans la partie des thermiques
4891	! Le controle par iflag_coupl est peut etre provisoire.
4892	DO k=1,klev
4893	DO i=1,klon
4894	IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
4895	cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
4896	cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
4897	ELSE IF (ptconv(i,k)) THEN
4898	cldfra(i,k)=rnebcon(i,k)
4899	cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
4900	ENDIF
4901	ENDDO
4902	ENDDO
4903
4904	ELSE IF (iflag_coupl==5) THEN
4905	DO k=1,klev
4906	DO i=1,klon
4907	cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
4908	cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
4909	ENDDO
4910	ENDDO
4911
4912	ELSE
4913
4914	! Si on est sur un point touche par la convection
4915	! profonde et pas par les thermiques, on prend la
4916	! couverture nuageuse et l'eau nuageuse de la convection
4917	! profonde.
4918
4919	!IM/FH: 2011/02/23
4920	! definition des points sur lesquels ls thermiques sont actifs
4921
4922	DO k=1,klev
4923	DO i=1,klon
4924	IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
4925	cldfra(i,k)=rnebcon(i,k)
4926	cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
4927	ENDIF
4928	ENDDO
4929	ENDDO
4930
4931	ENDIF
4932
4933	ELSE
4934
4935	! Ancienne version
4936	cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
4937	cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
4938	ENDIF
4939
4940	ENDIF
4941
4942	! plulsc(:)=0.
4943	! do k=1,klev,-1
4944	! do i=1,klon
4945	! zzz=prfl(:,k)+psfl(:,k)
4946	! if (.not.ptconvth.zzz.gt.0.)
4947	! enddo prfl, psfl,
4948	! enddo
4949	!
4950	! 2. NUAGES STARTIFORMES
4951	!
4952	IF (ok_stratus) THEN
4953	CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
4954	DO k = 1, klev
4955	DO i = 1, klon
4956	IF (diafra(i,k).GT.cldfra(i,k)) THEN
4957	cldliq(i,k) = dialiq(i,k)
4958	cldfra(i,k) = diafra(i,k)
4959	ENDIF
4960	ENDDO
4961	ENDDO
4962	ENDIF
4963	!
4964	! Precipitation totale
4965	!
4966	DO i = 1, klon
4967	rain_fall(i) = rain_con(i) + rain_lsc(i)
4968	snow_fall(i) = snow_con(i) + snow_lsc(i)
4969	ENDDO
4970
4971
4972
4973	#ifdef ISO
4974	DO i = 1, klon
4975	do ixt=1,ntraciso
4976	xtrain_fall(ixt,i)=xtrain_con(ixt,i) + xtrain_lsc(ixt,i)
4977	xtsnow_fall(ixt,i)=xtsnow_con(ixt,i) + xtsnow_lsc(ixt,i)
4978	enddo
4979	ENDDO !DO i = 1, klon
4980	#ifdef ISOVERIF
4981	if (iso_eau.gt.0) then
4982	DO i = 1, klon
4983	call iso_verif_egalite_choix(xtsnow_fall(iso_eau,i), &
4984	& snow_fall(i),'physiq 3387', &
4985	& errmax,errmaxrel)
4986	if (iso_verif_positif_nostop(xtrain_lsc(iso_eau,i), &
4987	& 'physiq 4298').eq.1) then
4988	if (rain_lsc(i).ge.0.0) then
4989	write(,) 'rain_fall(i)=',rain_lsc(i)
4990	stop
4991	endif !if (rain_con(i).ge.0.0) then
4992	endif !if (iso_verif_positif_nostop
4993	if (iso_verif_positif_nostop(xtrain_fall(iso_eau,i), &
4994	& 'physiq 3405').eq.1) then
4995	if (rain_fall(i).ge.0.0) then
4996	write(,) 'rain_fall(i)=',rain_fall(i)
4997	stop
4998	endif !if (rain_con(i).ge.0.0) then
4999	endif !if (iso_verif_positif_nostop
5000	ENDDO !DO i = 1, klon
5001	endif !if (iso_eau.gt.0) then
5002	if (iso_HDO.gt.0) then
5003	DO i = 1, klon
5004	call iso_verif_aberrant_choix(xtsnow_fall(iso_hdo,i), &
5005	& snow_fall(i),ridicule_snow, &
5006	& deltalim_snow,'physiq 3856')
5007	enddo !DO i = 1, klon
5008	endif
5009	#ifdef ISOTRAC
5010	DO i = 1, klon
5011	call iso_verif_traceur(xtrain_fall(1,i),'physiq 4012')
5012	call iso_verif_traceur(xtsnow_fall(1,i),'physiq 4013')
5013	enddo
5014	#endif
5015	#endif
5016	#ifdef ISOVERIF
5017	do i=1,klon
5018	do ixt=1,ntraciso
5019	call iso_verif_noNaN(xtsnow_con(ixt,i), &
5020	& 'physiq 4942')
5021	call iso_verif_noNaN(xtsnow_lsc(ixt,i), &
5022	& 'physiq 4942')
5023	call iso_verif_noNaN(xtsnow_fall(ixt,i), &
5024	& 'physiq 4942')
5025	enddo !do ixt=1,ntraciso
5026	enddo ! do klon
5027	#endif
5028	#endif
5029	#ifdef ISO
5030	if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
5031	do i=1,klon
5032	xtrain_fall(iso_eau,i)=rain_fall(i)
5033	enddo !do i=1,klon
5034	endif
5035	#endif
5036	!
5037	! Calculer l'humidite relative pour diagnostique
5038	!
5039	DO k = 1, klev
5040	DO i = 1, klon
5041	zx_t = t_seri(i,k)
5042	IF (thermcep) THEN
5043	!! if (iflag_ice_thermo.eq.0) then !jyg
5044	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
5045	!! else !jyg
5046	!! zdelta = MAX(0.,SIGN(1.,t_glace_min-zx_t)) !jyg
5047	!! endif !jyg
5048	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
5049	zx_qs = MIN(0.5,zx_qs)
5050	zcor = 1./(1.-retv*zx_qs)
5051	zx_qs = zx_qs*zcor
5052	ELSE
5053	!! IF (zx_t.LT.t_coup) THEN !jyg
5054	IF (zx_t.LT.rtt) THEN !jyg
5055	zx_qs = qsats(zx_t)/pplay(i,k)
5056	ELSE
5057	zx_qs = qsatl(zx_t)/pplay(i,k)
5058	ENDIF
5059	ENDIF
5060	zx_rh(i,k) = q_seri(i,k)/zx_qs
5061	IF (iflag_ice_thermo .GT. 0) THEN
5062	zx_rhl(i,k) = q_seri(i,k)/(qsatl(zx_t)/pplay(i,k))
5063	zx_rhi(i,k) = q_seri(i,k)/(qsats(zx_t)/pplay(i,k))
5064	ENDIF
5065	zqsat(i,k)=zx_qs
5066	ENDDO
5067	ENDDO
5068
5069	!IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle
5070	! equivalente a 2m (tpote) pour diagnostique
5071	!
5072	DO i = 1, klon
5073	tpot(i)=zt2m(i)(100000./paprs(i,1))*RKAPPA
5074	IF (thermcep) THEN
5075	IF(zt2m(i).LT.RTT) then
5076	Lheat=RLSTT
5077	ELSE
5078	Lheat=RLVTT
5079	ENDIF
5080	ELSE
5081	IF (zt2m(i).LT.RTT) THEN
5082	Lheat=RLSTT
5083	ELSE
5084	Lheat=RLVTT
5085	ENDIF
5086	ENDIF
5087	tpote(i) = tpot(i)* &
5088	EXP((Lheat qsat2m(i))/(RCPDzt2m(i)))
5089	ENDDO
5090
5091	IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN ! ModThL
5092	#ifdef INCA
5093	CALL VTe(VTphysiq)
5094	CALL VTb(VTinca)
5095	calday = REAL(days_elapsed + 1) + jH_cur
5096
5097	CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)
5098	CALL AEROSOL_METEO_CALC( &
5099	calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
5100	prfl,psfl,pctsrf,cell_area, &
5101	latitude_deg,longitude_deg,u10m,v10m)
5102
5103	zxsnow_dummy(:) = 0.0
5104
5105	CALL chemhook_begin (calday, &
5106	days_elapsed+1, &
5107	jH_cur, &
5108	pctsrf(1,1), &
5109	latitude_deg, &
5110	longitude_deg, &
5111	cell_area, &
5112	paprs, &
5113	pplay, &
5114	coefh(1:klon,1:klev,is_ave), &
5115	pphi, &
5116	t_seri, &
5117	u, &
5118	v, &
5119	rot, &
5120	wo(:, :, 1), &
5121	q_seri, &
5122	zxtsol, &
5123	zt2m, &
5124	zxsnow_dummy, &
5125	solsw, &
5126	albsol1, &
5127	rain_fall, &
5128	snow_fall, &
5129	itop_con, &
5130	ibas_con, &
5131	cldfra, &
5132	nbp_lon, &
5133	nbp_lat-1, &
5134	tr_seri(:,:,1+nqCO2:nbtr), &
5135	ftsol, &
5136	paprs, &
5137	cdragh, &
5138	cdragm, &
5139	pctsrf, &
5140	pdtphys, &
5141	itap)
5142
5143	CALL VTe(VTinca)
5144	CALL VTb(VTphysiq)
5145	#endif
5146	ENDIF !type_trac = inca or inco
5147	IF (type_trac == 'repr') THEN
5148	#ifdef REPROBUS
5149	!CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
5150	CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
5151	#endif
5152	ENDIF
5153
5154	!
5155	! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
5156	!
5157	IF (MOD(itaprad,radpas).EQ.0) THEN
5158
5159	!
5160	!jq - introduce the aerosol direct and first indirect radiative forcings
5161	!jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
5162	IF (flag_aerosol .GT. 0) THEN
5163	IF (iflag_rrtm .EQ. 0) THEN !--old radiation
5164	IF (.NOT. aerosol_couple) THEN
5165	!
5166	CALL readaerosol_optic( &
5167	debut, flag_aerosol, itap, jD_cur-jD_ref, &
5168	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
5169	mass_solu_aero, mass_solu_aero_pi, &
5170	tau_aero, piz_aero, cg_aero, &
5171	tausum_aero, tau3d_aero)
5172	ENDIF
5173	ELSE ! RRTM radiation
5174	IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
5175	abort_message='config_inca=aero et rrtm=1 impossible'
5176	CALL abort_physic(modname,abort_message,1)
5177	ELSE
5178	!
5179	#ifdef CPP_RRTM
5180	IF (NSW.EQ.6) THEN
5181	!--new aerosol properties SW and LW
5182	!
5183	#ifdef CPP_Dust
5184	!--SPL aerosol model
5185	CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &
5186	tr_seri, mass_solu_aero, mass_solu_aero_pi, &
5187	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
5188	tausum_aero, tau3d_aero)
5189	#else
5190	!--climatologies or INCA aerosols
5191	CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &
5192	flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
5193	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
5194	tr_seri, mass_solu_aero, mass_solu_aero_pi, &
5195	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
5196	tausum_aero, drytausum_aero, tau3d_aero)
5197	#endif
5198
5199	IF (flag_aerosol .EQ. 7) THEN
5200	CALL MACv2SP(pphis,pplay,paprs,longitude_deg,latitude_deg, &
5201	tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm)
5202	ENDIF
5203
5204	!
5205	ELSE IF (NSW.EQ.2) THEN
5206	!--for now we use the old aerosol properties
5207	!
5208	CALL readaerosol_optic( &
5209	debut, flag_aerosol, itap, jD_cur-jD_ref, &
5210	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
5211	mass_solu_aero, mass_solu_aero_pi, &
5212	tau_aero, piz_aero, cg_aero, &
5213	tausum_aero, tau3d_aero)
5214	!
5215	!--natural aerosols
5216	tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
5217	piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
5218	cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
5219	!--all aerosols
5220	tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
5221	piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
5222	cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
5223	!
5224	!--no LW optics
5225	tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
5226	!
5227	ELSE
5228	abort_message='Only NSW=2 or 6 are possible with ' &
5229	// 'aerosols and iflag_rrtm=1'
5230	CALL abort_physic(modname,abort_message,1)
5231	ENDIF
5232	#else
5233	abort_message='You should compile with -rrtm if running ' &
5234	// 'with iflag_rrtm=1'
5235	CALL abort_physic(modname,abort_message,1)
5236	#endif
5237	!
5238	ENDIF
5239	ENDIF
5240	ELSE !--flag_aerosol = 0
5241	tausum_aero(:,:,:) = 0.
5242	drytausum_aero(:,:) = 0.
5243	mass_solu_aero(:,:) = 0.
5244	mass_solu_aero_pi(:,:) = 0.
5245	IF (iflag_rrtm .EQ. 0) THEN !--old radiation
5246	tau_aero(:,:,:,:) = 1.e-15
5247	piz_aero(:,:,:,:) = 1.
5248	cg_aero(:,:,:,:) = 0.
5249	ELSE
5250	tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
5251	tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
5252	piz_aero_sw_rrtm(:,:,:,:) = 1.0
5253	cg_aero_sw_rrtm(:,:,:,:) = 0.0
5254	ENDIF
5255	ENDIF
5256	!
5257	!--WMO criterion to determine tropopause
5258	CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
5259	!
5260	!--STRAT AEROSOL
5261	!--updates tausum_aero,tau_aero,piz_aero,cg_aero
5262	IF (flag_aerosol_strat.GT.0) THEN
5263	IF (prt_level .GE.10) THEN
5264	PRINT *,'appel a readaerosolstrat', mth_cur
5265	ENDIF
5266	IF (iflag_rrtm.EQ.0) THEN
5267	IF (flag_aerosol_strat.EQ.1) THEN
5268	CALL readaerosolstrato(debut)
5269	ELSE
5270	abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
5271	CALL abort_physic(modname,abort_message,1)
5272	ENDIF
5273	ELSE
5274	#ifdef CPP_RRTM
5275	#ifndef CPP_StratAer
5276	!--prescribed strat aerosols
5277	!--only in the case of non-interactive strat aerosols
5278	IF (flag_aerosol_strat.EQ.1) THEN
5279	CALL readaerosolstrato1_rrtm(debut)
5280	ELSEIF (flag_aerosol_strat.EQ.2) THEN
5281	CALL readaerosolstrato2_rrtm(debut, ok_volcan)
5282	ELSE
5283	abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
5284	CALL abort_physic(modname,abort_message,1)
5285	ENDIF
5286	#endif
5287	#else
5288	abort_message='You should compile with -rrtm if running ' &
5289	// 'with iflag_rrtm=1'
5290	CALL abort_physic(modname,abort_message,1)
5291	#endif
5292	ENDIF
5293	ELSE
5294	tausum_aero(:,:,id_STRAT_phy) = 0.
5295	ENDIF
5296	!
5297	#ifdef CPP_RRTM
5298	#ifdef CPP_StratAer
5299	!--compute stratospheric mask
5300	CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
5301	!--interactive strat aerosols
5302	CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
5303	#endif
5304	#endif
5305	!--fin STRAT AEROSOL
5306	!
5307
5308	! Calculer les parametres optiques des nuages et quelques
5309	! parametres pour diagnostiques:
5310	!
5311	IF (aerosol_couple.AND.config_inca=='aero') THEN
5312	mass_solu_aero(:,:) = ccm(:,:,1)
5313	mass_solu_aero_pi(:,:) = ccm(:,:,2)
5314	ENDIF
5315
5316	IF (ok_newmicro) then
5317	! AI IF (iflag_rrtm.NE.0) THEN
5318	IF (iflag_rrtm.EQ.1) THEN
5319	#ifdef CPP_RRTM
5320	IF (ok_cdnc.AND.NRADLP.NE.3) THEN
5321	abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
5322	// 'pour ok_cdnc'
5323	CALL abort_physic(modname,abort_message,1)
5324	ENDIF
5325	#else
5326
5327	abort_message='You should compile with -rrtm if running with '//'iflag_rrtm=1'
5328	CALL abort_physic(modname,abort_message,1)
5329	#endif
5330	ENDIF
5331	CALL newmicro (flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, &
5332	paprs, pplay, t_seri, cldliq, picefra, cldfra, &
5333	cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
5334	flwp, fiwp, flwc, fiwc, &
5335	mass_solu_aero, mass_solu_aero_pi, &
5336	cldtaupi, re, fl, ref_liq, ref_ice, &
5337	ref_liq_pi, ref_ice_pi)
5338	ELSE
5339	CALL nuage (paprs, pplay, &
5340	t_seri, cldliq, picefra, cldfra, cldtau, cldemi, &
5341	cldh, cldl, cldm, cldt, cldq, &
5342	ok_aie, &
5343	mass_solu_aero, mass_solu_aero_pi, &
5344	bl95_b0, bl95_b1, &
5345	cldtaupi, re, fl)
5346	ENDIF
5347	!
5348	!IM betaCRF
5349	!
5350	cldtaurad = cldtau
5351	cldtaupirad = cldtaupi
5352	cldemirad = cldemi
5353	cldfrarad = cldfra
5354
5355	!
5356	IF (lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. &
5357	lat1_beta.EQ.90..AND.lat2_beta.EQ.-90.) THEN
5358	!
5359	! global
5360	!
5361	!IM 251017 begin
5362	! print*,'physiq betaCRF global zdtime=',zdtime
5363	!IM 251017 end
5364	DO k=1, klev
5365	DO i=1, klon
5366	IF (pplay(i,k).GE.pfree) THEN
5367	beta(i,k) = beta_pbl
5368	ELSE
5369	beta(i,k) = beta_free
5370	ENDIF
5371	IF (mskocean_beta) THEN
5372	beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
5373	ENDIF
5374	cldtaurad(i,k) = cldtau(i,k) * beta(i,k)
5375	cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
5376	cldemirad(i,k) = cldemi(i,k) * beta(i,k)
5377	cldfrarad(i,k) = cldfra(i,k) * beta(i,k)
5378	ENDDO
5379	ENDDO
5380	!
5381	ELSE
5382	!
5383	! regional
5384	!
5385	DO k=1, klev
5386	DO i=1,klon
5387	!
5388	IF (longitude_deg(i).ge.lon1_beta.AND. &
5389	longitude_deg(i).le.lon2_beta.AND. &
5390	latitude_deg(i).le.lat1_beta.AND. &
5391	latitude_deg(i).ge.lat2_beta) THEN
5392	IF (pplay(i,k).GE.pfree) THEN
5393	beta(i,k) = beta_pbl
5394	ELSE
5395	beta(i,k) = beta_free
5396	ENDIF
5397	IF (mskocean_beta) THEN
5398	beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
5399	ENDIF
5400	cldtaurad(i,k) = cldtau(i,k) * beta(i,k)
5401	cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
5402	cldemirad(i,k) = cldemi(i,k) * beta(i,k)
5403	cldfrarad(i,k) = cldfra(i,k) * beta(i,k)
5404	ENDIF
5405	!
5406	ENDDO
5407	ENDDO
5408	!
5409	ENDIF
5410
5411	!lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek
5412	IF (ok_chlorophyll) THEN
5413	print*,"-- reading chlorophyll"
5414	CALL readchlorophyll(debut)
5415	ENDIF
5416
5417	!--if ok_suntime_rrtm we use ancillay data for RSUN
5418	!--previous values are therefore overwritten
5419	!--this is needed for CMIP6 runs
5420	!--and only possible for new radiation scheme
5421	IF (iflag_rrtm.EQ.1.AND.ok_suntime_rrtm) THEN
5422	#ifdef CPP_RRTM
5423	CALL read_rsun_rrtm(debut)
5424	#endif
5425	ENDIF
5426
5427	IF (mydebug) THEN
5428	CALL writefield_phy('u_seri',u_seri,nbp_lev)
5429	CALL writefield_phy('v_seri',v_seri,nbp_lev)
5430	CALL writefield_phy('t_seri',t_seri,nbp_lev)
5431	CALL writefield_phy('q_seri',q_seri,nbp_lev)
5432	ENDIF
5433
5434	!
5435	!sonia : If Iflag_radia >=2, pertubation of some variables
5436	!input to radiation (DICE)
5437	!
5438	IF (iflag_radia .ge. 2) THEN
5439	zsav_tsol (:) = zxtsol(:)
5440	CALL perturb_radlwsw(zxtsol,iflag_radia)
5441	ENDIF
5442
5443	IF (aerosol_couple.AND.config_inca=='aero') THEN
5444	#ifdef INCA
5445	CALL radlwsw_inca &
5446	(chemistry_couple, kdlon,kflev,dist, rmu0, fract, solaire, &
5447	paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, &
5448	size(wo,3), wo, &
5449	cldfrarad, cldemirad, cldtaurad, &
5450	heat,heat0,cool,cool0,albpla, &
5451	topsw,toplw,solsw,sollw, &
5452	sollwdown, &
5453	topsw0,toplw0,solsw0,sollw0, &
5454	lwdn0, lwdn, lwup0, lwup, &
5455	swdn0, swdn, swup0, swup, &
5456	ok_ade, ok_aie, &
5457	tau_aero, piz_aero, cg_aero, &
5458	topswad_aero, solswad_aero, &
5459	topswad0_aero, solswad0_aero, &
5460	topsw_aero, topsw0_aero, &
5461	solsw_aero, solsw0_aero, &
5462	cldtaupirad, &
5463	topswai_aero, solswai_aero)
5464	#endif
5465	ELSE
5466	!
5467	!IM calcul radiatif pour le cas actuel
5468	!
5469	RCO2 = RCO2_act
5470	RCH4 = RCH4_act
5471	RN2O = RN2O_act
5472	RCFC11 = RCFC11_act
5473	RCFC12 = RCFC12_act
5474	!
5475	!--interactive CO2 in ppm from carbon cycle
5476	IF (carbon_cycle_rad.AND..NOT.debut) THEN
5477	RCO2=RCO2_glo
5478	ENDIF
5479	!
5480	IF (prt_level .GE.10) THEN
5481	print *,' ->radlwsw, number 1 '
5482	ENDIF
5483	!
5484	CALL radlwsw &
5485	(dist, rmu0, fract, &
5486	!albedo SB >>>
5487	! paprs, pplay,zxtsol,albsol1, albsol2, &
5488	paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
5489	!albedo SB <<<
5490	t_seri,q_seri,wo, &
5491	cldfrarad, cldemirad, cldtaurad, &
5492	ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &
5493	flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
5494	tau_aero, piz_aero, cg_aero, &
5495	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
5496	! Rajoute par OB pour RRTM
5497	tau_aero_lw_rrtm, &
5498	cldtaupirad, &
5499	! zqsat, flwcrad, fiwcrad, &
5500	zqsat, flwc, fiwc, &
5501	ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
5502	heat,heat0,cool,cool0,albpla, &
5503	heat_volc,cool_volc, &
5504	topsw,toplw,solsw,solswfdiff,sollw, &
5505	sollwdown, &
5506	topsw0,toplw0,solsw0,sollw0, &
5507	lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup, &
5508	swdnc0, swdn0, swdn, swupc0, swup0, swup, &
5509	topswad_aero, solswad_aero, &
5510	topswai_aero, solswai_aero, &
5511	topswad0_aero, solswad0_aero, &
5512	topsw_aero, topsw0_aero, &
5513	solsw_aero, solsw0_aero, &
5514	topswcf_aero, solswcf_aero, &
5515	!-C. Kleinschmitt for LW diagnostics
5516	toplwad_aero, sollwad_aero,&
5517	toplwai_aero, sollwai_aero, &
5518	toplwad0_aero, sollwad0_aero,&
5519	!-end
5520	ZLWFT0_i, ZFLDN0, ZFLUP0, &
5521	ZSWFT0_i, ZFSDN0, ZFSUP0)
5522
5523	!lwoff=y, betalwoff=1. : offset LW CRE for radiation code and other
5524	!schemes
5525	toplw = toplw + betalwoff * (toplw0 - toplw)
5526	sollw = sollw + betalwoff * (sollw0 - sollw)
5527	lwdn = lwdn + betalwoff * (lwdn0 - lwdn)
5528	lwup = lwup + betalwoff * (lwup0 - lwup)
5529	sollwdown(:)= sollwdown(:) + betalwoff (-1.ZFLDN0(:,1) - &
5530	sollwdown(:))
5531	cool = cool + betalwoff * (cool0 - cool)
5532
5533	#ifndef CPP_XIOS
5534	!--OB 30/05/2016 modified 21/10/2016
5535	!--here we return swaero_diag and dryaod_diag to FALSE
5536	!--and histdef will switch it back to TRUE if necessary
5537	!--this is necessary to get the right swaero at first step
5538	!--but only in the case of no XIOS as XIOS is covered elsewhere
5539	IF (debut) swaerofree_diag = .FALSE.
5540	IF (debut) swaero_diag = .FALSE.
5541	IF (debut) dryaod_diag = .FALSE.
5542	!--IM 15/09/2017 here we return ok_4xCO2atm to FALSE
5543	!--as for swaero_diag, see above
5544	IF (debut) ok_4xCO2atm = .FALSE.
5545
5546	!
5547	!IM 2eme calcul radiatif pour le cas perturbe ou au moins un
5548	!IM des taux doit etre different du taux actuel
5549	!IM Par defaut on a les taux perturbes egaux aux taux actuels
5550	!
5551	IF (RCO2_per.NE.RCO2_act.OR. &
5552	RCH4_per.NE.RCH4_act.OR. &
5553	RN2O_per.NE.RN2O_act.OR. &
5554	RCFC11_per.NE.RCFC11_act.OR. &
5555	RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE.
5556	#endif
5557	!
5558	IF (ok_4xCO2atm) THEN
5559	!
5560	RCO2 = RCO2_per
5561	RCH4 = RCH4_per
5562	RN2O = RN2O_per
5563	RCFC11 = RCFC11_per
5564	RCFC12 = RCFC12_per
5565	!
5566	IF (prt_level .GE.10) THEN
5567	print *,' ->radlwsw, number 2 '
5568	ENDIF
5569	!
5570	CALL radlwsw &
5571	(dist, rmu0, fract, &
5572	!albedo SB >>>
5573	! paprs, pplay,zxtsol,albsol1, albsol2, &
5574	paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
5575	!albedo SB <<<
5576	t_seri,q_seri,wo, &
5577	cldfrarad, cldemirad, cldtaurad, &
5578	ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &
5579	flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
5580	tau_aero, piz_aero, cg_aero, &
5581	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
5582	! Rajoute par OB pour RRTM
5583	tau_aero_lw_rrtm, &
5584	cldtaupi, &
5585	! zqsat, flwcrad, fiwcrad, &
5586	zqsat, flwc, fiwc, &
5587	ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
5588	heatp,heat0p,coolp,cool0p,albplap, &
5589	heat_volc,cool_volc, &
5590	topswp,toplwp,solswp,solswfdiffp,sollwp, &
5591	sollwdownp, &
5592	topsw0p,toplw0p,solsw0p,sollw0p, &
5593	lwdnc0p, lwdn0p, lwdnp, lwupc0p, lwup0p, lwupp, &
5594	swdnc0p, swdn0p, swdnp, swupc0p, swup0p, swupp, &
5595	topswad_aerop, solswad_aerop, &
5596	topswai_aerop, solswai_aerop, &
5597	topswad0_aerop, solswad0_aerop, &
5598	topsw_aerop, topsw0_aerop, &
5599	solsw_aerop, solsw0_aerop, &
5600	topswcf_aerop, solswcf_aerop, &
5601	!-C. Kleinschmitt for LW diagnostics
5602	toplwad_aerop, sollwad_aerop,&
5603	toplwai_aerop, sollwai_aerop, &
5604	toplwad0_aerop, sollwad0_aerop,&
5605	!-end
5606	ZLWFT0_i, ZFLDN0, ZFLUP0, &
5607	ZSWFT0_i, ZFSDN0, ZFSUP0)
5608	endif !ok_4xCO2atm
5609	ENDIF ! aerosol_couple
5610	itaprad = 0
5611	!
5612	! If Iflag_radia >=2, reset pertubed variables
5613	!
5614	IF (iflag_radia .ge. 2) THEN
5615	zxtsol(:) = zsav_tsol (:)
5616	ENDIF
5617	ENDIF ! MOD(itaprad,radpas)
5618	itaprad = itaprad + 1
5619
5620	IF (iflag_radia.eq.0) THEN
5621	IF (prt_level.ge.9) THEN
5622	PRINT *,'--------------------------------------------------'
5623	PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas'
5624	PRINT *,'>>>> heat et cool mis a zero '
5625	PRINT *,'--------------------------------------------------'
5626	ENDIF
5627	heat=0.
5628	cool=0.
5629	sollw=0. ! MPL 01032011
5630	solsw=0.
5631	radsol=0.
5632	swup=0. ! MPL 27102011 pour les fichiers AMMA_profiles et AMMA_scalars
5633	swup0=0.
5634	lwup=0.
5635	lwup0=0.
5636	lwdn=0.
5637	lwdn0=0.
5638	ENDIF
5639
5640	!
5641	! Calculer radsol a l'exterieur de radlwsw
5642	! pour prendre en compte le cycle diurne
5643	! recode par Olivier Boucher en sept 2015
5644	!
5645	radsol=solsw*swradcorr+sollw
5646
5647	IF (ok_4xCO2atm) THEN
5648	radsolp=solswp*swradcorr+sollwp
5649	ENDIF
5650
5651	!
5652	! Ajouter la tendance des rayonnements (tous les pas)
5653	! avec une correction pour le cycle diurne dans le SW
5654	!
5655
5656	DO k=1, klev
5657	d_t_swr(:,k)=swradcorr(:)heat(:,k)phys_tstep/RDAY
5658	d_t_sw0(:,k)=swradcorr(:)heat0(:,k)phys_tstep/RDAY
5659	d_t_lwr(:,k)=-cool(:,k)*phys_tstep/RDAY
5660	d_t_lw0(:,k)=-cool0(:,k)*phys_tstep/RDAY
5661	ENDDO
5662
5663	CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy,flag_inhib_tend,itap,0 &
5664	#ifdef ISO
5665	& ,dxt0,dxtl0,dxti0 &
5666	#endif
5667	& )
5668	CALL prt_enerbil('SW',itap)
5669	CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy,flag_inhib_tend,itap,0 &
5670	#ifdef ISO
5671	& ,dxt0,dxtl0,dxti0 &
5672	#endif
5673	& )
5674	CALL prt_enerbil('LW',itap)
5675
5676	!
5677	IF (mydebug) THEN
5678	CALL writefield_phy('u_seri',u_seri,nbp_lev)
5679	CALL writefield_phy('v_seri',v_seri,nbp_lev)
5680	CALL writefield_phy('t_seri',t_seri,nbp_lev)
5681	CALL writefield_phy('q_seri',q_seri,nbp_lev)
5682	ENDIF
5683
5684	! Calculer l'hydrologie de la surface
5685	!
5686	! CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
5687	! . agesno, ftsol,fqsurf,fsnow, ruis)
5688	!
5689
5690	!
5691	! Calculer le bilan du sol et la derive de temperature (couplage)
5692	!
5693	DO i = 1, klon
5694	! bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
5695	! a la demande de JLD
5696	bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
5697	ENDDO
5698	!
5699	!moddeblott(jan95)
5700	! Appeler le programme de parametrisation de l'orographie
5701	! a l'echelle sous-maille:
5702	!
5703	IF (prt_level .GE.10) THEN
5704	print *,' call orography ? ', ok_orodr
5705	ENDIF
5706	!
5707	IF (ok_orodr) THEN
5708	!
5709	! selection des points pour lesquels le shema est actif:
5710	igwd=0
5711	DO i=1,klon
5712	itest(i)=0
5713	! IF ((zstd(i).gt.10.0)) THEN
5714	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
5715	itest(i)=1
5716	igwd=igwd+1
5717	idx(igwd)=i
5718	ENDIF
5719	ENDDO
5720	! igwdim=MAX(1,igwd)
5721	!
5722	IF (ok_strato) THEN
5723
5724	CALL drag_noro_strato(0,klon,klev,phys_tstep,paprs,pplay, &
5725	zmea,zstd, zsig, zgam, zthe,zpic,zval, &
5726	igwd,idx,itest, &
5727	t_seri, u_seri, v_seri, &
5728	zulow, zvlow, zustrdr, zvstrdr, &
5729	d_t_oro, d_u_oro, d_v_oro)
5730
5731	ELSE
5732	CALL drag_noro(klon,klev,phys_tstep,paprs,pplay, &
5733	zmea,zstd, zsig, zgam, zthe,zpic,zval, &
5734	igwd,idx,itest, &
5735	t_seri, u_seri, v_seri, &
5736	zulow, zvlow, zustrdr, zvstrdr, &
5737	d_t_oro, d_u_oro, d_v_oro)
5738	ENDIF
5739	!
5740	! ajout des tendances
5741	!-----------------------------------------------------------------------
5742	! ajout des tendances de la trainee de l'orographie
5743	CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro', &
5744	abortphy,flag_inhib_tend,itap,0 &
5745	#ifdef ISO
5746	& ,dxt0,dxtl0,dxti0 &
5747	#endif
5748	& )
5749	CALL prt_enerbil('oro',itap)
5750	!----------------------------------------------------------------------
5751	!
5752	ENDIF ! fin de test sur ok_orodr
5753	!
5754	IF (mydebug) THEN
5755	CALL writefield_phy('u_seri',u_seri,nbp_lev)
5756	CALL writefield_phy('v_seri',v_seri,nbp_lev)
5757	CALL writefield_phy('t_seri',t_seri,nbp_lev)
5758	CALL writefield_phy('q_seri',q_seri,nbp_lev)
5759	ENDIF
5760
5761	IF (ok_orolf) THEN
5762	!
5763	! selection des points pour lesquels le shema est actif:
5764	igwd=0
5765	DO i=1,klon
5766	itest(i)=0
5767	IF ((zpic(i)-zmea(i)).GT.100.) THEN
5768	itest(i)=1
5769	igwd=igwd+1
5770	idx(igwd)=i
5771	ENDIF
5772	ENDDO
5773	! igwdim=MAX(1,igwd)
5774	!
5775	IF (ok_strato) THEN
5776
5777	CALL lift_noro_strato(klon,klev,phys_tstep,paprs,pplay, &
5778	latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, &
5779	igwd,idx,itest, &
5780	t_seri, u_seri, v_seri, &
5781	zulow, zvlow, zustrli, zvstrli, &
5782	d_t_lif, d_u_lif, d_v_lif )
5783
5784	ELSE
5785	CALL lift_noro(klon,klev,phys_tstep,paprs,pplay, &
5786	latitude_deg,zmea,zstd,zpic, &
5787	itest, &
5788	t_seri, u_seri, v_seri, &
5789	zulow, zvlow, zustrli, zvstrli, &
5790	d_t_lif, d_u_lif, d_v_lif)
5791	ENDIF
5792
5793	! ajout des tendances de la portance de l'orographie
5794	CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, paprs, &
5795	'lif', abortphy,flag_inhib_tend,itap,0 &
5796	#ifdef ISO
5797	& ,dxt0,dxtl0,dxti0 &
5798	#endif
5799	& )
5800	CALL prt_enerbil('lif',itap)
5801	ENDIF ! fin de test sur ok_orolf
5802
5803	IF (ok_hines) then
5804	! HINES GWD PARAMETRIZATION
5805	east_gwstress=0.
5806	west_gwstress=0.
5807	du_gwd_hines=0.
5808	dv_gwd_hines=0.
5809	CALL hines_gwd(klon, klev, phys_tstep, paprs, pplay, latitude_deg, t_seri, &
5810	u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, &
5811	du_gwd_hines, dv_gwd_hines)
5812	zustr_gwd_hines=0.
5813	zvstr_gwd_hines=0.
5814	DO k = 1, klev
5815	zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/phys_tstep &
5816	* (paprs(:, k)-paprs(:, k+1))/rg
5817	zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/phys_tstep &
5818	* (paprs(:, k)-paprs(:, k+1))/rg
5819	ENDDO
5820
5821	d_t_hin(:, :)=0.
5822	CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, &
5823	dqi0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0 &
5824	#ifdef ISO
5825	& ,dxt0,dxtl0,dxti0 &
5826	#endif
5827	& )
5828	CALL prt_enerbil('hin',itap)
5829	ENDIF
5830
5831	IF (.not. ok_hines .and. ok_gwd_rando) then
5832	! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod
5833	CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, &
5834	v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, &
5835	dv_gwd_front, east_gwstress, west_gwstress)
5836	zustr_gwd_front=0.
5837	zvstr_gwd_front=0.
5838	DO k = 1, klev
5839	zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/phys_tstep &
5840	* (paprs(:, k)-paprs(:, k+1))/rg
5841	zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/phys_tstep &
5842	* (paprs(:, k)-paprs(:, k+1))/rg
5843	ENDDO
5844
5845	CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, &
5846	paprs, 'front_gwd_rando', abortphy,flag_inhib_tend,itap,0 &
5847	#ifdef ISO
5848	& ,dxt0,dxtl0,dxti0 &
5849	#endif
5850	& )
5851	CALL prt_enerbil('front_gwd_rando',itap)
5852	ENDIF
5853
5854	IF (ok_gwd_rando) THEN
5855	CALL FLOTT_GWD_rando(PHYS_TSTEP, pplay, t_seri, u_seri, v_seri, &
5856	rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
5857	du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
5858	CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, &
5859	paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend,itap,0 &
5860	#ifdef ISO
5861	& ,dxt0,dxtl0,dxti0 &
5862	#endif
5863	& )
5864	CALL prt_enerbil('flott_gwd_rando',itap)
5865	zustr_gwd_rando=0.
5866	zvstr_gwd_rando=0.
5867	DO k = 1, klev
5868	zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/phys_tstep &
5869	* (paprs(:, k)-paprs(:, k+1))/rg
5870	zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/phys_tstep &
5871	* (paprs(:, k)-paprs(:, k+1))/rg
5872	ENDDO
5873	ENDIF
5874
5875	! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
5876
5877	IF (mydebug) THEN
5878	CALL writefield_phy('u_seri',u_seri,nbp_lev)
5879	CALL writefield_phy('v_seri',v_seri,nbp_lev)
5880	CALL writefield_phy('t_seri',t_seri,nbp_lev)
5881	CALL writefield_phy('q_seri',q_seri,nbp_lev)
5882	ENDIF
5883
5884	DO i = 1, klon
5885	zustrph(i)=0.
5886	zvstrph(i)=0.
5887	ENDDO
5888	DO k = 1, klev
5889	DO i = 1, klon
5890	zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/phys_tstep* &
5891	(paprs(i,k)-paprs(i,k+1))/rg
5892	zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/phys_tstep* &
5893	(paprs(i,k)-paprs(i,k+1))/rg
5894	ENDDO
5895	ENDDO
5896	!
5897	!IM calcul composantes axiales du moment angulaire et couple des montagnes
5898	!
5899	IF (is_sequential .and. ok_orodr) THEN
5900	CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, &
5901	ra,rg,romega, &
5902	latitude_deg,longitude_deg,pphis, &
5903	zustrdr,zustrli,zustrph, &
5904	zvstrdr,zvstrli,zvstrph, &
5905	paprs,u,v, &
5906	aam, torsfc)
5907	ENDIF
5908	!IM cf. FLott END
5909	!DC Calcul de la tendance due au methane
5910	IF (ok_qch4) THEN
5911	CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
5912	! ajout de la tendance d'humidite due au methane
5913	d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep
5914	#ifdef ISO
5915	d_xt_ch4_dtime(:,:,:) = d_xt_ch4(:,:,:)*phys_tstep
5916	#endif
5917	CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, paprs, &
5918	'q_ch4', abortphy,flag_inhib_tend,itap,0 &
5919	#ifdef ISO
5920	& ,d_xt_ch4_dtime,dxtl0,dxti0 &
5921	#endif
5922	& )
5923	d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/phys_tstep
5924	#ifdef ISO
5925	d_xt_ch4(:,:,:) = d_xt_ch4_dtime(:,:,:)/phys_tstep
5926	#endif
5927	ENDIF
5928	!
5929	!
5930
5931	!===============================================================
5932	! Additional tendency of TKE due to orography
5933	!===============================================================
5934	!
5935	! Inititialization
5936	!------------------
5937
5938	addtkeoro=0
5939	CALL getin_p('addtkeoro',addtkeoro)
5940
5941	IF (prt_level.ge.5) &
5942	print*,'addtkeoro', addtkeoro
5943
5944	alphatkeoro=1.
5945	CALL getin_p('alphatkeoro',alphatkeoro)
5946	alphatkeoro=min(max(0.,alphatkeoro),1.)
5947
5948	smallscales_tkeoro=.FALSE.
5949	CALL getin_p('smallscales_tkeoro',smallscales_tkeoro)
5950
5951
5952	dtadd(:,:)=0.
5953	duadd(:,:)=0.
5954	dvadd(:,:)=0.
5955
5956	! Choices for addtkeoro:
5957	! ** 0 no TKE tendency from orography
5958	! ** 1 we include a fraction alphatkeoro of the whole tendency duoro
5959	! ** 2 we include a fraction alphatkeoro of the gravity wave part of duoro
5960	!
5961
5962	IF (addtkeoro .GT. 0 .AND. ok_orodr ) THEN
5963	! -------------------------------------------
5964
5965
5966	! selection des points pour lesquels le schema est actif:
5967
5968
5969	IF (addtkeoro .EQ. 1 ) THEN
5970
5971	duadd(:,:)=alphatkeoro*d_u_oro(:,:)
5972	dvadd(:,:)=alphatkeoro*d_v_oro(:,:)
5973
5974	ELSE IF (addtkeoro .EQ. 2) THEN
5975
5976	IF (smallscales_tkeoro) THEN
5977	igwd=0
5978	DO i=1,klon
5979	itest(i)=0
5980	! Etienne: ici je prends en compte plus de relief que la routine drag_noro_strato
5981	! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
5982	! Mais attention, cela ne va pas dans le sens de la conservation de l'energie!
5983	IF (zstd(i).GT.1.0) THEN
5984	itest(i)=1
5985	igwd=igwd+1
5986	idx(igwd)=i
5987	ENDIF
5988	ENDDO
5989
5990	ELSE
5991
5992	igwd=0
5993	DO i=1,klon
5994	itest(i)=0
5995	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
5996	itest(i)=1
5997	igwd=igwd+1
5998	idx(igwd)=i
5999	ENDIF
6000	ENDDO
6001
6002	ENDIF
6003
6004	CALL drag_noro_strato(addtkeoro,klon,klev,phys_tstep,paprs,pplay, &
6005	zmea,zstd, zsig, zgam, zthe,zpic,zval, &
6006	igwd,idx,itest, &
6007	t_seri, u_seri, v_seri, &
6008	zulow, zvlow, zustrdr, zvstrdr, &
6009	d_t_oro_gw, d_u_oro_gw, d_v_oro_gw)
6010
6011	zustrdr(:)=0.
6012	zvstrdr(:)=0.
6013	zulow(:)=0.
6014	zvlow(:)=0.
6015
6016	duadd(:,:)=alphatkeoro*d_u_oro_gw(:,:)
6017	dvadd(:,:)=alphatkeoro*d_v_oro_gw(:,:)
6018	ENDIF
6019
6020
6021	! TKE update from subgrid temperature and wind tendencies
6022	!----------------------------------------------------------
6023	forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
6024
6025
6026	CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pctsrf,pbl_tke)
6027	!
6028	! Prevent pbl_tke_w from becoming negative
6029	wake_delta_pbl_tke(:,:,:) = max(wake_delta_pbl_tke(:,:,:), -pbl_tke(:,:,:))
6030	!
6031
6032	ENDIF
6033	! -----
6034	!===============================================================
6035
6036	#ifdef ISO
6037	#ifdef ISOVERIF
6038	if (iso_HDO.gt.0) then
6039	call iso_verif_aberrant_enc_vect2D( &
6040	& xt_seri,q_seri, &
6041	& 'physiq 5924, juste apres methox',ntraciso,klon,klev)
6042	endif
6043	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
6044	do i=1,klon
6045	do k=1,klev
6046	if (q_seri(i,k).gt.ridicule) then
6047	if (iso_verif_o18_aberrant_nostop( &
6048	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
6049	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
6050	& 'physiq 5937, juste apres methox, qv').eq.1) then
6051	write(,) 'physic 2444: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
6052	write(,) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
6053	stop
6054	endif ! if (iso_verif_o18_aberrant_nostop
6055	endif !if (q_seri(i,k).gt.errmax) then
6056	if (ql_seri(i,k).gt.ridicule) then
6057	if (iso_verif_o18_aberrant_nostop( &
6058	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
6059	& xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
6060	& 'physiq 5937, juste apres methox, ql').eq.1) then
6061	write(,) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
6062	stop
6063	endif ! if (iso_verif_o18_aberrant_nostop
6064	endif !if (q_seri(i,k).gt.errmax) then
6065	if (qs_seri(i,k).gt.ridicule) then
6066	if (iso_verif_o18_aberrant_nostop( &
6067	& xts_seri(iso_HDO,i,k)/qs_seri(i,k), &
6068	& xts_seri(iso_O18,i,k)/qs_seri(i,k), &
6069	& 'physiq 5937, juste apres methox, qs').eq.1) then
6070	write(,) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k)
6071	stop
6072	endif ! if (iso_verif_o18_aberrant_nostop
6073	endif !if (q_seri(i,k).gt.errmax) then
6074	enddo !k=1,klev
6075	enddo !i=1,klon
6076	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
6077	#endif
6078	#endif
6079
6080	!====================================================================
6081	! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
6082	!====================================================================
6083	! Abderrahmane 24.08.09
6084
6085	IF (ok_cosp) THEN
6086	! adeclarer
6087	#ifdef CPP_COSP
6088	IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
6089
6090	IF (prt_level .GE.10) THEN
6091	print*,'freq_cosp',freq_cosp
6092	ENDIF
6093	mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
6094	! print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
6095	! s ref_liq,ref_ice
6096	CALL phys_cosp(itap,phys_tstep,freq_cosp, &
6097	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
6098	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
6099	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
6100	JrNt,ref_liq,ref_ice, &
6101	pctsrf(:,is_ter)+pctsrf(:,is_lic), &
6102	zu10m,zv10m,pphis, &
6103	zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
6104	qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
6105	prfl(:,1:klev),psfl(:,1:klev), &
6106	pmflxr(:,1:klev),pmflxs(:,1:klev), &
6107	mr_ozone,cldtau, cldemi)
6108
6109	! L calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol,
6110	! L cfaddbze,clcalipso2,dbze,cltlidarradar,
6111	! M clMISR,
6112	! R clisccp2,boxtauisccp,boxptopisccp,tclisccp,ctpisccp,
6113	! I tauisccp,albisccp,meantbisccp,meantbclrisccp)
6114
6115	ENDIF
6116	#endif
6117
6118	#ifdef CPP_COSP2
6119	IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
6120
6121	IF (prt_level .GE.10) THEN
6122	print*,'freq_cosp',freq_cosp
6123	ENDIF
6124	mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
6125	print*,'Dans physiq.F avant appel '
6126	! s ref_liq,ref_ice
6127	CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
6128	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
6129	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
6130	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
6131	JrNt,ref_liq,ref_ice, &
6132	pctsrf(:,is_ter)+pctsrf(:,is_lic), &
6133	zu10m,zv10m,pphis, &
6134	zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
6135	qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
6136	prfl(:,1:klev),psfl(:,1:klev), &
6137	pmflxr(:,1:klev),pmflxs(:,1:klev), &
6138	mr_ozone,cldtau, cldemi)
6139	ENDIF
6140	#endif
6141
6142	#ifdef CPP_COSPV2
6143	IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
6144	! IF (MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
6145
6146	IF (prt_level .GE.10) THEN
6147	print*,'freq_cosp',freq_cosp
6148	ENDIF
6149	DO k = 1, klev
6150	DO i = 1, klon
6151	phicosp(i,k) = pphi(i,k) + pphis(i)
6152	ENDDO
6153	ENDDO
6154	mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
6155	print*,'Dans physiq.F avant appel '
6156	! s ref_liq,ref_ice
6157	CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
6158	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
6159	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
6160	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
6161	JrNt,ref_liq,ref_ice, &
6162	pctsrf(:,is_ter)+pctsrf(:,is_lic), &
6163	zu10m,zv10m,pphis, &
6164	zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
6165	qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
6166	prfl(:,1:klev),psfl(:,1:klev), &
6167	pmflxr(:,1:klev),pmflxs(:,1:klev), &
6168	mr_ozone,cldtau, cldemi)
6169	ENDIF
6170	#endif
6171
6172	ENDIF !ok_cosp
6173
6174	!c====================================================================
6175	!c Ajout de la production de tritium (naturelle et essais nucléaires)
6176	!c====================================================================
6177	!C
6178	#ifdef ISO
6179	#ifdef ISOVERIF
6180	call iso_verif_noNaN_vect2D(xt_seri, &
6181	& 'physiq 5595: avant appel tritium',ntraciso,klon,klev)
6182	#endif
6183	call iso_tritium(paprs,pplay, &
6184	& zphi,phys_tstep, &
6185	& d_xt_prod_nucl, &
6186	& d_xt_cosmo, &
6187	& d_xt_decroiss, &
6188	& xt_seri)
6189	#ifdef ISOVERIF
6190	call iso_verif_noNaN_vect2D(xt_seri, &
6191	& 'physiq 5607: apres appel tritium',ntraciso,klon,klev)
6192	if (iso_HTO.gt.0) then ! Tritium
6193	ixt=iso_HTO
6194	do i=1,klon
6195	do k=1,klev
6196	if (iso_verif_positif_strict_nostop(xt_seri(ixt,i,k), &
6197	& 'physiq 5620 : xt_seri(HTO) nul ou negatif').eq.1) then
6198	write(,) 'ixt,i,klon,k,klev=',ixt,i,klon,k,klev
6199	write(,) 'xt_seri(iso_HTO,i,k)=',xt_seri(ixt,i,k)
6200	stop
6201	endif
6202	enddo
6203	enddo
6204	endif
6205	#endif
6206	! write(,)'itap=',itap
6207	! write(,)'itau_phy=',itau_phy
6208	! write(,)'jD_cur=',jD_cur
6209	#endif
6210	!ifdef ISO
6211
6212
6213	! Marine
6214
6215	IF (ok_airs) then
6216
6217	IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/phys_tstep)).EQ.0) THEN
6218	write(,) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
6219	CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
6220	& map_prop_hc,map_prop_hist,&
6221	& map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
6222	& map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
6223	& map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
6224	& map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
6225	& map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
6226	& map_ntot,map_hc,map_hist,&
6227	& map_Cb,map_ThCi,map_Anv,&
6228	& alt_tropo )
6229	ENDIF
6230
6231	ENDIF ! ok_airs
6232
6233
6234	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6235	!AA
6236	!AA Installation de l'interface online-offline pour traceurs
6237	!AA
6238	!====================================================================
6239	! Calcul des tendances traceurs
6240	!====================================================================
6241	!
6242
6243	IF (type_trac=='repr') THEN
6244	!MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod
6245	!MM dans Reprobus
6246	sh_in(:,:) = q_seri(:,:)
6247	#ifdef REPROBUS
6248	d_q_rep(:,:) = 0.
6249	d_ql_rep(:,:) = 0.
6250	d_qi_rep(:,:) = 0.
6251	#endif
6252	ELSE
6253	sh_in(:,:) = qx(:,:,ivap)
6254	IF (nqo .EQ. 3) THEN
6255	ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol)
6256	ELSE
6257	ch_in(:,:) = qx(:,:,iliq)
6258	ENDIF
6259	ENDIF
6260
6261	#ifdef CPP_Dust
6262	! Avec SPLA, iflag_phytrac est forcé =1
6263	CALL phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con, & ! I
6264	pdtphys,ftsol, & ! I
6265	t,q_seri,paprs,pplay,RHcl, & ! I
6266	pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & ! I
6267	coefh(1:klon,1:klev,is_ave), cdragh, cdragm, u1, v1, & ! I
6268	u_seri, v_seri, latitude_deg, longitude_deg, &
6269	pphis,pctsrf,pmflxr,pmflxs,prfl,psfl, & ! I
6270	da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij, & ! I
6271	epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con, & ! I
6272	ev,wdtrainA, wdtrainM,wght_cvfd, & ! I
6273	fm_therm, entr_therm, rneb, & ! I
6274	beta_prec_fisrt,beta_prec, & !I
6275	zu10m,zv10m,wstar,ale_bl,ale_wake, & ! I
6276	d_tr_dyn,tr_seri)
6277
6278	#else
6279	IF (iflag_phytrac == 1 ) THEN
6280	CALL phytrac ( &
6281	itap, days_elapsed+1, jH_cur, debut, &
6282	lafin, phys_tstep, u, v, t, &
6283	paprs, pplay, pmfu, pmfd, &
6284	pen_u, pde_u, pen_d, pde_d, &
6285	cdragh, coefh(1:klon,1:klev,is_ave), fm_therm, entr_therm, &
6286	u1, v1, ftsol, pctsrf, &
6287	zustar, zu10m, zv10m, &
6288	wstar(:,is_ave), ale_bl, ale_wake, &
6289	latitude_deg, longitude_deg, &
6290	frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, &
6291	presnivs, pphis, pphi, albsol1, &
6292	sh_in, ch_in, rhcl, cldfra, rneb, &
6293	diafra, cldliq, itop_con, ibas_con, &
6294	pmflxr, pmflxs, prfl, psfl, &
6295	da, phi, mp, upwd, &
6296	phi2, d1a, dam, sij, wght_cvfd, & !<<RomP+RL
6297	wdtrainA, wdtrainM, sigd, clw,elij, & !<<RomP
6298	ev, ep, epmlmMm, eplaMm, & !<<RomP
6299	dnwd, aerosol_couple, flxmass_w, &
6300	tau_aero, piz_aero, cg_aero, ccm, &
6301	rfname, &
6302	d_tr_dyn, & !<<RomP
6303	tr_seri, init_source)
6304	#ifdef REPROBUS
6305
6306
6307	print*,'avt add phys rep',abortphy
6308
6309	CALL add_phys_tend &
6310	(du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,paprs,&
6311	'rep',abortphy,flag_inhib_tend,itap,0)
6312	IF (abortphy==1) Print*,'ERROR ABORT REP'
6313
6314	print*,'apr add phys rep',abortphy
6315
6316	#endif
6317	ENDIF ! (iflag_phytrac=1)
6318
6319	#endif
6320	!ENDIF ! (iflag_phytrac=1)
6321
6322	IF (offline) THEN
6323
6324	IF (prt_level.ge.9) &
6325	print*,'Attention on met a 0 les thermiques pour phystoke'
6326	CALL phystokenc ( &
6327	nlon,klev,pdtphys,longitude_deg,latitude_deg, &
6328	t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
6329	fm_therm,entr_therm, &
6330	cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, &
6331	frac_impa, frac_nucl, &
6332	pphis,cell_area,phys_tstep,itap, &
6333	qx(:,:,ivap),da,phi,mp,upwd,dnwd)
6334
6335
6336	ENDIF
6337
6338	!
6339	! Calculer le transport de l'eau et de l'energie (diagnostique)
6340	!
6341	CALL transp (paprs,zxtsol, &
6342	t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, &
6343	ve, vq, ue, uq, vwat, uwat)
6344	!
6345	!IM global posePB BEG
6346	IF(1.EQ.0) THEN
6347	!
6348	CALL transp_lay (paprs,zxtsol, &
6349	t_seri, q_seri, u_seri, v_seri, zphi, &
6350	ve_lay, vq_lay, ue_lay, uq_lay)
6351	!
6352	ENDIF !(1.EQ.0) THEN
6353	!IM global posePB END
6354	! Accumuler les variables a stocker dans les fichiers histoire:
6355	!
6356
6357	!================================================================
6358	! Conversion of kinetic and potential energy into heat, for
6359	! parameterisation of subgrid-scale motions
6360	!================================================================
6361
6362	d_t_ec(:,:)=0.
6363	forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
6364	CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap),qx(:,:,iliq),qx(:,:,isol), &
6365	u_seri,v_seri,t_seri,q_seri,ql_seri,qs_seri,pbl_tke(:,:,is_ave)-tke0(:,:), &
6366	zmasse,exner,d_t_ec)
6367	t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
6368
6369	!=======================================================================
6370	! SORTIES
6371	!=======================================================================
6372	!
6373	!IM initialisation + calculs divers diag AMIP2
6374	!
6375	include "calcul_divers.h"
6376	!
6377	!IM Interpolation sur les niveaux de pression du NMC
6378	! -------------------------------------------------
6379	!
6380	include "calcul_STDlev.h"
6381	!
6382	! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
6383	CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)
6384	!
6385	!cc prw = eau precipitable
6386	! prlw = colonne eau liquide
6387	! prlw = colonne eau solide
6388	prw(:) = 0.
6389	prlw(:) = 0.
6390	prsw(:) = 0.
6391	DO k = 1, klev
6392	prw(:) = prw(:) + q_seri(:,k)*zmasse(:,k)
6393	prlw(:) = prlw(:) + ql_seri(:,k)*zmasse(:,k)
6394	prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k)
6395	ENDDO
6396
6397	#ifdef ISO
6398	DO i = 1, klon
6399	do ixt=1,ntraciso
6400	xtprw(ixt,i) = 0.
6401	DO k = 1, klev
6402	xtprw(ixt,i) = xtprw(ixt,i) + &
6403	& xt_seri(ixt,i,k)*(paprs(i,k)-paprs(i,k+1))/RG
6404	ENDDO !DO k = 1, klev
6405	enddo !do ixt=1,ntraciso
6406	enddo !DO i = 1, klon
6407	#endif
6408	!
6409	IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
6410	#ifdef INCA
6411	CALL VTe(VTphysiq)
6412	CALL VTb(VTinca)
6413
6414	CALL chemhook_end ( &
6415	phys_tstep, &
6416	pplay, &
6417	t_seri, &
6418	tr_seri(:,:,1+nqCO2:nbtr), &
6419	nbtr, &
6420	paprs, &
6421	q_seri, &
6422	cell_area, &
6423	pphi, &
6424	pphis, &
6425	zx_rh, &
6426	aps, bps, ap, bp)
6427
6428	CALL VTe(VTinca)
6429	CALL VTb(VTphysiq)
6430	#endif
6431	ENDIF
6432
6433
6434	!
6435	! Convertir les incrementations en tendances
6436	!
6437	IF (prt_level .GE.10) THEN
6438	print *,'Convertir les incrementations en tendances '
6439	ENDIF
6440	!
6441	IF (mydebug) THEN
6442	CALL writefield_phy('u_seri',u_seri,nbp_lev)
6443	CALL writefield_phy('v_seri',v_seri,nbp_lev)
6444	CALL writefield_phy('t_seri',t_seri,nbp_lev)
6445	CALL writefield_phy('q_seri',q_seri,nbp_lev)
6446	ENDIF
6447
6448	DO k = 1, klev
6449	DO i = 1, klon
6450	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / phys_tstep
6451	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / phys_tstep
6452	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / phys_tstep
6453	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / phys_tstep
6454	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep
6455	!CR: on ajoute le contenu en glace
6456	IF (nqo.eq.3) THEN
6457	d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
6458	ENDIF
6459	ENDDO
6460	ENDDO
6461
6462	! C Risi: dispatcher les isotopes dans les xt_seri
6463	#ifdef ISO
6464	do ixt=1,ntraciso
6465	DO k = 1, klev
6466	DO i = 1, klon
6467	iq=iqiso(ixt,ivap)
6468	d_qx(i,k,iq) = ( xt_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
6469	iq=iqiso(ixt,iliq)
6470	d_qx(i,k,iq) = ( xtl_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
6471	if (nqo.eq.3) then
6472	iq=iqiso(ixt,isol)
6473	d_qx(i,k,iq) = ( xts_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
6474	endif
6475	enddo !DO i = 1, klon
6476	enddo ! DO k = 1, klev
6477	enddo !do ixt=1,ntraciso
6478	!#ifdef ISOVERIF
6479	! write(,) 'physiq 6120: d_qx(1,1,:)=',d_qx(1,1,:)
6480	! write(,) 'qx(1,1,:)=',qx(1,1,:)
6481	! write(,) 'xt_seri(:,1,1)=',xt_seri(:,1,1)
6482	!#endif
6483	#endif
6484	! #ifdef ISO
6485	!
6486	!CR: nb de traceurs eau: nqo
6487	! IF (nqtot.GE.3) THEN
6488	IF (nqtot.GE.(nqo+1)) THEN
6489	! DO iq = 3, nqtot
6490	! DO iq = nqo+1, nqtot ! modif C Risi
6491	do itr=1,nqtottr
6492	iq=itr_indice(itr)
6493	DO k = 1, klev
6494	DO i = 1, klon
6495	! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / phys_tstep
6496	d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / phys_tstep
6497	ENDDO
6498	ENDDO
6499	ENDDO ! !do itr=1,nqtottr
6500	ENDIF
6501	!
6502	!IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
6503	!IM global posePB include "write_bilKP_ins.h"
6504	!IM global posePB include "write_bilKP_ave.h"
6505	!
6506
6507	!--OB mass fixer
6508	!--profile is corrected to force mass conservation of water
6509	IF (mass_fixer) THEN
6510	qql2(:)=0.0
6511	DO k = 1, klev
6512	qql2(:)=qql2(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k))*zmasse(:,k)
6513	ENDDO
6514	DO i = 1, klon
6515	!--compute ratio of what q+ql should be with conservation to what it is
6516	corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
6517	DO k = 1, klev
6518	q_seri(i,k) =q_seri(i,k)*corrqql
6519	ql_seri(i,k)=ql_seri(i,k)*corrqql
6520	ENDDO
6521	ENDDO
6522	#ifdef ISO
6523	do ixt=1,ntraciso
6524	xtql2(ixt,:)=0.0
6525	DO k = 1, klev
6526	xtql2(ixt,:)=xtql2(ixt,:)+(xt_seri(ixt,:,k)+xtl_seri(ixt,:,k)+xts_seri(ixt,:,k))*zmasse(:,k)
6527	ENDDO
6528	DO i = 1, klon
6529	!--compute ratio of what q+ql should be with conservation to what it is
6530	corrxtql(ixt)=(xtql1(ixt,i)+(xtevap(ixt,i)-xtrain_fall(ixt,i)-xtsnow_fall(ixt,i))*pdtphys)/xtql2(ixt,i)
6531	DO k = 1, klev
6532	xt_seri(ixt,i,k) =xt_seri(ixt,i,k)*corrxtql(ixt)
6533	xtl_seri(ixt,i,k)=xtl_seri(ixt,i,k)*corrxtql(ixt)
6534	ENDDO
6535	ENDDO
6536	enddo !do ixt=1,ntraciso
6537	#endif
6538	ENDIF
6539	!--fin mass fixer
6540
6541	! Sauvegarder les valeurs de t et q a la fin de la physique:
6542	!
6543	u_ancien(:,:) = u_seri(:,:)
6544	v_ancien(:,:) = v_seri(:,:)
6545	t_ancien(:,:) = t_seri(:,:)
6546	q_ancien(:,:) = q_seri(:,:)
6547	ql_ancien(:,:) = ql_seri(:,:)
6548	qs_ancien(:,:) = qs_seri(:,:)
6549	#ifdef ISO
6550	xt_ancien(:,:,:)=xt_seri(:,:,:)
6551	xtl_ancien(:,:,:)=xtl_seri(:,:,:)
6552	xts_ancien(:,:,:)=xts_seri(:,:,:)
6553	#endif
6554	CALL water_int(klon,klev,q_ancien,zmasse,prw_ancien)
6555	CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien)
6556	CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien)
6557	! !! RomP >>>
6558	!CR: nb de traceurs eau: nqo
6559	IF (nqtot.GT.nqo) THEN
6560	! DO iq = nqo+1, nqtot ! modif C Risi
6561	do itr=1,nqtottr
6562	tr_ancien(:,:,itr) = tr_seri(:,:,itr)
6563	ENDDO
6564	ENDIF
6565	! !! RomP <<<
6566	!==========================================================================
6567	! Sorties des tendances pour un point particulier
6568	! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
6569	! pour le debug
6570	! La valeur de igout est attribuee plus haut dans le programme
6571	!==========================================================================
6572
6573	IF (prt_level.ge.1) THEN
6574	write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
6575	write(lunout,*) &
6576	'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
6577	write(lunout,*) &
6578	nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
6579	pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
6580	pctsrf(igout,is_sic)
6581	write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
6582	DO k=1,klev
6583	write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
6584	d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
6585	d_t_eva(igout,k)
6586	ENDDO
6587	write(lunout,*) 'cool,heat'
6588	DO k=1,klev
6589	write(lunout,*) cool(igout,k),heat(igout,k)
6590	ENDDO
6591
6592	!jyg< (En attendant de statuer sur le sort de d_t_oli)
6593	!jyg! write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
6594	!jyg! do k=1,klev
6595	!jyg! write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
6596	!jyg! d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
6597	!jyg! enddo
6598	write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
6599	DO k=1,klev
6600	write(lunout,*) d_t_vdf(igout,k), &
6601	d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
6602	ENDDO
6603	!>jyg
6604
6605	write(lunout,*) 'd_ps ',d_ps(igout)
6606	write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
6607	DO k=1,klev
6608	write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
6609	d_qx(igout,k,1),d_qx(igout,k,2)
6610	ENDDO
6611	ENDIF
6612
6613	!============================================================
6614	! Calcul de la temperature potentielle
6615	!============================================================
6616	DO k = 1, klev
6617	DO i = 1, klon
6618	!JYG/IM theta en debut du pas de temps
6619	!JYG/IM theta(i,k)=t(i,k)(100000./pplay(i,k))*(RD/RCPD)
6620	!JYG/IM theta en fin de pas de temps de physique
6621	theta(i,k)=t_seri(i,k)(100000./pplay(i,k))*(RD/RCPD)
6622	! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
6623	! MPL 20130625
6624	! fth_fonctions.F90 et parkind1.F90
6625	! sinon thetal=theta
6626	! thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
6627	! : ql_seri(i,k))
6628	thetal(i,k)=theta(i,k)
6629	ENDDO
6630	ENDDO
6631	!
6632
6633	! 22.03.04 BEG
6634	!=============================================================
6635	! Ecriture des sorties
6636	!=============================================================
6637	#ifdef CPP_IOIPSL
6638
6639	! Recupere des varibles calcule dans differents modules
6640	! pour ecriture dans histxxx.nc
6641
6642	! Get some variables from module fonte_neige_mod
6643	CALL fonte_neige_get_vars(pctsrf, &
6644	zxfqcalving, zxfqfonte, zxffonte, zxrunofflic &
6645	#ifdef ISO
6646	& ,zxfxtcalving, zxfxtfonte,zxxtrunofflic &
6647	#endif
6648	& )
6649
6650
6651	!=============================================================
6652	! Separation entre thermiques et non thermiques dans les sorties
6653	! de fisrtilp
6654	!=============================================================
6655
6656	IF (iflag_thermals>=1) THEN
6657	d_t_lscth=0.
6658	d_t_lscst=0.
6659	d_q_lscth=0.
6660	d_q_lscst=0.
6661	DO k=1,klev
6662	DO i=1,klon
6663	IF (ptconvth(i,k)) THEN
6664	d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
6665	d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
6666	ELSE
6667	d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
6668	d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
6669	ENDIF
6670	ENDDO
6671	ENDDO
6672
6673	DO i=1,klon
6674	plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
6675	plul_th(i)=prfl(i,1)+psfl(i,1)
6676	ENDDO
6677	ENDIF
6678
6679	!On effectue les sorties:
6680
6681	#ifdef CPP_Dust
6682	CALL phys_output_write_spl(itap, pdtphys, paprs, pphis, &
6683	pplay, lmax_th, aerosol_couple, &
6684	ok_ade, ok_aie, ivap, ok_sync, &
6685	ptconv, read_climoz, clevSTD, &
6686	ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse, &
6687	flag_aerosol, flag_aerosol_strat, ok_cdnc)
6688	#else
6689	CALL phys_output_write(itap, pdtphys, paprs, pphis, &
6690	pplay, lmax_th, aerosol_couple, &
6691	ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, &
6692	ok_sync, ptconv, read_climoz, clevSTD, &
6693	ptconvth, d_u, d_t, qx, d_qx, zmasse, &
6694	flag_aerosol, flag_aerosol_strat, ok_cdnc)
6695	#endif
6696
6697	#ifndef CPP_XIOS
6698	CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
6699	#endif
6700
6701	#endif
6702
6703	! Pour XIOS : On remet des variables a .false. apres un premier appel
6704	IF (debut) THEN
6705	#ifdef CPP_XIOS
6706	swaero_diag=.FALSE.
6707	swaerofree_diag=.FALSE.
6708	dryaod_diag=.FALSE.
6709	ok_4xCO2atm= .FALSE.
6710	! write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm
6711
6712	IF (is_master) THEN
6713	!--setting up swaero_diag to TRUE in XIOS case
6714	IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. &
6715	xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. &
6716	xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR. &
6717	(iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. &
6718	xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0")))) &
6719	!!!--for now these fields are not in the XML files so they are omitted
6720	!!! xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) &
6721	swaero_diag=.TRUE.
6722
6723	!--setting up swaerofree_diag to TRUE in XIOS case
6724	IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
6725	xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR. &
6726	xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
6727	xios_field_is_active("LWupTOAcleanclr")) &
6728	swaerofree_diag=.TRUE.
6729
6730	!--setting up dryaod_diag to TRUE in XIOS case
6731	DO naero = 1, naero_tot-1
6732	IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE.
6733	ENDDO
6734	!
6735	!--setting up ok_4xCO2atm to TRUE in XIOS case
6736	IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. &
6737	xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
6738	xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
6739	xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
6740	xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
6741	xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
6742	ok_4xCO2atm=.TRUE.
6743	ENDIF
6744	!$OMP BARRIER
6745	CALL bcast(swaero_diag)
6746	CALL bcast(swaerofree_diag)
6747	CALL bcast(dryaod_diag)
6748	CALL bcast(ok_4xCO2atm)
6749	! write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm
6750	#endif
6751	ENDIF
6752
6753	!====================================================================
6754	! Arret du modele apres hgardfou en cas de detection d'un
6755	! plantage par hgardfou
6756	!====================================================================
6757
6758	IF (abortphy==1) THEN
6759	abort_message ='Plantage hgardfou'
6760	CALL abort_physic (modname,abort_message,1)
6761	ENDIF
6762
6763	! 22.03.04 END
6764	!
6765	!====================================================================
6766	! Si c'est la fin, il faut conserver l'etat de redemarrage
6767	!====================================================================
6768	!
6769	#ifdef ISO
6770	#ifdef ISOVERIF
6771	if (iso_HDO.gt.0) then
6772	call iso_verif_aberrant_enc_vect2D( &
6773	& xt_ancien,q_ancien, &
6774	& 'physiq 6577',ntraciso,klon,klev)
6775	endif
6776	write(,) 'physiq 3731: verif avant phyisoredem'
6777	do k=1,klev
6778	do i=1,klon
6779	if (iso_eau.gt.0) then
6780	call iso_verif_egalite_choix(xt_ancien(iso_eau,i,k), &
6781	& q_ancien(i,k),'physiq 3728: avant phyisoredem', &
6782	& errmax,errmaxrel)
6783	endif ! if (iso_eau.gt.0) then
6784	#ifdef ISOTRAC
6785	if (ok_isotrac) then
6786	call iso_verif_traceur(xt_ancien(1,i,k),'physiq 4802')
6787	endif !if (ok_isotrac) then
6788	#endif
6789	enddo
6790	enddo !do k=1,klev
6791	#endif
6792	#endif
6793	! ISO
6794
6795	IF (lafin) THEN
6796	itau_phy = itau_phy + itap
6797	CALL phyredem ("restartphy.nc")
6798	! open(97,form="unformatted",file="finbin")
6799	! write(97) u_seri,v_seri,t_seri,q_seri
6800	! close(97)
6801
6802	IF (is_omp_master) THEN
6803
6804	IF (read_climoz >= 1) THEN
6805	IF (is_mpi_root) CALL nf95_close(ncid_climoz)
6806	DEALLOCATE(press_edg_climoz) ! pointer
6807	DEALLOCATE(press_cen_climoz) ! pointer
6808	ENDIF
6809
6810	ENDIF
6811	#ifdef CPP_XIOS
6812	IF (is_omp_master) CALL xios_context_finalize
6813	#endif
6814	WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
6815	ENDIF
6816
6817	! first=.false.
6818
6819	END SUBROUTINE physiq
6820
6821	END MODULE physiq_mod

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

Download in other formats:

Original Format