source: trunk/LMDZ.COMMON/libf/evolution/layered_deposits.F90 @ 4074

Last change on this file since 4074 was 4068, checked in by jbclement, 2 weeks ago

PEM:
Following r4065, some safeguards forgotten in "io_netcdf.F90" + 'tsurf' is not needed anymore in the "start1D.txt" + few forgotten small updates.
JBC

File size: 48.2 KB
Line 
1MODULE 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! ------------
19use numerics, only: dp, di, k4, tol
20use geometry, only: ngrid, nslope
21use surf_ice, only: rho_co2ice, rho_h2oice
22
23! DECLARATION
24! -----------
25implicit none
26
27! VARIABLES
28! ---------
29! Numerical parameter
30logical(k4),  protected :: do_layering
31
32! Physical parameters
33logical(k4), protected :: impose_dust_ratio            ! Impose dust-to-ice ratio instead of dust tendency (see 'dust2ice_ratio')
34real(dp),    protected :: dust2ice_ratio               ! Dust-to-ice ratio when ice condenses (10% by default)
35real(dp),    protected :: d_dust                       ! Tendency of dust [kg.m-2.y-1]
36real(dp),    parameter :: dry_lag_porosity  = 0.2_dp   ! Porosity of dust lag
37real(dp),    parameter :: wet_lag_porosity  = 0.15_dp  ! Porosity of water ice lag
38real(dp),    parameter :: regolith_porosity = 0.4_dp   ! Porosity of regolith
39real(dp),    parameter :: breccia_porosity  = 0.1_dp   ! Porosity of breccia
40real(dp),    parameter :: co2ice_porosity   = 0.05_dp  ! Porosity of CO2 ice
41real(dp),    parameter :: h2oice_porosity   = 0.1_dp   ! Porosity of H2O ice
42real(dp),    parameter :: rho_dust          = 2500._dp ! Density of dust [kg.m-3]
43real(dp),    parameter :: rho_rock          = 3200._dp ! Density of rock [kg.m-3]
44real(dp),    parameter :: h_patchy_dust     = 5.e-4_dp ! Height under which a dust lag is considered patchy [m]
45real(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)
48real(dp), parameter :: hmin_lag_co2 = 0.5_dp ! Minimal height of the lag deposit to reduce the sublimation rate [m]
49real(dp), parameter :: fred_sublco2 = 0.1_dp ! Reduction factor of sublimation rate
50
51! DATA STRUCTURES
52! ---------------
53! Stratum = node of the linked list
54type :: 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)
63end type stratum
64
65! Layering = linked list
66type 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
73end type layering
74
75! Array of pointers to "stratum"
76type ptrarray
77    type(stratum), pointer :: p
78end type ptrarray
79
80contains
81!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
82
83!=======================================================================
84SUBROUTINE 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! ------------
101use utility, only: real2str, bool2str
102use display, only: print_msg
103
104! DECLARATION
105! -----------
106implicit none
107
108! ARGUMENTS
109! ---------
110logical(k4), intent(in) :: do_layering_in, impose_dust_ratio_in
111real(dp),    intent(in) :: d_dust_in, dust2ice_ratio_in
112
113! CODE
114! ----
115do_layering = do_layering_in
116impose_dust_ratio = impose_dust_ratio_in
117d_dust = d_dust_in
118dust2ice_ratio = dust2ice_ratio_in
119call print_msg('do_layering       = '//bool2str(do_layering))
120call print_msg('impose_dust_ratio = '//bool2str(impose_dust_ratio))
121call print_msg('d_dust            = '//real2str(d_dust))
122call print_msg('dust2ice_ratio    = '//real2str(dust2ice_ratio))
123
124END SUBROUTINE set_layered_deposits_config
125!=======================================================================
126
127!=======================================================================
128SUBROUTINE 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! ------------
145use utility, only: real2str
146use display, only: print_msg
147
148! DECLARATION
149! -----------
150implicit none
151
152! ARGUMENTS
153! ---------
154type(stratum), intent(in) :: this
155
156! CODE
157! ----
158call print_msg('Top elevation       [m]: '//real2str(this%top_elevation))
159call print_msg('Height of CO2 ice   [m]: '//real2str(this%h_co2ice))
160call print_msg('Height of H2O ice   [m]: '//real2str(this%h_h2oice))
161call print_msg('Height of dust      [m]: '//real2str(this%h_dust))
162call print_msg('Height of pores     [m]: '//real2str(this%h_pore))
163call print_msg('Pore-filled ice [m3/m3]: '//real2str(this%poreice_volfrac))
164
165END SUBROUTINE print_stratum
166!=======================================================================
167
168!=======================================================================
169SUBROUTINE 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! -----------
186implicit none
187
188! ARGUMENTS
189! ---------
190type(layering), intent(inout)        :: this
191real(dp),       intent(in), optional :: top_elevation, co2ice, h2oice, dust, pore, poreice
192
193! LOCAL VARIABLES
194! ---------------
195type(stratum), pointer :: str
196
197! CODE
198! ----
199! Creation of the stratum
200allocate(str)
201nullify(str%up,str%down)
202str%top_elevation   = 1._dp
203str%h_co2ice        = 0._dp
204str%h_h2oice        = 0._dp
205str%h_dust          = 1._dp
206str%h_pore          = 0._dp
207str%poreice_volfrac = 0._dp
208if (present(top_elevation)) str%top_elevation   = top_elevation
209if (present(co2ice))        str%h_co2ice        = co2ice
210if (present(h2oice))        str%h_h2oice        = h2oice
211if (present(dust))          str%h_dust          = dust
212if (present(pore))          str%h_pore          = pore
213if (present(poreice))       str%poreice_volfrac = poreice
214
215! Increment the number of strata
216this%nb_str = this%nb_str + 1
217
218! Add the stratum to the layering
219if (.not. associated(this%bottom)) then ! If it is the very first one
220    this%bottom => str
221    this%top => str
222else
223    str%down => this%top
224    this%top%up => str
225    this%top => str
226end if
227
228END SUBROUTINE add_stratum
229!=======================================================================
230
231!=======================================================================
232SUBROUTINE 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! -----------
249implicit none
250
251! ARGUMENTS
252! ---------
253type(layering),         intent(inout)        ::  this
254type(stratum), pointer, intent(inout)        ::  str_prev
255real(dp),               intent(in), optional :: top_elevation, co2ice, h2oice, dust, pore, poreice
256
257! LOCAL VARIABLES
258! ---------------
259type(stratum), pointer :: str, current
260
261! CODE
262! ----
263if (.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)
265else
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
297end if
298
299END SUBROUTINE insert_stratum
300!=======================================================================
301
302!=======================================================================
303SUBROUTINE 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! -----------
320implicit none
321
322! ARGUMENTS
323! ---------
324type(layering),         intent(inout) :: this
325type(stratum), pointer, intent(inout) :: str
326
327! LOCAL VARIABLES
328! ---------------
329type(stratum), pointer :: new_str
330
331! CODE
332! ----
333! Protect the sub-surface strata from deletion
334if (str%top_elevation <= 0.) return
335
336! Decrement the number of strata
337this%nb_str = this%nb_str - 1
338
339! Making the new links
340if (associated(str%down)) then ! If there is a lower stratum
341    str%down%up => str%up
342else ! If it was the first stratum (bottom of layering)
343    this%bottom => str%up
344end if
345if (associated(str%up)) then ! If there is an upper stratum
346    str%up%down => str%down
347else ! If it was the last stratum (top of layering)
348    this%top => str%down
349end if
350
351! Remove the stratum from the layering
352new_str => str%down
353nullify(str%up,str%down)
354deallocate(str)
355nullify(str)
356str => new_str
357
358END SUBROUTINE del_stratum
359!=======================================================================
360
361!=======================================================================
362FUNCTION 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! ------------
379use stoppage, only: stop_clean
380
381! DECLARATION
382! -----------
383implicit none
384
385! ARGUMENTS
386! ---------
387type(layering), intent(in) :: lay
388integer(di),    intent(in) :: i
389type(stratum), pointer     :: str
390
391! LOCAL VARIABLES
392! ---------------
393integer(di) :: k
394
395! CODE
396! ----
397if (i < 1 .or. i > lay%nb_str) call stop_clean(__FILE__,__LINE__,'requested number is beyond the number of strata of the layering!',1)
398k = 1
399str => lay%bottom
400do while (k /= i)
401    str => str%up
402    k = k + 1
403end do
404
405END FUNCTION get_stratum
406!=======================================================================
407
408!=======================================================================
409SUBROUTINE 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! ------------
426use soil,     only: do_soil, layer, index_breccia, index_bedrock
427use geometry, only: nsoil
428
429! DECLARATION
430! -----------
431implicit none
432
433! ARGUMENTS
434! ---------
435type(layering), intent(inout) :: this
436
437! LOCAL VARIABLES
438! ---------------
439integer(di) :: i
440real(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
445if (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)
465end if
466
467END SUBROUTINE ini_layering
468!=======================================================================
469
470!=======================================================================
471SUBROUTINE 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! -----------
488implicit none
489
490! ARGUMENTS
491! ---------
492type(layering), intent(inout) :: this
493
494! LOCAL VARIABLES
495! ---------------
496type(stratum), pointer :: current, next
497
498! CODE
499! ----
500current => this%bottom
501do while (associated(current))
502    next => current%up
503    deallocate(current)
504    nullify(current)
505    current => next
506end do
507this%nb_str = 0
508
509END SUBROUTINE del_layering
510!=======================================================================
511
512!=======================================================================
513SUBROUTINE 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! ------------
530use utility, only: int2str
531use display, only: print_msg
532
533! DECLARATION
534! -----------
535implicit none
536
537! ARGUMENTS
538! ---------
539type(layering), intent(in) :: this
540
541! LOCAL VARIABLES
542! ---------------
543type(stratum), pointer :: current
544integer(di)            :: i
545
546! CODE
547! ----
548current => this%top
549
550i = this%nb_str
551do 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
557end do
558
559END SUBROUTINE print_layering
560!=======================================================================
561
562!=======================================================================
563FUNCTION 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! ------------
580use geometry, only: ngrid, nslope
581
582! DECLARATION
583! -----------
584implicit none
585
586! ARGUMENTS
587! ---------
588type(layering), dimension(:,:), intent(in) :: layerings_map
589integer(di)                                :: nb_str_max
590
591! LOCAL VARIABLES
592! ---------------
593integer(di) :: ig, islope
594
595! CODE
596! ----
597nb_str_max = 0
598do 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
602end do
603
604END FUNCTION get_nb_str_max
605!=======================================================================
606
607!=======================================================================
608SUBROUTINE 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! ------------
625use geometry, only: ngrid, nslope
626
627! DECLARATION
628! -----------
629implicit none
630
631! ARGUMENTS
632! ---------
633type(layering), dimension(:,:),     intent(in)  :: layerings_map
634real(dp),       dimension(:,:,:,:), intent(out) :: layerings_array
635
636! LOCAL VARIABLES
637! ---------------
638type(stratum), pointer :: current
639integer(di)            :: ig, islope, k
640
641! CODE
642! ----
643layerings_array = 0.
644do 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
659end do
660
661END SUBROUTINE map2array
662!=======================================================================
663
664!=======================================================================
665SUBROUTINE 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! ------------
682use geometry, only: ngrid, nslope
683
684! DECLARATION
685! -----------
686implicit none
687
688! ARGUMENTS
689! ---------
690real(dp),       dimension(:,:,:,:), intent(in)    :: layerings_array
691type(layering), dimension(:,:),     intent(inout) :: layerings_map
692
693! LOCAL VARIABLES
694! ---------------
695integer(di) :: ig, islope, k
696
697! CODE
698! ----
699do 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
705end do
706
707END SUBROUTINE array2map
708!=======================================================================
709
710!=======================================================================
711SUBROUTINE 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! ------------
728use geometry, only: ngrid, nslope
729
730! DECLARATION
731! -----------
732implicit none
733
734! ARGUMENTS
735! ---------
736type(layering), dimension(:,:), intent(in)  :: layerings_map
737real(dp),       dimension(:,:), intent(out) :: h2o_ice, co2_ice, h2oice_depth
738
739! LOCAL VARIABLES
740! ---------------
741integer(di) :: ig, islope
742
743! CODE
744! ----
745do 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
755end do
756
757END SUBROUTINE layering2surfice
758!=======================================================================
759
760!=======================================================================
761SUBROUTINE 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! ------------
778use geometry, only: ngrid, nslope
779
780! DECLARATION
781! -----------
782implicit none
783
784! ARGUMENTS
785! ---------
786real(dp),       dimension(:,:), intent(in)    :: h2o_ice, co2_ice
787type(layering), dimension(:,:), intent(inout) :: layerings_map
788
789! LOCAL VARIABLES
790! ---------------
791integer(di) :: i, islope
792
793! CODE
794! ----
795do 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
800end do
801
802END SUBROUTINE surfice2layering
803!=======================================================================
804
805!=======================================================================
806SUBROUTINE 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! ------------
823use utility, only: int2str
824use display, only: print_msg
825
826! DEPENDENCIES
827! ------------
828use geometry, only: ngrid, nslope
829
830! DECLARATION
831! -----------
832implicit none
833
834! ARGUMENTS
835! ---------
836type(layering), dimension(:,:), intent(in) :: this
837
838! LOCAL VARIABLES
839! ---------------
840integer(di) :: ig, islope
841
842! CODE
843! ----
844do 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('--------------------')
852end do
853
854END SUBROUTINE print_layerings_map
855!=======================================================================
856
857!=======================================================================
858FUNCTION 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! -----------
875implicit none
876
877! ARGUMENTS
878! ---------
879type(stratum), intent(in) :: this
880
881! LOCAL VARIABLES
882! ---------------
883real(dp) :: h_str
884
885! CODE
886! ----
887h_str = this%h_co2ice + this%h_h2oice + this%h_dust + this%h_pore
888
889END FUNCTION thickness
890!=======================================================================
891
892!=======================================================================
893FUNCTION 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! -----------
910implicit none
911
912! ARGUMENTS
913! ---------
914type(stratum), intent(in) :: str
915
916! LOCAL VARIABLES
917! ---------------
918logical(k4) :: co2ice_str
919
920! CODE
921! ----
922co2ice_str = .false.
923if (str%h_co2ice > str%h_h2oice .and. str%h_co2ice > str%h_dust) co2ice_str = .true.
924
925END FUNCTION is_co2ice_str
926!=======================================================================
927
928!=======================================================================
929FUNCTION 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! -----------
946implicit none
947
948! ARGUMENTS
949! ---------
950type(stratum), intent(in) :: str
951
952! LOCAL VARIABLES
953! ---------------
954logical(k4) :: h2oice_str
955
956! CODE
957! ----
958h2oice_str = .false.
959if (str%h_h2oice > str%h_co2ice .and. str%h_h2oice > str%h_dust) h2oice_str = .true.
960
961END FUNCTION is_h2oice_str
962!=======================================================================
963
964!=======================================================================
965FUNCTION 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! -----------
982implicit none
983
984! ARGUMENTS
985! ---------
986type(stratum), intent(in) :: str
987
988! LOCAL VARIABLES
989! ---------------
990logical(k4) :: dust_str
991
992! CODE
993! ----
994dust_str = .false.
995if (str%h_dust > str%h_co2ice .and. str%h_dust > str%h_h2oice) dust_str = .true.
996
997END FUNCTION is_dust_str
998!=======================================================================
999
1000!=======================================================================
1001FUNCTION 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! -----------
1018implicit none
1019
1020! ARGUMENTS
1021! ---------
1022type(stratum), intent(in) :: str
1023
1024! LOCAL VARIABLES
1025! ---------------
1026logical(k4) :: dust_lag
1027
1028! CODE
1029! ----
1030dust_lag = .false.
1031if (str%h_co2ice < tol .and. str%h_h2oice < tol .and. str%poreice_volfrac < tol) dust_lag = .true.
1032
1033END FUNCTION is_dust_lag
1034!=======================================================================
1035
1036!=======================================================================
1037SUBROUTINE 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! -----------
1054implicit none
1055
1056! ARGUMENTS
1057! ---------
1058type(layering), intent(in)  :: this
1059real(dp),       intent(out) :: h2o_ice, co2_ice, h_toplag
1060
1061! LOCAL VARIABLES
1062! ---------------
1063type(stratum), pointer :: current
1064
1065! CODE
1066! ----
1067h_toplag = 0._dp
1068h2o_ice = 0._dp
1069co2_ice = 0._dp
1070current => this%top
1071! Is the considered stratum a dust lag?
1072if (.not. is_dust_lag(current)) return
1073do 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
1080end do
1081
1082if (.not. associated(current%down)) then ! Bottom of the layering -> no ice below
1083    h_toplag = 0._dp
1084    return
1085end if
1086
1087! Is the stratum below the dust lag made of ice?
1088if (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
1093else 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
1096end if
1097
1098END SUBROUTINE subsurface_ice_layering
1099!=======================================================================
1100
1101!=======================================================================
1102SUBROUTINE 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! -----------
1119implicit none
1120
1121! ARGUMENTS
1122! ---------
1123type(layering),         intent(inout) :: this
1124type(stratum), pointer, intent(inout) :: str
1125real(dp),               intent(in)    :: h2lift
1126
1127! CODE
1128! ----
1129! Update of properties in the eroding dust lag
1130str%top_elevation = str%top_elevation - h2lift*(1._dp + str%h_pore/str%h_dust)
1131str%h_pore        = str%h_pore        - h2lift*str%h_pore/str%h_dust
1132str%h_dust        = str%h_dust        - h2lift
1133
1134! Remove the eroding dust lag if there is no dust anymore
1135if (str%h_dust < tol) call del_stratum(this,str)
1136
1137END SUBROUTINE lift_dust
1138!=======================================================================
1139
1140!=======================================================================
1141SUBROUTINE 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! -----------
1158implicit none
1159
1160! ARGUMENTS
1161! ---------
1162type(layering),         intent(inout) :: this
1163type(stratum), pointer, intent(inout) :: str
1164logical(k4),            intent(inout) :: new_lag
1165real(dp),               intent(inout) :: zlag
1166real(dp),               intent(in)    :: h2subl_co2ice, h2subl_h2oice
1167
1168! LOCAL VARIABLES
1169! ---------------
1170real(dp)               :: h2subl, h_ice, h_pore, h_pore_new, h_tot
1171real(dp)               :: hlag_dust, hlag_h2oice
1172type(stratum), pointer :: current
1173
1174! CODE
1175! ----
1176h_ice = str%h_co2ice + str%h_h2oice
1177h_pore = str%h_pore
1178h2subl = h2subl_co2ice + h2subl_h2oice
1179
1180! How much dust and H2O ice does ice sublimation involve to create the lag?
1181hlag_dust = str%h_dust*h2subl/h_ice
1182hlag_h2oice = 0._dp
1183if (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
1186str%top_elevation = str%top_elevation - h2subl*(1._dp + h_pore/h_ice) - hlag_dust - hlag_h2oice
1187str%h_co2ice      = str%h_co2ice      - h2subl_co2ice
1188str%h_h2oice      = str%h_h2oice      - h2subl_h2oice - hlag_h2oice
1189str%h_dust        = str%h_dust        - hlag_dust
1190str%h_pore        = str%h_pore        - h2subl*h_pore/h_ice
1191
1192! Correct the value of top_elevation for the upper strata
1193current => str%up
1194do while (associated(current))
1195    current%top_elevation = current%down%top_elevation + thickness(current)
1196    current => current%up
1197end do
1198
1199! Remove the sublimating stratum if there is no ice anymore
1200if (str%h_co2ice < tol .and. str%h_h2oice < tol) call del_stratum(this,str)
1201
1202! Which porosity is considered?
1203if (hlag_dust >= hlag_h2oice) then
1204    h_pore_new = hlag_dust*dry_lag_porosity/(1._dp - dry_lag_porosity)
1205else
1206    h_pore_new = hlag_h2oice*wet_lag_porosity/(1._dp - wet_lag_porosity)
1207end if
1208h_tot = hlag_dust + hlag_h2oice + h_pore_new
1209
1210! New stratum above the current stratum as a lag layer
1211if (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.
1214else
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
1219end if
1220
1221zlag = zlag + h_tot
1222
1223END SUBROUTINE sublimate_ice
1224!=======================================================================
1225
1226!=======================================================================
1227SUBROUTINE 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! ------------
1247use stoppage, only: stop_clean
1248use utility,  only: real2str
1249use display,  only: print_err
1250
1251! DECLARATION
1252! -----------
1253implicit none
1254
1255! ARGUMENTS
1256! ---------
1257type(layering),         intent(inout) ::  this
1258type(stratum), pointer, intent(inout) ::  current
1259real(dp),               intent(inout) ::  d_co2ice, d_h2oice
1260logical(k4),            intent(inout) ::  new_str, new_lag
1261real(dp),               intent(out)   ::  zshift_surf, zlag
1262
1263! LOCAL VARIABLES
1264! ---------------
1265real(dp)               :: dh_co2ice, dh_h2oice, dh_dust, dh_dust_co2, dh_dust_h2o
1266real(dp)               :: h_co2ice_old, h_h2oice_old
1267real(dp)               :: h2subl_co2ice, h2subl_h2oice, h2subl_co2ice_tot, h2subl_h2oice_tot
1268real(dp)               :: h2lift, h2lift_tot, h_pore, h_tot, h_toplag, R_subl
1269logical(k4)            :: unexpected
1270type(stratum), pointer :: currentloc
1271
1272! CODE
1273! ----
1274dh_co2ice = d_co2ice/rho_co2ice
1275dh_h2oice = d_h2oice/rho_h2oice
1276dh_dust = 0._dp
1277if (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
1287end if
1288zshift_surf = this%top%top_elevation
1289zlag = 0._dp
1290unexpected = .false.
1291
1292!~~~~~~~~~~
1293! NOTHING HAPPENS
1294if (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)
1298else 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)
1323else 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
1395else 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
1558else
1559    unexpected = .true.
1560end if
1561
1562if (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)
1567end if
1568
1569zshift_surf = this%top%top_elevation - zshift_surf
1570
1571END SUBROUTINE evolve_layering
1572!=======================================================================
1573
1574END MODULE layered_deposits
Note: See TracBrowser for help on using the repository browser.