| 1 | MODULE layered_deposits |
|---|
| 2 | !----------------------------------------------------------------------- |
|---|
| 3 | ! NAME |
|---|
| 4 | ! layered_deposits |
|---|
| 5 | ! |
|---|
| 6 | ! DESCRIPTION |
|---|
| 7 | ! Manage layered deposits in the PEM with a linked list data structure. |
|---|
| 8 | ! Provides data types and subroutines to manipulate layers of ice and dust. |
|---|
| 9 | ! |
|---|
| 10 | ! AUTHORS & DATE |
|---|
| 11 | ! JB Clement, 2024 |
|---|
| 12 | ! |
|---|
| 13 | ! NOTES |
|---|
| 14 | ! |
|---|
| 15 | !----------------------------------------------------------------------- |
|---|
| 16 | |
|---|
| 17 | ! DEPENDENCIES |
|---|
| 18 | ! ------------ |
|---|
| 19 | use numerics, only: dp, di, k4, tol |
|---|
| 20 | use geometry, only: ngrid, nslope |
|---|
| 21 | use surf_ice, only: rho_co2ice, rho_h2oice |
|---|
| 22 | |
|---|
| 23 | ! DECLARATION |
|---|
| 24 | ! ----------- |
|---|
| 25 | implicit none |
|---|
| 26 | |
|---|
| 27 | ! VARIABLES |
|---|
| 28 | ! --------- |
|---|
| 29 | ! Numerical parameter |
|---|
| 30 | logical(k4), protected :: do_layering |
|---|
| 31 | |
|---|
| 32 | ! Physical parameters |
|---|
| 33 | logical(k4), protected :: impose_dust_ratio ! Impose dust-to-ice ratio instead of dust tendency (see 'dust2ice_ratio') |
|---|
| 34 | real(dp), protected :: dust2ice_ratio ! Dust-to-ice ratio when ice condenses (10% by default) |
|---|
| 35 | real(dp), protected :: d_dust ! Tendency of dust [kg.m-2.y-1] |
|---|
| 36 | real(dp), parameter :: dry_lag_porosity = 0.2_dp ! Porosity of dust lag |
|---|
| 37 | real(dp), parameter :: wet_lag_porosity = 0.15_dp ! Porosity of water ice lag |
|---|
| 38 | real(dp), parameter :: regolith_porosity = 0.4_dp ! Porosity of regolith |
|---|
| 39 | real(dp), parameter :: breccia_porosity = 0.1_dp ! Porosity of breccia |
|---|
| 40 | real(dp), parameter :: co2ice_porosity = 0.05_dp ! Porosity of CO2 ice |
|---|
| 41 | real(dp), parameter :: h2oice_porosity = 0.1_dp ! Porosity of H2O ice |
|---|
| 42 | real(dp), parameter :: rho_dust = 2500._dp ! Density of dust [kg.m-3] |
|---|
| 43 | real(dp), parameter :: rho_rock = 3200._dp ! Density of rock [kg.m-3] |
|---|
| 44 | real(dp), parameter :: h_patchy_dust = 5.e-4_dp ! Height under which a dust lag is considered patchy [m] |
|---|
| 45 | real(dp), parameter :: h_patchy_ice = 5.e-4_dp ! Height under which a H2O ice lag is considered patchy [m] |
|---|
| 46 | |
|---|
| 47 | ! Parameters for CO2 flux correction (inspired by Levrard et al. 2007) |
|---|
| 48 | real(dp), parameter :: hmin_lag_co2 = 0.5_dp ! Minimal height of the lag deposit to reduce the sublimation rate [m] |
|---|
| 49 | real(dp), parameter :: fred_sublco2 = 0.1_dp ! Reduction factor of sublimation rate |
|---|
| 50 | |
|---|
| 51 | ! DATA STRUCTURES |
|---|
| 52 | ! --------------- |
|---|
| 53 | ! Stratum = node of the linked list |
|---|
| 54 | type :: stratum |
|---|
| 55 | real(dp) :: top_elevation ! Layer top_elevation (top height from the surface) [m] |
|---|
| 56 | real(dp) :: h_co2ice ! Height of CO2 ice [m] |
|---|
| 57 | real(dp) :: h_h2oice ! Height of H2O ice [m] |
|---|
| 58 | real(dp) :: h_dust ! Height of dust [m] |
|---|
| 59 | real(dp) :: h_pore ! Height of pores [m] |
|---|
| 60 | real(dp) :: poreice_volfrac ! Pore-filled ice volumetric fraction |
|---|
| 61 | type(stratum), pointer :: up => null() ! Upper stratum (next node) |
|---|
| 62 | type(stratum), pointer :: down => null() ! Lower stratum (previous node) |
|---|
| 63 | end type stratum |
|---|
| 64 | |
|---|
| 65 | ! Layering = linked list |
|---|
| 66 | type layering |
|---|
| 67 | integer(di) :: nb_str = 0 ! Number of strata |
|---|
| 68 | type(stratum), pointer :: bottom => null() ! First stratum (head of the list) |
|---|
| 69 | type(stratum), pointer :: top => null() ! Last stratum (tail of the list) |
|---|
| 70 | !real(dp) :: h_toplag ! Height of dust layer at the top [m] |
|---|
| 71 | !type(stratum), pointer :: subice => null() ! Shallower stratum containing ice |
|---|
| 72 | !type(stratum), pointer :: surf => null() ! Surface stratum |
|---|
| 73 | end type layering |
|---|
| 74 | |
|---|
| 75 | ! Array of pointers to "stratum" |
|---|
| 76 | type ptrarray |
|---|
| 77 | type(stratum), pointer :: p |
|---|
| 78 | end type ptrarray |
|---|
| 79 | |
|---|
| 80 | contains |
|---|
| 81 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 82 | |
|---|
| 83 | !======================================================================= |
|---|
| 84 | SUBROUTINE set_layered_deposits_config(do_layering_in,impose_dust_ratio_in,d_dust_in,dust2ice_ratio_in) |
|---|
| 85 | !----------------------------------------------------------------------- |
|---|
| 86 | ! NAME |
|---|
| 87 | ! set_layered_deposits_config |
|---|
| 88 | ! |
|---|
| 89 | ! DESCRIPTION |
|---|
| 90 | ! Setter for 'layered_deposits' configuration parameters. |
|---|
| 91 | ! |
|---|
| 92 | ! AUTHORS & DATE |
|---|
| 93 | ! JB Clement, 02/2026 |
|---|
| 94 | ! |
|---|
| 95 | ! NOTES |
|---|
| 96 | ! |
|---|
| 97 | !----------------------------------------------------------------------- |
|---|
| 98 | |
|---|
| 99 | ! DEPENDENCIES |
|---|
| 100 | ! ------------ |
|---|
| 101 | use utility, only: real2str, bool2str |
|---|
| 102 | use display, only: print_msg |
|---|
| 103 | |
|---|
| 104 | ! DECLARATION |
|---|
| 105 | ! ----------- |
|---|
| 106 | implicit none |
|---|
| 107 | |
|---|
| 108 | ! ARGUMENTS |
|---|
| 109 | ! --------- |
|---|
| 110 | logical(k4), intent(in) :: do_layering_in, impose_dust_ratio_in |
|---|
| 111 | real(dp), intent(in) :: d_dust_in, dust2ice_ratio_in |
|---|
| 112 | |
|---|
| 113 | ! CODE |
|---|
| 114 | ! ---- |
|---|
| 115 | do_layering = do_layering_in |
|---|
| 116 | impose_dust_ratio = impose_dust_ratio_in |
|---|
| 117 | d_dust = d_dust_in |
|---|
| 118 | dust2ice_ratio = dust2ice_ratio_in |
|---|
| 119 | call print_msg('do_layering = '//bool2str(do_layering)) |
|---|
| 120 | call print_msg('impose_dust_ratio = '//bool2str(impose_dust_ratio)) |
|---|
| 121 | call print_msg('d_dust = '//real2str(d_dust)) |
|---|
| 122 | call print_msg('dust2ice_ratio = '//real2str(dust2ice_ratio)) |
|---|
| 123 | |
|---|
| 124 | END SUBROUTINE set_layered_deposits_config |
|---|
| 125 | !======================================================================= |
|---|
| 126 | |
|---|
| 127 | !======================================================================= |
|---|
| 128 | SUBROUTINE print_stratum(this) |
|---|
| 129 | !----------------------------------------------------------------------- |
|---|
| 130 | ! NAME |
|---|
| 131 | ! print_stratum |
|---|
| 132 | ! |
|---|
| 133 | ! DESCRIPTION |
|---|
| 134 | ! Print a stratum. |
|---|
| 135 | ! |
|---|
| 136 | ! AUTHORS & DATE |
|---|
| 137 | ! JB Clement, 2024 |
|---|
| 138 | ! |
|---|
| 139 | ! NOTES |
|---|
| 140 | ! |
|---|
| 141 | !----------------------------------------------------------------------- |
|---|
| 142 | |
|---|
| 143 | ! DEPENDENCIES |
|---|
| 144 | ! ------------ |
|---|
| 145 | use utility, only: real2str |
|---|
| 146 | use display, only: print_msg |
|---|
| 147 | |
|---|
| 148 | ! DECLARATION |
|---|
| 149 | ! ----------- |
|---|
| 150 | implicit none |
|---|
| 151 | |
|---|
| 152 | ! ARGUMENTS |
|---|
| 153 | ! --------- |
|---|
| 154 | type(stratum), intent(in) :: this |
|---|
| 155 | |
|---|
| 156 | ! CODE |
|---|
| 157 | ! ---- |
|---|
| 158 | call print_msg('Top elevation [m]: '//real2str(this%top_elevation)) |
|---|
| 159 | call print_msg('Height of CO2 ice [m]: '//real2str(this%h_co2ice)) |
|---|
| 160 | call print_msg('Height of H2O ice [m]: '//real2str(this%h_h2oice)) |
|---|
| 161 | call print_msg('Height of dust [m]: '//real2str(this%h_dust)) |
|---|
| 162 | call print_msg('Height of pores [m]: '//real2str(this%h_pore)) |
|---|
| 163 | call print_msg('Pore-filled ice [m3/m3]: '//real2str(this%poreice_volfrac)) |
|---|
| 164 | |
|---|
| 165 | END SUBROUTINE print_stratum |
|---|
| 166 | !======================================================================= |
|---|
| 167 | |
|---|
| 168 | !======================================================================= |
|---|
| 169 | SUBROUTINE add_stratum(this,top_elevation,co2ice,h2oice,dust,pore,poreice) |
|---|
| 170 | !----------------------------------------------------------------------- |
|---|
| 171 | ! NAME |
|---|
| 172 | ! add_stratum |
|---|
| 173 | ! |
|---|
| 174 | ! DESCRIPTION |
|---|
| 175 | ! Add a stratum to the top of a layering. |
|---|
| 176 | ! |
|---|
| 177 | ! AUTHORS & DATE |
|---|
| 178 | ! JB Clement, 2024 |
|---|
| 179 | ! |
|---|
| 180 | ! NOTES |
|---|
| 181 | ! |
|---|
| 182 | !----------------------------------------------------------------------- |
|---|
| 183 | |
|---|
| 184 | ! DECLARATION |
|---|
| 185 | ! ----------- |
|---|
| 186 | implicit none |
|---|
| 187 | |
|---|
| 188 | ! ARGUMENTS |
|---|
| 189 | ! --------- |
|---|
| 190 | type(layering), intent(inout) :: this |
|---|
| 191 | real(dp), intent(in), optional :: top_elevation, co2ice, h2oice, dust, pore, poreice |
|---|
| 192 | |
|---|
| 193 | ! LOCAL VARIABLES |
|---|
| 194 | ! --------------- |
|---|
| 195 | type(stratum), pointer :: str |
|---|
| 196 | |
|---|
| 197 | ! CODE |
|---|
| 198 | ! ---- |
|---|
| 199 | ! Creation of the stratum |
|---|
| 200 | allocate(str) |
|---|
| 201 | nullify(str%up,str%down) |
|---|
| 202 | str%top_elevation = 1._dp |
|---|
| 203 | str%h_co2ice = 0._dp |
|---|
| 204 | str%h_h2oice = 0._dp |
|---|
| 205 | str%h_dust = 1._dp |
|---|
| 206 | str%h_pore = 0._dp |
|---|
| 207 | str%poreice_volfrac = 0._dp |
|---|
| 208 | if (present(top_elevation)) str%top_elevation = top_elevation |
|---|
| 209 | if (present(co2ice)) str%h_co2ice = co2ice |
|---|
| 210 | if (present(h2oice)) str%h_h2oice = h2oice |
|---|
| 211 | if (present(dust)) str%h_dust = dust |
|---|
| 212 | if (present(pore)) str%h_pore = pore |
|---|
| 213 | if (present(poreice)) str%poreice_volfrac = poreice |
|---|
| 214 | |
|---|
| 215 | ! Increment the number of strata |
|---|
| 216 | this%nb_str = this%nb_str + 1 |
|---|
| 217 | |
|---|
| 218 | ! Add the stratum to the layering |
|---|
| 219 | if (.not. associated(this%bottom)) then ! If it is the very first one |
|---|
| 220 | this%bottom => str |
|---|
| 221 | this%top => str |
|---|
| 222 | else |
|---|
| 223 | str%down => this%top |
|---|
| 224 | this%top%up => str |
|---|
| 225 | this%top => str |
|---|
| 226 | end if |
|---|
| 227 | |
|---|
| 228 | END SUBROUTINE add_stratum |
|---|
| 229 | !======================================================================= |
|---|
| 230 | |
|---|
| 231 | !======================================================================= |
|---|
| 232 | SUBROUTINE insert_stratum(this,str_prev,top_elevation,co2ice,h2oice,dust,pore,poreice) |
|---|
| 233 | !----------------------------------------------------------------------- |
|---|
| 234 | ! NAME |
|---|
| 235 | ! insert_stratum |
|---|
| 236 | ! |
|---|
| 237 | ! DESCRIPTION |
|---|
| 238 | ! Insert a stratum after a given previous stratum in the layering. |
|---|
| 239 | ! |
|---|
| 240 | ! AUTHORS & DATE |
|---|
| 241 | ! JB Clement, 2024 |
|---|
| 242 | ! |
|---|
| 243 | ! NOTES |
|---|
| 244 | ! |
|---|
| 245 | !----------------------------------------------------------------------- |
|---|
| 246 | |
|---|
| 247 | ! DECLARATION |
|---|
| 248 | ! ----------- |
|---|
| 249 | implicit none |
|---|
| 250 | |
|---|
| 251 | ! ARGUMENTS |
|---|
| 252 | ! --------- |
|---|
| 253 | type(layering), intent(inout) :: this |
|---|
| 254 | type(stratum), pointer, intent(inout) :: str_prev |
|---|
| 255 | real(dp), intent(in), optional :: top_elevation, co2ice, h2oice, dust, pore, poreice |
|---|
| 256 | |
|---|
| 257 | ! LOCAL VARIABLES |
|---|
| 258 | ! --------------- |
|---|
| 259 | type(stratum), pointer :: str, current |
|---|
| 260 | |
|---|
| 261 | ! CODE |
|---|
| 262 | ! ---- |
|---|
| 263 | if (.not. associated(str_prev%up)) then ! If str_prev is the top stratum of the layering |
|---|
| 264 | call add_stratum(this,top_elevation,co2ice,h2oice,dust,pore,poreice) |
|---|
| 265 | else |
|---|
| 266 | ! Creation of the stratum |
|---|
| 267 | allocate(str) |
|---|
| 268 | nullify(str%up,str%down) |
|---|
| 269 | str%top_elevation = 1._dp |
|---|
| 270 | str%h_co2ice = 0._dp |
|---|
| 271 | str%h_h2oice = 0._dp |
|---|
| 272 | str%h_dust = 1._dp |
|---|
| 273 | str%h_pore = 0._dp |
|---|
| 274 | str%poreice_volfrac = 0._dp |
|---|
| 275 | if (present(top_elevation)) str%top_elevation = top_elevation |
|---|
| 276 | if (present(co2ice)) str%h_co2ice = co2ice |
|---|
| 277 | if (present(h2oice)) str%h_h2oice = h2oice |
|---|
| 278 | if (present(dust)) str%h_dust = dust |
|---|
| 279 | if (present(pore)) str%h_pore = pore |
|---|
| 280 | if (present(poreice)) str%poreice_volfrac = poreice |
|---|
| 281 | |
|---|
| 282 | ! Increment the number of strata |
|---|
| 283 | this%nb_str = this%nb_str + 1 |
|---|
| 284 | |
|---|
| 285 | ! Insert the stratum into the layering at the right place |
|---|
| 286 | str%down => str_prev |
|---|
| 287 | str%up => str_prev%up |
|---|
| 288 | str_prev%up => str |
|---|
| 289 | str%up%down => str |
|---|
| 290 | |
|---|
| 291 | ! Correct the value of top_elevation for the upper strata |
|---|
| 292 | current => str%up |
|---|
| 293 | do while (associated(current)) |
|---|
| 294 | current%top_elevation = current%down%top_elevation + thickness(current) |
|---|
| 295 | current => current%up |
|---|
| 296 | end do |
|---|
| 297 | end if |
|---|
| 298 | |
|---|
| 299 | END SUBROUTINE insert_stratum |
|---|
| 300 | !======================================================================= |
|---|
| 301 | |
|---|
| 302 | !======================================================================= |
|---|
| 303 | SUBROUTINE del_stratum(this,str) |
|---|
| 304 | !----------------------------------------------------------------------- |
|---|
| 305 | ! NAME |
|---|
| 306 | ! del_stratum |
|---|
| 307 | ! |
|---|
| 308 | ! DESCRIPTION |
|---|
| 309 | ! Delete a stratum from the layering and fix links. |
|---|
| 310 | ! |
|---|
| 311 | ! AUTHORS & DATE |
|---|
| 312 | ! JB Clement, 2024 |
|---|
| 313 | ! |
|---|
| 314 | ! NOTES |
|---|
| 315 | ! |
|---|
| 316 | !----------------------------------------------------------------------- |
|---|
| 317 | |
|---|
| 318 | ! DECLARATION |
|---|
| 319 | ! ----------- |
|---|
| 320 | implicit none |
|---|
| 321 | |
|---|
| 322 | ! ARGUMENTS |
|---|
| 323 | ! --------- |
|---|
| 324 | type(layering), intent(inout) :: this |
|---|
| 325 | type(stratum), pointer, intent(inout) :: str |
|---|
| 326 | |
|---|
| 327 | ! LOCAL VARIABLES |
|---|
| 328 | ! --------------- |
|---|
| 329 | type(stratum), pointer :: new_str |
|---|
| 330 | |
|---|
| 331 | ! CODE |
|---|
| 332 | ! ---- |
|---|
| 333 | ! Protect the sub-surface strata from deletion |
|---|
| 334 | if (str%top_elevation <= 0.) return |
|---|
| 335 | |
|---|
| 336 | ! Decrement the number of strata |
|---|
| 337 | this%nb_str = this%nb_str - 1 |
|---|
| 338 | |
|---|
| 339 | ! Making the new links |
|---|
| 340 | if (associated(str%down)) then ! If there is a lower stratum |
|---|
| 341 | str%down%up => str%up |
|---|
| 342 | else ! If it was the first stratum (bottom of layering) |
|---|
| 343 | this%bottom => str%up |
|---|
| 344 | end if |
|---|
| 345 | if (associated(str%up)) then ! If there is an upper stratum |
|---|
| 346 | str%up%down => str%down |
|---|
| 347 | else ! If it was the last stratum (top of layering) |
|---|
| 348 | this%top => str%down |
|---|
| 349 | end if |
|---|
| 350 | |
|---|
| 351 | ! Remove the stratum from the layering |
|---|
| 352 | new_str => str%down |
|---|
| 353 | nullify(str%up,str%down) |
|---|
| 354 | deallocate(str) |
|---|
| 355 | nullify(str) |
|---|
| 356 | str => new_str |
|---|
| 357 | |
|---|
| 358 | END SUBROUTINE del_stratum |
|---|
| 359 | !======================================================================= |
|---|
| 360 | |
|---|
| 361 | !======================================================================= |
|---|
| 362 | FUNCTION get_stratum(lay,i) RESULT(str) |
|---|
| 363 | !----------------------------------------------------------------------- |
|---|
| 364 | ! NAME |
|---|
| 365 | ! get_stratum |
|---|
| 366 | ! |
|---|
| 367 | ! DESCRIPTION |
|---|
| 368 | ! Return the i-th stratum in the layering. |
|---|
| 369 | ! |
|---|
| 370 | ! AUTHORS & DATE |
|---|
| 371 | ! JB Clement, 2024 |
|---|
| 372 | ! |
|---|
| 373 | ! NOTES |
|---|
| 374 | ! |
|---|
| 375 | !----------------------------------------------------------------------- |
|---|
| 376 | |
|---|
| 377 | ! DEPENDENCIES |
|---|
| 378 | ! ------------ |
|---|
| 379 | use stoppage, only: stop_clean |
|---|
| 380 | |
|---|
| 381 | ! DECLARATION |
|---|
| 382 | ! ----------- |
|---|
| 383 | implicit none |
|---|
| 384 | |
|---|
| 385 | ! ARGUMENTS |
|---|
| 386 | ! --------- |
|---|
| 387 | type(layering), intent(in) :: lay |
|---|
| 388 | integer(di), intent(in) :: i |
|---|
| 389 | type(stratum), pointer :: str |
|---|
| 390 | |
|---|
| 391 | ! LOCAL VARIABLES |
|---|
| 392 | ! --------------- |
|---|
| 393 | integer(di) :: k |
|---|
| 394 | |
|---|
| 395 | ! CODE |
|---|
| 396 | ! ---- |
|---|
| 397 | if (i < 1 .or. i > lay%nb_str) call stop_clean(__FILE__,__LINE__,'requested number is beyond the number of strata of the layering!',1) |
|---|
| 398 | k = 1 |
|---|
| 399 | str => lay%bottom |
|---|
| 400 | do while (k /= i) |
|---|
| 401 | str => str%up |
|---|
| 402 | k = k + 1 |
|---|
| 403 | end do |
|---|
| 404 | |
|---|
| 405 | END FUNCTION get_stratum |
|---|
| 406 | !======================================================================= |
|---|
| 407 | |
|---|
| 408 | !======================================================================= |
|---|
| 409 | SUBROUTINE ini_layering(this) |
|---|
| 410 | !----------------------------------------------------------------------- |
|---|
| 411 | ! NAME |
|---|
| 412 | ! del_layering |
|---|
| 413 | ! |
|---|
| 414 | ! DESCRIPTION |
|---|
| 415 | ! Initialize the layering base structure. |
|---|
| 416 | ! |
|---|
| 417 | ! AUTHORS & DATE |
|---|
| 418 | ! JB Clement, 2024 |
|---|
| 419 | ! |
|---|
| 420 | ! NOTES |
|---|
| 421 | ! |
|---|
| 422 | !----------------------------------------------------------------------- |
|---|
| 423 | |
|---|
| 424 | ! DEPENDENCIES |
|---|
| 425 | ! ------------ |
|---|
| 426 | use soil, only: do_soil, layer, index_breccia, index_bedrock |
|---|
| 427 | use geometry, only: nsoil |
|---|
| 428 | |
|---|
| 429 | ! DECLARATION |
|---|
| 430 | ! ----------- |
|---|
| 431 | implicit none |
|---|
| 432 | |
|---|
| 433 | ! ARGUMENTS |
|---|
| 434 | ! --------- |
|---|
| 435 | type(layering), intent(inout) :: this |
|---|
| 436 | |
|---|
| 437 | ! LOCAL VARIABLES |
|---|
| 438 | ! --------------- |
|---|
| 439 | integer(di) :: i |
|---|
| 440 | real(dp) :: h_soil, h_pore, h_tot |
|---|
| 441 | |
|---|
| 442 | ! CODE |
|---|
| 443 | ! ---- |
|---|
| 444 | ! Creation of strata at the bottom of the layering to describe the sub-surface |
|---|
| 445 | if (do_soil) then |
|---|
| 446 | do i = nsoil,index_bedrock,-1 |
|---|
| 447 | h_soil = layer(i) - layer(i - 1) ! No porosity |
|---|
| 448 | call add_stratum(this,-layer(i - 1),0._dp,0._dp,h_soil,0._dp,0._dp) |
|---|
| 449 | end do |
|---|
| 450 | do i = index_bedrock - 1,index_breccia,-1 |
|---|
| 451 | h_tot = layer(i) - layer(i - 1) |
|---|
| 452 | h_pore = h_tot*breccia_porosity |
|---|
| 453 | h_soil = h_tot - h_pore |
|---|
| 454 | call add_stratum(this,-layer(i - 1),0._dp,0._dp,h_soil,h_pore,0._dp) |
|---|
| 455 | end do |
|---|
| 456 | do i = index_breccia - 1,2,-1 |
|---|
| 457 | h_tot = layer(i) - layer(i - 1) |
|---|
| 458 | h_pore = h_tot*regolith_porosity |
|---|
| 459 | h_soil = h_tot - h_pore |
|---|
| 460 | call add_stratum(this,-layer(i - 1),0._dp,0._dp,h_soil,h_pore,0._dp) |
|---|
| 461 | end do |
|---|
| 462 | h_pore = layer(1)*regolith_porosity |
|---|
| 463 | h_soil = layer(1) - h_pore |
|---|
| 464 | call add_stratum(this,0._dp,0._dp,0._dp,h_soil,h_pore,0._dp) |
|---|
| 465 | end if |
|---|
| 466 | |
|---|
| 467 | END SUBROUTINE ini_layering |
|---|
| 468 | !======================================================================= |
|---|
| 469 | |
|---|
| 470 | !======================================================================= |
|---|
| 471 | SUBROUTINE del_layering(this) |
|---|
| 472 | !----------------------------------------------------------------------- |
|---|
| 473 | ! NAME |
|---|
| 474 | ! del_layering |
|---|
| 475 | ! |
|---|
| 476 | ! DESCRIPTION |
|---|
| 477 | ! Delete all strata in a layering and reset counters. |
|---|
| 478 | ! |
|---|
| 479 | ! AUTHORS & DATE |
|---|
| 480 | ! JB Clement, 2024 |
|---|
| 481 | ! |
|---|
| 482 | ! NOTES |
|---|
| 483 | ! |
|---|
| 484 | !----------------------------------------------------------------------- |
|---|
| 485 | |
|---|
| 486 | ! DECLARATION |
|---|
| 487 | ! ----------- |
|---|
| 488 | implicit none |
|---|
| 489 | |
|---|
| 490 | ! ARGUMENTS |
|---|
| 491 | ! --------- |
|---|
| 492 | type(layering), intent(inout) :: this |
|---|
| 493 | |
|---|
| 494 | ! LOCAL VARIABLES |
|---|
| 495 | ! --------------- |
|---|
| 496 | type(stratum), pointer :: current, next |
|---|
| 497 | |
|---|
| 498 | ! CODE |
|---|
| 499 | ! ---- |
|---|
| 500 | current => this%bottom |
|---|
| 501 | do while (associated(current)) |
|---|
| 502 | next => current%up |
|---|
| 503 | deallocate(current) |
|---|
| 504 | nullify(current) |
|---|
| 505 | current => next |
|---|
| 506 | end do |
|---|
| 507 | this%nb_str = 0 |
|---|
| 508 | |
|---|
| 509 | END SUBROUTINE del_layering |
|---|
| 510 | !======================================================================= |
|---|
| 511 | |
|---|
| 512 | !======================================================================= |
|---|
| 513 | SUBROUTINE print_layering(this) |
|---|
| 514 | !----------------------------------------------------------------------- |
|---|
| 515 | ! NAME |
|---|
| 516 | ! print_layering |
|---|
| 517 | ! |
|---|
| 518 | ! DESCRIPTION |
|---|
| 519 | ! Display all strata from top to bottom for a layering. |
|---|
| 520 | ! |
|---|
| 521 | ! AUTHORS & DATE |
|---|
| 522 | ! JB Clement, 2024 |
|---|
| 523 | ! |
|---|
| 524 | ! NOTES |
|---|
| 525 | ! |
|---|
| 526 | !----------------------------------------------------------------------- |
|---|
| 527 | |
|---|
| 528 | ! DEPENDENCIES |
|---|
| 529 | ! ------------ |
|---|
| 530 | use utility, only: int2str |
|---|
| 531 | use display, only: print_msg |
|---|
| 532 | |
|---|
| 533 | ! DECLARATION |
|---|
| 534 | ! ----------- |
|---|
| 535 | implicit none |
|---|
| 536 | |
|---|
| 537 | ! ARGUMENTS |
|---|
| 538 | ! --------- |
|---|
| 539 | type(layering), intent(in) :: this |
|---|
| 540 | |
|---|
| 541 | ! LOCAL VARIABLES |
|---|
| 542 | ! --------------- |
|---|
| 543 | type(stratum), pointer :: current |
|---|
| 544 | integer(di) :: i |
|---|
| 545 | |
|---|
| 546 | ! CODE |
|---|
| 547 | ! ---- |
|---|
| 548 | current => this%top |
|---|
| 549 | |
|---|
| 550 | i = this%nb_str |
|---|
| 551 | do while (associated(current)) |
|---|
| 552 | call print_msg('Stratum '//int2str(i)) |
|---|
| 553 | call print_stratum(current) |
|---|
| 554 | call print_msg('') |
|---|
| 555 | current => current%down |
|---|
| 556 | i = i - 1 |
|---|
| 557 | end do |
|---|
| 558 | |
|---|
| 559 | END SUBROUTINE print_layering |
|---|
| 560 | !======================================================================= |
|---|
| 561 | |
|---|
| 562 | !======================================================================= |
|---|
| 563 | FUNCTION get_nb_str_max(layerings_map) RESULT(nb_str_max) |
|---|
| 564 | !----------------------------------------------------------------------- |
|---|
| 565 | ! NAME |
|---|
| 566 | ! get_nb_str_max |
|---|
| 567 | ! |
|---|
| 568 | ! DESCRIPTION |
|---|
| 569 | ! Return the maximum number of strata across all grid/slope layerings. |
|---|
| 570 | ! |
|---|
| 571 | ! AUTHORS & DATE |
|---|
| 572 | ! JB Clement, 2024 |
|---|
| 573 | ! |
|---|
| 574 | ! NOTES |
|---|
| 575 | ! |
|---|
| 576 | !----------------------------------------------------------------------- |
|---|
| 577 | |
|---|
| 578 | ! DEPENDENCIES |
|---|
| 579 | ! ------------ |
|---|
| 580 | use geometry, only: ngrid, nslope |
|---|
| 581 | |
|---|
| 582 | ! DECLARATION |
|---|
| 583 | ! ----------- |
|---|
| 584 | implicit none |
|---|
| 585 | |
|---|
| 586 | ! ARGUMENTS |
|---|
| 587 | ! --------- |
|---|
| 588 | type(layering), dimension(:,:), intent(in) :: layerings_map |
|---|
| 589 | integer(di) :: nb_str_max |
|---|
| 590 | |
|---|
| 591 | ! LOCAL VARIABLES |
|---|
| 592 | ! --------------- |
|---|
| 593 | integer(di) :: ig, islope |
|---|
| 594 | |
|---|
| 595 | ! CODE |
|---|
| 596 | ! ---- |
|---|
| 597 | nb_str_max = 0 |
|---|
| 598 | do islope = 1,nslope |
|---|
| 599 | do ig = 1,ngrid |
|---|
| 600 | nb_str_max = max(layerings_map(ig,islope)%nb_str,nb_str_max) |
|---|
| 601 | end do |
|---|
| 602 | end do |
|---|
| 603 | |
|---|
| 604 | END FUNCTION get_nb_str_max |
|---|
| 605 | !======================================================================= |
|---|
| 606 | |
|---|
| 607 | !======================================================================= |
|---|
| 608 | SUBROUTINE map2array(layerings_map,layerings_array) |
|---|
| 609 | !----------------------------------------------------------------------- |
|---|
| 610 | ! NAME |
|---|
| 611 | ! map2array |
|---|
| 612 | ! |
|---|
| 613 | ! DESCRIPTION |
|---|
| 614 | ! Convert the layerings map into an allocatable array for output. |
|---|
| 615 | ! |
|---|
| 616 | ! AUTHORS & DATE |
|---|
| 617 | ! JB Clement, 2024 |
|---|
| 618 | ! |
|---|
| 619 | ! NOTES |
|---|
| 620 | ! |
|---|
| 621 | !----------------------------------------------------------------------- |
|---|
| 622 | |
|---|
| 623 | ! DEPENDENCIES |
|---|
| 624 | ! ------------ |
|---|
| 625 | use geometry, only: ngrid, nslope |
|---|
| 626 | |
|---|
| 627 | ! DECLARATION |
|---|
| 628 | ! ----------- |
|---|
| 629 | implicit none |
|---|
| 630 | |
|---|
| 631 | ! ARGUMENTS |
|---|
| 632 | ! --------- |
|---|
| 633 | type(layering), dimension(:,:), intent(in) :: layerings_map |
|---|
| 634 | real(dp), dimension(:,:,:,:), intent(out) :: layerings_array |
|---|
| 635 | |
|---|
| 636 | ! LOCAL VARIABLES |
|---|
| 637 | ! --------------- |
|---|
| 638 | type(stratum), pointer :: current |
|---|
| 639 | integer(di) :: ig, islope, k |
|---|
| 640 | |
|---|
| 641 | ! CODE |
|---|
| 642 | ! ---- |
|---|
| 643 | layerings_array = 0. |
|---|
| 644 | do islope = 1,nslope |
|---|
| 645 | do ig = 1,ngrid |
|---|
| 646 | current => layerings_map(ig,islope)%bottom |
|---|
| 647 | k = 1 |
|---|
| 648 | do while (associated(current)) |
|---|
| 649 | layerings_array(ig,islope,k,1) = current%top_elevation |
|---|
| 650 | layerings_array(ig,islope,k,2) = current%h_co2ice |
|---|
| 651 | layerings_array(ig,islope,k,3) = current%h_h2oice |
|---|
| 652 | layerings_array(ig,islope,k,4) = current%h_dust |
|---|
| 653 | layerings_array(ig,islope,k,5) = current%h_pore |
|---|
| 654 | layerings_array(ig,islope,k,6) = current%poreice_volfrac |
|---|
| 655 | current => current%up |
|---|
| 656 | k = k + 1 |
|---|
| 657 | end do |
|---|
| 658 | end do |
|---|
| 659 | end do |
|---|
| 660 | |
|---|
| 661 | END SUBROUTINE map2array |
|---|
| 662 | !======================================================================= |
|---|
| 663 | |
|---|
| 664 | !======================================================================= |
|---|
| 665 | SUBROUTINE array2map(layerings_array,layerings_map) |
|---|
| 666 | !----------------------------------------------------------------------- |
|---|
| 667 | ! NAME |
|---|
| 668 | ! array2map |
|---|
| 669 | ! |
|---|
| 670 | ! DESCRIPTION |
|---|
| 671 | ! Convert the stratification array back into the layerings map. |
|---|
| 672 | ! |
|---|
| 673 | ! AUTHORS & DATE |
|---|
| 674 | ! JB Clement, 2024 |
|---|
| 675 | ! |
|---|
| 676 | ! NOTES |
|---|
| 677 | ! |
|---|
| 678 | !----------------------------------------------------------------------- |
|---|
| 679 | |
|---|
| 680 | ! DEPENDENCIES |
|---|
| 681 | ! ------------ |
|---|
| 682 | use geometry, only: ngrid, nslope |
|---|
| 683 | |
|---|
| 684 | ! DECLARATION |
|---|
| 685 | ! ----------- |
|---|
| 686 | implicit none |
|---|
| 687 | |
|---|
| 688 | ! ARGUMENTS |
|---|
| 689 | ! --------- |
|---|
| 690 | real(dp), dimension(:,:,:,:), intent(in) :: layerings_array |
|---|
| 691 | type(layering), dimension(:,:), intent(inout) :: layerings_map |
|---|
| 692 | |
|---|
| 693 | ! LOCAL VARIABLES |
|---|
| 694 | ! --------------- |
|---|
| 695 | integer(di) :: ig, islope, k |
|---|
| 696 | |
|---|
| 697 | ! CODE |
|---|
| 698 | ! ---- |
|---|
| 699 | do islope = 1,nslope |
|---|
| 700 | do ig = 1,ngrid |
|---|
| 701 | do k = 1,size(layerings_array,3) |
|---|
| 702 | call add_stratum(layerings_map(ig,islope),layerings_array(ig,islope,k,1),layerings_array(ig,islope,k,2),layerings_array(ig,islope,k,3),layerings_array(ig,islope,k,4),layerings_array(ig,islope,k,5),layerings_array(ig,islope,k,6)) |
|---|
| 703 | end do |
|---|
| 704 | end do |
|---|
| 705 | end do |
|---|
| 706 | |
|---|
| 707 | END SUBROUTINE array2map |
|---|
| 708 | !======================================================================= |
|---|
| 709 | |
|---|
| 710 | !======================================================================= |
|---|
| 711 | SUBROUTINE layering2surfice(layerings_map,h2o_ice,co2_ice,h2oice_depth) |
|---|
| 712 | !----------------------------------------------------------------------- |
|---|
| 713 | ! NAME |
|---|
| 714 | ! layering2surfice |
|---|
| 715 | ! |
|---|
| 716 | ! DESCRIPTION |
|---|
| 717 | ! Convert the layerings map into surface ice arrays. |
|---|
| 718 | ! |
|---|
| 719 | ! AUTHORS & DATE |
|---|
| 720 | ! JB Clement, 01/2026 |
|---|
| 721 | ! |
|---|
| 722 | ! NOTES |
|---|
| 723 | ! |
|---|
| 724 | !----------------------------------------------------------------------- |
|---|
| 725 | |
|---|
| 726 | ! DEPENDENCIES |
|---|
| 727 | ! ------------ |
|---|
| 728 | use geometry, only: ngrid, nslope |
|---|
| 729 | |
|---|
| 730 | ! DECLARATION |
|---|
| 731 | ! ----------- |
|---|
| 732 | implicit none |
|---|
| 733 | |
|---|
| 734 | ! ARGUMENTS |
|---|
| 735 | ! --------- |
|---|
| 736 | type(layering), dimension(:,:), intent(in) :: layerings_map |
|---|
| 737 | real(dp), dimension(:,:), intent(out) :: h2o_ice, co2_ice, h2oice_depth |
|---|
| 738 | |
|---|
| 739 | ! LOCAL VARIABLES |
|---|
| 740 | ! --------------- |
|---|
| 741 | integer(di) :: ig, islope |
|---|
| 742 | |
|---|
| 743 | ! CODE |
|---|
| 744 | ! ---- |
|---|
| 745 | do ig = 1,ngrid |
|---|
| 746 | do islope = 1,nslope |
|---|
| 747 | if (is_co2ice_str(layerings_map(ig,islope)%top)) then |
|---|
| 748 | co2_ice(ig,islope) = layerings_map(ig,islope)%top%h_co2ice*rho_co2ice |
|---|
| 749 | else if (is_h2oice_str(layerings_map(ig,islope)%top)) then |
|---|
| 750 | h2o_ice(ig,islope) = layerings_map(ig,islope)%top%h_h2oice*rho_h2oice |
|---|
| 751 | else |
|---|
| 752 | call subsurface_ice_layering(layerings_map(ig,islope),h2oice_depth(ig,islope),h2o_ice(ig,islope),co2_ice(ig,islope)) |
|---|
| 753 | end if |
|---|
| 754 | end do |
|---|
| 755 | end do |
|---|
| 756 | |
|---|
| 757 | END SUBROUTINE layering2surfice |
|---|
| 758 | !======================================================================= |
|---|
| 759 | |
|---|
| 760 | !======================================================================= |
|---|
| 761 | SUBROUTINE surfice2layering(h2o_ice,co2_ice,layerings_map) |
|---|
| 762 | !----------------------------------------------------------------------- |
|---|
| 763 | ! NAME |
|---|
| 764 | ! surfice2layering |
|---|
| 765 | ! |
|---|
| 766 | ! DESCRIPTION |
|---|
| 767 | ! Convert surface ice arrays into the layerings map. |
|---|
| 768 | ! |
|---|
| 769 | ! AUTHORS & DATE |
|---|
| 770 | ! JB Clement, 01/2026 |
|---|
| 771 | ! |
|---|
| 772 | ! NOTES |
|---|
| 773 | ! |
|---|
| 774 | !----------------------------------------------------------------------- |
|---|
| 775 | |
|---|
| 776 | ! DEPENDENCIES |
|---|
| 777 | ! ------------ |
|---|
| 778 | use geometry, only: ngrid, nslope |
|---|
| 779 | |
|---|
| 780 | ! DECLARATION |
|---|
| 781 | ! ----------- |
|---|
| 782 | implicit none |
|---|
| 783 | |
|---|
| 784 | ! ARGUMENTS |
|---|
| 785 | ! --------- |
|---|
| 786 | real(dp), dimension(:,:), intent(in) :: h2o_ice, co2_ice |
|---|
| 787 | type(layering), dimension(:,:), intent(inout) :: layerings_map |
|---|
| 788 | |
|---|
| 789 | ! LOCAL VARIABLES |
|---|
| 790 | ! --------------- |
|---|
| 791 | integer(di) :: i, islope |
|---|
| 792 | |
|---|
| 793 | ! CODE |
|---|
| 794 | ! ---- |
|---|
| 795 | do islope = 1,nslope |
|---|
| 796 | do i = 1,ngrid |
|---|
| 797 | layerings_map(i,islope)%top%h_h2oice = h2o_ice(i,islope)/rho_h2oice |
|---|
| 798 | layerings_map(i,islope)%top%h_co2ice = co2_ice(i,islope)/rho_co2ice |
|---|
| 799 | end do |
|---|
| 800 | end do |
|---|
| 801 | |
|---|
| 802 | END SUBROUTINE surfice2layering |
|---|
| 803 | !======================================================================= |
|---|
| 804 | |
|---|
| 805 | !======================================================================= |
|---|
| 806 | SUBROUTINE print_layerings_map(this) |
|---|
| 807 | !----------------------------------------------------------------------- |
|---|
| 808 | ! NAME |
|---|
| 809 | ! print_layerings_map |
|---|
| 810 | ! |
|---|
| 811 | ! DESCRIPTION |
|---|
| 812 | ! Display the entire layerings map for all grids and slopes. |
|---|
| 813 | ! |
|---|
| 814 | ! AUTHORS & DATE |
|---|
| 815 | ! JB Clement, 2024 |
|---|
| 816 | ! |
|---|
| 817 | ! NOTES |
|---|
| 818 | ! |
|---|
| 819 | !----------------------------------------------------------------------- |
|---|
| 820 | |
|---|
| 821 | ! DEPENDENCIES |
|---|
| 822 | ! ------------ |
|---|
| 823 | use utility, only: int2str |
|---|
| 824 | use display, only: print_msg |
|---|
| 825 | |
|---|
| 826 | ! DEPENDENCIES |
|---|
| 827 | ! ------------ |
|---|
| 828 | use geometry, only: ngrid, nslope |
|---|
| 829 | |
|---|
| 830 | ! DECLARATION |
|---|
| 831 | ! ----------- |
|---|
| 832 | implicit none |
|---|
| 833 | |
|---|
| 834 | ! ARGUMENTS |
|---|
| 835 | ! --------- |
|---|
| 836 | type(layering), dimension(:,:), intent(in) :: this |
|---|
| 837 | |
|---|
| 838 | ! LOCAL VARIABLES |
|---|
| 839 | ! --------------- |
|---|
| 840 | integer(di) :: ig, islope |
|---|
| 841 | |
|---|
| 842 | ! CODE |
|---|
| 843 | ! ---- |
|---|
| 844 | do ig = 1,ngrid |
|---|
| 845 | call print_msg('Grid cell '//int2str(ig)) |
|---|
| 846 | do islope = 1,nslope |
|---|
| 847 | call print_msg('Slope number '//int2str(islope)) |
|---|
| 848 | call print_layering(this(ig,islope)) |
|---|
| 849 | call print_msg('~~~~~~~~~~') |
|---|
| 850 | end do |
|---|
| 851 | call print_msg('--------------------') |
|---|
| 852 | end do |
|---|
| 853 | |
|---|
| 854 | END SUBROUTINE print_layerings_map |
|---|
| 855 | !======================================================================= |
|---|
| 856 | |
|---|
| 857 | !======================================================================= |
|---|
| 858 | FUNCTION thickness(this) RESULT(h_str) |
|---|
| 859 | !----------------------------------------------------------------------- |
|---|
| 860 | ! NAME |
|---|
| 861 | ! thickness |
|---|
| 862 | ! |
|---|
| 863 | ! DESCRIPTION |
|---|
| 864 | ! Compute the total thickness of a stratum. |
|---|
| 865 | ! |
|---|
| 866 | ! AUTHORS & DATE |
|---|
| 867 | ! JB Clement, 2024 |
|---|
| 868 | ! |
|---|
| 869 | ! NOTES |
|---|
| 870 | ! |
|---|
| 871 | !----------------------------------------------------------------------- |
|---|
| 872 | |
|---|
| 873 | ! DECLARATION |
|---|
| 874 | ! ----------- |
|---|
| 875 | implicit none |
|---|
| 876 | |
|---|
| 877 | ! ARGUMENTS |
|---|
| 878 | ! --------- |
|---|
| 879 | type(stratum), intent(in) :: this |
|---|
| 880 | |
|---|
| 881 | ! LOCAL VARIABLES |
|---|
| 882 | ! --------------- |
|---|
| 883 | real(dp) :: h_str |
|---|
| 884 | |
|---|
| 885 | ! CODE |
|---|
| 886 | ! ---- |
|---|
| 887 | h_str = this%h_co2ice + this%h_h2oice + this%h_dust + this%h_pore |
|---|
| 888 | |
|---|
| 889 | END FUNCTION thickness |
|---|
| 890 | !======================================================================= |
|---|
| 891 | |
|---|
| 892 | !======================================================================= |
|---|
| 893 | FUNCTION is_co2ice_str(str) RESULT(co2ice_str) |
|---|
| 894 | !----------------------------------------------------------------------- |
|---|
| 895 | ! NAME |
|---|
| 896 | ! is_co2ice_str |
|---|
| 897 | ! |
|---|
| 898 | ! DESCRIPTION |
|---|
| 899 | ! Check if a stratum can be considered as a CO2 ice layer. |
|---|
| 900 | ! |
|---|
| 901 | ! AUTHORS & DATE |
|---|
| 902 | ! JB Clement, 2024 |
|---|
| 903 | ! |
|---|
| 904 | ! NOTES |
|---|
| 905 | ! |
|---|
| 906 | !----------------------------------------------------------------------- |
|---|
| 907 | |
|---|
| 908 | ! DECLARATION |
|---|
| 909 | ! ----------- |
|---|
| 910 | implicit none |
|---|
| 911 | |
|---|
| 912 | ! ARGUMENTS |
|---|
| 913 | ! --------- |
|---|
| 914 | type(stratum), intent(in) :: str |
|---|
| 915 | |
|---|
| 916 | ! LOCAL VARIABLES |
|---|
| 917 | ! --------------- |
|---|
| 918 | logical(k4) :: co2ice_str |
|---|
| 919 | |
|---|
| 920 | ! CODE |
|---|
| 921 | ! ---- |
|---|
| 922 | co2ice_str = .false. |
|---|
| 923 | if (str%h_co2ice > str%h_h2oice .and. str%h_co2ice > str%h_dust) co2ice_str = .true. |
|---|
| 924 | |
|---|
| 925 | END FUNCTION is_co2ice_str |
|---|
| 926 | !======================================================================= |
|---|
| 927 | |
|---|
| 928 | !======================================================================= |
|---|
| 929 | FUNCTION is_h2oice_str(str) RESULT(h2oice_str) |
|---|
| 930 | !----------------------------------------------------------------------- |
|---|
| 931 | ! NAME |
|---|
| 932 | ! is_h2oice_str |
|---|
| 933 | ! |
|---|
| 934 | ! DESCRIPTION |
|---|
| 935 | ! Check if a stratum can be considered as a H2O ice layer. |
|---|
| 936 | ! |
|---|
| 937 | ! AUTHORS & DATE |
|---|
| 938 | ! JB Clement, 2024 |
|---|
| 939 | ! |
|---|
| 940 | ! NOTES |
|---|
| 941 | ! |
|---|
| 942 | !----------------------------------------------------------------------- |
|---|
| 943 | |
|---|
| 944 | ! DECLARATION |
|---|
| 945 | ! ----------- |
|---|
| 946 | implicit none |
|---|
| 947 | |
|---|
| 948 | ! ARGUMENTS |
|---|
| 949 | ! --------- |
|---|
| 950 | type(stratum), intent(in) :: str |
|---|
| 951 | |
|---|
| 952 | ! LOCAL VARIABLES |
|---|
| 953 | ! --------------- |
|---|
| 954 | logical(k4) :: h2oice_str |
|---|
| 955 | |
|---|
| 956 | ! CODE |
|---|
| 957 | ! ---- |
|---|
| 958 | h2oice_str = .false. |
|---|
| 959 | if (str%h_h2oice > str%h_co2ice .and. str%h_h2oice > str%h_dust) h2oice_str = .true. |
|---|
| 960 | |
|---|
| 961 | END FUNCTION is_h2oice_str |
|---|
| 962 | !======================================================================= |
|---|
| 963 | |
|---|
| 964 | !======================================================================= |
|---|
| 965 | FUNCTION is_dust_str(str) RESULT(dust_str) |
|---|
| 966 | !----------------------------------------------------------------------- |
|---|
| 967 | ! NAME |
|---|
| 968 | ! is_dust_str |
|---|
| 969 | ! |
|---|
| 970 | ! DESCRIPTION |
|---|
| 971 | ! Check if a stratum can be considered as a dust layer. |
|---|
| 972 | ! |
|---|
| 973 | ! AUTHORS & DATE |
|---|
| 974 | ! JB Clement, 2024 |
|---|
| 975 | ! |
|---|
| 976 | ! NOTES |
|---|
| 977 | ! |
|---|
| 978 | !----------------------------------------------------------------------- |
|---|
| 979 | |
|---|
| 980 | ! DECLARATION |
|---|
| 981 | ! ----------- |
|---|
| 982 | implicit none |
|---|
| 983 | |
|---|
| 984 | ! ARGUMENTS |
|---|
| 985 | ! --------- |
|---|
| 986 | type(stratum), intent(in) :: str |
|---|
| 987 | |
|---|
| 988 | ! LOCAL VARIABLES |
|---|
| 989 | ! --------------- |
|---|
| 990 | logical(k4) :: dust_str |
|---|
| 991 | |
|---|
| 992 | ! CODE |
|---|
| 993 | ! ---- |
|---|
| 994 | dust_str = .false. |
|---|
| 995 | if (str%h_dust > str%h_co2ice .and. str%h_dust > str%h_h2oice) dust_str = .true. |
|---|
| 996 | |
|---|
| 997 | END FUNCTION is_dust_str |
|---|
| 998 | !======================================================================= |
|---|
| 999 | |
|---|
| 1000 | !======================================================================= |
|---|
| 1001 | FUNCTION is_dust_lag(str) RESULT(dust_lag) |
|---|
| 1002 | !----------------------------------------------------------------------- |
|---|
| 1003 | ! NAME |
|---|
| 1004 | ! is_dust_lag |
|---|
| 1005 | ! |
|---|
| 1006 | ! DESCRIPTION |
|---|
| 1007 | ! Check if a stratum is a dust lag (no ice content). |
|---|
| 1008 | ! |
|---|
| 1009 | ! AUTHORS & DATE |
|---|
| 1010 | ! JB Clement, 2024 |
|---|
| 1011 | ! |
|---|
| 1012 | ! NOTES |
|---|
| 1013 | ! |
|---|
| 1014 | !----------------------------------------------------------------------- |
|---|
| 1015 | |
|---|
| 1016 | ! DECLARATION |
|---|
| 1017 | ! ----------- |
|---|
| 1018 | implicit none |
|---|
| 1019 | |
|---|
| 1020 | ! ARGUMENTS |
|---|
| 1021 | ! --------- |
|---|
| 1022 | type(stratum), intent(in) :: str |
|---|
| 1023 | |
|---|
| 1024 | ! LOCAL VARIABLES |
|---|
| 1025 | ! --------------- |
|---|
| 1026 | logical(k4) :: dust_lag |
|---|
| 1027 | |
|---|
| 1028 | ! CODE |
|---|
| 1029 | ! ---- |
|---|
| 1030 | dust_lag = .false. |
|---|
| 1031 | if (str%h_co2ice < tol .and. str%h_h2oice < tol .and. str%poreice_volfrac < tol) dust_lag = .true. |
|---|
| 1032 | |
|---|
| 1033 | END FUNCTION is_dust_lag |
|---|
| 1034 | !======================================================================= |
|---|
| 1035 | |
|---|
| 1036 | !======================================================================= |
|---|
| 1037 | SUBROUTINE subsurface_ice_layering(this,h_toplag,h2o_ice,co2_ice) |
|---|
| 1038 | !----------------------------------------------------------------------- |
|---|
| 1039 | ! NAME |
|---|
| 1040 | ! subsurface_ice_layering |
|---|
| 1041 | ! |
|---|
| 1042 | ! DESCRIPTION |
|---|
| 1043 | ! Get data about possible subsurface ice in a layering. |
|---|
| 1044 | ! |
|---|
| 1045 | ! AUTHORS & DATE |
|---|
| 1046 | ! JB Clement, 2024 |
|---|
| 1047 | ! |
|---|
| 1048 | ! NOTES |
|---|
| 1049 | ! |
|---|
| 1050 | !----------------------------------------------------------------------- |
|---|
| 1051 | |
|---|
| 1052 | ! DECLARATION |
|---|
| 1053 | ! ----------- |
|---|
| 1054 | implicit none |
|---|
| 1055 | |
|---|
| 1056 | ! ARGUMENTS |
|---|
| 1057 | ! --------- |
|---|
| 1058 | type(layering), intent(in) :: this |
|---|
| 1059 | real(dp), intent(out) :: h2o_ice, co2_ice, h_toplag |
|---|
| 1060 | |
|---|
| 1061 | ! LOCAL VARIABLES |
|---|
| 1062 | ! --------------- |
|---|
| 1063 | type(stratum), pointer :: current |
|---|
| 1064 | |
|---|
| 1065 | ! CODE |
|---|
| 1066 | ! ---- |
|---|
| 1067 | h_toplag = 0._dp |
|---|
| 1068 | h2o_ice = 0._dp |
|---|
| 1069 | co2_ice = 0._dp |
|---|
| 1070 | current => this%top |
|---|
| 1071 | ! Is the considered stratum a dust lag? |
|---|
| 1072 | if (.not. is_dust_lag(current)) return |
|---|
| 1073 | do while (is_dust_lag(current)) |
|---|
| 1074 | h_toplag = h_toplag + thickness(current) |
|---|
| 1075 | if (associated(current%down)) then |
|---|
| 1076 | current => current%down |
|---|
| 1077 | else |
|---|
| 1078 | exit |
|---|
| 1079 | end if |
|---|
| 1080 | end do |
|---|
| 1081 | |
|---|
| 1082 | if (.not. associated(current%down)) then ! Bottom of the layering -> no ice below |
|---|
| 1083 | h_toplag = 0._dp |
|---|
| 1084 | return |
|---|
| 1085 | end if |
|---|
| 1086 | |
|---|
| 1087 | ! Is the stratum below the dust lag made of ice? |
|---|
| 1088 | if (current%h_h2oice > 0._dp .and. current%h_h2oice > current%h_co2ice) then ! Yes, there is more H2O ice than CO2 ice |
|---|
| 1089 | if (h_toplag < h_patchy_dust) then ! But the dust lag is too thin to considered ice as subsurface ice |
|---|
| 1090 | h_toplag = 0._dp |
|---|
| 1091 | h2o_ice = current%h_h2oice*rho_h2oice |
|---|
| 1092 | end if |
|---|
| 1093 | else if (current%h_co2ice > 0._dp .and. current%h_co2ice > current%h_h2oice) then ! No, there is more CO2 ice than H2O ice |
|---|
| 1094 | h_toplag = 0._dp ! Because it matters only for H2O ice |
|---|
| 1095 | if (h_toplag < h_patchy_ice) co2_ice = current%h_co2ice*rho_co2ice ! But the dust lag is too thin to considered ice as subsurface ice |
|---|
| 1096 | end if |
|---|
| 1097 | |
|---|
| 1098 | END SUBROUTINE subsurface_ice_layering |
|---|
| 1099 | !======================================================================= |
|---|
| 1100 | |
|---|
| 1101 | !======================================================================= |
|---|
| 1102 | SUBROUTINE lift_dust(this,str,h2lift) |
|---|
| 1103 | !----------------------------------------------------------------------- |
|---|
| 1104 | ! NAME |
|---|
| 1105 | ! lift_dust |
|---|
| 1106 | ! |
|---|
| 1107 | ! DESCRIPTION |
|---|
| 1108 | ! Lift dust in a stratum by wind erosion or other processes. |
|---|
| 1109 | ! |
|---|
| 1110 | ! AUTHORS & DATE |
|---|
| 1111 | ! JB Clement, 2024 |
|---|
| 1112 | ! |
|---|
| 1113 | ! NOTES |
|---|
| 1114 | ! |
|---|
| 1115 | !----------------------------------------------------------------------- |
|---|
| 1116 | |
|---|
| 1117 | ! DECLARATION |
|---|
| 1118 | ! ----------- |
|---|
| 1119 | implicit none |
|---|
| 1120 | |
|---|
| 1121 | ! ARGUMENTS |
|---|
| 1122 | ! --------- |
|---|
| 1123 | type(layering), intent(inout) :: this |
|---|
| 1124 | type(stratum), pointer, intent(inout) :: str |
|---|
| 1125 | real(dp), intent(in) :: h2lift |
|---|
| 1126 | |
|---|
| 1127 | ! CODE |
|---|
| 1128 | ! ---- |
|---|
| 1129 | ! Update of properties in the eroding dust lag |
|---|
| 1130 | str%top_elevation = str%top_elevation - h2lift*(1._dp + str%h_pore/str%h_dust) |
|---|
| 1131 | str%h_pore = str%h_pore - h2lift*str%h_pore/str%h_dust |
|---|
| 1132 | str%h_dust = str%h_dust - h2lift |
|---|
| 1133 | |
|---|
| 1134 | ! Remove the eroding dust lag if there is no dust anymore |
|---|
| 1135 | if (str%h_dust < tol) call del_stratum(this,str) |
|---|
| 1136 | |
|---|
| 1137 | END SUBROUTINE lift_dust |
|---|
| 1138 | !======================================================================= |
|---|
| 1139 | |
|---|
| 1140 | !======================================================================= |
|---|
| 1141 | SUBROUTINE sublimate_ice(this,str,h2subl_co2ice,h2subl_h2oice,new_lag,zlag) |
|---|
| 1142 | !----------------------------------------------------------------------- |
|---|
| 1143 | ! NAME |
|---|
| 1144 | ! sublimate_ice |
|---|
| 1145 | ! |
|---|
| 1146 | ! DESCRIPTION |
|---|
| 1147 | ! Handle ice sublimation in a stratum and create lag layer. |
|---|
| 1148 | ! |
|---|
| 1149 | ! AUTHORS & DATE |
|---|
| 1150 | ! JB Clement, 2024 |
|---|
| 1151 | ! |
|---|
| 1152 | ! NOTES |
|---|
| 1153 | ! |
|---|
| 1154 | !----------------------------------------------------------------------- |
|---|
| 1155 | |
|---|
| 1156 | ! DECLARATION |
|---|
| 1157 | ! ----------- |
|---|
| 1158 | implicit none |
|---|
| 1159 | |
|---|
| 1160 | ! ARGUMENTS |
|---|
| 1161 | ! --------- |
|---|
| 1162 | type(layering), intent(inout) :: this |
|---|
| 1163 | type(stratum), pointer, intent(inout) :: str |
|---|
| 1164 | logical(k4), intent(inout) :: new_lag |
|---|
| 1165 | real(dp), intent(inout) :: zlag |
|---|
| 1166 | real(dp), intent(in) :: h2subl_co2ice, h2subl_h2oice |
|---|
| 1167 | |
|---|
| 1168 | ! LOCAL VARIABLES |
|---|
| 1169 | ! --------------- |
|---|
| 1170 | real(dp) :: h2subl, h_ice, h_pore, h_pore_new, h_tot |
|---|
| 1171 | real(dp) :: hlag_dust, hlag_h2oice |
|---|
| 1172 | type(stratum), pointer :: current |
|---|
| 1173 | |
|---|
| 1174 | ! CODE |
|---|
| 1175 | ! ---- |
|---|
| 1176 | h_ice = str%h_co2ice + str%h_h2oice |
|---|
| 1177 | h_pore = str%h_pore |
|---|
| 1178 | h2subl = h2subl_co2ice + h2subl_h2oice |
|---|
| 1179 | |
|---|
| 1180 | ! How much dust and H2O ice does ice sublimation involve to create the lag? |
|---|
| 1181 | hlag_dust = str%h_dust*h2subl/h_ice |
|---|
| 1182 | hlag_h2oice = 0._dp |
|---|
| 1183 | if (h2subl_co2ice > 0._dp .and. h2subl_h2oice < tol) hlag_h2oice = str%h_h2oice*h2subl/h_ice |
|---|
| 1184 | |
|---|
| 1185 | ! Update of properties in the sublimating stratum |
|---|
| 1186 | str%top_elevation = str%top_elevation - h2subl*(1._dp + h_pore/h_ice) - hlag_dust - hlag_h2oice |
|---|
| 1187 | str%h_co2ice = str%h_co2ice - h2subl_co2ice |
|---|
| 1188 | str%h_h2oice = str%h_h2oice - h2subl_h2oice - hlag_h2oice |
|---|
| 1189 | str%h_dust = str%h_dust - hlag_dust |
|---|
| 1190 | str%h_pore = str%h_pore - h2subl*h_pore/h_ice |
|---|
| 1191 | |
|---|
| 1192 | ! Correct the value of top_elevation for the upper strata |
|---|
| 1193 | current => str%up |
|---|
| 1194 | do while (associated(current)) |
|---|
| 1195 | current%top_elevation = current%down%top_elevation + thickness(current) |
|---|
| 1196 | current => current%up |
|---|
| 1197 | end do |
|---|
| 1198 | |
|---|
| 1199 | ! Remove the sublimating stratum if there is no ice anymore |
|---|
| 1200 | if (str%h_co2ice < tol .and. str%h_h2oice < tol) call del_stratum(this,str) |
|---|
| 1201 | |
|---|
| 1202 | ! Which porosity is considered? |
|---|
| 1203 | if (hlag_dust >= hlag_h2oice) then |
|---|
| 1204 | h_pore_new = hlag_dust*dry_lag_porosity/(1._dp - dry_lag_porosity) |
|---|
| 1205 | else |
|---|
| 1206 | h_pore_new = hlag_h2oice*wet_lag_porosity/(1._dp - wet_lag_porosity) |
|---|
| 1207 | end if |
|---|
| 1208 | h_tot = hlag_dust + hlag_h2oice + h_pore_new |
|---|
| 1209 | |
|---|
| 1210 | ! New stratum above the current stratum as a lag layer |
|---|
| 1211 | if (new_lag) then |
|---|
| 1212 | call insert_stratum(this,str,str%top_elevation + h_tot,0._dp,hlag_h2oice,hlag_dust,h_pore_new,0._dp) |
|---|
| 1213 | new_lag = .false. |
|---|
| 1214 | else |
|---|
| 1215 | str%up%top_elevation = str%up%top_elevation + h_tot |
|---|
| 1216 | str%up%h_h2oice = str%up%h_h2oice + hlag_h2oice |
|---|
| 1217 | str%up%h_dust = str%up%h_dust + hlag_dust |
|---|
| 1218 | str%up%h_pore = str%up%h_pore + h_pore_new |
|---|
| 1219 | end if |
|---|
| 1220 | |
|---|
| 1221 | zlag = zlag + h_tot |
|---|
| 1222 | |
|---|
| 1223 | END SUBROUTINE sublimate_ice |
|---|
| 1224 | !======================================================================= |
|---|
| 1225 | |
|---|
| 1226 | !======================================================================= |
|---|
| 1227 | SUBROUTINE evolve_layering(this,d_co2ice,d_h2oice,new_str,zshift_surf,new_lag,zlag,current) |
|---|
| 1228 | !----------------------------------------------------------------------- |
|---|
| 1229 | ! NAME |
|---|
| 1230 | ! evolve_layering |
|---|
| 1231 | ! |
|---|
| 1232 | ! DESCRIPTION |
|---|
| 1233 | ! Main algorithm for layering evolution. Manages ice condensation/sublimation |
|---|
| 1234 | ! and dust sedimentation/lifting. Handles multiple scenarios: building new |
|---|
| 1235 | ! strata from ice/dust, retreating strata from sublimation/lifting, and mixed |
|---|
| 1236 | ! scenarios with CO2 ice sublimation combined with H2O ice condensation. |
|---|
| 1237 | ! |
|---|
| 1238 | ! AUTHORS & DATE |
|---|
| 1239 | ! JB Clement, 09/2024 |
|---|
| 1240 | ! |
|---|
| 1241 | ! NOTES |
|---|
| 1242 | ! Creates dust lag layers when ice sublimation occurs. |
|---|
| 1243 | !----------------------------------------------------------------------- |
|---|
| 1244 | |
|---|
| 1245 | ! DEPENDENCIES |
|---|
| 1246 | ! ------------ |
|---|
| 1247 | use stoppage, only: stop_clean |
|---|
| 1248 | use utility, only: real2str |
|---|
| 1249 | use display, only: print_err |
|---|
| 1250 | |
|---|
| 1251 | ! DECLARATION |
|---|
| 1252 | ! ----------- |
|---|
| 1253 | implicit none |
|---|
| 1254 | |
|---|
| 1255 | ! ARGUMENTS |
|---|
| 1256 | ! --------- |
|---|
| 1257 | type(layering), intent(inout) :: this |
|---|
| 1258 | type(stratum), pointer, intent(inout) :: current |
|---|
| 1259 | real(dp), intent(inout) :: d_co2ice, d_h2oice |
|---|
| 1260 | logical(k4), intent(inout) :: new_str, new_lag |
|---|
| 1261 | real(dp), intent(out) :: zshift_surf, zlag |
|---|
| 1262 | |
|---|
| 1263 | ! LOCAL VARIABLES |
|---|
| 1264 | ! --------------- |
|---|
| 1265 | real(dp) :: dh_co2ice, dh_h2oice, dh_dust, dh_dust_co2, dh_dust_h2o |
|---|
| 1266 | real(dp) :: h_co2ice_old, h_h2oice_old |
|---|
| 1267 | real(dp) :: h2subl_co2ice, h2subl_h2oice, h2subl_co2ice_tot, h2subl_h2oice_tot |
|---|
| 1268 | real(dp) :: h2lift, h2lift_tot, h_pore, h_tot, h_toplag, R_subl |
|---|
| 1269 | logical(k4) :: unexpected |
|---|
| 1270 | type(stratum), pointer :: currentloc |
|---|
| 1271 | |
|---|
| 1272 | ! CODE |
|---|
| 1273 | ! ---- |
|---|
| 1274 | dh_co2ice = d_co2ice/rho_co2ice |
|---|
| 1275 | dh_h2oice = d_h2oice/rho_h2oice |
|---|
| 1276 | dh_dust = 0._dp |
|---|
| 1277 | if (dh_h2oice > 0._dp) then ! To put a dust sedimentation tendency only when ice is condensing |
|---|
| 1278 | if (impose_dust_ratio) then |
|---|
| 1279 | if (dh_co2ice > 0._dp) then |
|---|
| 1280 | dh_dust = dust2ice_ratio*(dh_h2oice + dh_co2ice) |
|---|
| 1281 | else |
|---|
| 1282 | dh_dust = dust2ice_ratio*dh_h2oice |
|---|
| 1283 | end if |
|---|
| 1284 | else |
|---|
| 1285 | dh_dust = d_dust/rho_dust |
|---|
| 1286 | end if |
|---|
| 1287 | end if |
|---|
| 1288 | zshift_surf = this%top%top_elevation |
|---|
| 1289 | zlag = 0._dp |
|---|
| 1290 | unexpected = .false. |
|---|
| 1291 | |
|---|
| 1292 | !~~~~~~~~~~ |
|---|
| 1293 | ! NOTHING HAPPENS |
|---|
| 1294 | if (abs(dh_co2ice) < tol .and. abs(dh_h2oice) < tol .and. abs(dh_dust) < tol) then |
|---|
| 1295 | ! So we do nothing |
|---|
| 1296 | !~~~~~~~~~~ |
|---|
| 1297 | ! BUILDING A STRATUM (ice condensation and/or dust desimentation) |
|---|
| 1298 | else if (dh_co2ice >= 0._dp .and. dh_h2oice >= 0._dp .and. dh_dust >= 0._dp) then |
|---|
| 1299 | ! Which porosity is considered? |
|---|
| 1300 | if (dh_co2ice > dh_h2oice .and. dh_co2ice > dh_dust) then ! CO2 ice is dominant |
|---|
| 1301 | h_pore = dh_co2ice*co2ice_porosity/(1._dp - co2ice_porosity) |
|---|
| 1302 | else if (dh_h2oice > dh_co2ice .and. dh_h2oice > dh_dust) then ! H2O ice is dominant |
|---|
| 1303 | h_pore = dh_h2oice*h2oice_porosity/(1._dp - h2oice_porosity) |
|---|
| 1304 | else if (dh_dust > dh_co2ice .and. dh_dust > dh_h2oice) then ! Dust is dominant |
|---|
| 1305 | h_pore = dh_dust*regolith_porosity/(1._dp - regolith_porosity) |
|---|
| 1306 | else |
|---|
| 1307 | unexpected = .true. |
|---|
| 1308 | end if |
|---|
| 1309 | h_tot = dh_co2ice + dh_h2oice + dh_dust + h_pore |
|---|
| 1310 | ! New stratum at the top of the layering |
|---|
| 1311 | if (new_str) then |
|---|
| 1312 | call add_stratum(this,this%top%top_elevation + h_tot,dh_co2ice,dh_h2oice,dh_dust,h_pore,0._dp) |
|---|
| 1313 | new_str = .false. |
|---|
| 1314 | else |
|---|
| 1315 | this%top%top_elevation = this%top%top_elevation + h_tot |
|---|
| 1316 | this%top%h_co2ice = this%top%h_co2ice + dh_co2ice |
|---|
| 1317 | this%top%h_h2oice = this%top%h_h2oice + dh_h2oice |
|---|
| 1318 | this%top%h_dust = this%top%h_dust + dh_dust |
|---|
| 1319 | this%top%h_pore = this%top%h_pore + h_pore |
|---|
| 1320 | end if |
|---|
| 1321 | !~~~~~~~~~~ |
|---|
| 1322 | ! RETREATING A STRATUM (ice sublimation and/or dust lifting) |
|---|
| 1323 | else if (dh_co2ice <= 0._dp .and. dh_h2oice <= 0._dp .and. dh_dust <= 0._dp) then |
|---|
| 1324 | h2subl_co2ice_tot = abs(dh_co2ice) |
|---|
| 1325 | h2subl_h2oice_tot = abs(dh_h2oice) |
|---|
| 1326 | h2lift_tot = abs(dh_dust) |
|---|
| 1327 | do while ((h2subl_co2ice_tot > 0._dp .or. h2subl_h2oice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. associated(current)) |
|---|
| 1328 | h_co2ice_old = current%h_co2ice |
|---|
| 1329 | h_h2oice_old = current%h_h2oice |
|---|
| 1330 | |
|---|
| 1331 | ! How much is CO2 ice sublimation inhibited by the top dust lag? |
|---|
| 1332 | R_subl = 1. |
|---|
| 1333 | if (associated(current%up)) then ! If there is an upper stratum |
|---|
| 1334 | h_toplag = 0._dp |
|---|
| 1335 | currentloc => current%up |
|---|
| 1336 | do while (is_dust_lag(currentloc) .and. associated(currentloc%up)) |
|---|
| 1337 | h_toplag = h_toplag + thickness(currentloc) |
|---|
| 1338 | currentloc => currentloc%up |
|---|
| 1339 | end do |
|---|
| 1340 | if (currentloc%h_h2oice >= h_patchy_ice) then |
|---|
| 1341 | R_subl = 0._dp |
|---|
| 1342 | else if (0._dp < currentloc%h_h2oice .and. currentloc%h_h2oice < h_patchy_ice) then |
|---|
| 1343 | h_toplag = h_toplag + thickness(currentloc) |
|---|
| 1344 | R_subl = fred_sublco2**(h_toplag/hmin_lag_co2) |
|---|
| 1345 | else |
|---|
| 1346 | R_subl = fred_sublco2**(h_toplag/hmin_lag_co2) |
|---|
| 1347 | end if |
|---|
| 1348 | end if |
|---|
| 1349 | h2subl_co2ice_tot = h2subl_co2ice_tot*R_subl |
|---|
| 1350 | |
|---|
| 1351 | ! Is there CO2 ice to sublimate? |
|---|
| 1352 | h2subl_co2ice = 0._dp |
|---|
| 1353 | if (h_co2ice_old > 0._dp .and. h2subl_co2ice_tot > 0._dp) then |
|---|
| 1354 | h2subl_co2ice = min(h2subl_co2ice_tot,h_co2ice_old) |
|---|
| 1355 | h2subl_co2ice_tot = h2subl_co2ice_tot - h2subl_co2ice |
|---|
| 1356 | end if |
|---|
| 1357 | ! Is there H2O ice to sublimate? |
|---|
| 1358 | h2subl_h2oice = 0._dp |
|---|
| 1359 | if (h_h2oice_old > 0._dp .and. h2subl_h2oice_tot > 0._dp) then |
|---|
| 1360 | h2subl_h2oice = min(h2subl_h2oice_tot,h_h2oice_old) |
|---|
| 1361 | h2subl_h2oice_tot = h2subl_h2oice_tot - h2subl_h2oice |
|---|
| 1362 | end if |
|---|
| 1363 | ! Ice sublimation |
|---|
| 1364 | if (h2subl_co2ice > 0._dp .or. h2subl_h2oice > 0._dp) call sublimate_ice(this,current,h2subl_co2ice,h2subl_h2oice,new_lag,zlag) |
|---|
| 1365 | |
|---|
| 1366 | ! Is there dust to lift? |
|---|
| 1367 | h2lift = 0._dp |
|---|
| 1368 | if (is_dust_lag(current) .and. h2lift_tot > 0._dp) then |
|---|
| 1369 | h2lift = min(h2lift_tot,current%h_dust) |
|---|
| 1370 | h2lift_tot = h2lift_tot - h2lift |
|---|
| 1371 | ! Dust lifting |
|---|
| 1372 | if (h2lift > 0._dp) call lift_dust(this,current,h2lift) |
|---|
| 1373 | else if (associated(current%up)) then |
|---|
| 1374 | if (is_dust_lag(current%up) .and. h2lift_tot > 0._dp) then |
|---|
| 1375 | h2lift = min(h2lift_tot,current%up%h_dust) |
|---|
| 1376 | h2lift_tot = h2lift_tot - h2lift |
|---|
| 1377 | ! Dust lifting |
|---|
| 1378 | if (h2lift > 0._dp) call lift_dust(this,current%up,h2lift) |
|---|
| 1379 | end if |
|---|
| 1380 | end if |
|---|
| 1381 | |
|---|
| 1382 | ! Still ice to be sublimated or dust to be lifted and no more ice in the current stratum so we move to the underlying stratum |
|---|
| 1383 | if ((h2subl_co2ice_tot > 0. .or. h2subl_h2oice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. current%h_co2ice < tol .and. current%h_h2oice < tol .and. current%poreice_volfrac < tol) then |
|---|
| 1384 | current => current%down |
|---|
| 1385 | new_lag = .true. |
|---|
| 1386 | else |
|---|
| 1387 | exit |
|---|
| 1388 | end if |
|---|
| 1389 | end do |
|---|
| 1390 | if (h2subl_co2ice_tot > 0._dp) dh_co2ice = 0._dp ! No CO2 ice available anymore so the tendency is set to 0 |
|---|
| 1391 | if (h2subl_h2oice_tot > 0._dp) dh_h2oice = 0._dp ! No H2O ice available anymore so the tendency is set to 0 |
|---|
| 1392 | if (h2lift_tot > 0._dp) dh_dust = 0._dp ! No dust available anymore so the tendency is set to 0 |
|---|
| 1393 | !~~~~~~~~~~ |
|---|
| 1394 | ! CO2 ICE SUBLIMATION + H2O ICE CONDENSATION |
|---|
| 1395 | else if (dh_co2ice <= 0._dp .and. dh_h2oice >= 0._dp) then |
|---|
| 1396 | if (dh_dust >= 0._dp) then |
|---|
| 1397 | dh_dust_co2 = 0._dp |
|---|
| 1398 | dh_dust_h2o = dh_dust |
|---|
| 1399 | else |
|---|
| 1400 | dh_dust_co2 = dh_dust |
|---|
| 1401 | dh_dust_h2o = 0._dp |
|---|
| 1402 | end if |
|---|
| 1403 | if (abs(dh_co2ice) > dh_h2oice) then ! CO2 ice sublimation is dominant |
|---|
| 1404 | ! CO2 ICE SUBLIMATION: retreating a stratum |
|---|
| 1405 | h2subl_co2ice_tot = abs(dh_co2ice) |
|---|
| 1406 | h2lift_tot = abs(dh_dust_co2) |
|---|
| 1407 | do while ((h2subl_co2ice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. associated(current)) |
|---|
| 1408 | h_co2ice_old = current%h_co2ice |
|---|
| 1409 | |
|---|
| 1410 | ! How much is CO2 ice sublimation inhibited by the top dust lag? |
|---|
| 1411 | R_subl = 1. |
|---|
| 1412 | if (associated(current%up)) then ! If there is an upper stratum |
|---|
| 1413 | h_toplag = 0._dp |
|---|
| 1414 | currentloc => current%up |
|---|
| 1415 | do while (is_dust_lag(currentloc) .and. associated(currentloc%up)) |
|---|
| 1416 | h_toplag = h_toplag + thickness(currentloc) |
|---|
| 1417 | currentloc => currentloc%up |
|---|
| 1418 | end do |
|---|
| 1419 | if (currentloc%h_h2oice >= h_patchy_ice) then |
|---|
| 1420 | R_subl = 0._dp |
|---|
| 1421 | else if (0._dp < currentloc%h_h2oice .and. currentloc%h_h2oice < h_patchy_ice) then |
|---|
| 1422 | h_toplag = h_toplag + thickness(currentloc) |
|---|
| 1423 | R_subl = fred_sublco2**(h_toplag/hmin_lag_co2) |
|---|
| 1424 | else |
|---|
| 1425 | R_subl = fred_sublco2**(h_toplag/hmin_lag_co2) |
|---|
| 1426 | end if |
|---|
| 1427 | end if |
|---|
| 1428 | h2subl_co2ice_tot = h2subl_co2ice_tot*R_subl |
|---|
| 1429 | |
|---|
| 1430 | ! Is there CO2 ice to sublimate? |
|---|
| 1431 | h2subl_co2ice = 0._dp |
|---|
| 1432 | if (h_co2ice_old > 0._dp .and. h2subl_co2ice_tot > 0._dp) then |
|---|
| 1433 | h2subl_co2ice = min(h2subl_co2ice_tot,h_co2ice_old) |
|---|
| 1434 | h2subl_co2ice_tot = h2subl_co2ice_tot - h2subl_co2ice |
|---|
| 1435 | end if |
|---|
| 1436 | ! Ice sublimation |
|---|
| 1437 | if (h2subl_co2ice > 0._dp) call sublimate_ice(this,current,h2subl_co2ice,0._dp,new_lag,zlag) |
|---|
| 1438 | |
|---|
| 1439 | ! Is there dust to lift? |
|---|
| 1440 | h2lift = 0._dp |
|---|
| 1441 | if (is_dust_lag(current) .and. h2lift_tot > 0._dp) then |
|---|
| 1442 | h2lift = min(h2lift_tot,current%h_dust) |
|---|
| 1443 | h2lift_tot = h2lift_tot - h2lift |
|---|
| 1444 | ! Dust lifting |
|---|
| 1445 | if (h2lift > 0._dp) call lift_dust(this,current,h2lift) |
|---|
| 1446 | else if (associated(current%up)) then |
|---|
| 1447 | if (is_dust_lag(current%up) .and. h2lift_tot > 0._dp) then |
|---|
| 1448 | h2lift = min(h2lift_tot,current%up%h_dust) |
|---|
| 1449 | h2lift_tot = h2lift_tot - h2lift |
|---|
| 1450 | ! Dust lifting |
|---|
| 1451 | if (h2lift > 0._dp) call lift_dust(this,current%up,h2lift) |
|---|
| 1452 | end if |
|---|
| 1453 | end if |
|---|
| 1454 | |
|---|
| 1455 | ! Still ice to be sublimated or dust to be lifted and no more ice in the current stratum so we move to the underlying stratum |
|---|
| 1456 | if ((h2subl_co2ice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. current%h_co2ice < tol) then |
|---|
| 1457 | current => current%down |
|---|
| 1458 | new_lag = .true. |
|---|
| 1459 | else |
|---|
| 1460 | exit |
|---|
| 1461 | end if |
|---|
| 1462 | end do |
|---|
| 1463 | if (h2subl_co2ice_tot > 0._dp) dh_co2ice = 0._dp ! No CO2 ice available anymore so the tendency is set to 0 |
|---|
| 1464 | if (h2lift_tot > 0._dp) dh_dust = 0._dp ! No dust available anymore so the tendency is set to 0 |
|---|
| 1465 | |
|---|
| 1466 | ! H2O ICE CONDENSATION: building a stratum |
|---|
| 1467 | h_pore = dh_h2oice*h2oice_porosity/(1._dp - h2oice_porosity) |
|---|
| 1468 | h_tot = dh_h2oice + dh_dust_h2o + h_pore |
|---|
| 1469 | ! New stratum at the top of the layering |
|---|
| 1470 | if (new_str) then |
|---|
| 1471 | call add_stratum(this,this%top%top_elevation + h_tot,0._dp,dh_h2oice,dh_dust_h2o,h_pore,0._dp) |
|---|
| 1472 | new_str = .false. |
|---|
| 1473 | else |
|---|
| 1474 | this%top%top_elevation = this%top%top_elevation + h_tot |
|---|
| 1475 | this%top%h_h2oice = this%top%h_h2oice + dh_h2oice |
|---|
| 1476 | this%top%h_dust = this%top%h_dust + dh_dust_h2o |
|---|
| 1477 | this%top%h_pore = this%top%h_pore + h_pore |
|---|
| 1478 | end if |
|---|
| 1479 | else ! H2O ice condensation is dominant |
|---|
| 1480 | ! H2O ICE CONDENSATION: building a stratum |
|---|
| 1481 | h_pore = dh_h2oice*h2oice_porosity/(1._dp - h2oice_porosity) |
|---|
| 1482 | h_tot = dh_h2oice + dh_dust_h2o + h_pore |
|---|
| 1483 | ! New stratum at the top of the layering |
|---|
| 1484 | if (new_str) then |
|---|
| 1485 | call add_stratum(this,this%top%top_elevation + h_tot,0._dp,dh_h2oice,dh_dust_h2o,h_pore,0._dp) |
|---|
| 1486 | new_str = .false. |
|---|
| 1487 | else |
|---|
| 1488 | this%top%top_elevation = this%top%top_elevation + h_tot |
|---|
| 1489 | this%top%h_h2oice = this%top%h_h2oice + dh_h2oice |
|---|
| 1490 | this%top%h_dust = this%top%h_dust + dh_dust_h2o |
|---|
| 1491 | this%top%h_pore = this%top%h_pore + h_pore |
|---|
| 1492 | end if |
|---|
| 1493 | |
|---|
| 1494 | ! CO2 ICE SUBLIMATION: retreating a stratum |
|---|
| 1495 | h2subl_co2ice_tot = abs(dh_co2ice) |
|---|
| 1496 | h2lift_tot = abs(dh_dust_co2) |
|---|
| 1497 | do while ((h2subl_co2ice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. associated(current)) |
|---|
| 1498 | h_co2ice_old = current%h_co2ice |
|---|
| 1499 | |
|---|
| 1500 | ! How much is CO2 ice sublimation inhibited by the top dust lag? |
|---|
| 1501 | R_subl = 1._dp |
|---|
| 1502 | if (associated(current%up)) then ! If there is an upper stratum |
|---|
| 1503 | h_toplag = 0._dp |
|---|
| 1504 | currentloc => current%up |
|---|
| 1505 | do while (is_dust_lag(currentloc) .and. associated(currentloc%up)) |
|---|
| 1506 | h_toplag = h_toplag + thickness(currentloc) |
|---|
| 1507 | currentloc => currentloc%up |
|---|
| 1508 | end do |
|---|
| 1509 | if (currentloc%h_h2oice >= h_patchy_ice) then |
|---|
| 1510 | R_subl = 0._dp |
|---|
| 1511 | else if (0._dp < currentloc%h_h2oice .and. currentloc%h_h2oice < h_patchy_ice) then |
|---|
| 1512 | h_toplag = h_toplag + thickness(currentloc) |
|---|
| 1513 | R_subl = fred_sublco2**(h_toplag/hmin_lag_co2) |
|---|
| 1514 | else |
|---|
| 1515 | R_subl = fred_sublco2**(h_toplag/hmin_lag_co2) |
|---|
| 1516 | end if |
|---|
| 1517 | end if |
|---|
| 1518 | h2subl_co2ice_tot = h2subl_co2ice_tot*R_subl |
|---|
| 1519 | |
|---|
| 1520 | ! Is there CO2 ice to sublimate? |
|---|
| 1521 | h2subl_co2ice = 0._dp |
|---|
| 1522 | if (h_co2ice_old > 0._dp .and. h2subl_co2ice_tot > 0._dp) then |
|---|
| 1523 | h2subl_co2ice = min(h2subl_co2ice_tot,h_co2ice_old) |
|---|
| 1524 | h2subl_co2ice_tot = h2subl_co2ice_tot - h2subl_co2ice |
|---|
| 1525 | end if |
|---|
| 1526 | ! Ice sublimation |
|---|
| 1527 | if (h2subl_co2ice > 0._dp) call sublimate_ice(this,current,h2subl_co2ice,0._dp,new_lag,zlag) |
|---|
| 1528 | |
|---|
| 1529 | ! Is there dust to lift? |
|---|
| 1530 | h2lift = 0._dp |
|---|
| 1531 | if (is_dust_lag(current) .and. h2lift_tot > 0._dp) then |
|---|
| 1532 | h2lift = min(h2lift_tot,current%h_dust) |
|---|
| 1533 | h2lift_tot = h2lift_tot - h2lift |
|---|
| 1534 | ! Dust lifting |
|---|
| 1535 | if (h2lift > 0._dp) call lift_dust(this,current,h2lift) |
|---|
| 1536 | else if (associated(current%up)) then |
|---|
| 1537 | if (is_dust_lag(current%up) .and. h2lift_tot > 0.) then |
|---|
| 1538 | h2lift = min(h2lift_tot,current%up%h_dust) |
|---|
| 1539 | h2lift_tot = h2lift_tot - h2lift |
|---|
| 1540 | ! Dust lifting |
|---|
| 1541 | if (h2lift > 0.) call lift_dust(this,current%up,h2lift) |
|---|
| 1542 | end if |
|---|
| 1543 | end if |
|---|
| 1544 | |
|---|
| 1545 | ! Still ice to be sublimated or dust to be lifted and no more ice in the current stratum so we move to the underlying stratum |
|---|
| 1546 | if ((h2subl_co2ice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. current%h_co2ice < tol) then |
|---|
| 1547 | current => current%down |
|---|
| 1548 | new_lag = .true. |
|---|
| 1549 | else |
|---|
| 1550 | exit |
|---|
| 1551 | end if |
|---|
| 1552 | end do |
|---|
| 1553 | if (h2subl_co2ice_tot > 0._dp) dh_co2ice = 0._dp ! No CO2 ice available anymore so the tendency is set to 0 |
|---|
| 1554 | if (h2lift_tot > 0._dp) dh_dust = 0._dp ! No dust available anymore so the tendency is set to 0 |
|---|
| 1555 | end if |
|---|
| 1556 | !~~~~~~~~~~ |
|---|
| 1557 | ! NOT EXPECTED SITUATION |
|---|
| 1558 | else |
|---|
| 1559 | unexpected = .true. |
|---|
| 1560 | end if |
|---|
| 1561 | |
|---|
| 1562 | if (unexpected) then |
|---|
| 1563 | call print_err(' dh_co2ice [m/y] = '//real2str(dh_co2ice)) |
|---|
| 1564 | call print_err(' dh_h2oice [m/y] = '//real2str(dh_h2oice)) |
|---|
| 1565 | call print_err(' dh_dust [m/y] = '//real2str(dh_dust)) |
|---|
| 1566 | call stop_clean(__FILE__,__LINE__,'situation for the layering construction not managed!',1) |
|---|
| 1567 | end if |
|---|
| 1568 | |
|---|
| 1569 | zshift_surf = this%top%top_elevation - zshift_surf |
|---|
| 1570 | |
|---|
| 1571 | END SUBROUTINE evolve_layering |
|---|
| 1572 | !======================================================================= |
|---|
| 1573 | |
|---|
| 1574 | END MODULE layered_deposits |
|---|