| 1 | module updaterad |
|---|
| 2 | |
|---|
| 3 | |
|---|
| 4 | |
|---|
| 5 | ! This module intents to group together all ice and dust radius computations done in the GCM, |
|---|
| 6 | ! so that it stays coherent through the code and make (numerous) radius bugs easier to debug. |
|---|
| 7 | ! All different thresholds values are defined below. |
|---|
| 8 | |
|---|
| 9 | ! Radius computation do not always occur on the whole grid (cf. improvedcloud). |
|---|
| 10 | ! So, subroutines are designed for scalar values instead of tables |
|---|
| 11 | |
|---|
| 12 | ! T. Navarro, June 2012 |
|---|
| 13 | ! CO2 clouds added 09/16 by J. Audouard |
|---|
| 14 | |
|---|
| 15 | ! For instance, if R^3 is lower than r3icemin, then R is set to ricemin. |
|---|
| 16 | ! So, ricemin should be the cubic root of r3icemin, but not necessarily ... |
|---|
| 17 | |
|---|
| 18 | real, parameter :: r3icemin = 1.e-30 ! ie ricemin = 0.0001 microns |
|---|
| 19 | real, parameter :: ricemin = 1.e-10 |
|---|
| 20 | real, parameter :: r3icemax = 125.e-12 ! ie ricemax = 500 microns |
|---|
| 21 | real, parameter :: ricemax = 500.e-6 |
|---|
| 22 | |
|---|
| 23 | double precision, parameter :: r3iceco2min = 1.e-30 |
|---|
| 24 | double precision, parameter :: riceco2min = 1.e-10 |
|---|
| 25 | double precision, parameter :: r3iceco2max = 125.e-12 |
|---|
| 26 | double precision, parameter :: riceco2max = 500.e-6 |
|---|
| 27 | |
|---|
| 28 | real, parameter :: qice_threshold = 1.e-15 ! 1.e-10 |
|---|
| 29 | real, parameter :: qice_co2_threshold = 1.e-30 ! 1.e-10 |
|---|
| 30 | |
|---|
| 31 | real, parameter :: nccn_threshold = 1. |
|---|
| 32 | real, parameter :: qccn_threshold = 1.e-20 |
|---|
| 33 | |
|---|
| 34 | real, parameter :: r3ccnmin = 1.e-21 ! ie rccnmin = 0.1 microns |
|---|
| 35 | real, parameter :: rccnmin = 0.1e-6 |
|---|
| 36 | real, parameter :: rccnCO2min = 1e-9 |
|---|
| 37 | |
|---|
| 38 | real, parameter :: r3ccnmax = 125.e-12 ! ie rccnmax = 500 microns |
|---|
| 39 | real, parameter :: rccnmax = 500.e-6 |
|---|
| 40 | |
|---|
| 41 | real, parameter :: ndust_threshold = 1. |
|---|
| 42 | real, parameter :: qdust_threshold = 1.e-20 |
|---|
| 43 | |
|---|
| 44 | real, parameter :: r3dustmin = 1.e-24 ! ie rdustmin = 0.01 microns |
|---|
| 45 | real, parameter :: rdustmin = 1.e-8 |
|---|
| 46 | |
|---|
| 47 | real, parameter :: r3dustmax = 125.e-12 ! ie rdustmax = 500 microns |
|---|
| 48 | real, parameter :: rdustmax = 500.e-6 |
|---|
| 49 | |
|---|
| 50 | real, parameter :: rdust0 = 0.8e-6 |
|---|
| 51 | |
|---|
| 52 | |
|---|
| 53 | contains |
|---|
| 54 | |
|---|
| 55 | |
|---|
| 56 | !============================================================================ |
|---|
| 57 | !============================================================================ |
|---|
| 58 | !============================================================================ |
|---|
| 59 | ! Update ice radius if microphys == true |
|---|
| 60 | subroutine updaterice_micro(qice,qccn,nccn,coeff,rice,rhocloud) |
|---|
| 61 | use tracer_mod, only: rho_dust, rho_ice |
|---|
| 62 | USE comcstfi_h |
|---|
| 63 | implicit none |
|---|
| 64 | |
|---|
| 65 | real, intent(in) :: qice,qccn,nccn |
|---|
| 66 | real, intent(in) :: coeff ! this coeff is tauscaling if microphy = T (possibly ccn_factor^-1 otherwise) |
|---|
| 67 | real, intent(out) :: rice,rhocloud ! rhocloud is needed for sedimentation and is also a good diagnostic variable |
|---|
| 68 | real nccn_true,qccn_true ! radius of the ice crystal core to the power of 3 |
|---|
| 69 | |
|---|
| 70 | |
|---|
| 71 | nccn_true = max(nccn * coeff, 1.e-30) |
|---|
| 72 | qccn_true = max(qccn * coeff, 1.e-30) |
|---|
| 73 | |
|---|
| 74 | |
|---|
| 75 | !! Nota: It is very dangerous to apply a threshold on qccn or nccn to force rice to be ricemin. |
|---|
| 76 | !! Indeed, one can obtain ricemin for small but non negligible qice values, and therefore hugely opaque clouds. |
|---|
| 77 | |
|---|
| 78 | |
|---|
| 79 | rhocloud = (qice*rho_ice + qccn_true*rho_dust) / (qice + qccn_true) |
|---|
| 80 | rhocloud = min(max(rhocloud,rho_ice),rho_dust) |
|---|
| 81 | |
|---|
| 82 | rice = (qice + qccn_true) * 0.75 / pi / rhocloud / nccn_true |
|---|
| 83 | |
|---|
| 84 | if (rice .le. r3icemin) then |
|---|
| 85 | rice = ricemin |
|---|
| 86 | else if (rice .ge. r3icemax) then |
|---|
| 87 | rice = ricemax |
|---|
| 88 | else |
|---|
| 89 | rice = rice**(1./3.) ! here rice is always positive |
|---|
| 90 | endif |
|---|
| 91 | |
|---|
| 92 | |
|---|
| 93 | end subroutine updaterice_micro |
|---|
| 94 | !============================================================================ |
|---|
| 95 | !============================================================================ |
|---|
| 96 | !============================================================================ |
|---|
| 97 | subroutine updaterice_microco2(qice, qccn, nccn, qccn_h2o, nccn_h2o, temperature, coeff, rice, rhocloudco2) |
|---|
| 98 | use tracer_mod, only: rho_dust, rho_ice |
|---|
| 99 | use comcstfi_h, only: pi |
|---|
| 100 | use density_co2_ice_mod, only: density_co2_ice |
|---|
| 101 | |
|---|
| 102 | implicit none |
|---|
| 103 | !CO2 clouds parameter update by CL and JA 09/16 |
|---|
| 104 | |
|---|
| 105 | DOUBLE PRECISION, intent(in) :: qice,qccn,nccn, qccn_h2o, nccn_h2o |
|---|
| 106 | real, intent(in) :: coeff ! this coeff is tauscaling if microphy = T (possibly ccn_factor^-1 otherwise) |
|---|
| 107 | real, intent(in) :: temperature ! temperature effective for density co2_ice computation |
|---|
| 108 | real, intent(out) :: rhocloudco2 ! rhocloud is needed for sedimentation and is also a good diagnostic variable |
|---|
| 109 | double precision, intent(out) :: rice |
|---|
| 110 | real nccn_true,qccn_true, qccn_h2o_true, nccn_h2o_true ! nombre et masse de CCN |
|---|
| 111 | double precision :: rho_ice_co2T ! density co2_ice Temperature-dependent |
|---|
| 112 | |
|---|
| 113 | nccn_true = max(nccn * coeff, 1.e-30) |
|---|
| 114 | qccn_true = max(qccn * coeff, 1.e-30) |
|---|
| 115 | |
|---|
| 116 | nccn_h2o_true = max(nccn_h2o, 1.e-30) |
|---|
| 117 | qccn_h2o_true = max(qccn_h2o, 1.e-30) |
|---|
| 118 | |
|---|
| 119 | call density_co2_ice(dble(temperature), rho_ice_co2T) |
|---|
| 120 | |
|---|
| 121 | rhocloudco2 = (qice * rho_ice_co2T + qccn_true*rho_dust + qccn_h2o_true*rho_ice) / (qice + qccn_true + qccn_h2o_true) |
|---|
| 122 | |
|---|
| 123 | rhocloudco2 = min(max(rhocloudco2,rho_ice_co2T), rho_dust) |
|---|
| 124 | |
|---|
| 125 | rice = (qice + qccn_true + qccn_h2o_true) * 0.75 / pi / rhocloudco2 / (nccn_true + nccn_h2o_true) |
|---|
| 126 | |
|---|
| 127 | rhocloudco2 = (qice * rho_ice_co2T + qccn_true*rho_dust + qccn_h2o_true*rho_ice) / (qice + qccn_true + qccn_h2o_true) |
|---|
| 128 | |
|---|
| 129 | if (rice <= r3iceco2min) then !r3icemin radius power 3 ? |
|---|
| 130 | rice = riceco2min |
|---|
| 131 | else if (rice >= r3iceco2max) then !r3icemin radius power 3 ? |
|---|
| 132 | rice = riceco2max |
|---|
| 133 | else |
|---|
| 134 | rice = rice**(1./3.) ! here rice is always positive |
|---|
| 135 | endif |
|---|
| 136 | |
|---|
| 137 | |
|---|
| 138 | end subroutine updaterice_microco2 |
|---|
| 139 | |
|---|
| 140 | |
|---|
| 141 | |
|---|
| 142 | !============================================================================ |
|---|
| 143 | !============================================================================ |
|---|
| 144 | !============================================================================ |
|---|
| 145 | ! Update ice radius from a typical profile if microphys == false |
|---|
| 146 | subroutine updaterice_typ(qice,tau,pzlay,rice) |
|---|
| 147 | |
|---|
| 148 | use tracer_mod, only: rho_ice |
|---|
| 149 | USE comcstfi_h, only: pi |
|---|
| 150 | |
|---|
| 151 | implicit none |
|---|
| 152 | |
|---|
| 153 | real, intent(in) :: qice |
|---|
| 154 | real, intent(in) :: tau ! tau for dust |
|---|
| 155 | real, intent(in) :: pzlay ! altitude at the middle of the layers |
|---|
| 156 | real, intent(out) :: rice |
|---|
| 157 | real :: rccn, nccn ! radius and number of ice crystals |
|---|
| 158 | |
|---|
| 159 | ! Typical CCN profile following Montmessin et al. 2004 |
|---|
| 160 | ! (N0=2e6 m-3 has been converted into N0=1.3e8 kg-1 using a typical atmospheric density, |
|---|
| 161 | ! otherwise the equation for rice is not homogeneous...) |
|---|
| 162 | nccn = 1.3e+8*max(tau,0.001)/0.1*exp(-pzlay/10000.) |
|---|
| 163 | ! The previously used profile was not correct: |
|---|
| 164 | ! Nccn=( epaisseur/masse ) * 2.e+6/0.1*max(tau,0.001)*exp(-pzlay/10000.) |
|---|
| 165 | |
|---|
| 166 | if (nccn .le. 1) then |
|---|
| 167 | |
|---|
| 168 | rice = ricemin |
|---|
| 169 | |
|---|
| 170 | else |
|---|
| 171 | |
|---|
| 172 | ! Typical dust radius profile: |
|---|
| 173 | rccn = max(rdust0*exp(-pzlay/18000.),1.e-9) |
|---|
| 174 | rice = qice * 0.75 / pi / rho_ice / nccn + rccn*rccn*rccn |
|---|
| 175 | |
|---|
| 176 | if (rice .le. r3icemin) then |
|---|
| 177 | rice = ricemin |
|---|
| 178 | else if (rice .ge. r3icemax) then |
|---|
| 179 | rice = ricemax |
|---|
| 180 | else |
|---|
| 181 | rice = rice**(1./3.) ! here rice is always positive |
|---|
| 182 | endif |
|---|
| 183 | |
|---|
| 184 | endif |
|---|
| 185 | |
|---|
| 186 | end subroutine updaterice_typ |
|---|
| 187 | !============================================================================ |
|---|
| 188 | !============================================================================ |
|---|
| 189 | !============================================================================ |
|---|
| 190 | |
|---|
| 191 | |
|---|
| 192 | |
|---|
| 193 | |
|---|
| 194 | |
|---|
| 195 | |
|---|
| 196 | !============================================================================ |
|---|
| 197 | !============================================================================ |
|---|
| 198 | !============================================================================ |
|---|
| 199 | ! This subroutine computes the geometric mean radius(or number median radius) |
|---|
| 200 | ! For a lognormal distribution : |
|---|
| 201 | ! geometric mean radius = mass mean radius x exp(-1.5 sigma0^2) |
|---|
| 202 | ! To be used with doubleq == true. otherwise, rdust is constant !!! |
|---|
| 203 | subroutine updaterdust(qdust,ndust,rdust,tauscaling) |
|---|
| 204 | use tracer_mod, only: r3n_q |
|---|
| 205 | USE comcstfi_h |
|---|
| 206 | implicit none |
|---|
| 207 | |
|---|
| 208 | real, intent(in) :: qdust,ndust ! needed if doubleq |
|---|
| 209 | real, intent(in), optional :: tauscaling ! useful for realistic thresholds |
|---|
| 210 | real, intent(out) :: rdust |
|---|
| 211 | real coeff |
|---|
| 212 | |
|---|
| 213 | if (present(tauscaling)) then |
|---|
| 214 | coeff = tauscaling ! thresholds on realistic values |
|---|
| 215 | else |
|---|
| 216 | coeff = 1. ! thresholds on virtual values |
|---|
| 217 | endif |
|---|
| 218 | |
|---|
| 219 | if ((ndust .le. ndust_threshold/coeff) .or. (qdust .le. qdust_threshold/coeff)) then |
|---|
| 220 | |
|---|
| 221 | rdust = rdustmin |
|---|
| 222 | |
|---|
| 223 | else |
|---|
| 224 | |
|---|
| 225 | rdust = r3n_q * qdust / ndust |
|---|
| 226 | |
|---|
| 227 | if (rdust .le. r3dustmin) then |
|---|
| 228 | rdust = rdustmin |
|---|
| 229 | else if (rdust .ge. r3dustmax) then |
|---|
| 230 | rdust = rdustmax |
|---|
| 231 | else |
|---|
| 232 | rdust = rdust**(1./3.) |
|---|
| 233 | endif |
|---|
| 234 | |
|---|
| 235 | endif |
|---|
| 236 | |
|---|
| 237 | |
|---|
| 238 | end subroutine updaterdust |
|---|
| 239 | !============================================================================ |
|---|
| 240 | !============================================================================ |
|---|
| 241 | !============================================================================ |
|---|
| 242 | |
|---|
| 243 | |
|---|
| 244 | |
|---|
| 245 | |
|---|
| 246 | |
|---|
| 247 | |
|---|
| 248 | !============================================================================ |
|---|
| 249 | !============================================================================ |
|---|
| 250 | !============================================================================ |
|---|
| 251 | ! This subroutine computes the mass mean radius, |
|---|
| 252 | ! used for heterogenous nucleation on CCNs in microphysics. |
|---|
| 253 | ! For a lognormal distribution : |
|---|
| 254 | ! geometric mean radius = mass mean radius x exp(-1.5 sigma0^2) |
|---|
| 255 | subroutine updaterccn(qccn,nccn,rccn,tauscaling) |
|---|
| 256 | use tracer_mod, only: rho_dust |
|---|
| 257 | USE comcstfi_h |
|---|
| 258 | implicit none |
|---|
| 259 | |
|---|
| 260 | real, intent(in) :: qccn,nccn ! needed if doubleq |
|---|
| 261 | real, intent(in), optional :: tauscaling ! useful for realistic thresholds |
|---|
| 262 | |
|---|
| 263 | real, intent(out) :: rccn |
|---|
| 264 | |
|---|
| 265 | real coeff |
|---|
| 266 | |
|---|
| 267 | |
|---|
| 268 | if (present(tauscaling)) then |
|---|
| 269 | coeff = tauscaling ! threshold on realistic values |
|---|
| 270 | else |
|---|
| 271 | coeff = 1. ! threshold on virtual values |
|---|
| 272 | endif |
|---|
| 273 | |
|---|
| 274 | if ((nccn .le. nccn_threshold/coeff) .or. (qccn .le. qccn_threshold/coeff)) then |
|---|
| 275 | |
|---|
| 276 | rccn = rccnmin |
|---|
| 277 | |
|---|
| 278 | else |
|---|
| 279 | |
|---|
| 280 | rccn = qccn * 0.75 / pi / rho_dust / nccn |
|---|
| 281 | |
|---|
| 282 | if (rccn .le. r3ccnmin) then |
|---|
| 283 | rccn = rccnmin |
|---|
| 284 | else if (rccn .ge. r3ccnmax) then |
|---|
| 285 | rccn = rccnmax |
|---|
| 286 | else |
|---|
| 287 | rccn = rccn**(1./3.) |
|---|
| 288 | endif |
|---|
| 289 | |
|---|
| 290 | endif |
|---|
| 291 | |
|---|
| 292 | end subroutine updaterccn |
|---|
| 293 | !============================================================================ |
|---|
| 294 | !============================================================================ |
|---|
| 295 | !============================================================================ |
|---|
| 296 | |
|---|
| 297 | |
|---|
| 298 | |
|---|
| 299 | |
|---|
| 300 | |
|---|
| 301 | !============================================================================ |
|---|
| 302 | !============================================================================ |
|---|
| 303 | !============================================================================ |
|---|
| 304 | ! This subroutine computes the mass mean radius, |
|---|
| 305 | ! used for heterogenous nucleation on CCNs in microphysics of CO2. |
|---|
| 306 | ! For a lognormal distribution : |
|---|
| 307 | ! geometric mean radius = mass mean radius x exp(-1.5 sigma0^2) |
|---|
| 308 | subroutine updaterccnCO2(qccn,nccn,rccn,tauscaling) |
|---|
| 309 | use tracer_mod, only: rho_dust |
|---|
| 310 | USE comcstfi_h |
|---|
| 311 | implicit none |
|---|
| 312 | |
|---|
| 313 | real, intent(in) :: qccn,nccn ! needed if doubleq |
|---|
| 314 | real, intent(in), optional :: tauscaling ! useful for realistic thresholds |
|---|
| 315 | |
|---|
| 316 | real, intent(out) :: rccn |
|---|
| 317 | |
|---|
| 318 | real coeff |
|---|
| 319 | |
|---|
| 320 | |
|---|
| 321 | if (present(tauscaling)) then |
|---|
| 322 | coeff = tauscaling ! threshold on realistic values |
|---|
| 323 | else |
|---|
| 324 | coeff = 1. ! threshold on virtual values |
|---|
| 325 | endif |
|---|
| 326 | |
|---|
| 327 | if ((nccn .le. nccn_threshold/coeff) .or. (qccn .le. qccn_threshold/coeff)) then |
|---|
| 328 | |
|---|
| 329 | rccn = rccnCO2min |
|---|
| 330 | |
|---|
| 331 | else |
|---|
| 332 | |
|---|
| 333 | rccn = qccn * 0.75 / pi / rho_dust / nccn |
|---|
| 334 | rccn = rccn**(1./3.) |
|---|
| 335 | |
|---|
| 336 | endif |
|---|
| 337 | |
|---|
| 338 | rccn=min(5.E-4,rccn) |
|---|
| 339 | |
|---|
| 340 | end subroutine updaterccnCO2 |
|---|
| 341 | !============================================================================ |
|---|
| 342 | !============================================================================ |
|---|
| 343 | !============================================================================ |
|---|
| 344 | |
|---|
| 345 | |
|---|
| 346 | |
|---|
| 347 | end module updaterad |
|---|
| 348 | |
|---|