Path: blob/devel/elmerice/examples/Inverse_Methods/MassConservation/src/RAMP.F90
3206 views
!/*****************************************************************************/1! *2! * Elmer/Ice, a glaciological add-on to Elmer3! * http://elmerice.elmerfem.org4! *5! *6! * This program is free software; you can redistribute it and/or7! * modify it under the terms of the GNU General Public License8! * as published by the Free Software Foundation; either version 29! * of the License, or (at your option) any later version.10! *11! * This program is distributed in the hope that it will be useful,12! * but WITHOUT ANY WARRANTY; without even the implied warranty of13! * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14! * GNU General Public License for more details.15! *16! * You should have received a copy of the GNU General Public License17! * along with this program (in file fem/GPL-2); if not, write to the18! * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,19! * Boston, MA 02110-1301, USA.20! *21! *****************************************************************************/22! ******************************************************************************23! *24! * Authors: F. Gillet-Chaulet25! * Web: http://elmerice.elmerfem.org26! *27! * Original Date: Dec. 202028! *29! * A collection of user function for the ice shelf ramp :30! * - Thickness31! * - Velocity32! * - SMB33! * Required parameters are read from the constant section see the34! functions RAMP_PARAMETERS and PHYSICAL_PARAMETERS below35! *****************************************************************************36!-----------------------------------------------------------------------------37! H(x)38FUNCTION Thickness(Model,nodenumber,x) RESULT(H)39USE DefUtils40implicit none41!-----------------42TYPE(Model_t) :: Model43INTEGER :: nodenumber44REAL(kind=dp),INTENT(IN) :: x !x45REAL(kind=dp) :: H46LOGICAL,SAVE :: FirstTime=.TRUE.47REAL(kind=dp),SAVE :: Hgl,dhdx,Vgl4849IF (FirstTime) THEN50CALL RAMP_PARAMETERS(Model,Vgl,Hgl,dhdx)51FirstTime=.FALSE.52ENDIF5354H = Hgl + dhdx * x5556End FUNCTION Thickness5758! Ux(x)59FUNCTION Velocity(Model,nodenumber,x) RESULT(U)60USE DefUtils61implicit none62!-----------------63TYPE(Model_t) :: Model64INTEGER :: nodenumber65REAL(kind=dp),INTENT(IN) :: x !x66REAL(kind=dp) :: U67LOGICAL,SAVE :: FirstTime=.TRUE.68REAL(kind=dp),SAVE :: Vgl,Hgl,dhdx69REAL(kind=dp),SAVE :: A,n,rhoi,rhow,gravity70REAL(kind=dp) :: astar,Hn71REAL(kind=dp) :: A_star,H_n7273IF (FirstTime) THEN74CALL PHYSICAL_PARAMETERS(Model,A,n,rhoi,rhow,gravity)75CALL RAMP_PARAMETERS(Model,Vgl,Hgl,dhdx)76FirstTime=.FALSE.77END IF7879astar=A_star(A,n,rhoi,rhow,gravity)80Hn=H_n(x,n,Hgl,dhdx)8182U=Vgl+astar*Hn8384END FUNCTION Velocity8586! SMB(x)87FUNCTION SMB(Model,nodenumber,x) RESULT(adot)88USE DefUtils89implicit none90!-----------------91TYPE(Model_t) :: Model92INTEGER :: nodenumber93REAL(kind=dp),INTENT(IN) :: x !x94REAL(kind=dp) :: adot95LOGICAL,SAVE :: FirstTime=.TRUE.96REAL(kind=dp),SAVE :: Vgl,Hgl,dhdx97REAL(kind=dp),SAVE :: A,n,rhoi,rhow,gravity98REAL(kind=dp) :: astar,H,U99REAL(kind=dp) :: A_star,Thickness,Velocity100101IF (FirstTime) THEN102CALL PHYSICAL_PARAMETERS(Model,A,n,rhoi,rhow,gravity)103CALL RAMP_PARAMETERS(Model,Vgl,Hgl,dhdx)104FirstTime=.FALSE.105END IF106107astar=A_star(A,n,rhoi,rhow,gravity)108H=Thickness(Model,nodenumber,x)109U=Velocity(Model,nodenumber,x)110111adot=astar*H**(n+1)+dhdx*U112113END FUNCTION SMB114115FUNCTION H_n(x,n,Hgl,dhdx) RESULT(Hn)116USE DefUtils117implicit none118REAL(kind=dp),INTENT(IN) :: x,n,Hgl,dhdx119REAL(kind=dp) :: Hn120121Hn=-(1._dp/(n+1))*(1._dp/dhdx)*(Hgl**(n+1))*(1._dp-(1._dp+dhdx*x/Hgl)**(n+1))122123END FUNCTION H_n124125FUNCTION A_star(A,n,rhoi,rhow,gravity) RESULT(Astar)126USE DefUtils127implicit none128REAL(kind=dp),INTENT(IN) :: A,n,rhoi,rhow,gravity129REAL(kind=dp) :: Astar130REAL(kind=dp) :: rho_star131132rho_star=rhoi*(rhow-rhoi)/rhow133Astar=A*(0.25*rho_star*abs(gravity))**n134135END FUNCTION A_star136137SUBROUTINE RAMP_PARAMETERS(Model,Vgl,Hgl,dhdx)138USE DefUtils139implicit none140TYPE(Model_t) :: Model141REAL(kind=dp),INTENT(OUT) :: Vgl,Hgl,dhdx142143Hgl = ListGetConstReal( Model % Constants, 'RAMP Hgl', UnFoundFatal=.TRUE. )144dhdx = ListGetConstReal( Model % Constants, 'RAMP dhdx', UnFoundFatal=.TRUE. )145Vgl = ListGetConstReal( Model % Constants, 'RAMP Vgl', UnFoundFatal=.TRUE. )146147END SUBROUTINE RAMP_PARAMETERS148149SUBROUTINE PHYSICAL_PARAMETERS(Model,A,n,rhoi,rhow,gravity)150USE DefUtils151implicit none152TYPE(Model_t) :: Model153REAL(kind=dp),INTENT(OUT) :: A,n,rhoi,rhow,gravity154A = ListGetConstReal( Model % Constants, 'RAMP RateFactor', UnFoundFatal=.TRUE. )155n = ListGetConstReal( Model % Constants, 'RAMP Glen', UnFoundFatal=.TRUE. )156rhoi = ListGetConstReal( Model % Constants, 'RAMP rhoi', UnFoundFatal=.TRUE. )157rhow = ListGetConstReal( Model % Constants, 'RAMP rhow', UnFoundFatal=.TRUE. )158gravity = ListGetConstReal( Model % Constants, 'RAMP gravity', UnFoundFatal=.TRUE. )159END SUBROUTINE PHYSICAL_PARAMETERS160161162