source: trunk/LMDZ.COMMON/libf/evolution/tendencies.F90 @ 4140

Last change on this file since 4140 was 4140, checked in by jbclement, 9 days ago

PEM:
Fix to avoid building large temporary arrays in the arguments evaluation of "compute_tendice" which caused memory to stall.
JBC

File size: 7.1 KB
Line 
1MODULE tendencies
2!-----------------------------------------------------------------------
3! NAME
4!     tendencies
5!
6! DESCRIPTION
7!     Computation and update of PEM ice evolution tendencies.
8!
9! AUTHORS & DATE
10!     R. Vandemeulebrouck
11!     L. Lange
12!     JB Clement, 2023-2025
13!
14! NOTES
15!
16!-----------------------------------------------------------------------
17
18! DEPENDENCIES
19! ------------
20use numerics, only: dp, di, k4, minieps, tol
21
22! DECLARATION
23! -----------
24implicit none
25
26contains
27!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
28
29!=======================================================================
30SUBROUTINE compute_tendice(min_perice,min_frost,perice,d_ice)
31!-----------------------------------------------------------------------
32! NAME
33!     compute_tendice
34!
35! DESCRIPTION
36!     Compute initial ice evolution tendencies from PCM data.
37!
38! AUTHORS & DATE
39!     R. Vandemeulebrouck
40!     L. Lange
41!     JB Clement, 2023-2025
42!
43! NOTES
44!     Based on minima of ice at each point for the PCM years.
45!-----------------------------------------------------------------------
46
47! DECLARATION
48! -----------
49implicit none
50
51! ARGUMENTS
52! ---------
53real(dp), dimension(:,:,:), intent(in)  :: min_perice
54real(dp), dimension(:,:,:), intent(in)  :: min_frost
55real(dp), dimension(:,:),   intent(in)  :: perice
56real(dp), dimension(:,:),   intent(out) :: d_ice
57
58! CODE
59! ----
60! We compute the difference to get the tendency
61d_ice(:,:) = min_perice(:,:,2) + min_frost(:,:,2) - (min_perice(:,:,1) + min_frost(:,:,1))
62
63! If the difference is too small, then there is no evolution
64where (abs(d_ice) < minieps) d_ice = 0._dp
65
66! If the tendency is negative but there is no ice reservoir for the PEM
67where (d_ice < 0._dp .and. abs(perice) < minieps) d_ice = 0._dp
68
69END SUBROUTINE compute_tendice
70!=======================================================================
71
72!=======================================================================
73SUBROUTINE evolve_tend_co2ice(d_co2ice_ini,co2ice,emissivity,q_co2_ts_ini,q_co2_ts,ps_PCM,ps_avg_glob_ini,ps_avg_global,d_co2ice)
74!-----------------------------------------------------------------------
75! NAME
76!     evolve_tend_co2ice
77!
78! DESCRIPTION
79!     Recompute CO2 ice tendency based on pressure and atmospheric changes.
80!
81! AUTHORS & DATE
82!     L. Lange
83!     JB Clement, 2023-2025
84!
85! NOTES
86!     Adjusts CO2 ice evolution based on Clausius-Clapeyron changes.
87!-----------------------------------------------------------------------
88
89! DEPENDENCIES
90! ------------
91use geometry,   only: ngrid, nslope, nday
92use physics,    only: sigmaB, alpha_clap_co2, beta_clap_co2, Lco2, m_co2, A, B
93use orbit,      only: yr_len_sol, sol_len_s
94use display,    only: print_msg, LVL_NFO
95use utility,    only: real2str
96
97! DECLARATION
98! -----------
99implicit none
100
101! ARGUMENTS
102! ---------
103real(dp), dimension(:,:), intent(in)    :: q_co2_ts, q_co2_ts_ini, ps_PCM, d_co2ice_ini, co2ice, emissivity
104real(dp),                 intent(in)    :: ps_avg_global, ps_avg_glob_ini
105real(dp), dimension(:,:), intent(inout) :: d_co2ice
106
107! LOCAL VARIABLES
108! ---------------
109integer(di)                     :: i, iday, islope
110real(dp)                        :: coef, avg
111real(dp), dimension(ngrid,nday) :: vmr_co2_ts, vmr_co2_ts_ini
112
113! CODE
114! ----
115call print_msg("> Evolving the CO2 ice tendency according to the new pressure",LVL_NFO)
116call print_msg('Old CO2 ice tendencies [kg/m2/yr] (min|max): '//real2str(minval(d_co2ice))//' | '//real2str(maxval(d_co2ice)),LVL_NFO)
117
118! Compute volume mixing ratio
119vmr_co2_ts(:,:) = q_co2_ts(:,:)/(A*q_co2_ts(:,:) + B)/m_co2
120vmr_co2_ts_ini(:,:) = q_co2_ts_ini(:,:)/(A*q_co2_ts_ini(:,:) + B)/m_co2
121
122! Recompute the tendency
123do i = 1,ngrid
124    do islope = 1,nslope
125        coef = yr_len_sol*sol_len_s*emissivity(i,islope)*sigmaB/Lco2
126        avg = 0._dp
127        if (co2ice(i,islope) > 1.e-4_dp .and. abs(d_co2ice(i,islope)) > 1.e-5_dp) then
128            do iday = 1,nday
129                avg = avg + (beta_clap_co2/(alpha_clap_co2 - log(q_co2_ts_ini(i,iday)*ps_PCM(i,iday)/100._dp)))**4 &
130                      - (beta_clap_co2/(alpha_clap_co2 - log(vmr_co2_ts(i,iday)*ps_PCM(i,iday)*(ps_avg_global/ps_avg_glob_ini)/100._dp)))**4
131            end do
132            if (avg < 1.e-4_dp) avg = 0._dp
133            d_co2ice(i,islope) = d_co2ice_ini(i,islope) - coef*avg/nday
134        end if
135    end do
136end do
137call print_msg('New CO2 ice tendencies [kg/m2/yr] (min|max): '//real2str( minval(d_co2ice))//' | '//real2str(maxval(d_co2ice)),LVL_NFO)
138
139END SUBROUTINE evolve_tend_co2ice
140!=======================================================================
141
142!=======================================================================
143SUBROUTINE evolve_tend_h2oice(h2oice_depth_old,h2oice_depth_new,tsurf,tsoil_ts_old,tsoil_ts_new,d_h2oice)
144!-----------------------------------------------------------------------
145! NAME
146!     evolve_tend_h2oice
147!
148! DESCRIPTION
149!     Recompute H2O ice tendency based on soil depth and temperature changes.
150!
151! AUTHORS & DATE
152!     JB Clement, 2025 (following E. Vos's work)
153!
154! NOTES
155!
156!-----------------------------------------------------------------------
157
158! DEPENDENCIES
159! ------------
160use soil_temp,      only: itp_tsoil
161use subsurface_ice, only: psv
162use display,        only: print_msg, LVL_NFO
163
164! DECLARATION
165! -----------
166implicit none
167
168! ARGUMENTS
169! ---------
170real(dp),                 intent(in)    :: h2oice_depth_old ! Old H2O ice depth
171real(dp),                 intent(in)    :: h2oice_depth_new ! New H2O ice depth
172real(dp),                 intent(in)    :: tsurf            ! Surface temperature
173real(dp), dimension(:,:), intent(in)    :: tsoil_ts_old     ! Old soil temperature time series
174real(dp), dimension(:,:), intent(in)    :: tsoil_ts_new     ! New soil temperature time series
175real(dp),                 intent(inout) :: d_h2oice         ! Evolution of perennial ice
176
177! LOCAL VARIABLES
178! ---------------
179real(dp)            :: Rz_old, Rz_new, R_dec, hum_dec, psv_max_old, psv_max_new
180integer(di)         :: iday
181real(dp), parameter :: coef_diff = 4.e-4_dp ! Diffusion coefficient
182real(dp), parameter :: zcdv = 0.0325_dp     ! Drag coefficient
183
184! CODE
185! ----
186call print_msg("> Updating the H2O sub-surface ice tendency due to lag layer",LVL_NFO)
187
188! Higher resistance due to growing lag layer (higher depth)
189Rz_old = h2oice_depth_old*zcdv/coef_diff ! Old resistance from PCM
190Rz_new = h2oice_depth_new*zcdv/coef_diff ! New resistance based on new depth
191R_dec = Rz_old/Rz_new ! Decrease because of resistance
192
193! The maxmimum of the daily averages over one year for the saturation vapor pressure at the ice table location
194psv_max_old = 0._dp
195psv_max_new = 0._dp
196do iday = 1,size(tsoil_ts_old,2)
197    psv_max_old = max(psv_max_old,psv(itp_tsoil(tsoil_ts_old(:,iday),tsurf,h2oice_depth_old)))
198    psv_max_new = max(psv_max_new,psv(itp_tsoil(tsoil_ts_new(:,iday),tsurf,h2oice_depth_new)))
199end do
200
201! Lower humidity due to growing lag layer (higher depth)
202if (abs(psv_max_old) < tol) then
203    hum_dec = 1._dp
204else
205    hum_dec = psv_max_new/psv_max_old ! Decrease because of lower water vapor pressure at the new depth
206end if
207
208! Flux correction (decrease)
209d_h2oice = d_h2oice*R_dec*hum_dec
210
211END SUBROUTINE evolve_tend_h2oice
212!=======================================================================
213
214END MODULE tendencies
Note: See TracBrowser for help on using the repository browser.