Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/elmerice/examples/Inverse_Methods/MassConservation/src/RAMP.F90
3206 views
1
!/*****************************************************************************/
2
! *
3
! * Elmer/Ice, a glaciological add-on to Elmer
4
! * http://elmerice.elmerfem.org
5
! *
6
! *
7
! * This program is free software; you can redistribute it and/or
8
! * modify it under the terms of the GNU General Public License
9
! * as published by the Free Software Foundation; either version 2
10
! * of the License, or (at your option) any later version.
11
! *
12
! * This program is distributed in the hope that it will be useful,
13
! * but WITHOUT ANY WARRANTY; without even the implied warranty of
14
! * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
! * GNU General Public License for more details.
16
! *
17
! * You should have received a copy of the GNU General Public License
18
! * along with this program (in file fem/GPL-2); if not, write to the
19
! * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20
! * Boston, MA 02110-1301, USA.
21
! *
22
! *****************************************************************************/
23
! ******************************************************************************
24
! *
25
! * Authors: F. Gillet-Chaulet
26
! * Web: http://elmerice.elmerfem.org
27
! *
28
! * Original Date: Dec. 2020
29
! *
30
! * A collection of user function for the ice shelf ramp :
31
! * - Thickness
32
! * - Velocity
33
! * - SMB
34
! * Required parameters are read from the constant section see the
35
! functions RAMP_PARAMETERS and PHYSICAL_PARAMETERS below
36
! *****************************************************************************
37
!-----------------------------------------------------------------------------
38
! H(x)
39
FUNCTION Thickness(Model,nodenumber,x) RESULT(H)
40
USE DefUtils
41
implicit none
42
!-----------------
43
TYPE(Model_t) :: Model
44
INTEGER :: nodenumber
45
REAL(kind=dp),INTENT(IN) :: x !x
46
REAL(kind=dp) :: H
47
LOGICAL,SAVE :: FirstTime=.TRUE.
48
REAL(kind=dp),SAVE :: Hgl,dhdx,Vgl
49
50
IF (FirstTime) THEN
51
CALL RAMP_PARAMETERS(Model,Vgl,Hgl,dhdx)
52
FirstTime=.FALSE.
53
ENDIF
54
55
H = Hgl + dhdx * x
56
57
End FUNCTION Thickness
58
59
! Ux(x)
60
FUNCTION Velocity(Model,nodenumber,x) RESULT(U)
61
USE DefUtils
62
implicit none
63
!-----------------
64
TYPE(Model_t) :: Model
65
INTEGER :: nodenumber
66
REAL(kind=dp),INTENT(IN) :: x !x
67
REAL(kind=dp) :: U
68
LOGICAL,SAVE :: FirstTime=.TRUE.
69
REAL(kind=dp),SAVE :: Vgl,Hgl,dhdx
70
REAL(kind=dp),SAVE :: A,n,rhoi,rhow,gravity
71
REAL(kind=dp) :: astar,Hn
72
REAL(kind=dp) :: A_star,H_n
73
74
IF (FirstTime) THEN
75
CALL PHYSICAL_PARAMETERS(Model,A,n,rhoi,rhow,gravity)
76
CALL RAMP_PARAMETERS(Model,Vgl,Hgl,dhdx)
77
FirstTime=.FALSE.
78
END IF
79
80
astar=A_star(A,n,rhoi,rhow,gravity)
81
Hn=H_n(x,n,Hgl,dhdx)
82
83
U=Vgl+astar*Hn
84
85
END FUNCTION Velocity
86
87
! SMB(x)
88
FUNCTION SMB(Model,nodenumber,x) RESULT(adot)
89
USE DefUtils
90
implicit none
91
!-----------------
92
TYPE(Model_t) :: Model
93
INTEGER :: nodenumber
94
REAL(kind=dp),INTENT(IN) :: x !x
95
REAL(kind=dp) :: adot
96
LOGICAL,SAVE :: FirstTime=.TRUE.
97
REAL(kind=dp),SAVE :: Vgl,Hgl,dhdx
98
REAL(kind=dp),SAVE :: A,n,rhoi,rhow,gravity
99
REAL(kind=dp) :: astar,H,U
100
REAL(kind=dp) :: A_star,Thickness,Velocity
101
102
IF (FirstTime) THEN
103
CALL PHYSICAL_PARAMETERS(Model,A,n,rhoi,rhow,gravity)
104
CALL RAMP_PARAMETERS(Model,Vgl,Hgl,dhdx)
105
FirstTime=.FALSE.
106
END IF
107
108
astar=A_star(A,n,rhoi,rhow,gravity)
109
H=Thickness(Model,nodenumber,x)
110
U=Velocity(Model,nodenumber,x)
111
112
adot=astar*H**(n+1)+dhdx*U
113
114
END FUNCTION SMB
115
116
FUNCTION H_n(x,n,Hgl,dhdx) RESULT(Hn)
117
USE DefUtils
118
implicit none
119
REAL(kind=dp),INTENT(IN) :: x,n,Hgl,dhdx
120
REAL(kind=dp) :: Hn
121
122
Hn=-(1._dp/(n+1))*(1._dp/dhdx)*(Hgl**(n+1))*(1._dp-(1._dp+dhdx*x/Hgl)**(n+1))
123
124
END FUNCTION H_n
125
126
FUNCTION A_star(A,n,rhoi,rhow,gravity) RESULT(Astar)
127
USE DefUtils
128
implicit none
129
REAL(kind=dp),INTENT(IN) :: A,n,rhoi,rhow,gravity
130
REAL(kind=dp) :: Astar
131
REAL(kind=dp) :: rho_star
132
133
rho_star=rhoi*(rhow-rhoi)/rhow
134
Astar=A*(0.25*rho_star*abs(gravity))**n
135
136
END FUNCTION A_star
137
138
SUBROUTINE RAMP_PARAMETERS(Model,Vgl,Hgl,dhdx)
139
USE DefUtils
140
implicit none
141
TYPE(Model_t) :: Model
142
REAL(kind=dp),INTENT(OUT) :: Vgl,Hgl,dhdx
143
144
Hgl = ListGetConstReal( Model % Constants, 'RAMP Hgl', UnFoundFatal=.TRUE. )
145
dhdx = ListGetConstReal( Model % Constants, 'RAMP dhdx', UnFoundFatal=.TRUE. )
146
Vgl = ListGetConstReal( Model % Constants, 'RAMP Vgl', UnFoundFatal=.TRUE. )
147
148
END SUBROUTINE RAMP_PARAMETERS
149
150
SUBROUTINE PHYSICAL_PARAMETERS(Model,A,n,rhoi,rhow,gravity)
151
USE DefUtils
152
implicit none
153
TYPE(Model_t) :: Model
154
REAL(kind=dp),INTENT(OUT) :: A,n,rhoi,rhow,gravity
155
A = ListGetConstReal( Model % Constants, 'RAMP RateFactor', UnFoundFatal=.TRUE. )
156
n = ListGetConstReal( Model % Constants, 'RAMP Glen', UnFoundFatal=.TRUE. )
157
rhoi = ListGetConstReal( Model % Constants, 'RAMP rhoi', UnFoundFatal=.TRUE. )
158
rhow = ListGetConstReal( Model % Constants, 'RAMP rhow', UnFoundFatal=.TRUE. )
159
gravity = ListGetConstReal( Model % Constants, 'RAMP gravity', UnFoundFatal=.TRUE. )
160
END SUBROUTINE PHYSICAL_PARAMETERS
161
162