source: trunk/LMDZ.COMMON/libf/evolution/pem.F90 @ 4147

Last change on this file since 4147 was 4147, checked in by jbclement, 3 weeks ago

PEM:

  • Simplification of subroutines to convert data between the physical and the dynamical/lon-lat grids + making them more robust.
  • Correction for air mass to give back to the PCM. The variable is extensive so poles must be treated specifically.
  • Making the PEM able to do 0 year.
  • Explicit information about the frost values computed by the PEM + enforcing positivity of yearly minima.

JBC
File size: 27.3 KB
Line 
1PROGRAM pem
2!-----------------------------------------------------------------------
3! NAME
4!     pem
5!
6! DESCRIPTION
7!     Main entry point for the Planetary Evolution Model (PEM).
8!
9! AUTHORS & DATE
10!     R. Vandemeulebrouck, 22/07/2022
11!     L. Lange, 22/07/2022
12!     JB Clement, 2023-2025
13!
14! NOTES
15!
16!-----------------------------------------------------------------------
17
18! DEPENDENCIES
19! ------------
20! Common modules
21use job_mod,        only: timelimit, antetime, timewall
22use parse_args_mod, only: parse_args
23! PEM modules
24use allocation,         only: ini_allocation, end_allocation
25use atmosphere,         only: ps_PCM, evolve_pressure, CO2cond_ps_PCM
26use backup,             only: save_clim_state, backup_rate
27use clim_state_init,    only: read_start, read_startfi, read_startpem
28use config,             only: read_rundef, read_display_config
29use display,            only: print_ini, print_end, print_msg, LVL_NFO, LVL_WRN
30use evolution,          only: n_yr_run, n_yr_sim, ntot_yr_sim, nmax_yr_run, dt, idt, r_plnt2earth_yr, pem_ini_date
31use geometry,           only: ngrid, nslope, nday, nsoil_PCM, nsoil, cell_area, total_surface
32use glaciers,           only: h2oice_flow, co2ice_flow, flow_co2glaciers, flow_h2oglaciers
33use ice_table,          only: icetable_equilibrium, icetable_dynamic, evolve_ice_table
34use layered_deposits,   only: layering, do_layering, del_layering, evolve_layering, ptrarray, layering2surfice, surfice2layering, print_layering
35use maths,              only: pi
36use numerics,           only: dp, qp, di, li, k4, minieps, minieps_qp
37use orbit,              only: evo_orbit, read_orbitpm, compute_maxyr_orbit, update_orbit
38use output,             only: write_diagevo, dim_ngrid, dim_nsoil
39use physics,            only: g
40use slopes,             only: subslope_dist, def_slope_mean
41use soil,               only: do_soil, set_soil, TI
42use soil_temp,          only: tsoil_PCM, shift_tsoil2surf, evolve_soil_temp
43use soil_therm_inertia, only: update_soil_TI
44use sorption,           only: do_sorption, compute_totmass_adsorbed, evolve_regolith_adsorption
45use stopping_crit,      only: stopFlags, stopping_crit_pressure, stopping_crit_h2o, stopping_crit_h2oice, stopping_crit_co2ice
46use surface,            only: emissivity_PCM
47use surf_ice,           only: evolve_co2ice, evolve_h2oice, balance_h2oice_reservoirs
48use surf_temp,          only: tsurf_PCM, adapt_tsurf2disappearedice
49use tendencies,         only: compute_tendice, evolve_tend_co2ice, evolve_tend_h2oice
50use tracers,            only: adapt_tracers2pressure
51use utility,            only: real2str
52use workflow_status,    only: i_pem_run, read_workflow_status, update_workflow_status
53use xios_data,          only: load_xios_data
54
55! DECLARATION
56! -----------
57implicit none
58
59! LOCAL VARIABLES
60! ---------------
61! Utility-related:
62integer(li)               :: cr     ! Number of clock ticks per second (count rate)
63integer(li)               :: c1, c2 ! Counts of processor clock
64character(:), allocatable :: num    ! To write slope variables
65integer(di)               :: i, islope
66! Pressure-related:
67real(dp), dimension(:),   allocatable :: ps_avg          ! Average surface pressure [Pa]
68real(dp), dimension(:),   allocatable :: ps_dev          ! Deviation of surface pressure [Pa]
69real(dp), dimension(:,:), allocatable :: ps_ts           ! Surface pressure timeseries [Pa]
70real(dp)                              :: ps_avg_glob_ini ! Global average pressure at initialization [Pa]
71real(dp)                              :: ps_avg_glob_old ! Global average pressure of previous time step [Pa]
72real(dp)                              :: ps_avg_glob     ! Global average pressure of current time step [Pa]
73! Ice-related:
74real(dp),    dimension(:,:),   allocatable :: h2o_ice                    ! H2O ice [kg.m-2]
75real(dp),    dimension(:,:),   allocatable :: co2_ice                    ! CO2 ice [kg.m-2]
76real(dp)                                   :: h2oice_sublim_coverage_ini ! Initial surface area of sublimating H2O ice [m2]
77real(dp)                                   :: co2ice_sublim_coverage_ini ! Initial surface area of sublimating CO2 ice [m2]
78logical(k4), dimension(:,:),   allocatable :: is_h2oice_ini              ! Initial location of H2O ice
79logical(k4), dimension(:,:),   allocatable :: is_co2ice_ini              ! Initial location of CO2 ice
80logical(k4), dimension(:,:),   allocatable :: is_co2ice_flow             ! Flag for location of CO2 glacier flow
81logical(k4), dimension(:,:),   allocatable :: is_h2oice_flow             ! Flag for location of H2O glacier flow
82real(dp),    dimension(:,:,:), allocatable :: minPCM_h2operice              ! Minimum of H2O perennial ice over the last PCM year [kg.m-2]
83real(dp),    dimension(:,:,:), allocatable :: minPCM_co2perice              ! Minimum of CO2 perennial ice over the last PCM year [kg.m-2]
84real(dp),    dimension(:,:,:), allocatable :: minPCM_h2ofrost               ! Minimum of H2O frost over the last PCM year [kg.m-2]
85real(dp),    dimension(:,:,:), allocatable :: minPCM_co2frost               ! Minimum of CO2 frost over the last PCM year [kg.m-2]
86logical(k4), dimension(:,:),   allocatable :: is_co2ice_disappeared      ! Flag to check if CO2 ice disappeared at the previous timestep
87! Surface-related:
88real(dp), dimension(:,:), allocatable :: tsurf_avg           ! Average surface temperature [K]
89real(dp), dimension(:,:), allocatable :: tsurf_avg_yr1       ! Average surface temperature of the second to last PCM run [K]
90real(dp), dimension(:,:), allocatable :: tsurf_dev           ! Deviation of surface temperature [K]
91real(dp), dimension(:,:), allocatable :: h2o_surfdensity_avg ! Average water surface density [kg/m^3]
92real(dp), dimension(:,:), allocatable :: zshift_surf         ! Elevation shift for the surface [m]
93real(dp), dimension(:,:), allocatable :: zlag                ! Newly built lag thickness [m]
94! Soil-related:
95real(dp), dimension(:,:,:),   allocatable :: tsoil_avg                ! Average soil temperature [K]
96real(dp), dimension(:,:,:),   allocatable :: tsoil_dev                ! Deviation pf soil temperature [K]
97real(dp), dimension(:,:,:,:), allocatable :: tsoil_ts                 ! Soil temperature timeseries [K]
98real(dp), dimension(:,:,:,:), allocatable :: tsoil_ts_old             ! Soil temperature timeseries at the previous time step [K]
99real(dp), dimension(:,:,:),   allocatable :: h2o_soildensity_avg      ! Average of soil water soil density [kg/m^3]
100real(dp), dimension(:),       allocatable :: delta_co2_ads            ! Quantity of CO2 exchanged due to adsorption/desorption [kg/m^2]
101real(dp), dimension(:),       allocatable :: delta_h2o_ads            ! Quantity of H2O exchanged due to adsorption/desorption [kg/m^2]
102real(qp)                                  :: totmass_adsh2o           ! Total mass of H2O exchanged because of adsorption/desorption [kg]
103real(dp), dimension(:,:,:),   allocatable :: h2o_ads_reg              ! H2O adsorbed in the regolith [kg/m^2]
104real(dp), dimension(:,:,:),   allocatable :: co2_ads_reg              ! CO2 adsorbed in the regolith [kg/m^2]
105real(dp), dimension(:,:),     allocatable :: icetable_depth           ! Depth of the ice table [m]
106real(dp), dimension(:,:),     allocatable :: icetable_thickness       ! Thickness of the ice table [m]
107real(dp), dimension(:,:,:),   allocatable :: ice_porefilling          ! Amount of porefilling [m^3/m^3]
108real(dp), dimension(:,:),     allocatable :: icetable_depth_old       ! Old depth of the ice table [m]
109real(dp), dimension(:),       allocatable :: delta_icetable ! Total mass of the H2O that has sublimated / condenses from the ice table [kg]
110! Tracer-related:
111real(dp), dimension(:,:),   allocatable :: q_co2_ts     ! CO2 mass mixing ratio in the first layer [kg/kg]
112real(dp), dimension(:,:),   allocatable :: q_co2_ts_ini ! Initial CO2 mass mixing ratio in the first layer [kg/kg]
113real(dp), dimension(:,:),   allocatable :: q_h2o_ts     ! H2O mass mixing ratio in the first layer [kg/kg]
114! Tendency-related:
115real(dp), dimension(:,:), allocatable :: d_co2ice     ! Tendency of perennial CO2 ice [kg/m2/y]
116real(dp), dimension(:,:), allocatable :: d_co2ice_ini ! Tendency of perennial CO2 ice at the beginning [kg/m2/y]
117real(dp), dimension(:,:), allocatable :: d_h2oice     ! Tendency of perennial H2O ice [kg/m2/y]
118real(dp), dimension(:,:), allocatable :: d_h2oice_new ! Adjusted tendency of perennial H2O ice to keep balance between donor and recipient [kg/m2/y]
119! Layering-related:
120type(layering), dimension(:,:), allocatable :: layerings_map    ! Layering for each grid point and slope
121type(ptrarray), dimension(:,:), allocatable :: current          ! Current active stratum in the layering
122real(dp),       dimension(:,:), allocatable :: h2oice_depth     ! Depth of subsurface ice layer
123real(dp),       dimension(:,:), allocatable :: h2oice_depth_old ! Old depth of subsurface ice layer
124logical(k4),    dimension(:,:), allocatable :: new_str, new_lag ! Flags for the layering algorithm
125! Evolution-related:
126real(dp)        :: nmax_yr_runorb ! Maximum number of years for the run due to orbital parameters
127type(stopFlags) :: stopcrit       ! Stopping criteria
128! Balance-related
129real(qp) :: totmass_co2ice, totmass_atmco2, totmass_adsco2             ! Current total CO2 masses (surface ice|atmospheric|adsorbed)
130real(qp) :: totmass_co2ice_ini, totmass_atmco2_ini, totmass_adsco2_ini ! Initial total CO2 masses (surface ice|atmospheric|adsorbed)
131real(qp) :: totmass_ini                                                ! Initial total CO2 mass [kg]
132real(qp) :: S_atm_2_h2o, S_h2o_2_atm, S_atm_2_h2oice, S_h2oice_2_atm   ! Variables to balance H2O ice reservoirs
133
134! CODE
135! ----
136! Pre-processing step
137!~~~~~~~~~~~~~~~~~~~~
138! Elapsed time with system clock
139call system_clock(count_rate = cr)
140call system_clock(c1)
141
142! Parse command-line options
143call parse_args()
144
145! Initialization
146! ~~~~~~~~~~~~~~
147! Header
148call read_display_config()
149call print_ini()
150
151! Allocate module arrays
152call ini_allocation()
153
154! Read the duration information of the workflow
155call read_workflow_status()
156
157! Read the PEM parameters
158call read_rundef()
159
160! Read the orbital parameters
161call read_orbitpm(n_yr_sim)
162
163! Read the "start.nc"
164call read_start()
165
166! Read the "startfi.nc"
167call read_startfi()
168
169! Read the PCM data given by XIOS
170allocate(ps_avg(ngrid),ps_ts(ngrid,nday))
171allocate(tsurf_avg(ngrid,nslope),tsurf_avg_yr1(ngrid,nslope),h2o_surfdensity_avg(ngrid,nslope))
172allocate(tsoil_avg(ngrid,nsoil,nslope),tsoil_ts(ngrid,nsoil,nslope,nday),h2o_soildensity_avg(ngrid,nsoil,nslope))
173allocate(q_h2o_ts(ngrid,nday),q_co2_ts(ngrid,nday))
174allocate(minPCM_h2operice(ngrid,nslope,2),minPCM_co2perice(ngrid,nslope,2),minPCM_h2ofrost(ngrid,nslope,2),minPCM_co2frost(ngrid,nslope,2))
175
176call load_xios_data(ps_avg,ps_ts,tsurf_avg,tsurf_avg_yr1,tsoil_avg,tsoil_ts,h2o_surfdensity_avg,h2o_soildensity_avg, &
177                    q_h2o_ts,q_co2_ts,minPCM_h2operice,minPCM_co2perice,minPCM_h2ofrost,minPCM_co2frost)
178
179! Initiate soil settings and TI
180if (do_soil) call set_soil(TI)
181
182! Compute the deviation from the average
183allocate(ps_dev(ngrid),tsurf_dev(ngrid,nslope),tsoil_dev(ngrid,nsoil_PCM,nslope))
184ps_dev(:) = ps_PCM(:) - ps_avg(:)
185tsurf_dev(:,:) = tsurf_PCM(:,:) - tsurf_avg(:,:)
186tsoil_dev(:,:,:) = tsoil_PCM(:,:,:) - tsoil_avg(:,1:nsoil_PCM,:)
187
188! Compute global surface pressure
189ps_avg_glob = sum(cell_area*ps_avg)/total_surface
190
191! Compute the accepted maximum number of years due to orbital parameters (if needed)
192call compute_maxyr_orbit(n_yr_sim,nmax_yr_runorb)
193
194! Read the "startevo.nc"
195allocate(h2o_ice(ngrid,nslope),co2_ice(ngrid,nslope))
196allocate(icetable_depth(ngrid,nslope),icetable_thickness(ngrid,nslope),ice_porefilling(ngrid,nsoil,nslope))
197allocate(h2o_ads_reg(ngrid,nsoil,nslope),co2_ads_reg(ngrid,nsoil,nslope),delta_h2o_ads(ngrid),delta_co2_ads(ngrid))
198allocate(layerings_map(ngrid,nslope))
199icetable_depth(:,:) = 0._dp
200icetable_thickness(:,:) = 0._dp
201ice_porefilling(:,:,:) = 0._dp
202delta_h2o_ads(:) = 0._dp
203delta_co2_ads(:) = 0._dp
204call read_startpem(tsurf_avg_yr1,tsurf_avg,ps_avg_glob_ini,ps_ts,q_co2_ts,q_h2o_ts,h2o_surfdensity_avg,h2o_ice,co2_ice, &
205                   tsoil_avg,h2o_soildensity_avg,icetable_depth,icetable_thickness,ice_porefilling,layerings_map,       &
206                   h2o_ads_reg,co2_ads_reg,delta_h2o_ads,delta_co2_ads)
207deallocate(tsurf_avg_yr1)
208
209! Compute ice tendencies from yearly minima
210allocate(d_h2oice(ngrid,nslope),d_co2ice(ngrid,nslope))
211call print_msg('> Computing surface ice tendencies',LVL_NFO)
212call compute_tendice(minPCM_h2operice,minPCM_h2ofrost,h2o_ice,d_h2oice)
213call print_msg('H2O ice tendencies [kg/m2/yr] (min|max): '//real2str(minval(d_h2oice))//' | '//real2str(maxval(d_h2oice)),LVL_NFO)
214call compute_tendice(minPCM_co2perice,minPCM_co2frost,co2_ice,d_co2ice)
215call print_msg('CO2 ice tendencies [kg/m2/yr] (min|max): '//real2str(minval(d_co2ice))//' | '//real2str(maxval(d_co2ice)),LVL_NFO)
216deallocate(minPCM_h2operice,minPCM_co2perice,minPCM_h2ofrost,minPCM_co2frost)
217
218! Save initial set-up useful for the next computations
219call print_msg('> Saving some initial climate state variables',LVL_NFO)
220allocate(d_co2ice_ini(ngrid,nslope),q_co2_ts_ini(ngrid,nday))
221allocate(is_h2oice_ini(ngrid,nslope),is_co2ice_ini(ngrid,nslope))
222ps_avg_glob_ini = ps_avg_glob
223d_co2ice_ini(:,:) = d_co2ice(:,:)
224q_co2_ts_ini(:,:) = q_co2_ts(:,:)
225h2oice_sublim_coverage_ini = 0._dp
226co2ice_sublim_coverage_ini = 0._dp
227is_h2oice_ini(:,:) = .false.
228is_co2ice_ini(:,:) = .false.
229totmass_co2ice_ini = 0._qp
230totmass_atmco2_ini = 0._qp
231totmass_adsco2_ini = 0._qp
232totmass_adsh2o = 0._qp
233do i = 1,ngrid
234    totmass_atmco2_ini = totmass_atmco2_ini + cell_area(i)*ps_avg(i)/g
235    do islope = 1,nslope
236        totmass_co2ice_ini = totmass_co2ice_ini + co2_ice(i,islope)*cell_area(i)*subslope_dist(i,islope)/cos(pi*def_slope_mean(islope)/180._dp)
237        if (co2_ice(i,islope) > 0._dp) then
238            is_co2ice_ini(i,islope) = .true.
239            if (d_co2ice(i,islope) < 0._dp) co2ice_sublim_coverage_ini = co2ice_sublim_coverage_ini + cell_area(i)*subslope_dist(i,islope)/cos(pi*def_slope_mean(islope)/180._dp)
240        end if
241        if (h2o_ice(i,islope) > 0._dp) then
242            is_h2oice_ini(i,islope) = .true.
243            if (d_h2oice(i,islope) < 0._dp) h2oice_sublim_coverage_ini = h2oice_sublim_coverage_ini + cell_area(i)*subslope_dist(i,islope)/cos(pi*def_slope_mean(islope)/180._dp)
244        end if
245    end do
246end do
247call print_msg("Initial global average pressure [Pa] = "//real2str(ps_avg_glob_ini),LVL_NFO)
248call print_msg("Initial surface area of sublimating CO2 ice [m2] = "//real2str(co2ice_sublim_coverage_ini),LVL_NFO)
249call print_msg("Initial surface area of sublimating H2O ice [m2] = "//real2str(h2oice_sublim_coverage_ini),LVL_NFO)
250if (do_sorption) call compute_totmass_adsorbed(h2o_ads_reg,co2_ads_reg,totmass_adsco2_ini,totmass_adsh2o)
251
252! Main evolution loop
253! ~~~~~~~~~~~~~~~~~~~
254call print_msg('',LVL_NFO)
255call print_msg('********* Evolution *********',LVL_NFO)
256if (do_layering) then
257    allocate(h2oice_depth(ngrid,nslope),h2oice_depth_old(ngrid,nslope),new_str(ngrid,nslope),new_lag(ngrid,nslope),current(ngrid,nslope))
258    new_str = .true.
259    new_lag = .true.
260    do islope = 1,nslope
261        do i = 1,ngrid
262            current(i,islope)%p => layerings_map(i,islope)%top
263        end do
264    end do
265    ! Conversion to surface ice
266    call layering2surfice(layerings_map,h2o_ice,co2_ice,h2oice_depth)
267    ! We put the sublimating tendency coming from subsurface ice into the overall tendency
268    !where (h2oice_depth > 0. .and. zdqsdif_ssi_tot < -minieps) d_h2oice = zdqsdif_ssi_tot
269end if
270if (nslope == 1) then ! No slope
271    allocate(character(0) :: num)
272else ! Using slopes
273    allocate(character(8) :: num)
274end if
275allocate(delta_icetable(ngrid),icetable_depth_old(ngrid,nslope),is_co2ice_disappeared(ngrid,nslope),tsoil_ts_old(ngrid,nsoil,nslope,nday))
276is_co2ice_disappeared(:,:) = .false.
277delta_icetable(:) = 0._dp
278n_yr_run = 0
279idt = 0
280do while (n_yr_run < min(nmax_yr_runorb,nmax_yr_run) .and. n_yr_sim < ntot_yr_sim)
281    call print_msg('**** Iteration of the PEM run [Planetary years]: '//real2str(n_yr_run + dt),LVL_NFO)
282    ! Evolve global surface pressure
283    call evolve_pressure(d_co2ice,delta_co2_ads,do_sorption,ps_avg_glob_old,ps_avg_glob,ps_avg)
284
285    ! Adapt tracers according to global surface pressure
286    call adapt_tracers2pressure(ps_avg_glob_old,ps_avg_glob,ps_ts,q_h2o_ts,q_co2_ts)
287
288    ! Evolve surface ice
289    allocate(zshift_surf(ngrid,nslope),zlag(ngrid,nslope))
290    if (do_layering) then
291        h2oice_depth_old(:,:) = h2oice_depth(:,:)
292        do islope = 1,nslope
293            do i = 1,ngrid
294                call evolve_layering(layerings_map(i,islope),d_co2ice(i,islope),d_h2oice_new(i,islope),new_str(i,islope),zshift_surf(i,islope),new_lag(i,islope),zlag(i,islope),current(i,islope)%p)
295                call print_layering(layerings_map(i,islope))
296            end do
297        end do
298        ! Conversion to surface ice
299        call layering2surfice(layerings_map,h2o_ice,co2_ice,h2oice_depth)
300        ! Balance H2O ice reservoirs
301        allocate(d_h2oice_new(ngrid,nslope))
302        call stopping_crit_h2o(delta_h2o_ads,delta_icetable,h2o_ice,d_h2oice,S_atm_2_h2o,S_h2o_2_atm,S_atm_2_h2oice,S_h2oice_2_atm,stopcrit)
303        call balance_h2oice_reservoirs(S_atm_2_h2o,S_h2o_2_atm,S_atm_2_h2oice,S_h2oice_2_atm,h2o_ice,d_h2oice,d_h2oice_new)
304        deallocate(d_h2oice_new)
305    else
306        zlag(:,:) = 0._dp
307        call evolve_h2oice(delta_h2o_ads,delta_icetable,h2o_ice,d_h2oice,zshift_surf,stopcrit)
308        call evolve_co2ice(co2_ice,d_co2ice,zshift_surf)
309    end if
310
311    ! Flow glaciers according to surface ice
312    if (co2ice_flow) then
313        allocate(is_co2ice_flow(ngrid,nslope))
314        call flow_co2glaciers(q_co2_ts,ps_ts,ps_avg_glob_old,ps_avg_glob,co2_ice,is_co2ice_flow)
315    end if
316    if (h2oice_flow) then
317        allocate(is_h2oice_flow(ngrid,nslope))
318        call flow_h2oglaciers(tsurf_avg,h2o_ice,is_h2oice_flow)
319    end if
320    if (do_layering) call surfice2layering(h2o_ice,co2_ice,layerings_map)
321
322    ! Adapt surface temperature if surface ice disappeared
323    call adapt_tsurf2disappearedice(co2_ice,is_co2ice_ini,is_co2ice_disappeared,tsurf_avg)
324    !call adapt_tsurf2disappearedice(h2o_ice,is_h2oice_ini,tsurf_avg)
325
326    if (do_soil) then
327        ! Shift soil temperature to surface
328        call shift_tsoil2surf(ngrid,nsoil,nslope,zshift_surf,zlag,tsurf_avg,tsoil_avg)
329
330        ! Evolve soil temperature
331        call evolve_soil_temp(tsoil_avg,tsurf_avg,tsoil_ts,tsoil_ts_old,h2o_soildensity_avg)
332
333        ! Evolve ice table
334        call evolve_ice_table(h2o_ice,h2o_surfdensity_avg,h2o_soildensity_avg,tsoil_avg,tsurf_avg,delta_icetable,q_h2o_ts, &
335                              ps_avg,icetable_depth,icetable_thickness,ice_porefilling,icetable_depth_old)
336
337        ! Update soil thermal properties according to ice table and soil temperature
338        call update_soil_TI(h2o_ice,ps_avg_glob,icetable_depth,icetable_thickness,ice_porefilling,icetable_equilibrium,icetable_dynamic,TI)
339
340        ! Evolve adsorbed species
341        if (do_sorption) then
342            call evolve_regolith_adsorption(h2o_ice,co2_ice,tsoil_avg,TI,ps_ts,q_h2o_ts,q_co2_ts,h2o_ads_reg,co2_ads_reg,delta_h2o_ads,delta_co2_ads)
343            call compute_totmass_adsorbed(h2o_ads_reg,co2_ads_reg,totmass_adsco2,totmass_adsh2o)
344        else
345            totmass_adsh2o = 0._dp
346            totmass_adsco2 = 0._dp
347        end if
348    end if ! do_soil
349    deallocate(zshift_surf,zlag)
350
351    ! Output the results
352    call print_msg('> Standard outputs',LVL_NFO)
353    call write_diagevo('ps_avg_glob','Global average pressure','Pa',ps_avg_glob)
354    do islope = 1,nslope
355        if (nslope /= 1) then
356            num = '  '
357            write(num,'(i2.2)') islope
358            num = '_slope'//num
359        end if
360        call write_diagevo('h2oice'//num,'H2O ice','kg.m-2',h2o_ice(:,islope),(/dim_ngrid/))
361        call write_diagevo('co2ice'//num,'CO2 ice','kg.m-2',co2_ice(:,islope),(/dim_ngrid/))
362        call write_diagevo('d_h2oice'//num,'H2O ice tendency','kg.m-2.yr-1',d_h2oice(:,islope),(/dim_ngrid/))
363        call write_diagevo('d_co2ice'//num,'CO2 ice tendency','kg.m-2.yr-1',d_co2ice(:,islope),(/dim_ngrid/))
364        if (co2ice_flow) then
365            call write_diagevo('Flow_co2ice'//num,'CO2 ice flow location','T/F',merge(1._dp,0._dp,is_co2ice_flow(:,islope)),(/dim_ngrid/))
366            deallocate(is_co2ice_flow)
367        end if
368        if (h2oice_flow) then
369            call write_diagevo('Flow_h2oice'//num,'H2O ice flow location','T/F',merge(1._dp,0._dp,is_h2oice_flow(:,islope)),(/dim_ngrid/))
370            deallocate(is_h2oice_flow)
371        end if
372        call write_diagevo('tsurf'//num,'Surface temperature','K',tsurf_avg(:,islope),(/dim_ngrid/))
373        if (do_soil) then
374            if (icetable_equilibrium) then
375                call write_diagevo('icetable_depth'//num,'Ice table depth','m',icetable_depth(:,islope),(/dim_ngrid/))
376                call write_diagevo('icetable_thick'//num,'Ice table thickness','m',icetable_thickness(:,islope),(/dim_ngrid/))
377            else if (icetable_dynamic) then
378                call write_diagevo('icetable_depth'//num,'Ice table depth','m',icetable_depth(:,islope),(/dim_ngrid/))
379                call write_diagevo('ice_porefilling'//num,'Ice pore filling','-',ice_porefilling(:,:,islope),(/dim_ngrid,dim_nsoil/))
380            end if
381            call write_diagevo('tsoil_avg'//num,'Soil temperature','K',tsoil_avg(:,:,islope),(/dim_ngrid,dim_nsoil/))
382            call write_diagevo('inertiesoil'//num,'Thermal inertia','SI',TI(:,:,islope),(/dim_ngrid,dim_nsoil/))
383            if (do_sorption) then
384                call write_diagevo('co2_ads_reg'//num,'CO2 adsorbed in regolith','kg.m-2',co2_ads_reg(:,:,islope),(/dim_ngrid,dim_nsoil/))
385                call write_diagevo('h2o_ads_reg'//num,'H2O adsorbed in regolith','kg.m-2',h2o_ads_reg(:,:,islope),(/dim_ngrid,dim_nsoil/))
386            end if
387        end if
388    end do
389
390    ! Checking mass balance for CO2
391    if (abs(CO2cond_ps_PCM - 1._dp) < minieps) then
392        totmass_co2ice = 0._dp
393        totmass_atmco2 = 0._dp
394        do i = 1,ngrid
395            totmass_atmco2 = totmass_atmco2 + cell_area(i)*ps_avg(i)/g
396            do islope = 1,nslope
397                totmass_co2ice = totmass_co2ice + co2_ice(i,islope)*cell_area(i)*subslope_dist(i,islope)/cos(pi*def_slope_mean(islope)/180.)
398            end do
399        end do
400        totmass_ini = max(totmass_atmco2_ini + totmass_co2ice_ini + totmass_adsco2_ini,minieps_qp) ! To avoid division by 0
401        call print_msg('> Relative total CO2 mass balance = '//real2str(100._qp*(totmass_atmco2 + totmass_co2ice + totmass_adsco2 - totmass_atmco2_ini - totmass_co2ice_ini - totmass_adsco2_ini)/totmass_ini)//' %',LVL_NFO)
402        if (abs((totmass_atmco2 + totmass_co2ice + totmass_adsco2 - totmass_atmco2_ini - totmass_co2ice_ini - totmass_adsco2_ini)/totmass_ini) > 0.01_qp) then
403            call print_msg('Mass balance is not conserved!',LVL_WRN)
404            totmass_ini = max(totmass_atmco2_ini,minieps_qp) ! To avoid division by 0
405            call print_msg('    Atmospheric CO2 mass balance = '//real2str(100._qp*(totmass_atmco2 - totmass_atmco2_ini)/totmass_ini)//' %',LVL_WRN)
406            totmass_ini = max(totmass_co2ice_ini,minieps_qp) ! To avoid division by 0
407            call print_msg('    CO2 ice mass balance         = '//real2str(100._qp*(totmass_co2ice - totmass_co2ice_ini)/totmass_ini)//' %',LVL_WRN)
408            totmass_ini = max(totmass_adsco2_ini,minieps_qp) ! To avoid division by 0
409            call print_msg('    Adsorbed CO2 mass balance    = '//real2str(100._qp*(totmass_adsco2 - totmass_adsco2_ini)/totmass_ini)//' %',LVL_WRN)
410        end if
411    end if
412
413    ! Evolve the tendencies
414    call evolve_tend_co2ice(d_co2ice_ini,co2_ice,emissivity_PCM,q_co2_ts_ini,q_co2_ts,ps_ts,ps_avg_glob_ini,ps_avg_glob,d_co2ice)
415!~     if (do_layering) then
416!~         do i = 1,ngrid
417!~             do islope = 1,nslope
418!~                 if (is_h2oice_sublim_ini(i,islope) .and. h2oice_depth(i,islope) > 0._dp) call evolve_tend_h2oice(h2oice_depth_old(i,islope),h2oice_depth(i,islope),tsurf_avg(i,islope),tsoil_ts_old(i,:,islope,:),tsoil_ts(i,:,islope,:),d_h2oice(i,islope))
419!~             end do
420!~         end do
421!    else
422!        do i = 1,ngrid
423!            do islope = 1,nslope
424!                call evolve_tend_h2oice(icetable_depth_old(i,islope),icetable_depth(i,islope),tsurf_avg(i,islope),tsoil_ts_old(i,:,islope,:),tsoil_ts(i,:,islope,:),d_h2oice(i,islope))
425!            end do
426!        end do
427!~     end if
428
429    ! Increment time
430    n_yr_run = n_yr_run + dt
431    n_yr_sim = n_yr_sim + dt
432    idt = idt + 1
433
434    ! Save periodic backups of restart files
435    if (backup_rate > 0) then
436        if (mod(idt,backup_rate) == 0) call save_clim_state(h2o_ice,co2_ice,tsurf_avg,tsurf_dev,tsoil_avg,tsoil_dev,ps_avg,ps_dev,ps_avg_glob,ps_avg_glob_ini, &
437                                                            icetable_depth,icetable_thickness,ice_porefilling,h2o_ads_reg,co2_ads_reg,layerings_map,idt)
438    end if
439
440    ! Check the stopping criteria
441    call print_msg("> Checking the stopping criteria",LVL_NFO)
442    call stopping_crit_pressure(ps_avg_glob_ini,ps_avg_glob,stopcrit)
443    call stopping_crit_h2oice(h2oice_sublim_coverage_ini,h2o_ice,d_h2oice,stopcrit)
444    call stopping_crit_co2ice(co2ice_sublim_coverage_ini,co2_ice,d_co2ice,stopcrit)
445    call system_clock(c2)
446    if (stopcrit%stop_code() == 0 .and. n_yr_run >= nmax_yr_run) stopcrit%nmax_yr_run_reached = .true.
447    if (stopcrit%stop_code() == 0 .and. n_yr_run >= nmax_yr_runorb) stopcrit%nmax_yr_runorb_reached = .true.
448    if (stopcrit%stop_code() == 0 .and. n_yr_sim >= ntot_yr_sim) stopcrit%nmax_yr_sim_reached = .true.
449    if (stopcrit%stop_code() == 0 .and. timewall .and. real(c2 - c1,dp)/real(cr,dp) >= timelimit - antetime) stopcrit%time_limit_reached = .true.
450    if (stopcrit%is_any_set()) then
451        call print_msg(stopcrit%stop_message(),LVL_NFO)
452        exit
453    else
454        call print_msg('**** This run has achieved '//real2str(n_yr_run)//' Planetary years.',LVL_NFO)
455        call print_msg('**** The workflow has achieved '//real2str(n_yr_sim)//' Planetary years.',LVL_NFO)
456        call print_msg('**** This run is continuing!',LVL_NFO)
457        call print_msg('****',LVL_NFO)
458    end if
459end do ! End of the evolution loop
460deallocate(is_co2ice_disappeared)
461
462! Finalization
463! ~~~~~~~~~~~~
464call print_msg('',LVL_NFO)
465call print_msg('********* Finalization *********',LVL_NFO)
466! Update orbital parameters
467if (evo_orbit) call update_orbit(n_yr_sim,n_yr_run)
468
469call save_clim_state(h2o_ice,co2_ice,tsurf_avg,tsurf_dev,tsoil_avg,tsoil_dev,ps_avg,ps_dev,ps_avg_glob,ps_avg_glob_ini, &
470                     icetable_depth,icetable_thickness,ice_porefilling,h2o_ads_reg,co2_ads_reg,layerings_map)
471
472! Update the duration information of the workflow
473call update_workflow_status(n_yr_run,stopcrit%stop_code(),n_yr_sim,ntot_yr_sim)
474
475! Deallocation
476deallocate(num)
477if (do_layering) then
478    deallocate(h2oice_depth,h2oice_depth_old,new_str,new_lag,current)
479    do islope = 1,nslope
480        do i = 1,ngrid
481            call del_layering(layerings_map(i,islope))
482        end do
483    end do
484end if
485deallocate(layerings_map)
486deallocate(h2o_ads_reg,co2_ads_reg)
487deallocate(h2o_ice,co2_ice,is_h2oice_ini,is_co2ice_ini)
488deallocate(ps_avg,ps_dev,ps_ts)
489deallocate(tsurf_avg,tsurf_dev,h2o_surfdensity_avg)
490deallocate(tsoil_avg,tsoil_dev,tsoil_ts,tsoil_ts_old,h2o_soildensity_avg)
491deallocate(q_h2o_ts,q_co2_ts,q_co2_ts_ini)
492deallocate(d_h2oice,d_co2ice,d_co2ice_ini)
493deallocate(delta_h2o_ads,delta_co2_ads,delta_icetable,icetable_depth_old)
494deallocate(icetable_depth,icetable_thickness,ice_porefilling)
495call end_allocation()
496
497! Footer
498call system_clock(c2)
499call print_end(i_pem_run,n_yr_run,n_yr_sim,real((c2 - c1),dp)/real(cr,dp),pem_ini_date,r_plnt2earth_yr)
500
501END PROGRAM pem
Note: See TracBrowser for help on using the repository browser.