SICOPOLIS V5-dev  Revision 1288
calc_thk_water_bas_m.F90
Go to the documentation of this file.
1 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 !
3 ! Module : c a l c _ t h k _ w a t e r _ b a s _ m
4 !
5 !> @file
6 !!
7 !! Computation of the thickness of the water column under the ice base.
8 !!
9 !! @section Copyright
10 !!
11 !! Copyright 2009-2018 Ralf Greve
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 !> Computation of the thickness of the water column under the ice base.
34 !<------------------------------------------------------------------------------
36 
37  use sico_types_m
39  use sico_vars_m
40 
41 #if (BASAL_HYDROLOGY==1)
42  use hydro_m
43 #endif
44 
45  implicit none
46 
47  private
48  public :: calc_thk_water_bas
49 
50 contains
51 
52 !-------------------------------------------------------------------------------
53 !> Main subroutine of calc_thk_water_bas_m:
54 !! Computation of the thickness of the water column under the ice base.
55 !<------------------------------------------------------------------------------
56  subroutine calc_thk_water_bas(z_sl)
57 
58  implicit none
59 
60  real(dp), intent(in) :: z_sl
61 #ifdef ALLOW_OPENAD
62  integer(i4b) :: i, j
63 #endif
64 
65  logical, save :: firstcall = .true.
66 
67 #if (BASAL_HYDROLOGY==1)
68  real(dp), save :: rho_rho_w_ratio
69  integer , dimension(0:IMAX,0:JMAX) :: hydro_icemask
70  real(dp), dimension(0:IMAX,0:JMAX) :: hydro_topg, hydro_thk, &
71  hydro_temppabase, hydro_supply, &
72  hydro_sflux, hydro_bwat
73 #ifdef ALLOW_OPENAD
74  real(dp), dimension(0:IMAX,0:JMAX) :: t_maske, t_H_c, t_H_t, t_Q_b_tot
75 #endif
76  type(hydro_t), save :: hydro
77  !!! Does this need a save attribute?
78 #endif
79 
80 !-------- Water column --------
81 
82 #ifndef ALLOW_OPENAD
83 #if (BASAL_HYDROLOGY==1)
84 
85  if (firstcall) then
86 
87  rho_rho_w_ratio = rho/rho_w
88 
89  call hydro_init(hydro, xi, eta)
90  call hydro_gen_conf(hydro, &
91  & method='quinn', &
92  & avoid_frz=.false., &
93  & filter_len=0.0_dp, &
94  & rho_seawater=rho_sw, &
95  & rho_freshwater=rho_w, &
96  & rho_ice=rho)
97 
98  end if
99 
100  hydro_topg = transpose(zl)-z_sl
101  hydro_temppabase = transpose(temph_b)
102 
103  where (transpose(maske)==0_i2b) ! grounded ice
104  hydro_icemask = 1
105  hydro_thk = transpose(h_c+h_t)
106  hydro_supply = rho_rho_w_ratio*transpose(q_b_tot)
107  elsewhere
108  hydro_icemask = 0
109  hydro_thk = 0.0_dp
110  hydro_supply = 0.0_dp
111  end where
112 
113  call hydro_set_topg(hydro, hydro_topg)
114  call hydro_set_thk(hydro, hydro_thk)
115  call hydro_set_temppabase(hydro, hydro_temppabase)
116  call hydro_set_supply(hydro, hydro_supply)
117  call hydro_set_mask(hydro, hydro_icemask)
118 
119  call hydro_update(hydro)
120 
121  call hydro_get_sflux(hydro, hydro_sflux)
122  call hydro_get_bwat(hydro, hydro_bwat)
123 
124  h_w = transpose(hydro_bwat)
125 
126 #else
127  where (maske==0_i2b) h_w = 0.0_dp ! grounded ice
128 #endif
129 
130  where (maske==2_i2b) ! ocean
131  h_w = z_sl-zl
132  elsewhere (maske==3_i2b) ! floating ice
133  h_w = zb-zl
134  elsewhere (maske==1_i2b) ! ice-free land
135  h_w = 0.0_dp
136  end where
137 
138  if (firstcall) firstcall = .false.
139 
140 #else
141 #if (BASAL_HYDROLOGY==1)
142 
143  if (firstcall) then
144 
145  rho_rho_w_ratio = rho/rho_w
146 
147  call hydro_init(hydro, xi, eta)
148  call hydro_gen_conf(hydro, &
149  & method='quinn', &
150  & avoid_frz=.false., &
151  & filter_len=0.0_dp, &
152  & rho_seawater=rho_sw, &
153  & rho_freshwater=rho_w, &
154  & rho_ice=rho)
155 
156  end if
157 
158  ! hard-coding transpose
159  do j=0,jmax
160  do i=0,imax
161  hydro_topg(i,j) = zl(j,i) - z_sl
162  hydro_temppabase(i,j) = temph_b(j,i)
163  ! transpose these arrays for easy searching below
164  t_maske(i,j) = maske(j,i)
165  t_h_c(i,j) = h_c(j,i)
166  t_h_t(i,j) = h_t(j,i)
167  t_q_b_tot(i,j) = q_b_tot(j,i)
168  end do
169  end do
170 
171  do j=0,jmax
172  do i=0,imax
173  if (t_maske(i,j)==0_i2b) then
174  hydro_icemask(i,j) = 1
175  hydro_thk(i,j) = t_h_c(i,j) + t_h_t(i,j)
176  hydro_supply(i,j) = rho_rho_w_ratio*t_q_b_tot(i,j)
177  else
178  hydro_icemask(i,j) = 0
179  hydro_thk(i,j) = 0.0_dp
180  hydro_supply(i,j) = 0.0_dp
181  end if
182  end do
183  end do
184 
185  call hydro_set_topg(hydro, hydro_topg)
186  call hydro_set_thk(hydro, hydro_thk)
187  call hydro_set_temppabase(hydro, hydro_temppabase)
188  call hydro_set_supply(hydro, hydro_supply)
189  call hydro_set_mask(hydro, hydro_icemask)
190 
191  call hydro_update(hydro)
192 
193  call hydro_get_sflux(hydro, hydro_sflux)
194  call hydro_get_bwat(hydro, hydro_bwat)
195 
196  do i=0,imax
197  do j=0,jmax
198  h_w(j,i) = hydro_bwat(i,j)
199  end do
200  end do
201 
202 #else
203  do i=0,imax
204  do j=0,jmax
205  if ( maske(j,i)==0_i2b ) then
206  h_w(j,i) = 0.0_dp ! grounded ice
207  end if
208  end do
209  end do
210 #endif
211 
212  do i=0,imax
213  do j=0,jmax
214 
215  if ( maske(j,i)==2_i2b ) then
216  h_w(j,i) = z_sl-zl(j,i)
217 
218  else if ( maske(j,i)==3_i2b ) then
219  h_w(j,i) = zb(j,i)-zl(j,i)
220 
221  else if ( maske(j,i)==1_i2b ) then
222  h_w(j,i) = 0.0_dp
223 
224  end if
225 
226  end do
227  end do
228 
229  if (firstcall) firstcall = .false.
230 #endif
231 
232  end subroutine calc_thk_water_bas
233 
234 !-------------------------------------------------------------------------------
235 
236 end module calc_thk_water_bas_m
237 !
subroutine, public calc_thk_water_bas(z_sl)
Main subroutine of calc_thk_water_bas_m: Computation of the thickness of the water column under the i...
real(dp) rho_w
RHO_W: Density of pure water.
Computation of the thickness of the water column under the ice base.
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) zl
zl(j,i): Coordinate z of the lithosphere surface
Declarations of global variables for SICOPOLIS (for the ANT domain).
Definition: sico_vars_m.F90:35
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:jmax, 0:imax) q_b_tot
Q_b_tot(j,i): Sum of Q_bm and Q_tld.
real(dp), dimension(0:jmax, 0:imax) temph_b
temph_b(j,i): Basal temperature relative to the pressure melting point
real(dp), dimension(0:jmax) eta
eta(j): Coordinate eta (= y) of grid point j
real(dp), dimension(0:imax) xi
xi(i): Coordinate xi (= x) of grid point i
real(dp) rho_sw
RHO_SW: Density of sea water.
real(dp) rho
RHO: Density of ice.
real(dp), dimension(0:jmax, 0:imax) zb
zb(j,i): Coordinate z of the ice base
real(dp), dimension(0:jmax, 0:imax) h_t
H_t(j,i): Thickness of ice in the lower (kt) domain (thickness of the temperate layer for POLY...
real(dp), dimension(0:jmax, 0:imax) h_w
H_w(j,i): Thickness of the water column under the ice base.
Declarations of global variables for SICOPOLIS.