| 1 | !======================================================================================================================! |
|---|
| 2 | ! Module: CO2 condensation for the CO2 cloud microphysics =============================================================! |
|---|
| 3 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 4 | ! Authors: Christophe Mathé, Anni Määttänen |
|---|
| 5 | ! Date: 16/04/2020 |
|---|
| 6 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 7 | ! Contains subroutines: |
|---|
| 8 | ! - co2condens4micro: condensation/sublimation of CO2 ice on the ground and compute pressure change resulting |
|---|
| 9 | ! |
|---|
| 10 | ! - vl1d: Van-Leer scheme |
|---|
| 11 | !======================================================================================================================! |
|---|
| 12 | module co2condens_mod4micro |
|---|
| 13 | |
|---|
| 14 | implicit none |
|---|
| 15 | |
|---|
| 16 | contains |
|---|
| 17 | !======================================================================================================================! |
|---|
| 18 | ! SUBROUTINE: co2condens4micro ========================================================================================! |
|---|
| 19 | !======================================================================================================================! |
|---|
| 20 | ! Subject: |
|---|
| 21 | !--------- |
|---|
| 22 | ! Condensation/sublimation of CO2 ice on the ground and compute pressure change resulting |
|---|
| 23 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 24 | ! Comments: |
|---|
| 25 | !---------- |
|---|
| 26 | ! Adapted from co2condens_mod.F |
|---|
| 27 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 28 | ! Paper: |
|---|
| 29 | !------- |
|---|
| 30 | ! Forget et al. (2008), "Non condensable gas enrichment and depletion in the Martian polar regions." |
|---|
| 31 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 32 | ! Algorithm: |
|---|
| 33 | !----------- |
|---|
| 34 | ! 1. Initialization |
|---|
| 35 | ! 2. Firstcall |
|---|
| 36 | ! 3. Compute CO2 Volume mixing ratio |
|---|
| 37 | ! 4. Set zcondicea, zfallice from co2clouds condensation rate and set zt |
|---|
| 38 | ! 5. Main co2condens |
|---|
| 39 | ! 5.1. Forecast of ground temperature ztsrf and frost temperature ztcondsol |
|---|
| 40 | ! 5.2. Check if we have condensation/sublimation on the ground |
|---|
| 41 | ! 5.3. Compute zfallheat |
|---|
| 42 | ! 5.4. Compute direct condensation/sublimation of CO2 ice |
|---|
| 43 | ! 5.4.a. If there is not enough CO2 tracer in 1st layer to condense |
|---|
| 44 | ! 5.4.b. If the entire CO2 ice layer sublimes (including what has just condensed in the atmosphere) |
|---|
| 45 | ! 5.5. Changing CO2 ice amount and pressure |
|---|
| 46 | ! 5.6. Surface albedo and emissivity of the surface below the snow (emisref) |
|---|
| 47 | ! 5.6.a. Check that amont of CO2 ice is not problematic |
|---|
| 48 | ! 5.6.b. Set albedo and emissivity of the surface |
|---|
| 49 | ! 5.6.c. Set pemisurf to emissiv when there is bare surface (needed for co2snow) |
|---|
| 50 | ! 5.7. Correction to account for redistribution between sigma or hybrid layers when changing surface pressure (and |
|---|
| 51 | ! warming/cooling of the CO2 currently changing phase). |
|---|
| 52 | ! 5.7.a. Mass fluxes through the sigma levels (kg.m-2.s-1) (>0 when up) |
|---|
| 53 | ! 5.7.b. Mass of each layer at the end of timestep |
|---|
| 54 | ! 5.7.c. Corresponding fluxes for T, U, V and Q (averaging operator for transport) |
|---|
| 55 | ! 5.7.c.i. Value transfert at the surface interface when condensation/sublimation |
|---|
| 56 | ! 5.7.c.ii. Van Leer scheme |
|---|
| 57 | ! 5.7.c.iii Compute tendencies on T, U, V, Q |
|---|
| 58 | ! 6. CO2 snow / clouds scheme |
|---|
| 59 | ! 7. Extra special case for surface temperature tendency pdtsrfc |
|---|
| 60 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 61 | subroutine co2condens4micro(ngrid, nlayer, nq, ptimestep, pcapcal, pplay, pplev, ptsrf, pt, pphi, pdt, pdu, pdv, & |
|---|
| 62 | pdtsrf, pu, pv, pq, pdq, piceco2, psolaralb, pemisurf, pdtc, pdtsrfc, pdpsrf, pduc, & |
|---|
| 63 | pdvc, pdqc, fluxsurf_sw, zls, zdqssed_co2, pcondicea_co2microp, zdtcloudco2) |
|---|
| 64 | |
|---|
| 65 | use tracer_mod, only: noms, igcm_co2, igcm_co2_ice, igcm_h2o_vap, igcm_h2o_ice, igcm_dust_number, igcm_dust_mass, & |
|---|
| 66 | igcm_ccnco2_number, igcm_ccnco2_mass, igcm_ccn_mass |
|---|
| 67 | |
|---|
| 68 | use surfdat_h, only: emissiv, phisfi |
|---|
| 69 | |
|---|
| 70 | use geometry_mod, only: latitude, longitude_deg, latitude_deg |
|---|
| 71 | |
|---|
| 72 | use planete_h, only: obliquit |
|---|
| 73 | |
|---|
| 74 | use comcstfi_h, only: cpp, g, r, pi |
|---|
| 75 | |
|---|
| 76 | #ifndef MESOSCALE |
|---|
| 77 | use vertical_layers_mod, only: ap, bp |
|---|
| 78 | #endif |
|---|
| 79 | |
|---|
| 80 | implicit none |
|---|
| 81 | |
|---|
| 82 | include "callkeys.h" |
|---|
| 83 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 84 | ! VARIABLE DECLARATION |
|---|
| 85 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 86 | ! Input arguments: |
|---|
| 87 | !----------------- |
|---|
| 88 | integer, intent(in) :: & |
|---|
| 89 | nq, &! number of tracers |
|---|
| 90 | ngrid, &! number of atmospheric columns |
|---|
| 91 | nlayer ! number of vertical layers |
|---|
| 92 | |
|---|
| 93 | real, intent(in) :: & |
|---|
| 94 | ptimestep, &! physics timestep (s) |
|---|
| 95 | pcapcal(ngrid), &! surface specific heat |
|---|
| 96 | pplay(ngrid,nlayer), &! mid-layer pressure (Pa) |
|---|
| 97 | pplev(ngrid,nlayer+1), &! inter-layer pressure (Pa) |
|---|
| 98 | ptsrf(ngrid), &! surface temperature (K) |
|---|
| 99 | pphi(ngrid,nlayer), &! geopotential (m2.s-2) |
|---|
| 100 | pt(ngrid,nlayer), &! atmospheric temperature (K) |
|---|
| 101 | pu(ngrid,nlayer), &! zonal wind (m/s) |
|---|
| 102 | pv(ngrid,nlayer), &! meridional wind (m/s) |
|---|
| 103 | pdt(ngrid,nlayer), &! tendency on temperature from previous physical processes (K/s) |
|---|
| 104 | pdu(ngrid,nlayer), &! tendency on zonal wind from previous physical processes(m/s2) |
|---|
| 105 | pdv(ngrid,nlayer), &! tendency on meridional wind from previous physical processes (m/s2) |
|---|
| 106 | pdtsrf(ngrid), &! tendency on surface temperature from previous physical processes (K/s) |
|---|
| 107 | pq(ngrid,nlayer,nq), &! tracers (../kg_air) |
|---|
| 108 | pdq(ngrid,nlayer,nq), &! tendency on tracers from previous physical processes |
|---|
| 109 | zdqssed_co2(ngrid), &! CO2 flux at the surface (kg.m-2.s-1) |
|---|
| 110 | zdtcloudco2(ngrid,nlayer), &! tendency on temperature due to latent heat |
|---|
| 111 | fluxsurf_sw(ngrid,2), &! added to calculate flux dependent albedo |
|---|
| 112 | zls, &! solar longitude (rad) |
|---|
| 113 | pcondicea_co2microp(ngrid,nlayer) ! tendency due to CO2 condensation (kg/kg.s-1) |
|---|
| 114 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 115 | ! In/output arguments: |
|---|
| 116 | !--------------------- |
|---|
| 117 | real, intent(inout) :: & |
|---|
| 118 | piceco2(ngrid), &! CO2 ice on the surface (kg.m-2) |
|---|
| 119 | pemisurf(ngrid), &! emissivity of the surface |
|---|
| 120 | psolaralb(ngrid,2) ! albedo of the surface |
|---|
| 121 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 122 | ! Output arguments: |
|---|
| 123 | !------------------ |
|---|
| 124 | real, intent(out) :: & |
|---|
| 125 | pdtc(ngrid,nlayer), &! tendency on temperature dT/dt due to cond/sub (K/s) |
|---|
| 126 | pdtsrfc(ngrid), &! tendency on surface temperature (K/s) |
|---|
| 127 | pdpsrf(ngrid), &! tendency on surface pressure (Pa/s) |
|---|
| 128 | pduc(ngrid,nlayer), &! tendency on zonal wind (m.s-2) |
|---|
| 129 | pdvc(ngrid,nlayer), &! tendency on meridional wind (m.s-2) |
|---|
| 130 | pdqc(ngrid,nlayer,nq) ! tendency on tracers |
|---|
| 131 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 132 | ! Local: |
|---|
| 133 | !------- |
|---|
| 134 | !----1) Parameters: |
|---|
| 135 | !------------------ |
|---|
| 136 | real, parameter :: & |
|---|
| 137 | latcond = 595594, &! latent heat of solid CO2 ice (J/kg) |
|---|
| 138 | cpice = 1000., &! specific heat of CO2 ice (J.kg-1.K-1) |
|---|
| 139 | tcond1mb = 136.27,&! condensation temperature at 1 mbar (K) |
|---|
| 140 | m_co2 = 44.01E-3, &! CO2 molecular mass (kg/mol) |
|---|
| 141 | m_noco2 = 33.37E-3 ! non condensible molecular mass (kg/mol) |
|---|
| 142 | |
|---|
| 143 | logical, parameter :: & |
|---|
| 144 | improved_ztcond = .true. ! improved_ztcond flag: If set to .true. (AND running with a 'co2' tracer) then |
|---|
| 145 | ! condensation temperature is computed using partial pressure of CO2 |
|---|
| 146 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 147 | !----2) Saved: |
|---|
| 148 | !------------- |
|---|
| 149 | real, save :: & |
|---|
| 150 | A, &! coefficient used to compute mean molecular mass |
|---|
| 151 | B, &! coefficient used to compute mean molecular mass |
|---|
| 152 | acond,&! coefficient used to compute ztcondsol |
|---|
| 153 | bcond,&! coefficient used to compute ztcondsol |
|---|
| 154 | ccond ! coefficient used to compute ztcondsol |
|---|
| 155 | |
|---|
| 156 | logical, save :: & |
|---|
| 157 | firstcall = .true. ! Used to compute saved variables |
|---|
| 158 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 159 | !----3) Variables: |
|---|
| 160 | !----------------- |
|---|
| 161 | integer :: & |
|---|
| 162 | l, &! loop on layers |
|---|
| 163 | ig, &! loop on ngrid points |
|---|
| 164 | iq ! loop on tracer |
|---|
| 165 | |
|---|
| 166 | real :: & |
|---|
| 167 | qco2, &! effective quantity of CO2, used to compute mean molecular mass |
|---|
| 168 | mmean, &! mean molecular mass |
|---|
| 169 | zfallheat, &! aerodynamical friction and energy used to heat the amount of ice |
|---|
| 170 | zmflux(nlayer+1), &! mass fluxes through the sigma levels (kg.m-2.s-1) |
|---|
| 171 | zu(nlayer), &! effective zonal wind |
|---|
| 172 | zv(nlayer), &! effective meridional wind |
|---|
| 173 | zq(nlayer,nq), &! effective tracers quantities |
|---|
| 174 | zq1(nlayer), &! buffer of zq |
|---|
| 175 | ztsrf(ngrid), &! effective temperature at the surface |
|---|
| 176 | ztm(nlayer+1), &! temperature fluxes through the sigma levels |
|---|
| 177 | zum(nlayer+1), &! zonal wind fluxes through the sigma levels |
|---|
| 178 | zvm(nlayer+1), &! meridional wind fluxes through the sigma levels |
|---|
| 179 | zqm(nlayer+1,nq), &! quantity of tracers flux through the sigma levels |
|---|
| 180 | zqm1(nlayer), &! quantity of tracers after Van-Leer scheme |
|---|
| 181 | masse(nlayer), &! mass layer (kg) |
|---|
| 182 | w(nlayer+1), &! total mass fluxes through the sigma levels during ptimestep (kg.m-2) |
|---|
| 183 | availco2, &! available quantity of co2 (kg) |
|---|
| 184 | emisref(ngrid), &! emissivity reference |
|---|
| 185 | vmr_co2(ngrid,nlayer), &! CO2 volume mixing ratio |
|---|
| 186 | zt(nlayer), &! effective temperature in the atmosphere (K) |
|---|
| 187 | ztcond(ngrid,nlayer+1), &! CO2 condensation temperature (atm) |
|---|
| 188 | ztcondsol(ngrid), &! CO2 condensation temperature (surface) |
|---|
| 189 | zdiceco2(ngrid), &! tendency on co2ice surface tracer (kg/m2/s) |
|---|
| 190 | zcondicea(ngrid,nlayer),&! condensation rate in layer l (kg/m2/s) |
|---|
| 191 | zcondices(ngrid), &! condensation rate on the ground (kg/m2/s) |
|---|
| 192 | zfallice(ngrid) ! amount of ice falling from layer l (kg/m2/s) |
|---|
| 193 | |
|---|
| 194 | logical :: & |
|---|
| 195 | condsub(ngrid) ! True if there is condensation/sublimation (used for co2snow) |
|---|
| 196 | |
|---|
| 197 | |
|---|
| 198 | ! check with co2 cloud parameterisation |
|---|
| 199 | real :: & |
|---|
| 200 | zt_2(ngrid,nlayer), & |
|---|
| 201 | ztcond_2(ngrid,nlayer+1), & |
|---|
| 202 | zfallice_2(ngrid,nlayer+1), & |
|---|
| 203 | pdtc_2(ngrid,nlayer), & |
|---|
| 204 | zfallheat_2, & |
|---|
| 205 | zcondicea_2(ngrid,nlayer), & |
|---|
| 206 | diff_zcondicea(ngrid,nlayer), & |
|---|
| 207 | diff_zfallice(ngrid) |
|---|
| 208 | !======================================================================================================================! |
|---|
| 209 | ! BEGIN ===============================================================================================================! |
|---|
| 210 | !======================================================================================================================! |
|---|
| 211 | ! 1. Initialization |
|---|
| 212 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 213 | availco2 = 0. |
|---|
| 214 | zfallheat = 0. |
|---|
| 215 | zt(1:nlayer) = 0. |
|---|
| 216 | ztcond(1:ngrid, 1:nlayer+1) = 0. |
|---|
| 217 | ztcondsol(1:ngrid) = 0. |
|---|
| 218 | zmflux(1:nlayer+1) = 0. |
|---|
| 219 | zu(1:nlayer) = 0. |
|---|
| 220 | zv(1:nlayer) = 0. |
|---|
| 221 | zq(1:nlayer, 1:nq) = 0. |
|---|
| 222 | zq1(1:nlayer) = 0. |
|---|
| 223 | ztsrf(1:ngrid) = 0. |
|---|
| 224 | ztm(1:nlayer+1) = 0. |
|---|
| 225 | zum(1:nlayer+1) = 0. |
|---|
| 226 | zvm(1:nlayer+1) = 0. |
|---|
| 227 | zqm(1:nlayer+1, 1:nq) = 0. |
|---|
| 228 | masse(1:nlayer) = 0. |
|---|
| 229 | w(1:nlayer+1) = 0. |
|---|
| 230 | emisref(1:ngrid) = 0. |
|---|
| 231 | vmr_co2(1:ngrid, 1:nlayer) = 0. |
|---|
| 232 | zcondices(1:ngrid) = 0. |
|---|
| 233 | pdtsrfc(1:ngrid) = 0. |
|---|
| 234 | pdpsrf(1:ngrid) = 0. |
|---|
| 235 | zdiceco2(1:ngrid) = 0. |
|---|
| 236 | condsub(1:ngrid) = .false. |
|---|
| 237 | zcondicea(1:ngrid, 1:nlayer) = 0. |
|---|
| 238 | zfallice(1:ngrid) = 0. |
|---|
| 239 | pduc(1:ngrid, 1:nlayer) = 0. |
|---|
| 240 | pdvc(1:ngrid, 1:nlayer) = 0. |
|---|
| 241 | pdqc(1:ngrid, 1:nlayer, 1:nq) = 0. |
|---|
| 242 | pdtc(1:ngrid,1:nlayer) = 0. |
|---|
| 243 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 244 | ! 2. Firstcall |
|---|
| 245 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 246 | ! AS: firstcall OK absolute |
|---|
| 247 | if (firstcall) then |
|---|
| 248 | firstcall = .false. |
|---|
| 249 | |
|---|
| 250 | bcond = 1. / tcond1mb |
|---|
| 251 | ccond = cpp / (g*latcond) |
|---|
| 252 | acond = r / latcond |
|---|
| 253 | |
|---|
| 254 | write(*,*)'CO2condens: improved_ztcond=', improved_ztcond |
|---|
| 255 | write(*,*)'In co2condens:Tcond(P=1mb)=', tcond1mb, ' Lcond=', latcond |
|---|
| 256 | write(*,*)'acond,bcond,ccond', acond, bcond, ccond |
|---|
| 257 | |
|---|
| 258 | ! Prepare Special treatment if one of the tracer is CO2 gas. Compute A and B coefficient use to compute mean molecular |
|---|
| 259 | ! mass Mair defined by: |
|---|
| 260 | ! 1/Mair = q(igcm_co2)/m_co2 + (1-q(igcm_co2))/m_noco2 |
|---|
| 261 | ! 1/Mair = A*q(igcm_co2) + B |
|---|
| 262 | A = (1./m_co2 - 1./m_noco2) |
|---|
| 263 | B = 1./m_noco2 |
|---|
| 264 | end if ! of IF (firstcall) |
|---|
| 265 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 266 | ! 3. Compute CO2 Volume mixing ratio |
|---|
| 267 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 268 | if (improved_ztcond.and.(igcm_co2/=0)) then |
|---|
| 269 | do l = 1, nlayer |
|---|
| 270 | do ig = 1, ngrid |
|---|
| 271 | qco2 = pq(ig,l,igcm_co2) + pdq(ig,l,igcm_co2)*ptimestep |
|---|
| 272 | ! Mean air molecular mass = 1/(q(igcm_co2)/m_co2 + (1-q(igcm_co2))/m_noco2) |
|---|
| 273 | mmean = 1. / (A*qco2 +B) |
|---|
| 274 | vmr_co2(ig,l) = (qco2*mmean) / m_co2 |
|---|
| 275 | end do |
|---|
| 276 | end do |
|---|
| 277 | else |
|---|
| 278 | do l = 1, nlayer |
|---|
| 279 | do ig = 1, ngrid |
|---|
| 280 | vmr_co2(ig,l) = 0.95 |
|---|
| 281 | end do |
|---|
| 282 | end do |
|---|
| 283 | end if |
|---|
| 284 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 285 | ! 4. Set zcondicea, zfallice from co2clouds condensation rate |
|---|
| 286 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 287 | do l = nlayer, 1, -1 |
|---|
| 288 | do ig = 1, ngrid |
|---|
| 289 | zcondicea(ig,l) = pcondicea_co2microp(ig,l) * (pplev(ig,l) - pplev(ig,l+1))/g |
|---|
| 290 | end do |
|---|
| 291 | end do |
|---|
| 292 | |
|---|
| 293 | ! Only sedimentation falls on the ground ! |
|---|
| 294 | do ig = 1, ngrid |
|---|
| 295 | zfallice(ig) = zdqssed_co2(ig) |
|---|
| 296 | piceco2(ig) = piceco2(ig) + zfallice(ig)*ptimestep |
|---|
| 297 | end do |
|---|
| 298 | |
|---|
| 299 | call writediagfi(ngrid, "zcondicea","Condensation rate in layers", " ", 3, zcondicea) |
|---|
| 300 | |
|---|
| 301 | call writediagfi(ngrid,"zfallice", "Sedimentation rate", " ", 2, zfallice) |
|---|
| 302 | |
|---|
| 303 | ! Compute without microphysics |
|---|
| 304 | diff_zcondicea(1:ngrid, 1:nlayer) = 0. |
|---|
| 305 | diff_zfallice(1:ngrid) = 0. |
|---|
| 306 | do l =1, nlayer |
|---|
| 307 | do ig = 1, ngrid |
|---|
| 308 | zt_2(ig,l) = pt(ig,l) + pdt(ig,l)*ptimestep |
|---|
| 309 | end do |
|---|
| 310 | end do |
|---|
| 311 | |
|---|
| 312 | do l = 1, nlayer |
|---|
| 313 | do ig = 1, ngrid |
|---|
| 314 | if (pplay(ig,l).ge.1e-4) then |
|---|
| 315 | ztcond_2(ig,l) = 1. / (bcond-acond*log(.01*vmr_co2(ig,l)*pplay(ig,l))) |
|---|
| 316 | else |
|---|
| 317 | ztcond_2(ig,l) = 0.0 !mars Monica |
|---|
| 318 | endif |
|---|
| 319 | end do |
|---|
| 320 | end do |
|---|
| 321 | |
|---|
| 322 | ztcond_2(:,nlayer+1)=ztcond_2(:,nlayer) |
|---|
| 323 | zfallice_2(:,:) = 0. |
|---|
| 324 | zcondicea_2(:,:) = 0. |
|---|
| 325 | do l = nlayer , 1, -1 |
|---|
| 326 | do ig = 1, ngrid |
|---|
| 327 | pdtc_2(ig,l) = 0. |
|---|
| 328 | if ((zt_2(ig,l).lt.ztcond_2(ig,l)).or.(zfallice_2(ig,l+1).gt.0)) then |
|---|
| 329 | if (zfallice_2(ig,l+1).gt.0) then |
|---|
| 330 | zfallheat_2 = zfallice_2(ig,l+1)*(pphi(ig,l+1)-pphi(ig,l) + cpice*(ztcond_2(ig,l+1)-ztcond_2(ig,l)))/latcond |
|---|
| 331 | else |
|---|
| 332 | zfallheat_2 = 0. |
|---|
| 333 | end if |
|---|
| 334 | pdtc_2(ig,l) = (ztcond_2(ig,l) - zt_2(ig,l))/ptimestep |
|---|
| 335 | zcondicea_2(ig,l) = (pplev(ig,l)-pplev(ig,l+1))*ccond*pdtc(ig,l)- zfallheat_2 |
|---|
| 336 | ! Case when the ice from above sublimes entirely |
|---|
| 337 | ! """"""""""""""""""""""""""""""""""""""""""""""" |
|---|
| 338 | if (zfallice_2(ig,l+1).lt.- zcondicea_2(ig,l)) then |
|---|
| 339 | zcondicea_2(ig,l)= -zfallice_2(ig,l+1) |
|---|
| 340 | end if |
|---|
| 341 | zfallice_2(ig,l) = zcondicea_2(ig,l)+zfallice_2(ig,l+1) |
|---|
| 342 | end if |
|---|
| 343 | end do |
|---|
| 344 | end do |
|---|
| 345 | diff_zcondicea(:,:) = zcondicea_2(:,:) - zcondicea(:,:) |
|---|
| 346 | diff_zfallice(:) = zfallice_2(:,1) - zfallice(:) |
|---|
| 347 | call writediagfi(ngrid, "diff_zfallice", "sans - avec microphysique", "", 2, diff_zfallice) |
|---|
| 348 | call writediagfi(ngrid, "diff_zcondicea", "sans - avec microphysique", "", 3, diff_zcondicea) |
|---|
| 349 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 350 | ! 5. Main co2condens |
|---|
| 351 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 352 | do ig = 1, ngrid |
|---|
| 353 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 354 | ! 5.1. Forecast of ground temperature ztsrf and frost temperature ztcondsol |
|---|
| 355 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 356 | ztcondsol(ig) = 1. / (bcond-acond*log(.01*vmr_co2(ig,1)*pplev(ig,1))) |
|---|
| 357 | ztsrf(ig) = ptsrf(ig) + pdtsrf(ig)*ptimestep |
|---|
| 358 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 359 | ! 5.2. Check if we have condensation/sublimation on the ground |
|---|
| 360 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 361 | ! ground condensation || falling snow || ground sublimation |
|---|
| 362 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 363 | if ((ztsrf(ig)<ztcondsol(ig)) .OR. (zfallice(ig)/=0.) .OR. ((ztsrf(ig)>ztcondsol(ig)) .AND. (piceco2(ig)/=0.))) then |
|---|
| 364 | condsub(ig) = .true. |
|---|
| 365 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 366 | ! 5.3. Compute zfallheat |
|---|
| 367 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 368 | zfallheat = 0. |
|---|
| 369 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 370 | ! 5.4. Compute direct condensation/sublimation of CO2 ice |
|---|
| 371 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 372 | zcondices(ig) = pcapcal(ig) * (ztcondsol(ig)-ztsrf(ig)) / (latcond*ptimestep) - zfallheat |
|---|
| 373 | pdtsrfc(ig) = (ztcondsol(ig) - ztsrf(ig)) / ptimestep |
|---|
| 374 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 375 | ! 5.4.a. If there is not enough CO2 tracer in 1st layer to condense |
|---|
| 376 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 377 | ! Available CO2 tracer in layer 1 at end of timestep (kg/m2) |
|---|
| 378 | #ifndef MESOSCALE |
|---|
| 379 | availco2 = pq(ig,1,igcm_co2) * ( (ap(1)-ap(2)) + (bp(1)-bp(2)) * (pplev(ig,1)/g - zcondices(ig)*ptimestep) ) |
|---|
| 380 | #else |
|---|
| 381 | availco2 = pq(ig,1,igcm_co2) |
|---|
| 382 | PRINT*, "MESOSCALE: CO2 tracer AT FIRST LEVEL IS NOT CORRECTED FROM SIGMA LEVELS" |
|---|
| 383 | #endif |
|---|
| 384 | if ( zcondices(ig) * ptimestep>availco2 ) then |
|---|
| 385 | zcondices(ig) = availco2/ptimestep |
|---|
| 386 | zdiceco2(ig) = zcondices(ig) + zfallice(ig) |
|---|
| 387 | pdtsrfc(ig) = (latcond/pcapcal(ig)) * (zcondices(ig)+zfallheat) |
|---|
| 388 | end if |
|---|
| 389 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 390 | ! 5.4.b. If the entire CO2 ice layer sublimes (including what has just condensed in the atmosphere) |
|---|
| 391 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 392 | if ( (piceco2(ig)/ptimestep) <= -zcondices(ig) ) then |
|---|
| 393 | zcondices(ig) = -piceco2(ig)/ptimestep |
|---|
| 394 | pdtsrfc(ig) = (latcond/pcapcal(ig)) * (zcondices(ig)+zfallheat) |
|---|
| 395 | end if |
|---|
| 396 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 397 | ! 5.5. Changing CO2 ice amount and pressure |
|---|
| 398 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 399 | zdiceco2(ig) = zcondices(ig) + zfallice(ig) + sum(zcondicea(ig,:)) |
|---|
| 400 | piceco2(ig) = piceco2(ig) + zcondices(ig)*ptimestep |
|---|
| 401 | pdpsrf(ig) = -zdiceco2(ig) * g |
|---|
| 402 | |
|---|
| 403 | if (abs(pdpsrf(ig)*ptimestep)>pplev(ig,1)) then |
|---|
| 404 | print *, 'STOP in condens' |
|---|
| 405 | print *, 'condensing more than total mass' |
|---|
| 406 | print *, 'Grid point ', ig |
|---|
| 407 | print *, 'Longitude(degrees): ', longitude_deg(ig) |
|---|
| 408 | print *, 'Latitude(degrees): ', latitude_deg(ig) |
|---|
| 409 | print *, 'Ps = ', pplev(ig,1) |
|---|
| 410 | print *, 'd Ps = ', pdpsrf(ig) |
|---|
| 411 | call abort_physic('co2condens4micro', 'condensing more than total mass', 1) |
|---|
| 412 | end if |
|---|
| 413 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 414 | ! 5.6. Surface albedo and emissivity of the surface below the snow (emisref) |
|---|
| 415 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 416 | ! 5.6.a. Check that amont of CO2 ice is not problematic |
|---|
| 417 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 418 | if(.not.piceco2(ig)>=0.) then |
|---|
| 419 | if(piceco2(ig)<=-5.e-8) then |
|---|
| 420 | write(*,*)'WARNING co2condens piceco2(', ig, ')=', piceco2(ig) |
|---|
| 421 | piceco2(ig) = 0. |
|---|
| 422 | end if |
|---|
| 423 | end if |
|---|
| 424 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 425 | ! 5.6.c. Set pemisurf to emissiv when there is bare surface (needed for co2snow) |
|---|
| 426 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 427 | if (piceco2(ig)==0) then |
|---|
| 428 | pemisurf(ig) = emissiv |
|---|
| 429 | end if |
|---|
| 430 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 431 | ! 5.7. Correction to account for redistribution between sigma or hybrid layers when changing surface pressure (and |
|---|
| 432 | ! warming/cooling of the CO2 currently changing phase). |
|---|
| 433 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 434 | do l= 1, nlayer |
|---|
| 435 | zt(l) = pt(ig,l) + pdt(ig,l)*ptimestep |
|---|
| 436 | zu(l) = pu(ig,l) + pdu(ig,l)*ptimestep |
|---|
| 437 | zv(l) = pv(ig,l) + pdv(ig,l)*ptimestep |
|---|
| 438 | do iq=1,nq |
|---|
| 439 | zq(l,iq) = pq(ig,l,iq) + pdq(ig,l,iq)*ptimestep |
|---|
| 440 | end do |
|---|
| 441 | end do |
|---|
| 442 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 443 | ! 5.7.a. Mass fluxes through the sigma levels (kg.m-2.s-1) (>0 when up) |
|---|
| 444 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 445 | zmflux(1) = - zcondices(ig) - zfallice(ig) |
|---|
| 446 | do l = 1, nlayer |
|---|
| 447 | #ifndef MESOSCALE |
|---|
| 448 | zmflux(l+1) = zmflux(l) - zcondicea(ig,l) & |
|---|
| 449 | + (bp(l)-bp(l+1)) * (-pdpsrf(ig)/g) |
|---|
| 450 | ! zmflux set to 0 if very low to avoid: top layer is disappearing in v1ld |
|---|
| 451 | if (abs(zmflux(l+1))<1E-13.OR.bp(l+1)==0.) then |
|---|
| 452 | zmflux(l+1) = 0. |
|---|
| 453 | end if |
|---|
| 454 | #else |
|---|
| 455 | zmflux(l+1) = zmflux(l) - zcondicea(ig,l) |
|---|
| 456 | if (abs(zmflux(l+1))<1E-13) then |
|---|
| 457 | zmflux(l+1) = 0. |
|---|
| 458 | end if |
|---|
| 459 | PRINT*, "MESOSCALE: FLUX THROUGH SIGMA LEVELS from dPS HAVE TO BE IMPLEMENTED" |
|---|
| 460 | #endif |
|---|
| 461 | end do |
|---|
| 462 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 463 | ! 5.7.b. Mass of each layer at the end of timestep |
|---|
| 464 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 465 | do l = 1, nlayer |
|---|
| 466 | #ifndef MESOSCALE |
|---|
| 467 | masse(l) = (pplev(ig,l) - pplev(ig,l+1) + (bp(l)-bp(l+1))*pdpsrf(ig)*ptimestep)/g |
|---|
| 468 | #else |
|---|
| 469 | masse(l) = (pplev(ig,l) - pplev(ig,l+1))/g |
|---|
| 470 | PRINT*, "MESOSCALE: MASS OF EACH LAYER IS NOT CORRECTED AT END OF TIMESTEP (from SIGMA LEVELS and dPS)" |
|---|
| 471 | #endif |
|---|
| 472 | end do |
|---|
| 473 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 474 | ! 5.7.c. Corresponding fluxes for T, U, V and Q (averaging operator for transport) |
|---|
| 475 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 476 | ! 5.7.c.i. Value transfert at the surface interface when condensation/sublimation |
|---|
| 477 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 478 | ztm(1) = ztsrf(ig) + pdtsrfc(ig)*ptimestep |
|---|
| 479 | zum(1) = 0 |
|---|
| 480 | zvm(1) = 0 |
|---|
| 481 | |
|---|
| 482 | ! Most tracer do not condense |
|---|
| 483 | do iq = 1, nq |
|---|
| 484 | zqm(1,iq) = 0. |
|---|
| 485 | end do |
|---|
| 486 | |
|---|
| 487 | ! Special case if one of the tracer is CO2 gas |
|---|
| 488 | if (igcm_co2/=0) then |
|---|
| 489 | zqm(1,igcm_co2) = 1. ! flux is 100% CO2 |
|---|
| 490 | end if |
|---|
| 491 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 492 | ! 5.7.c.ii. Van Leer scheme |
|---|
| 493 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 494 | do l=1,nlayer |
|---|
| 495 | w(l)=-zmflux(l)*ptimestep |
|---|
| 496 | end do |
|---|
| 497 | |
|---|
| 498 | call vl1d(nlayer,zt,2.,masse,w,ztm) |
|---|
| 499 | call vl1d(nlayer,zu ,2.,masse,w,zum) |
|---|
| 500 | call vl1d(nlayer,zv ,2.,masse,w,zvm) |
|---|
| 501 | |
|---|
| 502 | do iq=1, nq |
|---|
| 503 | do l=1, nlayer |
|---|
| 504 | zq1(l) = zq(l,iq) |
|---|
| 505 | end do |
|---|
| 506 | |
|---|
| 507 | zqm1(1) = zqm(1,iq) |
|---|
| 508 | zqm1(2:nlayer) = 0. |
|---|
| 509 | |
|---|
| 510 | call vl1d(nlayer,zq1,2.,masse,w,zqm1) |
|---|
| 511 | |
|---|
| 512 | do l = 2, nlayer |
|---|
| 513 | zq(l,iq) = zq1(l) |
|---|
| 514 | zqm(l,iq) = zqm1(l) |
|---|
| 515 | end do |
|---|
| 516 | end do |
|---|
| 517 | |
|---|
| 518 | ! Surface condensation affects low winds |
|---|
| 519 | if (zmflux(1)<0) then |
|---|
| 520 | zum(1) = zu(1) * (w(1)/masse(1)) |
|---|
| 521 | zvm(1) = zv(1) * (w(1)/masse(1)) |
|---|
| 522 | if (w(1)>masse(1)) then ! ensure numerical stability |
|---|
| 523 | zum(1) = ((zu(1)-zum(2))*masse(1)/w(1)) + zum(2) |
|---|
| 524 | zvm(1) = ((zv(1)-zvm(2))*masse(1)/w(1)) + zvm(2) |
|---|
| 525 | end if |
|---|
| 526 | end if |
|---|
| 527 | |
|---|
| 528 | ztm(nlayer+1) = zt(nlayer) ! should not be used, but... |
|---|
| 529 | zum(nlayer+1) = zu(nlayer) ! should not be used, but... |
|---|
| 530 | zvm(nlayer+1) = zv(nlayer) ! should not be used, but... |
|---|
| 531 | |
|---|
| 532 | do iq = 1, nq |
|---|
| 533 | zqm(nlayer+1,iq) = zq(nlayer,iq) |
|---|
| 534 | end do |
|---|
| 535 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 536 | ! 5.7.c.iii Compute tendencies on T, U, V, Q |
|---|
| 537 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 538 | #ifdef MESOSCALE |
|---|
| 539 | ! AS: This part must be commented in the mesoscale model |
|---|
| 540 | ! AS: ... to avoid instabilities. |
|---|
| 541 | ! AS: you have to compile with -DMESOSCALE to do so |
|---|
| 542 | #else |
|---|
| 543 | do l = 1, nlayer |
|---|
| 544 | ! Tendencies on T |
|---|
| 545 | pdtc(ig,l) = (1./masse(l)) * ( zmflux(l)*(ztm(l) - zt(l)) - zmflux(l+1)*(ztm(l+1) - zt(l)) ) |
|---|
| 546 | |
|---|
| 547 | ! Tendencies on U |
|---|
| 548 | pduc(ig,l) = (1./masse(l)) * ( zmflux(l)*(zum(l) - zu(l)) - zmflux(l+1)*(zum(l+1) - zu(l)) ) |
|---|
| 549 | |
|---|
| 550 | ! Tendencies on V |
|---|
| 551 | pdvc(ig,l) = (1./masse(l)) * ( zmflux(l)*(zvm(l) - zv(l)) - zmflux(l+1)*(zvm(l+1) - zv(l)) ) |
|---|
| 552 | end do |
|---|
| 553 | #endif |
|---|
| 554 | ! Tendencies on Q |
|---|
| 555 | do iq = 1, nq |
|---|
| 556 | if (iq==igcm_co2) then |
|---|
| 557 | do l = 1, nlayer |
|---|
| 558 | pdqc(ig,l,iq) = (1./masse(l)) * (zmflux(l)*(zqm(l,iq) - zq(l,iq))- zmflux(l+1)*(zqm(l+1,iq) - zq(l,iq))& |
|---|
| 559 | + zcondicea(ig,l)*(zq(l,iq) - 1.)) |
|---|
| 560 | end do |
|---|
| 561 | else |
|---|
| 562 | do l = 1, nlayer |
|---|
| 563 | pdqc(ig,l,iq) = (1./masse(l)) * ( zmflux(l)*(zqm(l,iq)-zq(l,iq)) - zmflux(l+1)*(zqm(l+1,iq)-zq(l,iq))& |
|---|
| 564 | + zcondicea(ig,l)*zq(l,iq) ) |
|---|
| 565 | end do |
|---|
| 566 | end if |
|---|
| 567 | end do |
|---|
| 568 | end if ! if |
|---|
| 569 | end do ! loop on ig |
|---|
| 570 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 571 | ! 5.6.b. Set albedo and emissivity of the surface |
|---|
| 572 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 573 | call albedocaps(zls,ngrid,piceco2,psolaralb,emisref) |
|---|
| 574 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 575 | ! 6. CO2 snow / clouds scheme |
|---|
| 576 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 577 | call co2snow(ngrid, nlayer, ptimestep, emisref, condsub, pplev, zcondicea, zcondices, zdqssed_co2, & |
|---|
| 578 | pemisurf) |
|---|
| 579 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 580 | ! 7. Extra special case for surface temperature tendency pdtsrfc: |
|---|
| 581 | ! We want to fix the south pole temperature to CO2 condensation temperature. |
|---|
| 582 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 583 | #ifndef MESOSCALE |
|---|
| 584 | if (caps.and.(obliquit<27.)) then |
|---|
| 585 | ! check if last grid point is the south pole |
|---|
| 586 | if (abs(latitude(ngrid)-(-pi/2.))<1.e-5) then |
|---|
| 587 | ! NB: Updated surface pressure, at grid point 'ngrid', is ps(ngrid)=pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep |
|---|
| 588 | ! write(*,*)"co2condens: South pole: latitude(ngrid)=", latitude(ngrid) |
|---|
| 589 | ztcondsol(ngrid) = 1./(bcond-acond*log(.01*vmr_co2(ngrid,1) * (pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep))) |
|---|
| 590 | pdtsrfc(ngrid) = (ztcondsol(ngrid)-ztsrf(ngrid))/ptimestep |
|---|
| 591 | end if |
|---|
| 592 | end if |
|---|
| 593 | #endif |
|---|
| 594 | !======================================================================================================================! |
|---|
| 595 | ! END =================================================================================================================! |
|---|
| 596 | !======================================================================================================================! |
|---|
| 597 | end subroutine co2condens4micro |
|---|
| 598 | |
|---|
| 599 | |
|---|
| 600 | !**********************************************************************************************************************! |
|---|
| 601 | !**********************************************************************************************************************! |
|---|
| 602 | |
|---|
| 603 | |
|---|
| 604 | !======================================================================================================================! |
|---|
| 605 | ! SUBROUTINE: Van-Leer scheme =========================================================================================! |
|---|
| 606 | !======================================================================================================================! |
|---|
| 607 | ! Subject: |
|---|
| 608 | !--------- |
|---|
| 609 | ! Operateur de moyenne inter-couche pour calcul de transport type Van-Leer " pseudo amont " dans la verticale |
|---|
| 610 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 611 | ! Comments: |
|---|
| 612 | !---------- |
|---|
| 613 | ! q,w are input arguments for the s-pg .... |
|---|
| 614 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 615 | ! Paper: |
|---|
| 616 | !------- |
|---|
| 617 | ! Van-Leer (1977), "Towards the Ultimate Conservative Difference Scheme. IV. A New Approach to Numerical Convection" |
|---|
| 618 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 619 | subroutine vl1d(nlayer,q,pente_max,masse,w,qm) |
|---|
| 620 | |
|---|
| 621 | implicit none |
|---|
| 622 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 623 | ! VARIABLE DECLARATION |
|---|
| 624 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 625 | ! Input arguments: |
|---|
| 626 | !----------------- |
|---|
| 627 | integer, intent(in) :: & |
|---|
| 628 | nlayer ! number of layers |
|---|
| 629 | |
|---|
| 630 | real, intent(in) :: & |
|---|
| 631 | pente_max, &! coefficient, pente_max = 2 advised |
|---|
| 632 | masse(nlayer), &! masse layer Dp/g (kg) |
|---|
| 633 | q(nlayer) ! quantity of tracer |
|---|
| 634 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 635 | ! In-Output arguments: |
|---|
| 636 | !--------------------- |
|---|
| 637 | real, intent(inout) :: & |
|---|
| 638 | w(nlayer+1) ! masse d'atm ``transferee'' a chaque pas de temps (kg.m-2) |
|---|
| 639 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 640 | ! Output arguments: |
|---|
| 641 | !------------------ |
|---|
| 642 | real, intent(out) :: & |
|---|
| 643 | qm(nlayer+1) ! quantity of tracer after Van-Leer scheme |
|---|
| 644 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 645 | ! Locals variables: |
|---|
| 646 | !------------------ |
|---|
| 647 | integer :: & |
|---|
| 648 | l, &! loop on nlayer |
|---|
| 649 | m ! index |
|---|
| 650 | |
|---|
| 651 | real :: & |
|---|
| 652 | dzqmax, &! maximum of dzq between two adjacent layers |
|---|
| 653 | sigw, &! |
|---|
| 654 | Mtot, &! |
|---|
| 655 | MQtot, &! |
|---|
| 656 | dzq(nlayer), &! |
|---|
| 657 | dzqw(nlayer),&! |
|---|
| 658 | adzqw(nlayer) ! |
|---|
| 659 | !======================================================================================================================! |
|---|
| 660 | ! BEGIN ===============================================================================================================! |
|---|
| 661 | !======================================================================================================================! |
|---|
| 662 | ! 1. On oriente tout dans le sens de la pression: w > 0 when down |
|---|
| 663 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 664 | do l = 2, nlayer |
|---|
| 665 | dzqw(l) = q(l-1) - q(l) |
|---|
| 666 | adzqw(l) = abs(dzqw(l)) |
|---|
| 667 | end do |
|---|
| 668 | |
|---|
| 669 | do l = 2, nlayer-1 |
|---|
| 670 | if(dzqw(l)*dzqw(l+1)>0.) then |
|---|
| 671 | dzq(l) = 0.5 * (dzqw(l)+dzqw(l+1)) |
|---|
| 672 | else |
|---|
| 673 | dzq(l) = 0. |
|---|
| 674 | end if |
|---|
| 675 | |
|---|
| 676 | dzqmax = pente_max * min(adzqw(l), adzqw(l+1)) |
|---|
| 677 | |
|---|
| 678 | dzq(l) = sign(min(abs(dzq(l)),dzqmax), dzq(l)) |
|---|
| 679 | end do |
|---|
| 680 | |
|---|
| 681 | dzq(1)=0. |
|---|
| 682 | dzq(nlayer)=0. |
|---|
| 683 | |
|---|
| 684 | do l = 1, nlayer-1 |
|---|
| 685 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 686 | ! 2.1. Regular scheme (transfered mass < layer mass) |
|---|
| 687 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 688 | if (w(l+1)>0. .and. w(l+1)<=masse(l+1)) then |
|---|
| 689 | sigw = w(l+1) / masse(l+1) |
|---|
| 690 | qm(l+1) = (q(l+1) + 0.5*(1.-sigw)*dzq(l+1)) |
|---|
| 691 | else if (w(l+1)<=0. .and. -w(l+1)<=masse(l)) then |
|---|
| 692 | sigw = w(l+1) / masse(l) |
|---|
| 693 | qm(l+1) = (q(l) - 0.5*(1.+sigw)*dzq(l)) |
|---|
| 694 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 695 | ! 2.2. Extended scheme (transfered mass > layer mass) |
|---|
| 696 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 697 | else if (w(l+1)>0.) then |
|---|
| 698 | m = l+1 |
|---|
| 699 | Mtot = masse(m) |
|---|
| 700 | MQtot = masse(m)*q(m) |
|---|
| 701 | |
|---|
| 702 | do while ((m<nlayer).and.(w(l+1)>(Mtot+masse(m+1)))) |
|---|
| 703 | m = m+1 |
|---|
| 704 | Mtot = Mtot + masse(m) |
|---|
| 705 | MQtot = MQtot + masse(m)*q(m) |
|---|
| 706 | end do |
|---|
| 707 | |
|---|
| 708 | if (m<nlayer) then |
|---|
| 709 | sigw = (w(l+1)-Mtot) / masse(m+1) |
|---|
| 710 | qm(l+1) = (1/w(l+1))*( MQtot + (w(l+1)-Mtot)* (q(m+1)+0.5*(1.-sigw)*dzq(m+1)) ) |
|---|
| 711 | else |
|---|
| 712 | w(l+1) = Mtot |
|---|
| 713 | qm(l+1) = Mqtot / Mtot |
|---|
| 714 | call abort_physic('co2condens4micro', 'top layer is disapearing !', 1) |
|---|
| 715 | end if |
|---|
| 716 | !----------------------------------------------------------------------------------------------------------------------! |
|---|
| 717 | else ! if(w(l+1).lt.0) |
|---|
| 718 | m = l-1 |
|---|
| 719 | Mtot = masse(m+1) |
|---|
| 720 | MQtot = masse(m+1)*q(m+1) |
|---|
| 721 | if (m>0) then ! because some compilers will have problems evaluating masse(0) |
|---|
| 722 | do while ((m>0).and.(-w(l+1)>(Mtot+masse(m)))) |
|---|
| 723 | m = m-1 |
|---|
| 724 | Mtot = Mtot + masse(m+1) |
|---|
| 725 | MQtot = MQtot + masse(m+1)*q(m+1) |
|---|
| 726 | if (m==0) then |
|---|
| 727 | call abort_physic('co2condens_mod4micro','vl1d',1) |
|---|
| 728 | end if |
|---|
| 729 | end do |
|---|
| 730 | end if |
|---|
| 731 | |
|---|
| 732 | if (m>0) then |
|---|
| 733 | sigw = (w(l+1)+Mtot) / masse(m) |
|---|
| 734 | qm(l+1) = (-1/w(l+1)) * ( MQtot + (-w(l+1)-Mtot) * (q(m)-0.5*(1.+sigw)*dzq(m)) ) |
|---|
| 735 | else |
|---|
| 736 | qm(l+1) = (-1/w(l+1)) * (MQtot + (-w(l+1)-Mtot)*qm(1)) |
|---|
| 737 | end if |
|---|
| 738 | end if |
|---|
| 739 | end do ! l = 1, nlayer-1 |
|---|
| 740 | !======================================================================================================================! |
|---|
| 741 | ! END =================================================================================================================! |
|---|
| 742 | !======================================================================================================================! |
|---|
| 743 | end subroutine vl1d |
|---|
| 744 | |
|---|
| 745 | end module co2condens_mod4micro |
|---|
