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