source: trunk/LMDZ.GENERIC/libf/phystd/physiq_mod.F90 @ 2422

Last change on this file since 2422 was 2300, checked in by dbardet, 6 years ago

27/04/2020 (r2300) == DB

Add a parameter to lock a no seasonal cycle simulation during restart.
One sets the initial day using 'season=.true.' and set 'noseason_day'. This commit fixed the ticket #42 of planeto tack

  • Property svn:executable set to *
File size: 100.3 KB
Line 
1      module physiq_mod
2     
3      implicit none
4     
5      contains
6     
7      subroutine physiq(ngrid,nlayer,nq,   &
8                  nametrac,                &
9                  firstcall,lastcall,      &
10                  pday,ptime,ptimestep,    &
11                  pplev,pplay,pphi,        &
12                  pu,pv,pt,pq,             &
13                  flxw,                    &
14                  pdu,pdv,pdt,pdq,pdpsrf)
15 
16      use radinc_h, only : L_NSPECTI,L_NSPECTV,naerkind
17      use watercommon_h, only : RLVTT, Psat_water,epsi,su_watercycle, RV, T_h2o_ice_liq
18      use thermcell_mod, only: init_thermcell_mod
19      use gases_h, only: gnom, gfrac
20      use radcommon_h, only: sigma, glat, grav, BWNV
21      use radii_mod, only: h2o_reffrad, co2_reffrad
22      use aerosol_mod, only: iaero_co2, iaero_h2o
23      use surfdat_h, only: phisfi, zmea, zstd, zsig, zgam, zthe, &
24                           dryness, watercaptag
25      use comdiurn_h, only: coslat, sinlat, coslon, sinlon
26      use comsaison_h, only: mu0, fract, dist_star, declin, right_ascen
27      use comsoil_h, only: nsoilmx, layer, mlayer, inertiedat
28      use geometry_mod, only: latitude, longitude, cell_area
29      USE comgeomfi_h, only: totarea, totarea_planet
30      USE tracer_h, only: noms, mmol, radius, rho_q, qext, &
31                          alpha_lift, alpha_devil, qextrhor, &
32                          igcm_h2o_ice, igcm_h2o_vap, igcm_dustbin, &
33                          igcm_co2_ice
34      use time_phylmdz_mod, only: ecritphy, iphysiq, nday
35      use phyetat0_mod, only: phyetat0
36      use phyredem, only: physdem0, physdem1
37      use slab_ice_h, only: capcalocean, capcalseaice,capcalsno, &
38                            noceanmx
39      use ocean_slab_mod, only :ocean_slab_init, ocean_slab_ice, &
40                                ini_surf_heat_transp_mod, &
41                                ocean_slab_get_vars,ocean_slab_final
42      use surf_heat_transp_mod,only :init_masquv
43      use planetwide_mod, only: planetwide_minval,planetwide_maxval,planetwide_sumval
44      use mod_phys_lmdz_para, only : is_master
45      use planete_mod, only: apoastr, periastr, year_day, peri_day, &
46                            obliquit, nres, z0
47      use comcstfi_mod, only: pi, g, rcp, r, rad, mugaz, cpp
48      use time_phylmdz_mod, only: daysec
49      use callkeys_mod
50      use nonoro_gwd_ran_mod, only: nonoro_gwd_ran
51      use conc_mod
52      use phys_state_var_mod
53      use callcorrk_mod, only: callcorrk
54      use turb_mod, only : q2,sensibFlux,turb_resolved
55#ifndef MESOSCALE
56      use vertical_layers_mod, only: presnivs, pseudoalt
57      use mod_phys_lmdz_omp_data, ONLY: is_omp_master
58#else
59      use comm_wrf, only : comm_HR_SW, comm_HR_LW, &
60                           comm_CLOUDFRAC,comm_TOTCLOUDFRAC,&
61                           comm_SURFRAIN,comm_REEVAP,comm_HR_DYN,&
62                           comm_RAIN,comm_SNOW,comm_ALBEQ,&
63                           comm_FLUXTOP_DN,comm_FLUXABS_SW,&
64                           comm_FLUXTOP_LW,comm_FLUXSURF_SW,&
65                           comm_FLUXSURF_LW,comm_FLXGRD,&
66                           comm_LSCEZ,comm_H2OICE_REFF
67#endif
68
69#ifdef CPP_XIOS     
70      use xios_output_mod, only: initialize_xios_output, &
71                                 update_xios_timestep, &
72                                 send_xios_field
73      use wxios, only: wxios_context_init, xios_context_finalize
74#endif
75
76      implicit none
77
78
79!==================================================================
80!     
81!     Purpose
82!     -------
83!     Central subroutine for all the physics parameterisations in the
84!     universal model. Originally adapted from the Mars LMDZ model.
85!
86!     The model can be run without or with tracer transport
87!     depending on the value of "tracer" in file "callphys.def".
88!
89!
90!   It includes:
91!
92!      I. Initialization :
93!         I.1 Firstcall initializations.
94!         I.2 Initialization for every call to physiq.
95!
96!      II. Compute radiative transfer tendencies (longwave and shortwave) :
97!         II.a Option 1 : Call correlated-k radiative transfer scheme.
98!         II.b Option 2 : Call Newtonian cooling scheme.
99!         II.c Option 3 : Atmosphere has no radiative effect.
100!
101!      III. Vertical diffusion (turbulent mixing) :
102!
103!      IV. Convection :
104!         IV.a Thermal plume model
105!         IV.b Dry convective adjusment
106!
107!      V. Condensation and sublimation of gases (currently just CO2).
108!
109!      VI. Tracers
110!         VI.1. Water and water ice.
111!         VI.2  Photochemistry
112!         VI.3. Aerosols and particles.
113!         VI.4. Updates (pressure variations, surface budget).
114!         VI.5. Slab Ocean.
115!         VI.6. Surface Tracer Update.
116!
117!      VII. Surface and sub-surface soil temperature.
118!
119!      VIII. Perform diagnostics and write output files.
120!
121!
122!   arguments
123!   ---------
124!
125!   INPUT
126!   -----
127!
128!    ngrid                 Size of the horizontal grid.
129!    nlayer                Number of vertical layers.
130!    nq                    Number of advected fields.
131!    nametrac              Name of corresponding advected fields.
132!
133!    firstcall             True at the first call.
134!    lastcall              True at the last call.
135!
136!    pday                  Number of days counted from the North. Spring equinoxe.
137!    ptime                 Universal time (0<ptime<1): ptime=0.5 at 12:00 UT.
138!    ptimestep             timestep (s).
139!
140!    pplay(ngrid,nlayer)   Pressure at the middle of the layers (Pa).
141!    pplev(ngrid,nlayer+1) Intermediate pressure levels (Pa).
142!    pphi(ngrid,nlayer)    Geopotential at the middle of the layers (m2.s-2).
143!
144!    pu(ngrid,nlayer)      u, zonal component of the wind (ms-1).
145!    pv(ngrid,nlayer)      v, meridional component of the wind (ms-1).
146!
147!    pt(ngrid,nlayer)      Temperature (K).
148!
149!    pq(ngrid,nlayer,nq)   Advected fields.
150!
151!    pudyn(ngrid,nlayer)    \
152!    pvdyn(ngrid,nlayer)     \ Dynamical temporal derivative for the
153!    ptdyn(ngrid,nlayer)     / corresponding variables.
154!    pqdyn(ngrid,nlayer,nq) /
155!    flxw(ngrid,nlayer)      vertical mass flux (kg/s) at layer lower boundary
156!
157!   OUTPUT
158!   ------
159!
160!    pdu(ngrid,nlayer)        \
161!    pdv(ngrid,nlayer)         \  Temporal derivative of the corresponding
162!    pdt(ngrid,nlayer)         /  variables due to physical processes.
163!    pdq(ngrid,nlayer)        /
164!    pdpsrf(ngrid)             /
165!
166!
167!     Authors
168!     -------
169!           Frederic Hourdin        15/10/93
170!           Francois Forget        1994
171!           Christophe Hourdin        02/1997
172!           Subroutine completely rewritten by F. Forget (01/2000)
173!           Water ice clouds: Franck Montmessin (update 06/2003)
174!           Radiatively active tracers: J.-B. Madeleine (10/2008-06/2009)
175!           New correlated-k radiative scheme: R. Wordsworth (2009)
176!           Many specifically Martian subroutines removed: R. Wordsworth (2009)       
177!           Improved water cycle: R. Wordsworth / B. Charnay (2010)
178!           To F90: R. Wordsworth (2010)
179!           New turbulent diffusion scheme: J. Leconte (2012)
180!           Loops converted to F90 matrix format: J. Leconte (2012)
181!           No more ngridmx/nqmx, F90 commons and adaptation to parallel: A. Spiga (2012)
182!           Purge of the code : M. Turbet (2015)
183!           Photochemical core developped by F. Lefevre: B. Charnay (2017)
184!==================================================================
185
186
187!    0.  Declarations :
188!    ------------------
189
190include "netcdf.inc"
191
192! Arguments :
193! -----------
194
195!   INPUTS:
196!   -------
197
198      integer,intent(in) :: ngrid             ! Number of atmospheric columns.
199      integer,intent(in) :: nlayer            ! Number of atmospheric layers.
200      integer,intent(in) :: nq                ! Number of tracers.
201      character*30,intent(in) :: nametrac(nq) ! Names of the tracers taken from dynamics.
202     
203      logical,intent(in) :: firstcall ! Signals first call to physics.
204      logical,intent(in) :: lastcall  ! Signals last call to physics.
205     
206      real,intent(in) :: pday                  ! Number of elapsed sols since reference Ls=0.
207      real,intent(in) :: ptime                 ! "Universal time", given as fraction of sol (e.g.: 0.5 for noon).
208      real,intent(in) :: ptimestep             ! Physics timestep (s).
209      real,intent(in) :: pplev(ngrid,nlayer+1) ! Inter-layer pressure (Pa).
210      real,intent(in) :: pplay(ngrid,nlayer)   ! Mid-layer pressure (Pa).
211      real,intent(in) :: pphi(ngrid,nlayer)    ! Geopotential at mid-layer (m2s-2).
212      real,intent(in) :: pu(ngrid,nlayer)      ! Zonal wind component (m/s).
213      real,intent(in) :: pv(ngrid,nlayer)      ! Meridional wind component (m/s).
214      real,intent(in) :: pt(ngrid,nlayer)      ! Temperature (K).
215      real,intent(in) :: pq(ngrid,nlayer,nq)   ! Tracers (kg/kg_of_air).
216      real,intent(in) :: flxw(ngrid,nlayer)    ! Vertical mass flux (ks/s) at lower boundary of layer
217
218!   OUTPUTS:
219!   --------
220
221!     Physical tendencies :
222
223      real,intent(out) :: pdu(ngrid,nlayer)    ! Zonal wind tendencies (m/s/s).
224      real,intent(out) :: pdv(ngrid,nlayer)    ! Meridional wind tendencies (m/s/s).
225      real,intent(out) :: pdt(ngrid,nlayer)    ! Temperature tendencies (K/s).
226      real,intent(out) :: pdq(ngrid,nlayer,nq) ! Tracer tendencies (kg/kg_of_air/s).
227      real,intent(out) :: pdpsrf(ngrid)        ! Surface pressure tendency (Pa/s).
228
229! Local saved variables:
230! ----------------------
231      integer,save :: day_ini                                      ! Initial date of the run (sol since Ls=0).
232      integer,save :: icount                                       ! Counter of calls to physiq during the run.
233!$OMP THREADPRIVATE(day_ini,icount)
234
235! Local variables :
236! -----------------
237
238!     Aerosol (dust or ice) extinction optical depth  at reference wavelength
239!     for the "naerkind" optically active aerosols:
240
241      real aerosol(ngrid,nlayer,naerkind) ! Aerosols.
242      real zh(ngrid,nlayer)               ! Potential temperature (K).
243      real pw(ngrid,nlayer)               ! Vertical velocity (m/s). (NOTE : >0 WHEN DOWNWARDS !!)
244      real omega(ngrid,nlayer)            ! omega velocity (Pa/s, >0 when downward)
245
246      integer l,ig,ierr,iq,nw,isoil
247     
248      real zls                       ! Solar longitude (radians).
249      real zlss                      ! Sub solar point longitude (radians).
250      real zday                      ! Date (time since Ls=0, calculated in sols).
251      real zzlay(ngrid,nlayer)       ! Altitude at the middle of the atmospheric layers.
252      real zzlev(ngrid,nlayer+1)     ! Altitude at the atmospheric layer boundaries.
253
254! VARIABLES for the thermal plume model
255     
256      real f(ngrid)                       ! Mass flux norm
257      real fm(ngrid,nlayer+1)             ! Mass flux
258      real fm_bis(ngrid,nlayer)           ! Recasted fm
259      real entr(ngrid,nlayer)             ! Entrainment
260      real detr(ngrid,nlayer)             ! Detrainment
261      real dqevap(ngrid,nlayer,nq)        ! water tracer mass mixing ratio variations due to evaporation
262      real dtevap(ngrid,nlayer)           ! temperature variation due to evaporation
263      real zqtherm(ngrid,nlayer,nq)       ! vapor mass mixing ratio after evaporation
264      real zttherm(ngrid,nlayer)          ! temperature after evaporation
265      real fraca(ngrid,nlayer+1)          ! Fraction of the surface that plumes occupies
266      real zw2(ngrid,nlayer+1)            ! Vertical speed
267      real zw2_bis(ngrid,nlayer)          ! Recasted zw2
268     
269! TENDENCIES due to various processes :
270
271      ! For Surface Temperature : (K/s)
272      real zdtsurf(ngrid)     ! Cumulated tendencies.
273      real zdtsurfmr(ngrid)   ! Mass_redistribution routine.
274      real zdtsurfc(ngrid)    ! Condense_co2 routine.
275      real zdtsdif(ngrid)     ! Turbdiff/vdifc routines.
276      real zdtsurf_hyd(ngrid) ! Hydrol routine.
277           
278      ! For Atmospheric Temperatures : (K/s)   
279      real dtlscale(ngrid,nlayer)                             ! Largescale routine.
280      real zdtc(ngrid,nlayer)                                 ! Condense_co2 routine.
281      real zdtdif(ngrid,nlayer)                               ! Turbdiff/vdifc routines.
282      real zdttherm(ngrid,nlayer)                             ! Calltherm routine.
283      real zdtmr(ngrid,nlayer)                                ! Mass_redistribution routine.
284      real zdtrain(ngrid,nlayer)                              ! Rain routine.
285      real dtmoist(ngrid,nlayer)                              ! Moistadj routine.
286      real dt_ekman(ngrid,noceanmx), dt_hdiff(ngrid,noceanmx) ! Slab_ocean routine.
287      real zdtsw1(ngrid,nlayer), zdtlw1(ngrid,nlayer)         ! Callcorrk routine.
288                             
289      ! For Surface Tracers : (kg/m2/s)
290      real dqsurf(ngrid,nq)                 ! Cumulated tendencies.
291      real zdqsurfc(ngrid)                  ! Condense_co2 routine.
292      real zdqsdif(ngrid,nq)                ! Turbdiff/vdifc routines.
293      real zdqssed(ngrid,nq)                ! Callsedim routine.
294      real zdqsurfmr(ngrid,nq)              ! Mass_redistribution routine.
295      real zdqsrain(ngrid), zdqssnow(ngrid) ! Rain routine.
296      real dqs_hyd(ngrid,nq)                ! Hydrol routine.
297      real reevap_precip(ngrid)             ! re-evaporation flux of precipitation (integrated over the atmospheric column)
298                 
299      ! For Tracers : (kg/kg_of_air/s)
300      real zdqc(ngrid,nlayer,nq)      ! Condense_co2 routine.
301      real zdqadj(ngrid,nlayer,nq)    ! Convadj routine.
302      real zdqdif(ngrid,nlayer,nq)    ! Turbdiff/vdifc routines.
303      real zdqevap(ngrid,nlayer)      ! Turbdiff routine.
304      real zdqtherm(ngrid,nlayer,nq)  ! Calltherm routine.
305      real zdqsed(ngrid,nlayer,nq)    ! Callsedim routine.
306      real zdqmr(ngrid,nlayer,nq)     ! Mass_redistribution routine.
307      real zdqrain(ngrid,nlayer,nq)   ! Rain routine.
308      real dqmoist(ngrid,nlayer,nq)   ! Moistadj routine.
309      real dqvaplscale(ngrid,nlayer)  ! Largescale routine.
310      real dqcldlscale(ngrid,nlayer)  ! Largescale routine.
311      REAL zdqchim(ngrid,nlayer,nq)   ! Calchim_asis routine
312      REAL zdqschim(ngrid,nq)         ! Calchim_asis routine
313
314      REAL array_zero1(ngrid)
315      REAL array_zero2(ngrid,nlayer)
316                       
317      ! For Winds : (m/s/s)
318      real zdvadj(ngrid,nlayer), zduadj(ngrid,nlayer)       ! Convadj routine.
319      real zdutherm(ngrid,nlayer), zdvtherm(ngrid,nlayer)   ! Calltherm routine.
320      real zdumr(ngrid,nlayer), zdvmr(ngrid,nlayer)         ! Mass_redistribution routine.
321      real zdvdif(ngrid,nlayer), zdudif(ngrid,nlayer)       ! Turbdiff/vdifc routines.
322      real zdhdif(ngrid,nlayer)                             ! Turbdiff/vdifc routines.
323      real zdhadj(ngrid,nlayer)                             ! Convadj routine.
324     
325      ! For Pressure and Mass :
326      real zdmassmr(ngrid,nlayer) ! Atmospheric Mass tendency for mass_redistribution (kg_of_air/m2/s).
327      real zdmassmr_col(ngrid)    ! Atmospheric Column Mass tendency for mass_redistribution (kg_of_air/m2/s).
328      real zdpsrfmr(ngrid)        ! Pressure tendency for mass_redistribution routine (Pa/s).
329
330     
331   
332! Local variables for LOCAL CALCULATIONS:
333! ---------------------------------------
334      real zflubid(ngrid)
335      real zplanck(ngrid),zpopsk(ngrid,nlayer)
336      real ztim1,ztim2,ztim3, z1,z2
337      real ztime_fin
338      real zdh(ngrid,nlayer)
339      real gmplanet
340      real taux(ngrid),tauy(ngrid)
341
342
343! local variables for DIAGNOSTICS : (diagfi & stat)
344! -------------------------------------------------
345      real ps(ngrid)                                     ! Surface Pressure.
346      real zt(ngrid,nlayer)                              ! Atmospheric Temperature.
347      real zu(ngrid,nlayer),zv(ngrid,nlayer)             ! Zonal and Meridional Winds.
348      real zq(ngrid,nlayer,nq)                           ! Atmospheric Tracers.
349      real zdtadj(ngrid,nlayer)                          ! Convadj Diagnostic.
350      real zdtdyn(ngrid,nlayer)                          ! Dynamical Heating (K/s).
351      real zdudyn(ngrid,nlayer)                          ! Dynamical Zonal Wind tendency (m.s-2).
352
353      real reff(ngrid,nlayer)                       ! Effective dust radius (used if doubleq=T).
354      real vmr(ngrid,nlayer)                        ! volume mixing ratio
355      real time_phys
356     
357      real ISR,ASR,OLR,GND,DYN,GSR,Ts1,Ts2,Ts3,TsS ! for Diagnostic.
358     
359      real qcol(ngrid,nq) ! Tracer Column Mass (kg/m2).
360
361!     included by RW for H2O Manabe scheme
362      real rneb_man(ngrid,nlayer) ! H2O cloud fraction (moistadj).
363      real rneb_lsc(ngrid,nlayer) ! H2O cloud fraction (large scale).
364
365
366!     to test energy conservation (RW+JL)
367      real mass(ngrid,nlayer),massarea(ngrid,nlayer)
368      real dEtot, dEtots, AtmToSurf_TurbFlux
369      real,save :: dEtotSW, dEtotsSW, dEtotLW, dEtotsLW
370!$OMP THREADPRIVATE(dEtotSW, dEtotsSW, dEtotLW, dEtotsLW)
371      real dEzRadsw(ngrid,nlayer),dEzRadlw(ngrid,nlayer),dEzdiff(ngrid,nlayer)
372      real dEdiffs(ngrid),dEdiff(ngrid)
373      real madjdE(ngrid), lscaledE(ngrid),madjdEz(ngrid,nlayer), lscaledEz(ngrid,nlayer)
374     
375!JL12 conservation test for mean flow kinetic energy has been disabled temporarily
376
377      real dtmoist_max,dtmoist_min     
378      real dItot, dItot_tmp, dVtot, dVtot_tmp
379
380
381      real h2otot                      ! Total Amount of water. For diagnostic.
382      real icesrf,liqsrf,icecol,vapcol ! Total Amounts of water (ice,liq,vap). For diagnostic.
383      real dWtot, dWtot_tmp, dWtots, dWtots_tmp
384      logical,save :: watertest
385!$OMP THREADPRIVATE(watertest)
386
387      real qsat(ngrid,nlayer) ! Water Vapor Volume Mixing Ratio at saturation (kg/kg_of_air).
388      real RH(ngrid,nlayer)   ! Relative humidity.
389      real H2Omaxcol(ngrid)   ! Maximum possible H2O column amount (at 100% saturation) (kg/m2).
390      real psat_tmp
391     
392      logical clearsky ! For double radiative transfer call. By BC
393     
394      ! For Clear Sky Case.
395      real fluxsurf_lw1(ngrid), fluxsurf_sw1(ngrid), fluxsurfabs_sw1(ngrid)  ! For SW/LW flux.
396      real fluxtop_lw1(ngrid), fluxabs_sw1(ngrid)                            ! For SW/LW flux.
397      real albedo_equivalent1(ngrid)                                         ! For Equivalent albedo calculation.
398      real tau_col1(ngrid)                                                   ! For aerosol optical depth diagnostic.
399      real OLR_nu1(ngrid,L_NSPECTI), OSR_nu1(ngrid,L_NSPECTV)                ! For Outgoing Radiation diagnostics.
400      real int_dtaui1(ngrid,nlayer,L_NSPECTI),int_dtauv1(ngrid,nlayer,L_NSPECTV) ! For optical thickness diagnostics.
401      real tf, ntf
402
403      real nconsMAX, vdifcncons(ngrid), cadjncons(ngrid) ! Vdfic water conservation test. By RW
404
405      real muvar(ngrid,nlayer+1) ! For Runaway Greenhouse 1D study. By RW
406
407      real reffcol(ngrid,naerkind)
408
409!     Sourceevol for 'accelerated ice evolution'. By RW
410      real delta_ice,ice_tot
411      integer num_run
412      logical,save :: ice_update
413!  Non-oro GW tendencies
414      REAL d_u_hin(ngrid,nlayer), d_v_hin(ngrid,nlayer)
415      REAL d_t_hin(ngrid,nlayer)
416!  Diagnostics 2D of gw_nonoro
417      REAL zustrhi(ngrid), zvstrhi(ngrid)
418
419
420      real :: tsurf2(ngrid)
421      real :: flux_o(ngrid),flux_g(ngrid),fluxgrdocean(ngrid)
422      real :: flux_sens_lat(ngrid)
423      real :: qsurfint(ngrid,nq)
424#ifdef MESOSCALE
425      REAL :: lsf_dt(nlayer)
426      REAL :: lsf_dq(nlayer)
427#endif
428
429      ! Misc
430      character*2 :: str2
431!==================================================================================================
432
433! -----------------
434! I. INITIALISATION
435! -----------------
436
437! --------------------------------
438! I.1   First Call Initialisation.
439! --------------------------------
440      if (firstcall) then
441        ! Allocate saved arrays (except for 1D model, where this has already
442        ! been done)
443#ifndef MESOSCALE
444        if (ngrid>1) call phys_state_var_init(nq)
445#endif
446
447!        Variables set to 0
448!        ~~~~~~~~~~~~~~~~~~
449         dtrad(:,:) = 0.0
450         fluxrad(:) = 0.0
451         tau_col(:) = 0.0
452         zdtsw(:,:) = 0.0
453         zdtlw(:,:) = 0.0
454
455
456!        Initialize aerosol indexes.
457!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~
458         call iniaerosol()
459
460     
461!        Initialize tracer names, indexes and properties.
462!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
463         IF (.NOT.ALLOCATED(noms)) ALLOCATE(noms(nq)) ! (because noms is an argument of physdem1 whether or not tracer is on)
464         if (tracer) then
465            call initracer(ngrid,nq,nametrac)
466            if(photochem) then
467              call ini_conc_mod(ngrid,nlayer)
468            endif
469         endif
470
471#ifdef CPP_XIOS
472        ! Initialize XIOS context
473        write(*,*) "physiq: call wxios_context_init"
474        CALL wxios_context_init
475#endif
476
477!        Read 'startfi.nc' file.
478!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
479#ifndef MESOSCALE
480         call phyetat0(startphy_file,                                 &
481                       ngrid,nlayer,"startfi.nc",0,0,nsoilmx,nq,      &
482                       day_ini,time_phys,tsurf,tsoil,emis,q2,qsurf,   &
483                       cloudfrac,totcloudfrac,hice,                   &
484                       rnat,pctsrf_sic,tslab, tsea_ice,sea_ice)
485#else
486      emis(:)=0.0
487      q2(:,:)=0.0
488      qsurf(:,:)=0.0
489      day_ini = pday
490#endif
491
492#ifndef MESOSCALE
493         if (.not.startphy_file) then
494           ! additionnal "academic" initialization of physics
495           if (is_master) write(*,*) "Physiq: initializing tsurf(:) to pt(:,1) !!"
496           tsurf(:)=pt(:,1)
497           if (is_master) write(*,*) "Physiq: initializing tsoil(:) to pt(:,1) !!"
498           do isoil=1,nsoilmx
499             tsoil(1:ngrid,isoil)=tsurf(1:ngrid)
500           enddo
501           if (is_master) write(*,*) "Physiq: initializing day_ini to pdat !"
502           day_ini=pday
503         endif
504#endif
505         if (pday.ne.day_ini) then
506             write(*,*) "ERROR in physiq.F90:"
507             write(*,*) "bad synchronization between physics and dynamics"
508             write(*,*) "dynamics day: ",pday
509             write(*,*) "physics day:  ",day_ini
510             stop
511         endif
512
513         write (*,*) 'In physiq day_ini =', day_ini
514
515!        Initialize albedo calculation.
516!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
517         albedo(:,:)=0.0
518          albedo_bareground(:)=0.0
519          albedo_snow_SPECTV(:)=0.0
520          albedo_co2_ice_SPECTV(:)=0.0
521         call surfini(ngrid,nq,qsurf,albedo,albedo_bareground,albedo_snow_SPECTV,albedo_co2_ice_SPECTV)
522         
523!        Initialize orbital calculation.
524!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
525         call iniorbit(apoastr,periastr,year_day,peri_day,obliquit)
526
527
528         if(tlocked)then
529            print*,'Planet is tidally locked at resonance n=',nres
530            print*,'Make sure you have the right rotation rate!!!'
531         endif
532
533!        Initialize oceanic variables.
534!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
535
536         if (ok_slab_ocean)then
537
538           call ocean_slab_init(ngrid,ptimestep, tslab, &
539                                sea_ice, pctsrf_sic)
540
541           call ini_surf_heat_transp_mod()
542           
543           knindex(:) = 0
544
545           do ig=1,ngrid
546              zmasq(ig)=1
547              knindex(ig) = ig
548              if (nint(rnat(ig)).eq.0) then
549                 zmasq(ig)=0
550              endif
551           enddo
552
553           CALL init_masquv(ngrid,zmasq)
554
555         endif ! end of 'ok_slab_ocean'.
556
557
558!        Initialize soil.
559!        ~~~~~~~~~~~~~~~~
560         if (callsoil) then
561         
562            call soil(ngrid,nsoilmx,firstcall,lastcall,inertiedat, &
563                      ptimestep,tsurf,tsoil,capcal,fluxgrd)
564
565            if (ok_slab_ocean) then
566               do ig=1,ngrid
567                  if (nint(rnat(ig)).eq.2) then
568                     capcal(ig)=capcalocean
569                     if (pctsrf_sic(ig).gt.0.5) then
570                        capcal(ig)=capcalseaice
571                        if (qsurf(ig,igcm_h2o_ice).gt.0.) then
572                           capcal(ig)=capcalsno
573                        endif
574                     endif
575                  endif
576               enddo
577            endif ! end of 'ok_slab_ocean'.
578
579         else ! else of 'callsoil'.
580         
581            print*,'WARNING! Thermal conduction in the soil turned off'
582            capcal(:)=1.e6
583            fluxgrd(:)=intheat
584            print*,'Flux from ground = ',intheat,' W m^-2'
585           
586         endif ! end of 'callsoil'.
587         
588         icount=1
589
590!        Decide whether to update ice at end of run.
591!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
592         ice_update=.false.
593         if(sourceevol)then
594!$OMP MASTER
595            open(128,file='num_run',form='formatted', &
596                     status="old",iostat=ierr)
597            if (ierr.ne.0) then
598               write(*,*) "physiq: Error! No num_run file!"
599               write(*,*) " (which is needed for sourceevol option)"
600               stop
601            endif
602            read(128,*) num_run
603            close(128)
604!$OMP END MASTER
605!$OMP BARRIER
606       
607            if(num_run.ne.0.and.mod(num_run,2).eq.0)then
608               print*,'Updating ice at end of this year!'
609               ice_update=.true.
610               ice_min(:)=1.e4
611            endif
612           
613         endif ! end of 'sourceevol'.
614
615
616         ! Here is defined the type of the surface : Continent or Ocean.
617         ! BC2014 : This is now already done in newstart.
618         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
619         if (.not.ok_slab_ocean) then
620         
621           rnat(:)=1.
622           do ig=1,ngrid
623              if(inertiedat(ig,1).gt.1.E4)then
624                 rnat(ig)=0
625              endif
626           enddo
627
628           print*,'WARNING! Surface type currently decided by surface inertia'
629           print*,'This should be improved e.g. in newstart.F'
630           
631         endif ! end of 'ok_slab_ocean'.
632
633
634!        Initialize surface history variable.
635!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
636         qsurf_hist(:,:)=qsurf(:,:)
637
638!        Initialize variable for dynamical heating and zonal wind tendency diagnostic
639!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
640         ztprevious(:,:)=pt(:,:)
641         zuprevious(:,:)=pu(:,:)
642
643!        Set temperature just above condensation temperature (for Early Mars)
644!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
645         if(nearco2cond) then
646            write(*,*)' WARNING! Starting at Tcond+1K'
647            do l=1, nlayer
648               do ig=1,ngrid
649                  pdt(ig,l)= ((-3167.8)/(log(.01*pplay(ig,l))-23.23)+4     &
650                      -pt(ig,l)) / ptimestep
651               enddo
652            enddo
653         endif
654
655         if(meanOLR)then         
656            call system('rm -f rad_bal.out') ! to record global radiative balance.           
657            call system('rm -f tem_bal.out') ! to record global mean/max/min temperatures.           
658            call system('rm -f h2o_bal.out') ! to record global hydrological balance.
659         endif
660
661
662         watertest=.false.       
663         if(water)then ! Initialize variables for water cycle
664           
665            if(enertest)then
666               watertest = .true.
667            endif
668
669            if(ice_update)then
670               ice_initial(:)=qsurf(:,igcm_h2o_ice)
671            endif
672
673         endif
674         
675!        Set some parameters for the thermal plume model
676!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
677         if (calltherm) then
678            CALL init_thermcell_mod(g, rcp, r, pi, T_h2o_ice_liq, RV)
679         endif
680         
681         call su_watercycle ! even if we don't have a water cycle, we might
682                            ! need epsi for the wvp definitions in callcorrk.F
683                            ! or RETV, RLvCp for the thermal plume model
684#ifndef MESOSCALE
685         if (ngrid.ne.1) then ! Note : no need to create a restart file in 1d.
686            call physdem0("restartfi.nc",longitude,latitude,nsoilmx,ngrid,nlayer,nq, &
687                         ptimestep,pday+nday,time_phys,cell_area,          &
688                         albedo_bareground,inertiedat,zmea,zstd,zsig,zgam,zthe)
689         endif
690#endif         
691         
692         ! XIOS outputs
693#ifdef CPP_XIOS
694
695         write(*,*) "physiq: call initialize_xios_output"
696         call initialize_xios_output(pday,ptime,ptimestep,daysec, &
697                                     presnivs,pseudoalt)
698#endif
699         write(*,*) "physiq: end of firstcall"
700      endif ! end of 'firstcall'
701
702! ------------------------------------------------------
703! I.2   Initializations done at every physical timestep:
704! ------------------------------------------------------
705
706#ifdef CPP_XIOS     
707      ! update XIOS time/calendar
708      call update_xios_timestep
709#endif     
710
711      ! Initialize various variables
712      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
713     
714      if ( .not.nearco2cond ) then
715         pdt(1:ngrid,1:nlayer) = 0.0
716      endif     
717      zdtsurf(1:ngrid)      = 0.0
718      pdq(1:ngrid,1:nlayer,1:nq) = 0.0
719      dqsurf(1:ngrid,1:nq)= 0.0
720      pdu(1:ngrid,1:nlayer) = 0.0
721      pdv(1:ngrid,1:nlayer) = 0.0
722      pdpsrf(1:ngrid)       = 0.0
723      zflubid(1:ngrid)      = 0.0     
724      flux_sens_lat(1:ngrid) = 0.0
725      taux(1:ngrid) = 0.0
726      tauy(1:ngrid) = 0.0
727
728      zday=pday+ptime ! Compute time, in sols (and fraction thereof).
729
730      ! Compute Stellar Longitude (Ls), and orbital parameters.
731      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
732      if (season) then
733         call stellarlong(zday,zls)
734      else
735         call stellarlong(noseason_day,zls)
736      end if
737
738      call orbite(zls,dist_star,declin,right_ascen)
739     
740      if (tlocked) then
741              zlss=Mod(-(2.*pi*(zday/year_day)*nres - right_ascen),2.*pi)
742      elseif (diurnal) then
743              zlss=-2.*pi*(zday-.5)
744      else if(diurnal .eqv. .false.) then
745              zlss=9999.
746      endif
747
748
749      ! Compute variations of g with latitude (oblate case).
750      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
751      if (oblate .eqv. .false.) then     
752         glat(:) = g         
753      else if (flatten .eq. 0.0 .or. J2 .eq. 0.0 .or. Rmean .eq. 0.0 .or. MassPlanet .eq. 0.0) then     
754         print*,'I need values for flatten, J2, Rmean and MassPlanet to compute glat (else set oblate=.false.)'
755         call abort
756      else
757         gmplanet = MassPlanet*grav*1e24
758         do ig=1,ngrid
759            glat(ig)= gmplanet/(Rmean**2) * (1.D0 + 0.75 *J2 - 2.0*flatten/3. + (2.*flatten - 15./4.* J2) * cos(2. * (pi/2. - latitude(ig))))
760         end do
761      endif
762
763      ! Compute geopotential between layers.
764      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
765      zzlay(1:ngrid,1:nlayer)=pphi(1:ngrid,1:nlayer)
766      do l=1,nlayer         
767         zzlay(1:ngrid,l)= zzlay(1:ngrid,l)/glat(1:ngrid)
768      enddo
769
770      zzlev(1:ngrid,1)=0.
771      zzlev(1:ngrid,nlayer+1)=1.e7 ! Dummy top of last layer above 10000 km...
772
773      do l=2,nlayer
774         do ig=1,ngrid
775            z1=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
776            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
777            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
778         enddo
779      enddo     
780
781      ! Compute potential temperature
782      ! Note : Potential temperature calculation may not be the same in physiq and dynamic...
783      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
784      do l=1,nlayer         
785         do ig=1,ngrid
786            zpopsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**rcp
787            zh(ig,l)=pt(ig,l)/zpopsk(ig,l)
788            mass(ig,l)  = (pplev(ig,l) - pplev(ig,l+1))/glat(ig)
789            massarea(ig,l)=mass(ig,l)*cell_area(ig)
790         enddo
791      enddo
792
793     ! Compute vertical velocity (m/s) from vertical mass flux
794     ! w = F / (rho*area) and rho = P/(r*T)
795     ! But first linearly interpolate mass flux to mid-layers
796      do l=1,nlayer-1
797         pw(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1))
798      enddo
799      pw(1:ngrid,nlayer)=0.5*flxw(1:ngrid,nlayer) ! since flxw(nlayer+1)=0
800      do l=1,nlayer
801         pw(1:ngrid,l)=(pw(1:ngrid,l)*r*pt(1:ngrid,l)) /  &
802                       (pplay(1:ngrid,l)*cell_area(1:ngrid))
803      enddo
804      ! omega in Pa/s
805      do l=1,nlayer-1
806         omega(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1))
807      enddo
808      omega(1:ngrid,nlayer)=0.5*flxw(1:ngrid,nlayer) ! since flxw(nlayer+1)=0
809      do l=1,nlayer
810         omega(1:ngrid,l)=g*omega(1:ngrid,l)/cell_area(1:ngrid)
811      enddo
812
813      ! ----------------------------------------------------------------
814      ! Compute mean mass, cp, and R
815      ! --------------------------------
816#ifndef MESOSCALE
817      if(photochem) then
818         call concentrations(ngrid,nlayer,nq,pplay,pt,pdt,pq,pdq,ptimestep)
819      endif
820#endif
821
822!---------------------------------
823! II. Compute radiative tendencies
824!---------------------------------
825
826      if (callrad) then
827         if( mod(icount-1,iradia).eq.0.or.lastcall) then
828
829          ! Compute local stellar zenith angles
830          ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
831            if (tlocked) then
832            ! JL14 corrects tidally resonant (and inclined) cases. nres=omega_rot/omega_orb
833               ztim1=SIN(declin)
834               ztim2=COS(declin)*COS(zlss)
835               ztim3=COS(declin)*SIN(zlss)
836
837               call stelang(ngrid,sinlon,coslon,sinlat,coslat,    &
838                            ztim1,ztim2,ztim3,mu0,fract, flatten)
839
840            elseif (diurnal) then
841               ztim1=SIN(declin)
842               ztim2=COS(declin)*COS(2.*pi*(zday-.5))
843               ztim3=-COS(declin)*SIN(2.*pi*(zday-.5))
844
845               call stelang(ngrid,sinlon,coslon,sinlat,coslat,    &
846                            ztim1,ztim2,ztim3,mu0,fract, flatten)
847            else if(diurnal .eqv. .false.) then
848
849               call mucorr(ngrid,declin,latitude,mu0,fract,10000.,rad,flatten)
850               ! WARNING: this function appears not to work in 1D
851
852            endif
853           
854            ! Eclipse incoming sunlight (e.g. Saturn ring shadowing).       
855            if(rings_shadow) then
856                call call_rings(ngrid, ptime, pday, diurnal)
857            endif   
858
859
860            if (corrk) then
861           
862! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
863! II.a Call correlated-k radiative transfer scheme
864! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
865               if(kastprof)then
866                  print*,'kastprof should not = true here'
867                  call abort
868               endif
869               if(water) then
870                  muvar(1:ngrid,1:nlayer)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,1:nlayer,igcm_h2o_vap))
871                  muvar(1:ngrid,nlayer+1)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,nlayer,igcm_h2o_vap))
872                  ! take into account water effect on mean molecular weight
873               else
874                  muvar(1:ngrid,1:nlayer+1)=mugaz
875               endif
876     
877
878               if(ok_slab_ocean) then
879                  tsurf2(:)=tsurf(:)
880                  do ig=1,ngrid
881                     if (nint(rnat(ig))==0) then
882                        tsurf(ig)=((1.-pctsrf_sic(ig))*tslab(ig,1)**4+pctsrf_sic(ig)*tsea_ice(ig)**4)**0.25
883                     endif
884                  enddo
885               endif !(ok_slab_ocean)
886               
887               ! standard callcorrk
888               clearsky=.false.
889               call callcorrk(ngrid,nlayer,pq,nq,qsurf,                           &
890                              albedo,albedo_equivalent,emis,mu0,pplev,pplay,pt,   &
891                              tsurf,fract,dist_star,aerosol,muvar,                &
892                              zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,                &
893                              fluxsurfabs_sw,fluxtop_lw,                          &
894                              fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu,                &
895                              int_dtaui,int_dtauv,                                &
896                              tau_col,cloudfrac,totcloudfrac,                     &
897                              clearsky,firstcall,lastcall)     
898
899                ! Option to call scheme once more for clear regions 
900               if(CLFvarying)then
901
902                  ! ---> PROBLEMS WITH ALLOCATED ARRAYS : temporary solution in callcorrk: do not deallocate if CLFvarying ...
903                  clearsky=.true.
904                  call callcorrk(ngrid,nlayer,pq,nq,qsurf,                           &
905                                 albedo,albedo_equivalent1,emis,mu0,pplev,pplay,pt,   &
906                                 tsurf,fract,dist_star,aerosol,muvar,                &
907                                 zdtlw1,zdtsw1,fluxsurf_lw1,fluxsurf_sw1,            &
908                                 fluxsurfabs_sw1,fluxtop_lw1,                        &
909                                 fluxabs_sw1,fluxtop_dn,OLR_nu1,OSR_nu1,             &
910                                 int_dtaui1,int_dtauv1,                              &
911                                 tau_col1,cloudfrac,totcloudfrac,                    &
912                                 clearsky,firstcall,lastcall)
913                  clearsky = .false.  ! just in case.     
914
915                  ! Sum the fluxes and heating rates from cloudy/clear cases
916                  do ig=1,ngrid
917                     tf=totcloudfrac(ig)
918                     ntf=1.-tf                   
919                     fluxsurf_lw(ig)       = ntf*fluxsurf_lw1(ig)       + tf*fluxsurf_lw(ig)
920                     fluxsurf_sw(ig)       = ntf*fluxsurf_sw1(ig)       + tf*fluxsurf_sw(ig)
921                     albedo_equivalent(ig) = ntf*albedo_equivalent1(ig) + tf*albedo_equivalent(ig)
922                     fluxsurfabs_sw(ig)    = ntf*fluxsurfabs_sw1(ig)    + tf*fluxsurfabs_sw(ig)
923                     fluxtop_lw(ig)        = ntf*fluxtop_lw1(ig)        + tf*fluxtop_lw(ig)
924                     fluxabs_sw(ig)        = ntf*fluxabs_sw1(ig)        + tf*fluxabs_sw(ig)
925                     tau_col(ig)           = ntf*tau_col1(ig)           + tf*tau_col(ig)
926                   
927                     zdtlw(ig,1:nlayer) = ntf*zdtlw1(ig,1:nlayer) + tf*zdtlw(ig,1:nlayer)
928                     zdtsw(ig,1:nlayer) = ntf*zdtsw1(ig,1:nlayer) + tf*zdtsw(ig,1:nlayer)
929
930                     OSR_nu(ig,1:L_NSPECTV) = ntf*OSR_nu1(ig,1:L_NSPECTV) + tf*OSR_nu(ig,1:L_NSPECTV)                       
931                     OLR_nu(ig,1:L_NSPECTI) = ntf*OLR_nu1(ig,1:L_NSPECTI) + tf*OLR_nu(ig,1:L_NSPECTI)                       
932                     int_dtauv(ig,:,1:L_NSPECTV) = ntf*int_dtauv1(ig,:,1:L_NSPECTV) + tf*int_dtauv(ig,:,1:L_NSPECTV)                       
933                     int_dtaui(ig,:,1:L_NSPECTI) = ntf*int_dtaui1(ig,:,1:L_NSPECTI) + tf*int_dtaui(ig,:,1:L_NSPECTI)                       
934                  enddo                               
935
936               endif ! end of CLFvarying.
937
938               if(ok_slab_ocean) then
939                  tsurf(:)=tsurf2(:)
940               endif
941
942
943               ! Radiative flux from the sky absorbed by the surface (W.m-2).
944               GSR=0.0
945               fluxrad_sky(1:ngrid)=emis(1:ngrid)*fluxsurf_lw(1:ngrid)+fluxsurfabs_sw(1:ngrid)
946
947                            !if(noradsurf)then ! no lower surface; SW flux just disappears
948                            !   GSR = SUM(fluxsurf_sw(1:ngrid)*cell_area(1:ngrid))/totarea
949                            !   fluxrad_sky(1:ngrid)=emis(1:ngrid)*fluxsurf_lw(1:ngrid)
950                            !   print*,'SW lost in deep atmosphere = ',GSR,' W m^-2'
951                            !endif
952
953               ! Net atmospheric radiative heating rate (K.s-1)
954               dtrad(1:ngrid,1:nlayer)=zdtsw(1:ngrid,1:nlayer)+zdtlw(1:ngrid,1:nlayer)
955               
956               ! Late initialization of the Ice Spectral Albedo. We needed the visible bands to do that !
957               if (firstcall .and. albedo_spectral_mode) then
958                  call spectral_albedo_calc(albedo_snow_SPECTV)
959               endif
960
961            elseif(newtonian)then
962           
963! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
964! II.b Call Newtonian cooling scheme
965! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
966               call newtrelax(ngrid,nlayer,mu0,sinlat,zpopsk,pt,pplay,pplev,dtrad,firstcall)
967
968               zdtsurf(1:ngrid) = +(pt(1:ngrid,1)-tsurf(1:ngrid))/ptimestep
969               ! e.g. surface becomes proxy for 1st atmospheric layer ?
970
971            else
972           
973! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
974! II.c Atmosphere has no radiative effect
975! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
976               fluxtop_dn(1:ngrid)  = fract(1:ngrid)*mu0(1:ngrid)*Fat1AU/dist_star**2
977               if(ngrid.eq.1)then ! / by 4 globally in 1D case...
978                  fluxtop_dn(1)  = fract(1)*Fat1AU/dist_star**2/2.0
979               endif
980               fluxsurf_sw(1:ngrid) = fluxtop_dn(1:ngrid)
981               print*,'------------WARNING---WARNING------------' ! by MT2015.
982               print*,'You are in corrk=false mode, '
983               print*,'and the surface albedo is taken equal to the first visible spectral value'               
984               
985               fluxsurfabs_sw(1:ngrid) = fluxtop_dn(1:ngrid)*(1.-albedo(1:ngrid,1))
986               fluxrad_sky(1:ngrid)    = fluxsurfabs_sw(1:ngrid)
987               fluxtop_lw(1:ngrid)  = emis(1:ngrid)*sigma*tsurf(1:ngrid)**4
988
989               dtrad(1:ngrid,1:nlayer)=0.0 ! no atmospheric radiative heating
990
991            endif ! end of corrk
992
993         endif ! of if(mod(icount-1,iradia).eq.0)
994       
995
996         ! Transformation of the radiative tendencies
997         ! ------------------------------------------
998         zplanck(1:ngrid)=tsurf(1:ngrid)*tsurf(1:ngrid)
999         zplanck(1:ngrid)=emis(1:ngrid)*sigma*zplanck(1:ngrid)*zplanck(1:ngrid)
1000         fluxrad(1:ngrid)=fluxrad_sky(1:ngrid)-zplanck(1:ngrid)
1001         pdt(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)+dtrad(1:ngrid,1:nlayer)
1002         
1003         ! Test of energy conservation
1004         !----------------------------
1005         if(enertest)then
1006            call planetwide_sumval(cpp*massarea(:,:)*zdtsw(:,:)/totarea_planet,dEtotSW)
1007            call planetwide_sumval(cpp*massarea(:,:)*zdtlw(:,:)/totarea_planet,dEtotLW)
1008            !call planetwide_sumval(fluxsurf_sw(:)*(1.-albedo_equivalent(:))*cell_area(:)/totarea_planet,dEtotsSW) !JL13 carefull, albedo can have changed since the last time we called corrk
1009            call planetwide_sumval(fluxsurfabs_sw(:)*cell_area(:)/totarea_planet,dEtotsSW) !JL13 carefull, albedo can have changed since the last time we called corrk
1010            call planetwide_sumval((fluxsurf_lw(:)*emis(:)-zplanck(:))*cell_area(:)/totarea_planet,dEtotsLW)
1011            dEzRadsw(:,:)=cpp*mass(:,:)*zdtsw(:,:)
1012            dEzRadlw(:,:)=cpp*mass(:,:)*zdtlw(:,:)
1013            if (is_master) then
1014               print*,'---------------------------------------------------------------'
1015               print*,'In corrk SW atmospheric heating       =',dEtotSW,' W m-2'
1016               print*,'In corrk LW atmospheric heating       =',dEtotLW,' W m-2'
1017               print*,'atmospheric net rad heating (SW+LW)   =',dEtotLW+dEtotSW,' W m-2'
1018               print*,'In corrk SW surface heating           =',dEtotsSW,' W m-2'
1019               print*,'In corrk LW surface heating           =',dEtotsLW,' W m-2'
1020               print*,'surface net rad heating (SW+LW)       =',dEtotsLW+dEtotsSW,' W m-2'
1021            endif
1022         endif ! end of 'enertest'
1023
1024      endif ! of if (callrad)
1025
1026
1027
1028!  --------------------------------------------
1029!  III. Vertical diffusion (turbulent mixing) :
1030!  --------------------------------------------
1031
1032      if (calldifv) then
1033     
1034         zflubid(1:ngrid)=fluxrad(1:ngrid)+fluxgrd(1:ngrid)
1035
1036         ! JL12 the following if test is temporarily there to allow us to compare the old vdifc with turbdiff.
1037         if (UseTurbDiff) then
1038         
1039            call turbdiff(ngrid,nlayer,nq,rnat,                  &
1040                          ptimestep,capcal,lwrite,               &
1041                          pplay,pplev,zzlay,zzlev,z0,            &
1042                          pu,pv,pt,zpopsk,pq,tsurf,emis,qsurf,   &
1043                          pdt,pdq,zflubid,                       &
1044                          zdudif,zdvdif,zdtdif,zdtsdif,          &
1045                          sensibFlux,q2,zdqdif,zdqevap,zdqsdif,  &
1046                          taux,tauy,lastcall)
1047
1048         else
1049         
1050            zdh(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)/zpopsk(1:ngrid,1:nlayer)
1051 
1052            call vdifc(ngrid,nlayer,nq,rnat,zpopsk,           &
1053                       ptimestep,capcal,lwrite,               &
1054                       pplay,pplev,zzlay,zzlev,z0,            &
1055                       pu,pv,zh,pq,tsurf,emis,qsurf,          &
1056                       zdh,pdq,zflubid,                       &
1057                       zdudif,zdvdif,zdhdif,zdtsdif,          &
1058                       sensibFlux,q2,zdqdif,zdqsdif,          &
1059                       taux,tauy,lastcall)
1060
1061            zdtdif(1:ngrid,1:nlayer)=zdhdif(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) ! for diagnostic only
1062            zdqevap(1:ngrid,1:nlayer)=0.
1063
1064         end if !end of 'UseTurbDiff'
1065
1066         zdtsurf(1:ngrid)=zdtsurf(1:ngrid)+zdtsdif(1:ngrid)
1067
1068         !!! this is always done, except for turbulence-resolving simulations
1069         if (.not. turb_resolved) then
1070           pdv(1:ngrid,1:nlayer)=pdv(1:ngrid,1:nlayer)+zdvdif(1:ngrid,1:nlayer)
1071           pdu(1:ngrid,1:nlayer)=pdu(1:ngrid,1:nlayer)+zdudif(1:ngrid,1:nlayer)
1072           pdt(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)+zdtdif(1:ngrid,1:nlayer)
1073         endif
1074
1075         if(ok_slab_ocean)then
1076            flux_sens_lat(1:ngrid)=(zdtsdif(1:ngrid)*capcal(1:ngrid)-fluxrad(1:ngrid))
1077         endif
1078
1079
1080         if (tracer) then
1081           pdq(1:ngrid,1:nlayer,1:nq)=pdq(1:ngrid,1:nlayer,1:nq)+ zdqdif(1:ngrid,1:nlayer,1:nq)
1082           dqsurf(1:ngrid,1:nq)=dqsurf(1:ngrid,1:nq) + zdqsdif(1:ngrid,1:nq)
1083         end if ! of if (tracer)
1084
1085
1086         ! test energy conservation
1087         !-------------------------
1088         if(enertest)then
1089         
1090            dEzdiff(:,:)=cpp*mass(:,:)*zdtdif(:,:)
1091            do ig = 1, ngrid
1092               dEdiff(ig)=SUM(dEzdiff (ig,:))+ sensibFlux(ig)! subtract flux to the ground
1093               dEzdiff(ig,1)= dEzdiff(ig,1)+ sensibFlux(ig)! subtract flux to the ground
1094            enddo
1095           
1096            call planetwide_sumval(dEdiff(:)*cell_area(:)/totarea_planet,dEtot)
1097            dEdiffs(:)=capcal(:)*zdtsdif(:)-zflubid(:)-sensibFlux(:)
1098            call planetwide_sumval(dEdiffs(:)*cell_area(:)/totarea_planet,dEtots)
1099            call planetwide_sumval(sensibFlux(:)*cell_area(:)/totarea_planet,AtmToSurf_TurbFlux)
1100           
1101            if (is_master) then
1102           
1103               if (UseTurbDiff) then
1104                         print*,'In TurbDiff sensible flux (atm=>surf) =',AtmToSurf_TurbFlux,' W m-2'
1105                         print*,'In TurbDiff non-cons atm nrj change   =',dEtot,' W m-2'
1106                  print*,'In TurbDiff (correc rad+latent heat) surf nrj change =',dEtots,' W m-2'
1107               else
1108                         print*,'In vdifc sensible flux (atm=>surf)    =',AtmToSurf_TurbFlux,' W m-2'
1109                         print*,'In vdifc non-cons atm nrj change      =',dEtot,' W m-2'
1110                         print*,'In vdifc (correc rad+latent heat) surf nrj change =',dEtots,' W m-2'
1111               end if
1112            endif ! end of 'is_master'
1113           
1114         ! JL12 : note that the black body radiative flux emitted by the surface has been updated by the implicit scheme but not given back elsewhere.
1115         endif ! end of 'enertest'
1116
1117
1118         ! Test water conservation.
1119         if(watertest.and.water)then
1120         
1121            call planetwide_sumval(massarea(:,:)*zdqdif(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dWtot_tmp)
1122            call planetwide_sumval(zdqsdif(:,igcm_h2o_vap)*cell_area(:)*ptimestep/totarea_planet,dWtots_tmp)
1123            do ig = 1, ngrid
1124               vdifcncons(ig)=SUM(mass(ig,:)*zdqdif(ig,:,igcm_h2o_vap))
1125            enddo
1126            call planetwide_sumval(massarea(:,:)*zdqdif(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot)
1127            call planetwide_sumval(zdqsdif(:,igcm_h2o_ice)*cell_area(:)*ptimestep/totarea_planet,dWtots)
1128            dWtot = dWtot + dWtot_tmp
1129            dWtots = dWtots + dWtots_tmp
1130            do ig = 1, ngrid
1131               vdifcncons(ig)=vdifcncons(ig) + SUM(mass(ig,:)*zdqdif(ig,:,igcm_h2o_ice))
1132            enddo           
1133            call planetwide_maxval(vdifcncons(:),nconsMAX)
1134
1135            if (is_master) then
1136               print*,'---------------------------------------------------------------'
1137               print*,'In difv atmospheric water change        =',dWtot,' kg m-2'
1138               print*,'In difv surface water change            =',dWtots,' kg m-2'
1139               print*,'In difv non-cons factor                 =',dWtot+dWtots,' kg m-2'
1140               print*,'In difv MAX non-cons factor             =',nconsMAX,' kg m-2 s-1'
1141            endif
1142
1143         endif ! end of 'watertest'
1144         !-------------------------
1145
1146      else ! calldifv
1147
1148         if(.not.newtonian)then
1149
1150            zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + (fluxrad(1:ngrid) + fluxgrd(1:ngrid))/capcal(1:ngrid)
1151
1152         endif
1153
1154      endif ! end of 'calldifv'
1155
1156
1157!-------------------
1158!   IV. Convection :
1159!-------------------
1160     
1161! ~~~~~~~~~~~~~~~~~~~~~~~~~~
1162! IV.a Thermal plume model :
1163! ~~~~~~~~~~~~~~~~~~~~~~~~~~
1164     
1165      IF (calltherm) THEN
1166         
1167! AB: We need to evaporate ice before calling thermcell_main.
1168         IF (water) THEN
1169            CALL evap(ngrid,nlayer,nq,ptimestep,pt,pq,pdq,pdt,dqevap,dtevap,zqtherm,zttherm)
1170         ELSE
1171            zttherm(:,:)   = pt(:,:)   + pdt(:,:)   * ptimestep
1172            zqtherm(:,:,:) = pq(:,:,:) + pdq(:,:,:) * ptimestep
1173         ENDIF
1174         
1175         CALL thermcell_main(ngrid, nlayer, nq, ptimestep, firstcall,            &
1176                             pplay, pplev, pphi, zpopsk,                         &
1177                             pu, pv, zttherm, zqtherm,                           &
1178                             zdutherm, zdvtherm, zdttherm, zdqtherm,             &
1179                             fm, entr, detr, zw2, fraca)
1180         
1181         pdu(1:ngrid,1:nlayer) = pdu(1:ngrid,1:nlayer) + zdutherm(1:ngrid,1:nlayer)
1182         pdv(1:ngrid,1:nlayer) = pdv(1:ngrid,1:nlayer) + zdvtherm(1:ngrid,1:nlayer)
1183         pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer) + zdttherm(1:ngrid,1:nlayer)
1184         
1185         IF (tracer) THEN
1186            pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqtherm(1:ngrid,1:nlayer,1:nq)
1187         ENDIF
1188         
1189      ENDIF ! end of 'calltherm'
1190     
1191! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1192! IV.b Dry convective adjustment :
1193! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1194
1195      if(calladj) then
1196
1197         zdh(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)/zpopsk(1:ngrid,1:nlayer)
1198         zduadj(1:ngrid,1:nlayer)=0.0
1199         zdvadj(1:ngrid,1:nlayer)=0.0
1200         zdhadj(1:ngrid,1:nlayer)=0.0
1201
1202
1203         call convadj(ngrid,nlayer,nq,ptimestep,            &
1204                      pplay,pplev,zpopsk,                   &
1205                      pu,pv,zh,pq,                          &
1206                      pdu,pdv,zdh,pdq,                      &
1207                      zduadj,zdvadj,zdhadj,                 &
1208                      zdqadj)
1209
1210         pdu(1:ngrid,1:nlayer) = pdu(1:ngrid,1:nlayer) + zduadj(1:ngrid,1:nlayer)
1211         pdv(1:ngrid,1:nlayer) = pdv(1:ngrid,1:nlayer) + zdvadj(1:ngrid,1:nlayer)
1212         pdt(1:ngrid,1:nlayer)    = pdt(1:ngrid,1:nlayer) + zdhadj(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer)
1213         zdtadj(1:ngrid,1:nlayer) = zdhadj(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) ! for diagnostic only
1214
1215         if(tracer) then
1216            pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqadj(1:ngrid,1:nlayer,1:nq)
1217         end if
1218
1219         ! Test energy conservation
1220         if(enertest)then
1221            call planetwide_sumval(cpp*massarea(:,:)*zdtadj(:,:)/totarea_planet,dEtot)
1222            if (is_master) print*,'In convadj atmospheric energy change  =',dEtot,' W m-2'
1223         endif
1224
1225         ! Test water conservation
1226         if(watertest)then
1227            call planetwide_sumval(massarea(:,:)*zdqadj(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dWtot_tmp)
1228            do ig = 1, ngrid
1229               cadjncons(ig)=SUM(mass(ig,:)*zdqadj(ig,:,igcm_h2o_vap))
1230            enddo
1231            call planetwide_sumval(massarea(:,:)*zdqadj(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot)
1232            dWtot = dWtot + dWtot_tmp
1233            do ig = 1, ngrid
1234               cadjncons(ig)=cadjncons(ig) + SUM(mass(ig,:)*zdqadj(ig,:,igcm_h2o_ice))
1235            enddo           
1236            call planetwide_maxval(cadjncons(:),nconsMAX)
1237
1238            if (is_master) then
1239               print*,'In convadj atmospheric water change     =',dWtot,' kg m-2'
1240               print*,'In convadj MAX non-cons factor          =',nconsMAX,' kg m-2 s-1'
1241            endif
1242           
1243         endif ! end of 'watertest'
1244         
1245      endif ! end of 'calladj'
1246!----------------------------------------------
1247!   Non orographic Gravity Waves:
1248!---------------------------------------------
1249      IF (calllott_nonoro) THEN
1250
1251         CALL nonoro_gwd_ran(ngrid,nlayer,ptimestep,pplay,  &
1252                    zmax_th,                                &! max altitude reached by thermals (m)
1253                    pt, pu, pv,                             &
1254                    pdt, pdu, pdv,                          &
1255                    zustrhi,zvstrhi,                        &
1256                    d_t_hin, d_u_hin, d_v_hin)
1257
1258!  Update tendencies
1259         pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)      &
1260                               + d_t_hin(1:ngrid,1:nlayer)
1261!        d_t_hin(:,:)= d_t_hin(:,:)/ptimestep ! K/s (for outputs?)
1262         pdu(1:ngrid,1:nlayer) = pdu(1:ngrid,1:nlayer)      &
1263                               + d_u_hin(1:ngrid,1:nlayer)
1264!        d_u_hin(:,:)= d_u_hin(:,:)/ptimestep ! (m/s)/s (for outputs?)
1265         pdv(1:ngrid,1:nlayer) = pdv(1:ngrid,1:nlayer)      &
1266                               + d_v_hin(1:ngrid,1:nlayer)
1267!        d_v_hin(:,:)= d_v_hin(:,:)/ptimestep ! (m/s)/s (for outputs?)
1268         print*,'du_nonoro: max ', maxval(d_u_hin), 'min ', minval(d_u_hin)
1269         print*,'dv_nonoro: max ', maxval(d_v_hin), 'min ', minval(d_v_hin)
1270
1271      ENDIF ! of IF (calllott_nonoro)
1272
1273
1274     
1275!-----------------------------------------------
1276!   V. Carbon dioxide condensation-sublimation :
1277!-----------------------------------------------
1278
1279      if (co2cond) then
1280     
1281         if (.not.tracer) then
1282            print*,'We need a CO2 ice tracer to condense CO2'
1283            call abort
1284         endif
1285         call condense_co2(ngrid,nlayer,nq,ptimestep,                    &
1286                           capcal,pplay,pplev,tsurf,pt,                  &
1287                           pdt,zdtsurf,pq,pdq,                           &
1288                           qsurf,zdqsurfc,albedo,emis,                   &
1289                           albedo_bareground,albedo_co2_ice_SPECTV,      &
1290                           zdtc,zdtsurfc,pdpsrf,zdqc)
1291
1292         pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+zdtc(1:ngrid,1:nlayer)
1293         zdtsurf(1:ngrid)      = zdtsurf(1:ngrid) + zdtsurfc(1:ngrid)
1294
1295         pdq(1:ngrid,1:nlayer,1:nq)   = pdq(1:ngrid,1:nlayer,1:nq)+ zdqc(1:ngrid,1:nlayer,1:nq)
1296         dqsurf(1:ngrid,igcm_co2_ice) = dqsurf(1:ngrid,igcm_co2_ice) + zdqsurfc(1:ngrid)
1297
1298         ! test energy conservation
1299         if(enertest)then
1300            call planetwide_sumval(cpp*massarea(:,:)*zdtc(:,:)/totarea_planet,dEtot)
1301            call planetwide_sumval(capcal(:)*zdtsurfc(:)*cell_area(:)/totarea_planet,dEtots)
1302            if (is_master) then
1303               print*,'In co2cloud atmospheric energy change   =',dEtot,' W m-2'
1304               print*,'In co2cloud surface energy change       =',dEtots,' W m-2'
1305            endif
1306         endif
1307
1308      endif  ! end of 'co2cond'
1309
1310
1311!---------------------------------------------
1312!   VI. Specific parameterizations for tracers
1313!---------------------------------------------
1314
1315      if (tracer) then
1316     
1317  ! ---------------------
1318  !   VI.1. Water and ice
1319  ! ---------------------
1320         if (water) then
1321           
1322            ! Water ice condensation in the atmosphere
1323            if(watercond.and.(RLVTT.gt.1.e-8))then
1324               
1325               if (.not.calltherm) then
1326                  dqmoist(1:ngrid,1:nlayer,1:nq)=0.
1327                  dtmoist(1:ngrid,1:nlayer)=0.
1328                 
1329                  ! Moist Convective Adjustment.
1330                  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1331                  call moistadj(ngrid,nlayer,nq,pt,pq,pdq,pplev,pplay,dtmoist,dqmoist,ptimestep,rneb_man)
1332               
1333                  pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap)     &
1334                                                     + dqmoist(1:ngrid,1:nlayer,igcm_h2o_vap)
1335                  pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice)     &
1336                                                     + dqmoist(1:ngrid,1:nlayer,igcm_h2o_ice)
1337                  pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+dtmoist(1:ngrid,1:nlayer)
1338                   
1339                  ! Test energy conservation.
1340                  if(enertest)then
1341                     call planetwide_sumval(cpp*massarea(:,:)*dtmoist(:,:)/totarea_planet,dEtot)
1342                     call planetwide_maxval(dtmoist(:,:),dtmoist_max)
1343                     call planetwide_minval(dtmoist(:,:),dtmoist_min)
1344                     madjdEz(:,:)=cpp*mass(:,:)*dtmoist(:,:)
1345                     
1346                     do ig=1,ngrid
1347                        madjdE(ig) = cpp*SUM(mass(:,:)*dtmoist(:,:))
1348                     enddo
1349                     
1350                     if (is_master) then
1351                        print*,'In moistadj atmospheric energy change   =',dEtot,' W m-2'
1352                        print*,'In moistadj MAX atmospheric energy change   =',dtmoist_max*ptimestep,'K/step'
1353                        print*,'In moistadj MIN atmospheric energy change   =',dtmoist_min*ptimestep,'K/step'
1354                     endif
1355                     
1356                     call planetwide_sumval(massarea(:,:)*dqmoist(:,:,igcm_h2o_vap)*ptimestep/totarea_planet+        &
1357                                            massarea(:,:)*dqmoist(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot)
1358                     if (is_master) print*,'In moistadj atmospheric water change    =',dWtot,' kg m-2'
1359                     
1360                  endif ! end of 'enertest'
1361               endif ! end of '.not.calltherm'
1362               
1363               ! Large scale condensation/evaporation.
1364               ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1365               call largescale(ngrid,nlayer,nq,ptimestep,pplev,pplay,pt,pq,pdt,pdq,dtlscale,dqvaplscale,dqcldlscale,rneb_lsc)
1366
1367               pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+dtlscale(1:ngrid,1:nlayer)
1368               pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap)+dqvaplscale(1:ngrid,1:nlayer)
1369               pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice)+dqcldlscale(1:ngrid,1:nlayer)
1370
1371               ! Test energy conservation.
1372               if(enertest)then
1373                  lscaledEz(:,:) = cpp*mass(:,:)*dtlscale(:,:)
1374                  do ig=1,ngrid
1375                     lscaledE(ig) = cpp*SUM(mass(:,:)*dtlscale(:,:))
1376                  enddo
1377                  call planetwide_sumval(cpp*massarea(:,:)*dtlscale(:,:)/totarea_planet,dEtot)
1378
1379                  if (is_master) print*,'In largescale atmospheric energy change =',dEtot,' W m-2'
1380
1381                  ! Test water conservation.
1382                  call planetwide_sumval(massarea(:,:)*dqvaplscale(:,:)*ptimestep/totarea_planet+        &
1383                                           SUM(massarea(:,:)*dqcldlscale(:,:))*ptimestep/totarea_planet,dWtot)
1384                       
1385                  if (is_master) print*,'In largescale atmospheric water change  =',dWtot,' kg m-2'
1386               endif ! end of 'enertest'
1387
1388               ! Compute cloud fraction.
1389               do l = 1, nlayer
1390                  do ig=1,ngrid
1391                     cloudfrac(ig,l)=MAX(rneb_lsc(ig,l),rneb_man(ig,l))
1392                  enddo
1393               enddo
1394
1395            endif ! end of 'watercond'
1396           
1397            ! Water ice / liquid precipitation.
1398            ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1399            zdqrain(1:ngrid,1:nlayer,1:nq) = 0.0  !JL18 need to do that everytimestep if mass redis is on.
1400
1401            if(waterrain)then
1402
1403               zdqsrain(1:ngrid)    = 0.0
1404               zdqssnow(1:ngrid)    = 0.0
1405
1406               call rain(ngrid,nlayer,nq,ptimestep,pplev,pplay,pt,pdt,pq,pdq,            &
1407                         zdtrain,zdqrain,zdqsrain,zdqssnow,reevap_precip,cloudfrac)
1408
1409               pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap) &
1410                                                  + zdqrain(1:ngrid,1:nlayer,igcm_h2o_vap)
1411               pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice) &
1412                                                  + zdqrain(1:ngrid,1:nlayer,igcm_h2o_ice)
1413               pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+zdtrain(1:ngrid,1:nlayer)
1414               
1415               dqsurf(1:ngrid,igcm_h2o_vap) = dqsurf(1:ngrid,igcm_h2o_vap)+zdqsrain(1:ngrid)
1416               dqsurf(1:ngrid,igcm_h2o_ice) = dqsurf(1:ngrid,igcm_h2o_ice)+zdqssnow(1:ngrid)
1417
1418               ! Test energy conservation.
1419               if(enertest)then
1420               
1421                  call planetwide_sumval(cpp*massarea(:,:)*zdtrain(:,:)/totarea_planet,dEtot)
1422                  if (is_master) print*,'In rain atmospheric T energy change       =',dEtot,' W m-2'
1423                  call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_ice)/totarea_planet*RLVTT/cpp,dItot_tmp)
1424                  call planetwide_sumval(cell_area(:)*zdqssnow(:)/totarea_planet*RLVTT/cpp,dItot)
1425                  dItot = dItot + dItot_tmp
1426                  call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dVtot_tmp)
1427                  call planetwide_sumval(cell_area(:)*zdqsrain(:)/totarea_planet*RLVTT/cpp,dVtot)
1428                  dVtot = dVtot + dVtot_tmp
1429                  dEtot = dItot + dVtot
1430                 
1431                  if (is_master) then
1432                     print*,'In rain dItot =',dItot,' W m-2'
1433                     print*,'In rain dVtot =',dVtot,' W m-2'
1434                     print*,'In rain atmospheric L energy change       =',dEtot,' W m-2'
1435                  endif
1436
1437                  ! Test water conservation
1438                  call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_vap)*ptimestep/totarea_planet+        &
1439                          massarea(:,:)*zdqrain(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot)
1440                  call planetwide_sumval((zdqsrain(:)+zdqssnow(:))*cell_area(:)*ptimestep/totarea_planet,dWtots)
1441                 
1442                  if (is_master) then
1443                          print*,'In rain atmospheric water change        =',dWtot,' kg m-2'
1444                          print*,'In rain surface water change            =',dWtots,' kg m-2'
1445                          print*,'In rain non-cons factor                 =',dWtot+dWtots,' kg m-2'
1446                  endif
1447                 
1448               endif ! end of 'enertest'
1449
1450            end if ! enf of 'waterrain'
1451           
1452         end if ! end of 'water'
1453
1454 ! -------------------------
1455  !   VI.2. Photochemistry
1456  ! -------------------------
1457
1458#ifndef MESOSCALE
1459         IF (photochem) then
1460
1461             DO ig=1,ngrid
1462               array_zero1(ig)=0.0
1463               DO l=1,nlayer
1464                 array_zero2(ig,l)=0.
1465               ENDDO
1466             ENDDO
1467
1468            call calchim_asis(ngrid,nlayer,nq,                          &
1469                        ptimestep,pplay,pplev,pt,pdt,dist_star,mu0,     &
1470                        fract,zzlev,zzlay,zday,pq,pdq,zdqchim,zdqschim, &
1471                        array_zero1,array_zero1,                        &
1472                        pu,pdu,pv,pdv,array_zero2,array_zero2)
1473
1474           ! increment values of tracers:
1475           DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
1476                      ! tracers is zero anyways
1477             DO l=1,nlayer
1478               DO ig=1,ngrid
1479                 pdq(ig,l,iq)=pdq(ig,l,iq)+zdqchim(ig,l,iq)
1480               ENDDO
1481             ENDDO
1482           ENDDO ! of DO iq=1,nq
1483
1484
1485           ! increment surface values of tracers:
1486           DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
1487                      ! tracers is zero anyways
1488             DO ig=1,ngrid
1489!               dqsurf(ig,iq)=dqsurf(ig,iq)+zdqschim(ig,iq)
1490             ENDDO
1491           ENDDO ! of DO iq=1,nq
1492
1493         END IF  ! of IF (photochem)
1494#endif
1495
1496
1497  ! -------------------------
1498  !   VI.3. Aerosol particles
1499  ! -------------------------
1500
1501         ! Sedimentation.
1502         if (sedimentation) then
1503       
1504            zdqsed(1:ngrid,1:nlayer,1:nq) = 0.0
1505            zdqssed(1:ngrid,1:nq)  = 0.0
1506
1507            if(watertest)then
1508           
1509               iq=igcm_h2o_ice
1510               call planetwide_sumval(massarea(:,:)*pq(:,:,iq)*ptimestep/totarea_planet,dWtot)
1511               call planetwide_sumval(massarea(:,:)*pdq(:,:,iq)*ptimestep/totarea_planet,dWtots)
1512               if (is_master) then
1513                        print*,'Before sedim pq  =',dWtot,' kg m-2'
1514                  print*,'Before sedim pdq =',dWtots,' kg m-2'
1515               endif
1516            endif
1517           
1518            call callsedim(ngrid,nlayer,ptimestep,           &
1519                          pplev,zzlev,pt,pdt,pq,pdq,        &
1520                          zdqsed,zdqssed,nq)
1521
1522            if(watertest)then
1523               iq=igcm_h2o_ice
1524               call planetwide_sumval(massarea(:,:)*pq(:,:,iq)*ptimestep/totarea_planet,dWtot)
1525               call planetwide_sumval(massarea(:,:)*pdq(:,:,iq)*ptimestep/totarea_planet,dWtots)
1526               if (is_master) then
1527                        print*,'After sedim pq  =',dWtot,' kg m-2'
1528                        print*,'After sedim pdq =',dWtots,' kg m-2'
1529                 endif
1530            endif
1531
1532            ! Whether it falls as rain or snow depends only on the surface temperature
1533            pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqsed(1:ngrid,1:nlayer,1:nq)
1534            dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + zdqssed(1:ngrid,1:nq)
1535
1536            ! Test water conservation
1537            if(watertest)then
1538               call planetwide_sumval(massarea(:,:)*(zdqsed(:,:,igcm_h2o_vap)+zdqsed(:,:,igcm_h2o_ice))*ptimestep/totarea_planet,dWtot)
1539               call planetwide_sumval((zdqssed(:,igcm_h2o_vap)+zdqssed(:,igcm_h2o_ice))*cell_area(:)*ptimestep/totarea_planet,dWtots)
1540               if (is_master) then
1541                        print*,'In sedim atmospheric ice change         =',dWtot,' kg m-2'
1542                        print*,'In sedim surface ice change             =',dWtots,' kg m-2'
1543                        print*,'In sedim non-cons factor                =',dWtot+dWtots,' kg m-2'
1544               endif
1545            endif
1546
1547         end if ! end of 'sedimentation'
1548
1549
1550  ! ---------------
1551  !   VI.4. Updates
1552  ! ---------------
1553
1554         ! Updating Atmospheric Mass and Tracers budgets.
1555         if(mass_redistrib) then
1556
1557            zdmassmr(1:ngrid,1:nlayer) = mass(1:ngrid,1:nlayer) *     &
1558               (   zdqevap(1:ngrid,1:nlayer)                          &
1559                 + zdqrain(1:ngrid,1:nlayer,igcm_h2o_vap)             &
1560                 + dqmoist(1:ngrid,1:nlayer,igcm_h2o_vap)             &
1561                 + dqvaplscale(1:ngrid,1:nlayer) )
1562
1563            do ig = 1, ngrid
1564               zdmassmr_col(ig)=SUM(zdmassmr(ig,1:nlayer))
1565            enddo
1566           
1567            call writediagfi(ngrid,"mass_evap","mass gain"," ",3,zdmassmr)
1568            call writediagfi(ngrid,"mass_evap_col","mass gain col"," ",2,zdmassmr_col)
1569            call writediagfi(ngrid,"mass","mass","kg/m2",3,mass)
1570
1571            call mass_redistribution(ngrid,nlayer,nq,ptimestep,                     &
1572                                     rnat,capcal,pplay,pplev,pt,tsurf,pq,qsurf,     &
1573                                     pu,pv,pdt,zdtsurf,pdq,pdu,pdv,zdmassmr,        &
1574                                     zdtmr,zdtsurfmr,zdpsrfmr,zdumr,zdvmr,zdqmr,zdqsurfmr)
1575         
1576            pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqmr(1:ngrid,1:nlayer,1:nq)
1577            dqsurf(1:ngrid,1:nq)       = dqsurf(1:ngrid,1:nq) + zdqsurfmr(1:ngrid,1:nq)
1578            pdt(1:ngrid,1:nlayer)      = pdt(1:ngrid,1:nlayer) + zdtmr(1:ngrid,1:nlayer)
1579            pdu(1:ngrid,1:nlayer)      = pdu(1:ngrid,1:nlayer) + zdumr(1:ngrid,1:nlayer)
1580            pdv(1:ngrid,1:nlayer)      = pdv(1:ngrid,1:nlayer) + zdvmr(1:ngrid,1:nlayer)
1581            pdpsrf(1:ngrid)            = pdpsrf(1:ngrid) + zdpsrfmr(1:ngrid)
1582            zdtsurf(1:ngrid)           = zdtsurf(1:ngrid) + zdtsurfmr(1:ngrid)
1583           
1584         endif
1585
1586  ! ------------------
1587  !   VI.5. Slab Ocean
1588  ! ------------------
1589
1590         if (ok_slab_ocean)then
1591
1592            do ig=1,ngrid
1593               qsurfint(:,igcm_h2o_ice)=qsurf(:,igcm_h2o_ice)
1594            enddo
1595
1596            call ocean_slab_ice(ptimestep,                          &
1597                                ngrid, knindex, tsea_ice, fluxrad,  &
1598                                zdqssnow, qsurf(:,igcm_h2o_ice),    &
1599                              - zdqsdif(:,igcm_h2o_vap),            &
1600                                flux_sens_lat,tsea_ice, pctsrf_sic, &
1601                                taux,tauy,icount)
1602
1603
1604            call ocean_slab_get_vars(ngrid,tslab,      &
1605                                     sea_ice, flux_o,  &
1606                                     flux_g, dt_hdiff, &
1607                                     dt_ekman)
1608   
1609            do ig=1,ngrid
1610               if (nint(rnat(ig)).eq.1)then
1611                  tslab(ig,1) = 0.
1612                  tslab(ig,2) = 0.
1613                  tsea_ice(ig) = 0.
1614                  sea_ice(ig) = 0.
1615                  pctsrf_sic(ig) = 0.
1616                  qsurf(ig,igcm_h2o_ice) = qsurfint(ig,igcm_h2o_ice)
1617               endif
1618            enddo
1619
1620         endif ! end of 'ok_slab_ocean'
1621
1622  ! -----------------------------
1623  !   VI.6. Surface Tracer Update
1624  ! -----------------------------
1625
1626         if(hydrology)then
1627           
1628            call hydrol(ngrid,nq,ptimestep,rnat,tsurf,qsurf,dqsurf,dqs_hyd, &
1629                        capcal,albedo,albedo_bareground,                    &
1630                        albedo_snow_SPECTV,albedo_co2_ice_SPECTV,           &
1631                        mu0,zdtsurf,zdtsurf_hyd,hice,pctsrf_sic,            &
1632                        sea_ice)
1633
1634            zdtsurf(1:ngrid)     = zdtsurf(1:ngrid) + zdtsurf_hyd(1:ngrid)
1635            dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + dqs_hyd(1:ngrid,1:nq)
1636           
1637            qsurf(1:ngrid,1:nq) = qsurf(1:ngrid,1:nq) + ptimestep*dqsurf(1:ngrid,1:nq)
1638
1639            ! Test energy conservation
1640            if(enertest)then
1641               call planetwide_sumval(cell_area(:)*capcal(:)*zdtsurf_hyd(:)/totarea_planet,dEtots)
1642               if (is_master) print*,'In hydrol surface energy change     =',dEtots,' W m-2'
1643            endif
1644
1645            ! test water conservation
1646            if(watertest)then
1647               call planetwide_sumval(dqs_hyd(:,igcm_h2o_ice)*cell_area(:)*ptimestep/totarea_planet,dWtots)
1648               if (is_master) print*,'In hydrol surface ice change            =',dWtots,' kg m-2'
1649                  call planetwide_sumval(dqs_hyd(:,igcm_h2o_vap)*cell_area(:)*ptimestep/totarea_planet,dWtots)
1650               if (is_master) then
1651                  print*,'In hydrol surface water change          =',dWtots,' kg m-2'
1652                  print*,'---------------------------------------------------------------'
1653               endif
1654            endif
1655
1656         else ! of if (hydrology)
1657
1658            qsurf(1:ngrid,1:nq) = qsurf(1:ngrid,1:nq) + ptimestep*dqsurf(1:ngrid,1:nq)
1659
1660         end if ! of if (hydrology)
1661
1662         ! Add qsurf to qsurf_hist, which is what we save in diagfi.nc. At the same time, we set the water
1663         ! content of ocean gridpoints back to zero, in order to avoid rounding errors in vdifc, rain.
1664         qsurf_hist(:,:) = qsurf(:,:)
1665
1666         if(ice_update)then
1667            ice_min(1:ngrid)=min(ice_min(1:ngrid),qsurf(1:ngrid,igcm_h2o_ice))
1668         endif
1669
1670      endif! end of if 'tracer'
1671
1672
1673!------------------------------------------------
1674!   VII. Surface and sub-surface soil temperature
1675!------------------------------------------------
1676
1677
1678      ! Increment surface temperature
1679      if(ok_slab_ocean)then
1680         do ig=1,ngrid
1681           if (nint(rnat(ig)).eq.0)then
1682             zdtsurf(ig)= (tslab(ig,1)              &
1683             + pctsrf_sic(ig)*(tsea_ice(ig)-tslab(ig,1))-tsurf(ig))/ptimestep
1684           endif
1685           tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig)
1686         enddo
1687   
1688      else
1689        tsurf(1:ngrid)=tsurf(1:ngrid)+ptimestep*zdtsurf(1:ngrid)
1690      endif ! end of 'ok_slab_ocean'
1691
1692
1693      ! Compute soil temperatures and subsurface heat flux.
1694      if (callsoil) then
1695         call soil(ngrid,nsoilmx,.false.,lastcall,inertiedat,   &
1696                   ptimestep,tsurf,tsoil,capcal,fluxgrd)     
1697      endif
1698
1699
1700      if (ok_slab_ocean) then
1701     
1702         do ig=1,ngrid
1703         
1704            fluxgrdocean(ig)=fluxgrd(ig)
1705            if (nint(rnat(ig)).eq.0) then
1706               capcal(ig)=capcalocean
1707               fluxgrd(ig)=0.
1708               fluxgrdocean(ig)=pctsrf_sic(ig)*flux_g(ig)+(1-pctsrf_sic(ig))*(dt_hdiff(ig,1)+dt_ekman(ig,1))
1709               do iq=1,nsoilmx
1710                  tsoil(ig,iq)=tsurf(ig)
1711               enddo
1712               if (pctsrf_sic(ig).gt.0.5) then
1713                  capcal(ig)=capcalseaice
1714                  if (qsurf(ig,igcm_h2o_ice).gt.0.) then
1715                     capcal(ig)=capcalsno
1716                  endif
1717               endif               
1718            endif
1719           
1720         enddo
1721         
1722      endif !end of 'ok_slab_ocean'
1723
1724
1725      ! Test energy conservation
1726      if(enertest)then
1727         call planetwide_sumval(cell_area(:)*capcal(:)*zdtsurf(:)/totarea_planet,dEtots)         
1728         if (is_master) print*,'Surface energy change                 =',dEtots,' W m-2'
1729      endif
1730
1731
1732!---------------------------------------------------
1733!   VIII. Perform diagnostics and write output files
1734!---------------------------------------------------
1735
1736      ! Note : For output only: the actual model integration is performed in the dynamics.
1737
1738
1739 
1740      ! Temperature, zonal and meridional winds.
1741      zt(1:ngrid,1:nlayer) = pt(1:ngrid,1:nlayer) + pdt(1:ngrid,1:nlayer)*ptimestep
1742      zu(1:ngrid,1:nlayer) = pu(1:ngrid,1:nlayer) + pdu(1:ngrid,1:nlayer)*ptimestep
1743      zv(1:ngrid,1:nlayer) = pv(1:ngrid,1:nlayer) + pdv(1:ngrid,1:nlayer)*ptimestep
1744     
1745      ! Recast thermal plume vertical velocity array for outputs
1746      IF (calltherm) THEN
1747         DO ig=1,ngrid
1748            DO l=1,nlayer
1749               zw2_bis(ig,l) = zw2(ig,l)
1750               fm_bis(ig,l) = fm(ig,l)
1751            ENDDO
1752         ENDDO
1753      ENDIF
1754
1755      ! Diagnostic.
1756      zdtdyn(1:ngrid,1:nlayer)     = (pt(1:ngrid,1:nlayer)-ztprevious(1:ngrid,1:nlayer)) / ptimestep
1757      ztprevious(1:ngrid,1:nlayer) = zt(1:ngrid,1:nlayer)
1758
1759      zdudyn(1:ngrid,1:nlayer)     = (pu(1:ngrid,1:nlayer)-zuprevious(1:ngrid,1:nlayer)) / ptimestep
1760      zuprevious(1:ngrid,1:nlayer) = zu(1:ngrid,1:nlayer)
1761
1762      if(firstcall)then
1763         zdtdyn(1:ngrid,1:nlayer)=0.0
1764         zdudyn(1:ngrid,1:nlayer)=0.0
1765      endif
1766
1767      ! Dynamical heating diagnostic.
1768      do ig=1,ngrid
1769         fluxdyn(ig)= SUM(zdtdyn(ig,:) *mass(ig,:))*cpp
1770      enddo
1771
1772      ! Tracers.
1773      zq(1:ngrid,1:nlayer,1:nq) = pq(1:ngrid,1:nlayer,1:nq) + pdq(1:ngrid,1:nlayer,1:nq)*ptimestep
1774
1775      ! Surface pressure.
1776      ps(1:ngrid) = pplev(1:ngrid,1) + pdpsrf(1:ngrid)*ptimestep
1777
1778
1779
1780      ! Surface and soil temperature information
1781      call planetwide_sumval(cell_area(:)*tsurf(:)/totarea_planet,Ts1)
1782      call planetwide_minval(tsurf(:),Ts2)
1783      call planetwide_maxval(tsurf(:),Ts3)
1784      if(callsoil)then
1785         TsS = SUM(cell_area(:)*tsoil(:,nsoilmx))/totarea        ! mean temperature at bottom soil layer
1786         if (is_master) then
1787            print*,'          ave[Tsurf]             min[Tsurf]             max[Tsurf]             ave[Tdeep]'
1788            print*,Ts1,Ts2,Ts3,TsS
1789         end if
1790      else
1791         if (is_master) then
1792            print*,'          ave[Tsurf]             min[Tsurf]             max[Tsurf]'
1793            print*,Ts1,Ts2,Ts3
1794         endif
1795      end if
1796
1797
1798      ! Check the energy balance of the simulation during the run
1799      if(corrk)then
1800
1801         call planetwide_sumval(cell_area(:)*fluxtop_dn(:)/totarea_planet,ISR)
1802         call planetwide_sumval(cell_area(:)*fluxabs_sw(:)/totarea_planet,ASR)
1803         call planetwide_sumval(cell_area(:)*fluxtop_lw(:)/totarea_planet,OLR)
1804         call planetwide_sumval(cell_area(:)*fluxgrd(:)/totarea_planet,GND)
1805         call planetwide_sumval(cell_area(:)*fluxdyn(:)/totarea_planet,DYN)
1806         do ig=1,ngrid
1807            if(fluxtop_dn(ig).lt.0.0)then
1808               print*,'fluxtop_dn has gone crazy'
1809               print*,'fluxtop_dn=',fluxtop_dn(ig)
1810               print*,'tau_col=',tau_col(ig)
1811               print*,'aerosol=',aerosol(ig,:,:)
1812               print*,'temp=   ',pt(ig,:)
1813               print*,'pplay=  ',pplay(ig,:)
1814               call abort
1815            endif
1816         end do
1817                     
1818         if(ngrid.eq.1)then
1819            DYN=0.0
1820         endif
1821         
1822         if (is_master) then
1823            print*,'  ISR            ASR            OLR            GND            DYN [W m^-2]'
1824            print*, ISR,ASR,OLR,GND,DYN
1825         endif
1826
1827         if(enertest .and. is_master)then
1828            print*,'SW flux/heating difference SW++ - ASR = ',dEtotSW+dEtotsSW-ASR,' W m-2'
1829            print*,'LW flux/heating difference LW++ - OLR = ',dEtotLW+dEtotsLW+OLR,' W m-2'
1830            print*,'LW energy balance LW++ + ASR = ',dEtotLW+dEtotsLW+ASR,' W m-2'
1831         endif
1832
1833         if(meanOLR .and. is_master)then
1834            if((ngrid.gt.1) .or. (mod(icount-1,ecritphy).eq.0))then
1835               ! to record global radiative balance
1836               open(92,file="rad_bal.out",form='formatted',position='append')
1837               write(92,*) zday,ISR,ASR,OLR
1838               close(92)
1839               open(93,file="tem_bal.out",form='formatted',position='append')
1840               if(callsoil)then
1841                         write(93,*) zday,Ts1,Ts2,Ts3,TsS
1842               else
1843                  write(93,*) zday,Ts1,Ts2,Ts3
1844               endif
1845               close(93)
1846            endif
1847         endif
1848
1849      endif ! end of 'corrk'
1850
1851
1852      ! Diagnostic to test radiative-convective timescales in code.
1853      if(testradtimes)then
1854         open(38,file="tau_phys.out",form='formatted',position='append')
1855         ig=1
1856         do l=1,nlayer
1857            write(38,*) -1./pdt(ig,l),pt(ig,l),pplay(ig,l)
1858         enddo
1859         close(38)
1860         print*,'As testradtimes enabled,'
1861         print*,'exiting physics on first call'
1862         call abort
1863      endif
1864
1865
1866      ! Compute column amounts (kg m-2) if tracers are enabled.
1867      if(tracer)then
1868         qcol(1:ngrid,1:nq)=0.0
1869         do iq=1,nq
1870            do ig=1,ngrid
1871               qcol(ig,iq) = SUM( zq(ig,1:nlayer,iq) * mass(ig,1:nlayer))
1872            enddo
1873         enddo
1874
1875         ! Generalised for arbitrary aerosols now. By LK
1876         reffcol(1:ngrid,1:naerkind)=0.0
1877         if(co2cond.and.(iaero_co2.ne.0))then
1878            call co2_reffrad(ngrid,nlayer,nq,zq,reffrad(1,1,iaero_co2))
1879            do ig=1,ngrid
1880               reffcol(ig,iaero_co2) = SUM(zq(ig,1:nlayer,igcm_co2_ice)*reffrad(ig,1:nlayer,iaero_co2)*mass(ig,1:nlayer))
1881            enddo
1882         endif
1883         if(water.and.(iaero_h2o.ne.0))then
1884            call h2o_reffrad(ngrid,nlayer,zq(1,1,igcm_h2o_ice),zt, &
1885                             reffrad(1,1,iaero_h2o),nueffrad(1,1,iaero_h2o))
1886            do ig=1,ngrid
1887               reffcol(ig,iaero_h2o) = SUM(zq(ig,1:nlayer,igcm_h2o_ice)*reffrad(ig,1:nlayer,iaero_h2o)*mass(ig,1:nlayer))
1888            enddo
1889         endif
1890
1891      endif ! end of 'tracer'
1892
1893
1894      ! Test for water conservation.
1895      if(water)then
1896
1897         call planetwide_sumval(cell_area(:)*qsurf_hist(:,igcm_h2o_ice)/totarea_planet,icesrf)
1898         call planetwide_sumval(cell_area(:)*qsurf_hist(:,igcm_h2o_vap)/totarea_planet,liqsrf)
1899         call planetwide_sumval(cell_area(:)*qcol(:,igcm_h2o_ice)/totarea_planet,icecol)
1900         call planetwide_sumval(cell_area(:)*qcol(:,igcm_h2o_vap)/totarea_planet,vapcol)
1901
1902         h2otot = icesrf + liqsrf + icecol + vapcol
1903         
1904         if (is_master) then
1905            print*,' Total water amount [kg m^-2]: ',h2otot
1906            print*,' Surface ice    Surface liq.   Atmos. con.     Atmos. vap. [kg m^-2] '
1907            print*, icesrf,liqsrf,icecol,vapcol
1908         endif
1909
1910         if(meanOLR .and. is_master)then
1911            if((ngrid.gt.1) .or. (mod(icount-1,ecritphy).eq.0))then
1912               ! to record global water balance
1913               open(98,file="h2o_bal.out",form='formatted',position='append')
1914               write(98,*) zday,icesrf,liqsrf,icecol,vapcol
1915               close(98)
1916            endif
1917         endif
1918
1919      endif
1920
1921
1922      ! Calculate RH (Relative Humidity) for diagnostic.
1923      if(water)then
1924     
1925         do l = 1, nlayer
1926            do ig=1,ngrid
1927               call Psat_water(zt(ig,l),pplay(ig,l),psat_tmp,qsat(ig,l))
1928               RH(ig,l) = zq(ig,l,igcm_h2o_vap) / qsat(ig,l)
1929            enddo
1930         enddo
1931
1932         ! Compute maximum possible H2O column amount (100% saturation).
1933         do ig=1,ngrid
1934            H2Omaxcol(ig) = SUM( qsat(ig,:) * mass(ig,:))
1935         enddo
1936
1937      endif ! end of 'water'
1938
1939
1940      if (is_master) print*,'--> Ls =',zls*180./pi
1941     
1942     
1943!----------------------------------------------------------------------
1944!        Writing NetCDF file  "RESTARTFI" at the end of the run
1945!----------------------------------------------------------------------
1946
1947!        Note: 'restartfi' is stored just before dynamics are stored
1948!              in 'restart'. Between now and the writting of 'restart',
1949!              there will have been the itau=itau+1 instruction and
1950!              a reset of 'time' (lastacll = .true. when itau+1= itaufin)
1951!              thus we store for time=time+dtvr
1952
1953
1954
1955      if(lastcall) then
1956         ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec)
1957
1958         ! Update surface ice distribution to iterate to steady state if requested
1959         if(ice_update)then
1960
1961            do ig=1,ngrid
1962
1963               delta_ice = (qsurf(ig,igcm_h2o_ice)-ice_initial(ig))
1964               
1965               ! add multiple years of evolution
1966               qsurf_hist(ig,igcm_h2o_ice) = qsurf_hist(ig,igcm_h2o_ice) + delta_ice*icetstep
1967
1968               ! if ice has gone -ve, set to zero
1969               if(qsurf_hist(ig,igcm_h2o_ice).lt.0.0)then
1970                  qsurf_hist(ig,igcm_h2o_ice) = 0.0
1971               endif
1972
1973               ! if ice is seasonal, set to zero (NEW)
1974               if(ice_min(ig).lt.0.01)then
1975                  qsurf_hist(ig,igcm_h2o_ice) = 0.0
1976               endif
1977
1978            enddo
1979
1980            ! enforce ice conservation
1981            ice_tot= SUM(qsurf_hist(:,igcm_h2o_ice)*cell_area(:) )/SUM(cell_area(:))
1982            qsurf_hist(:,igcm_h2o_ice) = qsurf_hist(:,igcm_h2o_ice)*(icesrf/ice_tot)
1983
1984         endif
1985#ifndef MESOSCALE
1986         
1987         if (ngrid.ne.1) then
1988            write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
1989           
1990            call physdem1("restartfi.nc",nsoilmx,ngrid,nlayer,nq, &
1991                          ptimestep,ztime_fin,                    &
1992                          tsurf,tsoil,emis,q2,qsurf_hist,         &
1993                          cloudfrac,totcloudfrac,hice,            &
1994                          rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
1995         endif
1996#endif
1997         if(ok_slab_ocean) then
1998            call ocean_slab_final!(tslab, seaice)
1999         end if
2000
2001    endif ! end of 'lastcall'
2002
2003
2004!-----------------------------------
2005!        Saving statistics :
2006!-----------------------------------
2007
2008!    Note :("stats" stores and accumulates 8 key variables in file "stats.nc"
2009!           which can later be used to make the statistic files of the run:
2010!           "stats")          only possible in 3D runs !!!
2011
2012         
2013      if (callstats) then
2014
2015         call wstats(ngrid,"ps","Surface pressure","Pa",2,ps)
2016         call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf)
2017         call wstats(ngrid,"fluxsurf_lw",                               &
2018                     "Thermal IR radiative flux to surface","W.m-2",2,  &
2019                     fluxsurf_lw)
2020         call wstats(ngrid,"fluxtop_lw",                                &
2021                     "Thermal IR radiative flux to space","W.m-2",2,    &
2022                     fluxtop_lw)
2023                     
2024!            call wstats(ngrid,"fluxsurf_sw",                               &
2025!                        "Solar radiative flux to surface","W.m-2",2,       &
2026!                         fluxsurf_sw_tot)                     
2027!            call wstats(ngrid,"fluxtop_sw",                                &
2028!                        "Solar radiative flux to space","W.m-2",2,         &
2029!                        fluxtop_sw_tot)
2030
2031
2032         call wstats(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn)
2033         call wstats(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw)
2034         call wstats(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw)
2035         !call wstats(ngrid,"ALB","Surface albedo"," ",2,albedo_equivalent)
2036         !call wstats(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1))
2037         call wstats(ngrid,"p","Pressure","Pa",3,pplay)
2038         call wstats(ngrid,"temp","Atmospheric temperature","K",3,zt)
2039         call wstats(ngrid,"u","Zonal (East-West) wind","m.s-1",3,zu)
2040         call wstats(ngrid,"v","Meridional (North-South) wind","m.s-1",3,zv)
2041         call wstats(ngrid,"w","Vertical (down-up) wind","m.s-1",3,pw)
2042         call wstats(ngrid,"q2","Boundary layer eddy kinetic energy","m2.s-2",3,q2)
2043
2044         if (tracer) then
2045            do iq=1,nq
2046               call wstats(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq))
2047               call wstats(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',  &
2048                           'kg m^-2',2,qsurf(1,iq) )
2049               call wstats(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col',    &
2050                          'kg m^-2',2,qcol(1,iq) )
2051                         
2052!              call wstats(ngrid,trim(noms(iq))//'_reff',                          &
2053!                          trim(noms(iq))//'_reff',                                   &
2054!                          'm',3,reffrad(1,1,iq))
2055
2056            end do
2057           
2058            if (water) then
2059               vmr=zq(1:ngrid,1:nlayer,igcm_h2o_vap)*mugaz/mmol(igcm_h2o_vap)
2060               call wstats(ngrid,"vmr_h2ovapor",                             &
2061                           "H2O vapour volume mixing ratio","mol/mol",       &
2062                           3,vmr)
2063            endif
2064
2065         endif ! end of 'tracer'
2066
2067         if(watercond.and.CLFvarying)then
2068            call wstats(ngrid,"rneb_man","H2O cloud fraction (conv)"," ",3,rneb_man)
2069            call wstats(ngrid,"rneb_lsc","H2O cloud fraction (large scale)"," ",3,rneb_lsc)
2070            call wstats(ngrid,"CLF","H2O cloud fraction"," ",3,cloudfrac)
2071            call wstats(ngrid,"CLFt","H2O column cloud fraction"," ",2,totcloudfrac)
2072            call wstats(ngrid,"RH","relative humidity"," ",3,RH)
2073         endif
2074
2075         if (ok_slab_ocean) then
2076            call wstats(ngrid,"dt_hdiff1","dt_hdiff1","K/s",2,dt_hdiff(:,1))
2077            call wstats(ngrid,"dt_hdiff2","dt_hdiff2","K/s",2,dt_hdiff(:,2))
2078            call wstats(ngrid,"dt_ekman1","dt_ekman1","K/s",2,dt_ekman(:,1))
2079            call wstats(ngrid,"dt_ekman2","dt_ekman2","K/s",2,dt_ekman(:,2))
2080            call wstats(ngrid,"tslab1","tslab1","K",2,tslab(:,1))
2081            call wstats(ngrid,"tslab2","tslab2","K",2,tslab(:,2))
2082            call wstats(ngrid,"pctsrf_sic","pct ice/sea","",2,pctsrf_sic)
2083            call wstats(ngrid,"tsea_ice","tsea_ice","K",2,tsea_ice)
2084            call wstats(ngrid,"sea_ice","sea ice","kg/m2",2,sea_ice)
2085            call wstats(ngrid,"rnat","nature of the surface","",2,rnat)
2086         endif
2087
2088         if(lastcall) then
2089            write (*,*) "Writing stats..."
2090            call mkstats(ierr)
2091         endif
2092         
2093      endif ! end of 'callstats'
2094
2095#ifndef MESOSCALE
2096       
2097!-----------------------------------------------------------------------------------------------------
2098!           OUTPUT in netcdf file "DIAGFI.NC", containing any variable for diagnostic
2099!
2100!             Note 1 : output with  period "ecritphy", set in "run.def"
2101!
2102!             Note 2 : writediagfi can also be called from any other subroutine for any variable,
2103!                      but its preferable to keep all the calls in one place ...
2104!-----------------------------------------------------------------------------------------------------
2105
2106      call writediagfi(ngrid,"Ls","solar longitude","deg",0,zls*180./pi)
2107      call writediagfi(ngrid,"Lss","sub solar longitude","deg",0,zlss*180./pi)
2108      call writediagfi(ngrid,"RA","right ascension","deg",0,right_ascen*180./pi)
2109      call writediagfi(ngrid,"Declin","solar declination","deg",0,declin*180./pi)
2110      call writediagfi(ngrid,"tsurf","Surface temperature","K",2,tsurf)
2111      call writediagfi(ngrid,"ps","Surface pressure","Pa",2,ps)
2112      call writediagfi(ngrid,"temp","temperature","K",3,zt)
2113      call writediagfi(ngrid,"teta","potential temperature","K",3,zh)
2114      call writediagfi(ngrid,"u","Zonal wind","m.s-1",3,zu)
2115      call writediagfi(ngrid,"v","Meridional wind","m.s-1",3,zv)
2116      call writediagfi(ngrid,"w","Vertical wind","m.s-1",3,pw)
2117      call writediagfi(ngrid,"p","Pressure","Pa",3,pplay)
2118
2119!     Subsurface temperatures
2120!        call writediagsoil(ngrid,"tsurf","Surface temperature","K",2,tsurf)
2121!        call writediagsoil(ngrid,"temp","temperature","K",3,tsoil)
2122
2123      ! Oceanic layers
2124      if(ok_slab_ocean) then
2125         call writediagfi(ngrid,"pctsrf_sic","pct ice/sea","",2,pctsrf_sic)
2126         call writediagfi(ngrid,"tsea_ice","tsea_ice","K",2,tsea_ice)
2127         call writediagfi(ngrid,"sea_ice","sea ice","kg/m2",2,sea_ice)
2128         call writediagfi(ngrid,"tslab1","tslab1","K",2,tslab(:,1))
2129         call writediagfi(ngrid,"tslab2","tslab2","K",2,tslab(:,2))
2130         call writediagfi(ngrid,"dt_hdiff1","dt_hdiff1","K/s",2,dt_hdiff(:,1))
2131         call writediagfi(ngrid,"dt_hdiff2","dt_hdiff2","K/s",2,dt_hdiff(:,2))
2132         call writediagfi(ngrid,"dt_ekman1","dt_ekman1","K/s",2,dt_ekman(:,1))
2133         call writediagfi(ngrid,"dt_ekman2","dt_ekman2","K/s",2,dt_ekman(:,2))
2134         call writediagfi(ngrid,"rnat","nature of the surface","",2,rnat)
2135         call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux)
2136         call writediagfi(ngrid,"latentFlux","latent heat flux","w.m^-2",2,zdqsdif(:,igcm_h2o_vap)*RLVTT)
2137      endif
2138     
2139      ! Thermal plume model
2140      if (calltherm) then
2141         call writediagfi(ngrid,'entr','Entrainment','kg m$^{-2}$ s$^{-1}$', 3, entr)
2142         call writediagfi(ngrid,'detr','Detrainment','kg m$^{-2}$ s$^{-1}$', 3, detr)
2143         call writediagfi(ngrid,'fm','Mass flux','kg m$^{-2}$ s$^{-1}$', 3, fm_bis)
2144         call writediagfi(ngrid,'w_plm','Squared vertical velocity','m s$^{-1}$', 3, zw2_bis)
2145         call writediagfi(ngrid,'fraca','Updraft fraction','', 3, fraca)
2146      endif
2147
2148!        GW non-oro outputs
2149      if (calllott_nonoro) then
2150         call WRITEDIAGFI(ngrid,"dugwno","GW non-oro dU","m/s2", 3,d_u_hin/ptimestep)
2151         call WRITEDIAGFI(ngrid,"dvgwno","GW non-oro dV","m/s2", 3,d_v_hin/ptimestep)
2152      endif
2153     
2154      ! Total energy balance diagnostics
2155      if(callrad.and.(.not.newtonian))then
2156     
2157         !call writediagfi(ngrid,"ALB","Surface albedo"," ",2,albedo_equivalent)
2158         !call writediagfi(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1))
2159         call writediagfi(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn)
2160         call writediagfi(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw)
2161         call writediagfi(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw)
2162         call writediagfi(ngrid,"shad","rings"," ", 2, fract)
2163         
2164!           call writediagfi(ngrid,"ASRcs","absorbed stellar rad (cs).","W m-2",2,fluxabs_sw1)
2165!           call writediagfi(ngrid,"OLRcs","outgoing longwave rad (cs).","W m-2",2,fluxtop_lw1)
2166!           call writediagfi(ngrid,"fluxsurfsw","sw surface flux.","W m-2",2,fluxsurf_sw)
2167!           call writediagfi(ngrid,"fluxsurflw","lw back radiation.","W m-2",2,fluxsurf_lw)
2168!           call writediagfi(ngrid,"fluxsurfswcs","sw surface flux (cs).","W m-2",2,fluxsurf_sw1)
2169!           call writediagfi(ngrid,"fluxsurflwcs","lw back radiation (cs).","W m-2",2,fluxsurf_lw1)
2170
2171         if(ok_slab_ocean) then
2172            call writediagfi(ngrid,"GND","heat flux from ground","W m-2",2,fluxgrdocean)
2173         else
2174            call writediagfi(ngrid,"GND","heat flux from ground","W m-2",2,fluxgrd)
2175         endif
2176         
2177         call writediagfi(ngrid,"DYN","dynamical heat input","W m-2",2,fluxdyn)
2178         
2179      endif ! end of 'callrad'
2180       
2181      if(enertest) then
2182     
2183         if (calldifv) then
2184         
2185            call writediagfi(ngrid,"q2","turbulent kinetic energy","J.kg^-1",3,q2)
2186            call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux)
2187           
2188!             call writediagfi(ngrid,"dEzdiff","turbulent diffusion heating (-sensible flux)","w.m^-2",3,dEzdiff)
2189!             call writediagfi(ngrid,"dEdiff","integrated turbulent diffusion heating (-sensible flux)","w.m^-2",2,dEdiff)
2190!             call writediagfi(ngrid,"dEdiffs","In TurbDiff (correc rad+latent heat) surf nrj change","w.m^-2",2,dEdiffs)
2191             
2192         endif
2193         
2194         if (corrk) then
2195            call writediagfi(ngrid,"dEzradsw","radiative heating","w.m^-2",3,dEzradsw)
2196            call writediagfi(ngrid,"dEzradlw","radiative heating","w.m^-2",3,dEzradlw)
2197         endif
2198         
2199         if(watercond) then
2200
2201            call writediagfi(ngrid,"lscaledE","heat from largescale","W m-2",2,lscaledE)
2202            call writediagfi(ngrid,"madjdE","heat from moistadj","W m-2",2,madjdE)
2203            call writediagfi(ngrid,"qsatatm","atm qsat"," ",3,qsat)
2204             
2205!             call writediagfi(ngrid,"lscaledEz","heat from largescale","W m-2",3,lscaledEz)
2206!             call writediagfi(ngrid,"madjdEz","heat from moistadj","W m-2",3,madjdEz)             
2207!             call writediagfi(ngrid,"h2o_max_col","maximum H2O column amount","kg.m^-2",2,H2Omaxcol)
2208
2209         endif
2210         
2211      endif ! end of 'enertest'
2212
2213        ! Diagnostics of optical thickness
2214        ! Warning this is exp(-tau), I let you postproc with -log to have tau itself - JVO 19
2215        if (diagdtau) then               
2216          do nw=1,L_NSPECTV
2217            write(str2,'(i2.2)') nw
2218            call writediagfi(ngrid,'dtauv'//str2,'Layer optical thickness attenuation in VI band '//str2,'',1,int_dtauv(:,nlayer:1:-1,nw))
2219          enddo
2220          do nw=1,L_NSPECTI
2221            write(str2,'(i2.2)') nw
2222            call writediagfi(ngrid,'dtaui'//str2,'Layer optical thickness attenuation in IR band '//str2,'',1,int_dtaui(:,nlayer:1:-1,nw))
2223          enddo
2224        endif
2225
2226
2227        ! Temporary inclusions for heating diagnostics.
2228        !call writediagfi(ngrid,"zdtsw","SW heating","T s-1",3,zdtsw)
2229        !call writediagfi(ngrid,"zdtlw","LW heating","T s-1",3,zdtlw)
2230        call writediagfi(ngrid,"dtrad","radiative heating","K s-1",3,dtrad)
2231        ! call writediagfi(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn)
2232       
2233        ! For Debugging.
2234        !call writediagfi(ngrid,'rnat','Terrain type',' ',2,real(rnat))
2235        !call writediagfi(ngrid,'pphi','Geopotential',' ',3,pphi)
2236       
2237
2238      ! Output aerosols.
2239      if (igcm_co2_ice.ne.0.and.iaero_co2.ne.0) &
2240         call writediagfi(ngrid,'CO2ice_reff','CO2ice_reff','m',3,reffrad(1,1,iaero_co2))
2241      if (igcm_h2o_ice.ne.0.and.iaero_h2o.ne.0) &
2242         call writediagfi(ngrid,'H2Oice_reff','H2Oice_reff','m',3,reffrad(:,:,iaero_h2o))
2243      if (igcm_co2_ice.ne.0.and.iaero_co2.ne.0) &
2244         call writediagfi(ngrid,'CO2ice_reffcol','CO2ice_reffcol','um kg m^-2',2,reffcol(1,iaero_co2))
2245      if (igcm_h2o_ice.ne.0.and.iaero_h2o.ne.0) &
2246         call writediagfi(ngrid,'H2Oice_reffcol','H2Oice_reffcol','um kg m^-2',2,reffcol(1,iaero_h2o))
2247
2248      ! Output tracers.
2249      if (tracer) then
2250     
2251         do iq=1,nq
2252            call writediagfi(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq))
2253            call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',  &
2254                             'kg m^-2',2,qsurf_hist(1,iq) )
2255            call writediagfi(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col',    &
2256                            'kg m^-2',2,qcol(1,iq) )
2257                         
2258!          call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',  &
2259!                          'kg m^-2',2,qsurf(1,iq) )                         
2260
2261            if(watercond.or.CLFvarying)then
2262               call writediagfi(ngrid,"rneb_man","H2O cloud fraction (conv)"," ",3,rneb_man)
2263               call writediagfi(ngrid,"rneb_lsc","H2O cloud fraction (large scale)"," ",3,rneb_lsc)
2264               call writediagfi(ngrid,"CLF","H2O cloud fraction"," ",3,cloudfrac)
2265               call writediagfi(ngrid,"CLFt","H2O column cloud fraction"," ",2,totcloudfrac)
2266               call writediagfi(ngrid,"RH","relative humidity"," ",3,RH)
2267            endif
2268
2269            if(waterrain)then
2270               call writediagfi(ngrid,"rain","rainfall","kg m-2 s-1",2,zdqsrain)
2271               call writediagfi(ngrid,"snow","snowfall","kg m-2 s-1",2,zdqssnow)
2272               call writediagfi(ngrid,"reevap","reevaporation of precipitation","kg m-2 s-1",2,reevap_precip)
2273            endif
2274
2275            if((hydrology).and.(.not.ok_slab_ocean))then
2276               call writediagfi(ngrid,"hice","oceanic ice height","m",2,hice)
2277            endif
2278
2279            if(ice_update)then
2280               call writediagfi(ngrid,"ice_min","min annual ice","m",2,ice_min)
2281               call writediagfi(ngrid,"ice_ini","initial annual ice","m",2,ice_initial)
2282            endif
2283
2284            do ig=1,ngrid
2285               if(tau_col(ig).gt.1.e3)then
2286                  print*,'WARNING: tau_col=',tau_col(ig)
2287                  print*,'at ig=',ig,'in PHYSIQ'
2288               endif         
2289            end do
2290
2291            call writediagfi(ngrid,"tau_col","Total aerosol optical depth","[]",2,tau_col)
2292
2293         enddo ! end of 'nq' loop
2294         
2295       endif ! end of 'tracer'
2296
2297
2298      ! Output spectrum.
2299      if(specOLR.and.corrk)then     
2300         call writediagspecIR(ngrid,"OLR3D","OLR(lon,lat,band)","W/m^2/cm^-1",3,OLR_nu)
2301         call writediagspecVI(ngrid,"OSR3D","OSR(lon,lat,band)","W/m^2/cm^-1",3,OSR_nu)
2302      endif
2303
2304#else
2305      comm_HR_SW(1:ngrid,1:nlayer) = zdtsw(1:ngrid,1:nlayer)
2306      comm_HR_LW(1:ngrid,1:nlayer) = zdtlw(1:ngrid,1:nlayer)
2307      if ((tracer).and.(water)) then
2308        comm_CLOUDFRAC(1:ngrid,1:nlayer)=cloudfrac(1:ngrid,1:nlayer)
2309        comm_TOTCLOUDFRAC(1:ngrid)=totcloudfrac(1:ngrid)
2310        comm_RAIN(1:ngrid,1:nlayer)=zdqrain(1:ngrid,1:nlayer,igcm_h2o_vap)
2311        comm_SURFRAIN(1:ngrid)=zdqsrain(1:ngrid)
2312        comm_SNOW(1:ngrid,1:nlayer)=zdqrain(1:ngrid,1:nlayer,igcm_h2o_ice)
2313        comm_ALBEQ(1:ngrid)=albedo_equivalent(1:ngrid)
2314        comm_H2OICE_REFF(1:ngrid,1:nlayer)=reffrad(1:ngrid,1:nlayer,iaero_h2o)
2315        comm_REEVAP(1:ngrid)=reevap_precip(1:ngrid)
2316      endif
2317      comm_FLUXTOP_DN(1:ngrid)=fluxtop_dn(1:ngrid)
2318      comm_FLUXABS_SW(1:ngrid)=fluxabs_sw(1:ngrid)
2319      comm_FLUXTOP_LW(1:ngrid)=fluxtop_lw(1:ngrid)
2320      comm_FLUXSURF_SW(1:ngrid)=fluxsurf_sw(1:ngrid)
2321      comm_FLUXSURF_LW(1:ngrid)=fluxsurf_lw(1:ngrid)
2322      comm_FLXGRD(1:ngrid)=fluxgrd(1:ngrid)
2323      comm_LSCEZ(1:ngrid,1:nlayer)=lscaledEz(1:ngrid,1:nlayer)
2324      sensibFlux(1:ngrid) = zflubid(1:ngrid) - capcal(1:ngrid)*zdtsdif(1:ngrid) !!! ????
2325
2326      if (turb_resolved) then
2327        open(17,file='lsf.txt',form='formatted',status='old')
2328        rewind(17)
2329        DO l=1,nlayer
2330          read(17,*) lsf_dt(l),lsf_dq(l)
2331        ENDDO
2332        close(17)
2333        do ig=1,ngrid
2334          if ((tracer).and.(water)) then
2335           pdq(ig,:,igcm_h2o_vap) = pdq(ig,:,igcm_h2o_vap) + lsf_dq(:)
2336          endif
2337          pdt(ig,:) = pdt(ig,:) + lsf_dt(:)
2338          comm_HR_DYN(ig,:) = lsf_dt(:)
2339        enddo
2340      endif
2341#endif
2342
2343! XIOS outputs
2344#ifdef CPP_XIOS     
2345      ! Send fields to XIOS: (NB these fields must also be defined as
2346      ! <field id="..." /> in context_lmdz_physics.xml to be correctly used)
2347      CALL send_xios_field("ls",zls)
2348     
2349      CALL send_xios_field("ps",ps)
2350      CALL send_xios_field("area",cell_area)
2351     
2352      CALL send_xios_field("temperature",zt)
2353      CALL send_xios_field("u",zu)
2354      CALL send_xios_field("v",zv)
2355      CALL send_xios_field("omega",omega)
2356     
2357      IF (calltherm) THEN
2358         CALL send_xios_field('w_plm',zw2_bis)
2359         CALL send_xios_field('entr',entr)
2360         CALL send_xios_field('detr',detr)
2361!         CALL send_xios_field('fm',fm_bis)
2362!         CALL send_xios_field('fraca',fraca)
2363      ENDIF
2364     
2365      IF (water) THEN
2366         CALL send_xios_field('h2o_vap',zq(:,:,igcm_h2o_vap))
2367         CALL send_xios_field('h2o_ice',zq(:,:,igcm_h2o_ice))
2368      ENDIF
2369     
2370      CALL send_xios_field("ISR",fluxtop_dn)
2371      CALL send_xios_field("OLR",fluxtop_lw)
2372     
2373      if (lastcall.and.is_omp_master) then
2374        write(*,*) "physiq: call xios_context_finalize"
2375        call xios_context_finalize
2376      endif
2377#endif
2378     
2379      icount=icount+1
2380     
2381      end subroutine physiq
2382     
2383   end module physiq_mod
Note: See TracBrowser for help on using the repository browser.