SICOPOLIS V5-dev  Revision 1173
init_temp_water_age_m.F90
Go to the documentation of this file.
1 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 !
3 ! Module : i n i t _ t e m p _ w a t e r _ a g e _ m
4 !
5 !> @file
6 !!
7 !! Initial temperature, water content and age.
8 !!
9 !! @section Copyright
10 !!
11 !! Copyright 2009-2017 Ralf Greve, Thorben Dunse
12 !!
13 !! @section License
14 !!
15 !! This file is part of SICOPOLIS.
16 !!
17 !! SICOPOLIS is free software: you can redistribute it and/or modify
18 !! it under the terms of the GNU General Public License as published by
19 !! the Free Software Foundation, either version 3 of the License, or
20 !! (at your option) any later version.
21 !!
22 !! SICOPOLIS is distributed in the hope that it will be useful,
23 !! but WITHOUT ANY WARRANTY; without even the implied warranty of
24 !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 !! GNU General Public License for more details.
26 !!
27 !! You should have received a copy of the GNU General Public License
28 !! along with SICOPOLIS. If not, see <http://www.gnu.org/licenses/>.
29 !<
30 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
31 
32 !-------------------------------------------------------------------------------
33 !> Initial temperature, water content and age.
34 !<------------------------------------------------------------------------------
36 
37  use sico_types_m
39  use sico_vars_m
40 
41  implicit none
42 
43  private
46  public :: init_temp_water_age_2
47 
48 contains
49 
50 !-------------------------------------------------------------------------------
51 !> Initial temperature, water content and age
52 !! (case ANF_DAT==1, TEMP_INIT==1:
53 !! present-day initial topography, isothermal conditions).
54 !<------------------------------------------------------------------------------
55  subroutine init_temp_water_age_1_1()
56 
57  implicit none
58 
59  integer(i4b) :: i, j, kc
60 
61 !-------- Initial ice temperature --------
62 
63  do i=0, imax
64  do j=0, jmax
65 
66 #if (defined(NMARS) || defined(SMARS)) /* Polar caps of Mars */
67 
68  do kc=0, kcmax
69  temp_c(kc,j,i) = -100.0_dp
70  end do
71 
72 #else /* all other domains */
73 
74  do kc=0, kcmax
75  temp_c(kc,j,i) = -10.0_dp
76  end do
77 
78 #endif
79 
80  end do
81  end do
82 
83 !-------- Initial lithosphere temperature, water content and age --------
84 
85  call init_temp_r()
86  call init_water()
87  call init_age()
88 
89  end subroutine init_temp_water_age_1_1
90 
91 !-------------------------------------------------------------------------------
92 !> Initial temperature, water content and age
93 !! (case ANF_DAT==1, TEMP_INIT==2:
94 !! present-day initial topography,
95 !! ice temperature equal to local surface temperature).
96 !<------------------------------------------------------------------------------
97  subroutine init_temp_water_age_1_2()
98 
99  implicit none
100 
101  integer(i4b) :: i, j, kc
102 
103 !-------- Initial ice temperature --------
104 
105  do i=0, imax
106  do j=0, jmax
107 
108  do kc=0, kcmax
109  temp_c(kc,j,i) = temp_s(j,i)
110  end do
111 
112  end do
113  end do
114 
115 !-------- Initial lithosphere temperature, water content and age --------
116 
117  call init_temp_r()
118  call init_water()
119  call init_age()
120 
121  end subroutine init_temp_water_age_1_2
122 
123 !-------------------------------------------------------------------------------
124 !> Initial temperature, water content and age
125 !! (case ANF_DAT==1, TEMP_INIT==3:
126 !! present-day initial topography,
127 !! ice temperature linearly increasing with depth).
128 !<------------------------------------------------------------------------------
129  subroutine init_temp_water_age_1_3()
132 
133  implicit none
134 
135  integer(i4b) :: i, j, kc
136  real(dp) :: kappa_const_val
137  real(dp) :: temp_ice_base
138 
139 !-------- Initial ice temperature --------
140 
141 #if (defined(NMARS) || defined(SMARS)) /* Polar caps of Mars */
142  kappa_const_val = kappa_val(-100.0_dp)
143 #else /* all other domains */
144  kappa_const_val = kappa_val(-10.0_dp)
145 #endif
146 
147  do i=0, imax
148  do j=0, jmax
149 
150  if (maske(j,i)<=2_i2b) then
151 
152  do kc=0, kcmax
153 
154  temp_c(kc,j,i) = temp_s(j,i) &
155  + (q_geo(j,i)/kappa_const_val) &
156  *h_c(j,i)*(1.0_dp-eaz_c_quotient(kc))
157  ! linear temperature distribution according to the
158  ! geothermal heat flux
159  end do
160 
161  if (temp_c(0,j,i) >= -beta*h_c(j,i)) then
162 
163  temp_ice_base = -beta*h_c(j,i)
164 
165  do kc=0, kcmax
166  temp_c(kc,j,i) = temp_s(j,i) &
167  + (temp_ice_base-temp_s(j,i)) &
168  *(1.0_dp-eaz_c_quotient(kc))
169  end do
170 
171  end if
172 
173  else ! maske(j,i)==3_i2b, floating ice
174 
175  temp_ice_base = -beta*h_c(j,i) - delta_tm_sw
176 
177  do kc=0, kcmax
178  temp_c(kc,j,i) = temp_s(j,i) &
179  + (temp_ice_base-temp_s(j,i)) &
180  *(1.0_dp-eaz_c_quotient(kc))
181  end do
182 
183  end if
184 
185  end do
186  end do
187 
188 !-------- Initial lithosphere temperature, water content and age --------
189 
190  call init_temp_r()
191  call init_water()
192  call init_age()
193 
194  end subroutine init_temp_water_age_1_3
195 
196 !-------------------------------------------------------------------------------
197 !> Initial temperature, water content and age
198 !! (case ANF_DAT==1, TEMP_INIT==4:
199 !! present-day initial topography, ice temperature from Robin (1955) solution).
200 !<------------------------------------------------------------------------------
201  subroutine init_temp_water_age_1_4()
204 
205  implicit none
206 
207  integer(i4b) :: i, j, kc
208  real(dp) :: kappa_const_val, c_const_val
209  real(dp) :: as_val, H_val, qgeo_val, K, z_above_base
210  real(dp) :: erf_val_1, erf_val_2
211  real(dp) :: temp_ice_base, temp_scale_factor
212 
213 !-------- Initial ice temperature --------
214 
215 #if (defined(NMARS) || defined(SMARS)) /* Polar caps of Mars */
216  kappa_const_val = kappa_val(-100.0_dp)
217  c_const_val = c_val(-100.0_dp)
218 #else /* all other domains */
219  kappa_const_val = kappa_val(-10.0_dp)
220  c_const_val = c_val(-10.0_dp)
221 #endif
222 
223  do i=0, imax
224  do j=0, jmax
225 
226  if (maske(j,i)<=2_i2b) then
227  as_val = max(as_perp(j,i), epsi)
228  else ! maske(j,i)==3_i2b, floating ice
229  as_val = epsi ! this will produce an almost linear temperature profile
230  end if
231 
232  h_val = max(h_c(j,i) , eps)
233  qgeo_val = max(q_geo(j,i), eps)
234 
235  k = sqrt( (kappa_const_val/(rho*c_const_val)) * (h_val/as_val) )
236 
237  erf_val_1 = erf(h_c(j,i)/(sqrt(2.0_dp)*k))
238 
239  do kc=0, kcmax
240  z_above_base = h_c(j,i)*eaz_c_quotient(kc)
241  erf_val_2 = erf(z_above_base/(sqrt(2.0_dp)*k))
242  temp_c(kc,j,i) = temp_s(j,i) &
243  + (qgeo_val/kappa_const_val) &
244  * sqrt(0.5_dp*pi)*k*(erf_val_1-erf_val_2)
245  end do
246 
247  if ( (maske(j,i) <= 2_i2b).and.(temp_c(0,j,i) >= -beta*h_c(j,i)) ) then
248  temp_ice_base = -beta*h_c(j,i)
249  temp_scale_factor = (temp_ice_base-temp_s(j,i)) &
250  /(temp_c(0,j,i)-temp_s(j,i))
251  else if (maske(j,i) == 3_i2b) then
252  temp_ice_base = -beta*h_c(j,i)-delta_tm_sw
253  temp_scale_factor = (temp_ice_base-temp_s(j,i)) &
254  /(temp_c(0,j,i)-temp_s(j,i))
255  else
256  temp_scale_factor = 1.0_dp
257  end if
258 
259  do kc=0, kcmax
260  temp_c(kc,j,i) = temp_s(j,i) &
261  + temp_scale_factor*(temp_c(kc,j,i)-temp_s(j,i))
262  end do
263 
264  end do
265  end do
266 
267 !-------- Initial lithosphere temperature, water content and age --------
268 
269  call init_temp_r()
270  call init_water()
271  call init_age()
272 
273  end subroutine init_temp_water_age_1_4
274 
275 !-------------------------------------------------------------------------------
276 !> Initial temperature, water content and age
277 !! (case ANF_DAT==2: ice-free conditions with relaxed bedrock).
278 !<------------------------------------------------------------------------------
279  subroutine init_temp_water_age_2()
281  implicit none
282 
283  integer(i4b) :: i, j, kc
284 
285 !-------- Initial ice temperature --------
286 
287  do i=0, imax
288  do j=0, jmax
289 
290  do kc=0, kcmax
291  temp_c(kc,j,i) = temp_s(j,i)
292  end do
293 
294  end do
295  end do
296 
297 !-------- Initial lithosphere temperature, water content and age --------
298 
299  call init_temp_r()
300  call init_water()
301  call init_age()
302 
303  end subroutine init_temp_water_age_2
304 
305 !-------------------------------------------------------------------------------
306 !> Initial lithosphere temperature.
307 !<------------------------------------------------------------------------------
308  subroutine init_temp_r()
309 
310  implicit none
311 
312  integer(i4b) :: i, j, kr
313 
314  do i=0, imax
315  do j=0, jmax
316 
317  do kr=0, krmax
318  temp_r(kr,j,i) = temp_c(0,j,i) &
319  + (q_geo(j,i)/kappa_r) &
320  *h_r*(1.0_dp-zeta_r(kr))
321  ! linear temperature distribution according to the
322  ! geothermal heat flux
323  end do
324 
325  end do
326  end do
327 
328  end subroutine init_temp_r
329 
330 !-------------------------------------------------------------------------------
331 !> Initial water content.
332 !<------------------------------------------------------------------------------
333  subroutine init_water()
334 
335  implicit none
336 
337  omega_c = 0.0_dp ! only required for the enthalpy method
338  omega_t = 0.0_dp
339 
340  end subroutine init_water
341 
342 !-------------------------------------------------------------------------------
343 !> Initial age.
344 !<------------------------------------------------------------------------------
345  subroutine init_age()
346 
347  implicit none
348 
349 #if (defined(ASF)) /* Austfonna */
350 
351  age_c = 3500.0_dp*year_sec
352  age_t = 3500.0_dp*year_sec
353 
354 #elif (defined(NMARS) || defined(SMARS)) /* Polar caps of Mars */
355 
356  age_c = 1.0e+06_dp*year_sec
357  age_t = 1.0e+06_dp*year_sec
358 
359 #else /* all other domains */
360 
361  age_c = 15000.0_dp*year_sec
362  age_t = 15000.0_dp*year_sec
363 
364 #endif
365 
366  end subroutine init_age
367 
368 !-------------------------------------------------------------------------------
369 
370 end module init_temp_water_age_m
371 !
real(dp), dimension(0:kcmax, 0:jmax, 0:imax) temp_c
temp_c(kc,j,i): Temperature in the upper (kc) ice domain
real(dp) kappa_r
KAPPA_R: Heat conductivity of the lithosphere.
real(dp) delta_tm_sw
DELTA_TM_SW: Melting point depression of sea water due to its average salinity.
real(dp), dimension(0:kcmax, 0:jmax, 0:imax) age_c
age_c(kc,j,i): Age in the upper (kc) ice domain
real(dp), parameter epsi
epsi: Very small number
real(dp), dimension(0:jmax, 0:imax) q_geo
q_geo(j,i): Geothermal heat flux
real(dp), dimension(0:ktmax, 0:jmax, 0:imax) age_t
age_t(kt,j,i): Age in the lower (kt) ice domain
real(dp), dimension(0:krmax, 0:jmax, 0:imax) temp_r
temp_r(kr,j,i): Temperature in the bedrock
real(dp) h_r
H_R: Thickness of the modelled lithosphere layer.
Material properties of ice: Rate factor, heat conductivity, specific heat (heat capacity), creep function, viscosity.
real(dp), parameter eps
eps: Small number
subroutine, public init_temp_water_age_2()
Initial temperature, water content and age (case ANF_DAT==2: ice-free conditions with relaxed bedrock...
real(dp) function, public kappa_val(temp_val)
Heat conductivity of ice: Linear interpolation of tabulated values in KAPPA(.).
integer(i2b), dimension(0:jmax, 0:imax) maske
maske(j,i): Ice-land-ocean mask. 0: grounded ice, 1: ice-free land, 2: ocean, 3: floating ice ...
real(dp), dimension(0:jmax, 0:imax) as_perp
as_perp(j,i): Accumulation-ablation function at the ice surface (SMB)
subroutine, public init_temp_water_age_1_2()
Initial temperature, water content and age (case ANF_DAT==1, TEMP_INIT==2: present-day initial topogr...
real(dp), dimension(0:jmax, 0:imax) temp_s
temp_s(j,i): Ice surface temperature
Declarations of global variables for SICOPOLIS (for the ANT domain).
Definition: sico_vars_m.F90:35
Initial temperature, water content and age.
Declarations of kind types for SICOPOLIS.
real(dp), dimension(0:jmax, 0:imax) h_c
H_c(j,i): Thickness of ice in the upper (kc) domain (thickness of the cold-ice layer for POLY...
real(dp), dimension(0:krmax) zeta_r
zeta_r(kr): Sigma coordinate zeta_r of grid point kr
real(dp), dimension(0:kcmax, 0:jmax, 0:imax) omega_c
omega_c(kc,j,i): Water content in the upper (kc) ice domain
real(dp) function, public c_val(temp_val)
Specific heat of ice: Linear interpolation of tabulated values in C(.).
real(dp), dimension(0:kcmax) eaz_c_quotient
eaz_c_quotient(kc): Abbreviation for (eaz_c(kc)-1.0)/(ea-1.0)
subroutine, public init_temp_water_age_1_3()
Initial temperature, water content and age (case ANF_DAT==1, TEMP_INIT==3: present-day initial topogr...
real(dp) beta
BETA: Clausius-Clapeyron gradient of ice.
real(dp), parameter pi
pi: Constant pi
real(dp), dimension(0:ktmax, 0:jmax, 0:imax) omega_t
omega_t(kt,j,i): Water content in the lower (kt) ice domain
real(dp) rho
RHO: Density of ice.
subroutine, public init_temp_water_age_1_4()
Initial temperature, water content and age (case ANF_DAT==1, TEMP_INIT==4: present-day initial topogr...
subroutine, public init_temp_water_age_1_1()
Initial temperature, water content and age (case ANF_DAT==1, TEMP_INIT==1: present-day initial topogr...
Declarations of global variables for SICOPOLIS.