forked from ESCOMP/CISM
-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathglide_ground.F90
164 lines (128 loc) · 6.13 KB
/
glide_ground.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! glide_ground.F90 - part of the Community Ice Sheet Model (CISM)
!
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! Copyright (C) 2005-2018
! CISM contributors - see AUTHORS file for list of contributors
!
! This file is part of CISM.
!
! CISM is free software: you can redistribute it and/or modify it
! under the terms of the Lesser GNU General Public License as published
! by the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! CISM is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! Lesser GNU General Public License for more details.
!
! You should have received a copy of the Lesser GNU General Public License
! along with CISM. If not, see <http://www.gnu.org/licenses/>.
!
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!TODO - Change module and file names to something more appropriate (glide_calving?)
#ifdef HAVE_CONFIG_H
#include "config.inc"
#endif
#include "glide_mask.inc"
module glide_ground
use glide_types
use glimmer_global, only: dp
use parallel
implicit none
contains
!-------------------------------------------------------------------------------
subroutine glide_calve_ice(whichcalving, &
thck, relx, &
topg, mask, &
marine_limit, calving_fraction, &
eus, calving_thck)
! Calve ice according to one of several alternative methods
use glimmer_paramets, only: thk0
implicit none
!---------------------------------------------------------------------
! Subroutine arguments
!---------------------------------------------------------------------
!TODO: Change mask to thkmask? The argument passed in is model%geometry%thkmask.
integer, intent(in) :: whichcalving !> option for calving law
real(dp),dimension(:,:),intent(inout) :: thck !> ice thickness
real(dp),dimension(:,:),intent(in) :: relx !> relaxed bedrock topography
real(dp),dimension(:,:),intent(in) :: topg !> present bedrock topography
integer, dimension(:,:), intent(in) :: mask !> grid type mask
real(dp), intent(in) :: marine_limit !> lower limit on topography elevation for ice to be present
real(dp), intent(in) :: calving_fraction !> fraction of ice lost when calving; used with whichcalving = 2
real(dp), intent(in) :: eus !> eustatic sea level
real(dp),dimension(:,:),intent(out) :: calving_thck !> thickness lost due to calving
integer :: ew,ns
!---------------------------------------------------------------------
calving_thck(:,:) = 0.d0
select case (whichcalving)
case(CALVING_NONE) ! do nothing
case(CALVING_FLOAT_ZERO) ! set thickness to zero if ice is floating
where (GLIDE_IS_FLOAT(mask))
calving_thck = thck
thck = 0.0d0
end where
case(CALVING_FLOAT_FRACTION) ! remove fraction of ice when floating
!WHL - Changed definition of calving_fraction; now it is the fraction lost
do ns = 2,size(thck,2)-1
do ew = 2,size(thck,1)-1
if (GLIDE_IS_CALVING(mask(ew,ns))) then
!!! calving_thck(ew,ns) = (1.d0-calving_fraction)*thck(ew,ns)
!!! thck(ew,ns) = calving_fraction*thck(ew,ns)
calving_thck(ew,ns) = calving_fraction * thck(ew,ns)
thck(ew,ns) = thck(ew,ns) - calving_thck(ew,ns)
!mask(ew,ns) = ior(mask(ew,ns), GLIDE_MASK_OCEAN)
end if
end do
end do
! if uncomment above mask update, then call parallel_halo(mask)
case(CALVING_RELX_THRESHOLD) ! Set thickness to zero if relaxed bedrock is below a given depth
where (relx <= marine_limit+eus)
calving_thck = thck
thck = 0.0d0
end where
case(CALVING_TOPG_THRESHOLD) ! Set thickness to zero at marine edge if present bedrock is below a given level
where (GLIDE_IS_MARINE_ICE_EDGE(mask) .and. topg < marine_limit+eus)
calving_thck = thck
thck = 0.0d0
end where
! Huybrechts grounding line scheme for Greenland initialization
case(CALVING_HUYBRECHTS) ! used to be case(7)
!WHL - Previously, this code assumed that eus and relx have units of meters.
! Changed to be consistent with dimensionless thickness units.
! if(eus > -80.d0) then
! where (relx <= 2.d0*eus)
! calving_thck = thck
! thck = 0.0d0
! end where
! elseif (eus <= -80.d0) then
! where (relx <= (2.d0*eus - 0.25d0*(eus + 80.d0)**2.d0))
! calving_thck = thck
! thck = 0.0d0
! end where
! end if
if (eus*thk0 > -80.d0) then
where (relx*thk0 <= 2.d0*eus*thk0)
calving_thck = thck
thck = 0.0d0
end where
elseif (eus*thk0 <= -80.d0) then
where (relx*thk0 <= (2.d0*eus*thk0 - 0.25d0*(eus*thk0 + 80.d0)**2.d0))
calving_thck = thck
thck = 0.0d0
end where
end if
end select
end subroutine glide_calve_ice
!-------------------------------------------------------------------------
!WHL - Removed subroutine calc_gline_flux
!WHL - Removed functions get_ground_thck, get_ground_line
!WHL - Removed subroutines update_ground_line, set_ground_line, lin_reg_xg
! (Associated with unsupporting calving cases)
!-------------------------------------------------------------------------
end module glide_ground
!---------------------------------------------------------------------------