source: LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90 @ 4359

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