!/*****************************************************************************/ ! * ! * Elmer/Ice, a glaciological add-on to Elmer ! * http://elmerice.elmerfem.org ! * ! * ! * This program is free software; you can redistribute it and/or ! * modify it under the terms of the GNU General Public License ! * as published by the Free Software Foundation; either version 2 ! * of the License, or (at your option) any later version. ! * ! * This program 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 ! * GNU General Public License for more details. ! * ! * You should have received a copy of the GNU General Public License ! * along with this program (in file fem/GPL-2); if not, write to the ! * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! * Boston, MA 02110-1301, USA. ! * ! *****************************************************************************/ ! ****************************************************************************** ! * ! * Authors: Olivier Gagliardini ! * Email: ! * Web: http://elmerice.elmerfem.org ! * ! * Original Date: ! * Date Modifications: ! * 2009/03/17 GAG generalised for 3D problems and non-linear elements ! ***************************************************************************** !> !> !> !> ! ***************************************************************************** !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> !> Buoyancy user functions !> !> SeaPressure returns the pressure -rho_w. g . (Hsl - S - b.Ns.dt) !> where Ns = sqrt(1 + (dS/dx)^2 + (dS/dy)^2) !> b = melting below the shelf (normal flux) !> External Pressure = .... !> !> SeaSpring returns the viscous spring rho_w.g.Ns.dt !> Normal-Tangential set to true !> Slip Coefficient 1 = .... !> !> Adapted from SeaPressureOld. Allows accretion melting below the shelf. !> 2009/03/17 GAG !> - generalised for 3D problems and non-linear elements FUNCTION SeaPressure ( Model, nodenumber, y) RESULT(pw) USE types USE CoordinateSystems USE SolverUtils USE ElementDescription USE DefUtils IMPLICIT NONE TYPE(Model_t) :: Model TYPE(Solver_t):: Solver TYPE(Nodes_t), SAVE :: Nodes TYPE(variable_t), POINTER :: Timevar TYPE(Element_t), POINTER :: BoundaryElement, BCElement, CurElement, ParentElement TYPE(ValueList_t), POINTER :: BC, material, ParentMaterial, BodyForce INTEGER :: NBoundary, NParent, BoundaryElementNode, ParentElementNode, body_id, other_body_id, material_id INTEGER :: nodenumber, NumberOfNodesOnBoundary, OldMeshTag INTEGER, ALLOCATABLE :: NodeOnBoundary(:) INTEGER :: Nn, i, j, p, n, Nmax, bf_id, DIM, bf_id_FS REAL(KIND=dp) :: y, pw, t, told, dt, Bu, Bv REAL(KIND=dp) :: Zsl, rhow, gravity REAL(KIND=dp), ALLOCATABLE :: S(:), Ns(:), a_perp(:), SourceFunc(:), normal(:,:) LOGICAL :: FirstTime = .TRUE., NewTime, GotIt, ComputeS, NormalFlux = .TRUE., UnFoundFatal=.TRUE., MeshChanged=.FALSE. CHARACTER(LEN=MAX_NAME_LEN) :: BottomSurfaceName SAVE told, FirstTime, NewTime, Nn, dt, Ns, Bodyforce, DIM SAVE S, rhow, gravity, Zsl, NormalFlux, a_perp, SourceFunc SAVE NumberOfNodesOnBoundary, NodeOnBoundary, normal SAVE BottomSurfaceName, bf_id_FS, OldMeshTag Timevar => VariableGet( Model % Variables,'Time') t = TimeVar % Values(1) dt = Model % Solver % dt !Element type 101 doesn't have a parent element, can't enquire SeaLevel !Should only occur during SaveBoundaryValues, so isn't an issue IF(GetElementFamily(Model % CurrentElement) < 2) THEN pw = 0.0_dp RETURN END IF IF (FirstTime) THEN NewTime = .TRUE. told = t OldMeshTag = Model % Mesh % MeshTag DIM = CoordinateSystemDimension() rhow = GetConstReal( Model % Constants, 'Water Density', GotIt ) IF (.NOT.GotIt) THEN WRITE(Message,'(A)') 'Variable Water Density not found. & &Setting to 1.03225e-18' CALL INFO('SeaPressure', Message, level=20) rhow = 1.03225e-18_dp ELSE WRITE(Message,'(A,F10.4)') 'Water Density = ', rhow CALL INFO('SeaPressure', Message , level = 20) END IF !----------------------------------------------------------------- ! Is there basal melt to account for !----------------------------------------------------------------- NormalFlux = GetLogical( Model % Constants, 'Buoyancy Use Basal Melt', GotIt ) IF (.NOT.GotIt) THEN WRITE(Message,'(A)') 'Variable Buoyancy Use Basal Melt not found. & &Setting to FALSE' CALL INFO('SeaPressure', Message, level=20) NormalFlux = .FALSE. ELSE WRITE(Message,*) 'Buoyancy Use Basal Melt = ', NormalFlux CALL INFO('SeaPressure', Message , level = 20) END IF !----------------------------------------------------------------- ! Find the bf_id of the FS solvers if NormalFlux is TRUE ! and read the name of the Bottom Free surface solver !----------------------------------------------------------------- IF (NormalFlux) THEN BottomSurfaceName = GetString( Model % Constants, 'Bottom Surface Name', GotIt ) IF (.NOT.GotIt) THEN WRITE(Message,'(A)') 'Variable Bottom SUrface Name not found. & &Setting to DyBottom' CALL INFO('SeaPressure', Message, level=20) BottomSurfaceName = 'DyBottom' ELSE WRITE(Message,*)'Bottom Surface Name = ',TRIM(BottomSurfaceName) CALL INFO('SeaPressure', Message , level = 20) END IF bf_id_FS = -1 DO bf_id=1,Model % NumberOFBodyForces IF( ListCheckPresent( Model % BodyForces(bf_id) % Values, & TRIM(BottomSurfaceName)//' Accumulation') ) bf_id_FS = bf_id END DO IF (bf_id_FS<0) THEN CALL FATAL('Sea Pressure','No Basal Melt found in any body Force') END IF END IF !----------------------------------------------------------------- ! Read the gravity !----------------------------------------------------------------- bf_id = ListGetInteger( Model % Bodies(1) % Values,& 'Body Force', minv=1, maxv=Model % NumberOFMaterials) IF (DIM==2) THEN !NOT the same keyword if the shape factor is used gravity = -GetConstReal( Model % BodyForces(bf_id) % Values, 'Lateral Friction Gravity 2',Gotit) IF (.NOT. Gotit) THEN gravity = -GetConstReal( Model % BodyForces(bf_id) % Values, 'Flow BodyForce 2',Gotit) END IF ELSE gravity = -GetConstReal( Model % BodyForces(bf_id) % Values, 'Flow BodyForce 3',Gotit) END IF ELSE IF (t > told) THEN NewTime = .TRUE. told = t END IF ENDIF ! FirstTime IF(OldMeshTag /= Model % Mesh % MeshTag) THEN OldMeshTag = Model % Mesh % MeshTag MeshChanged = .TRUE. END IF IF(Model % Mesh % Changed) MeshChanged = .TRUE. IF(FirstTime .OR. (NewTime .AND. MeshChanged)) THEN MeshChanged = .FALSE. IF(.NOT. FirstTime) & DEALLOCATE(NodeOnBoundary, SourceFunc) ALLOCATE( NodeOnBoundary( Model % Mesh % NumberOfNodes )) n = Model % MaxElementNodes ALLOCATE( SourceFunc(n) ) FirstTime = .FALSE. !----------------------------------------------------------------- ! Number of nodes concerned (needed to compute Ns from the normal) !----------------------------------------------------------------- CurElement => Model % CurrentElement NodeOnBoundary = 0 NumberOfNodesOnBoundary = 0 DO p = 1, Model % NumberOfBoundaryElements BCElement => GetBoundaryElement(p) BC => GetBC( BCElement ) IF( GetElementFamily(BCElement) == 1 ) CYCLE ComputeS = GetLogical( BC, 'Compute Sea Pressure', GotIt) IF (.Not.GotIt) ComputeS = .FALSE. IF (ComputeS) THEN n = BCElement % Type % NumberOfNodes DO i = 1, n j = BCElement % NodeIndexes (i) IF (NodeOnBoundary(j)==0) THEN NumberOfNodesOnBoundary = NumberOfNodesOnBoundary + 1 NodeOnBoundary(j) = NumberOfNodesOnBoundary END IF END DO END IF END DO Model % CurrentElement => CurElement IF(ALLOCATED(S)) DEALLOCATE(S,Ns) IF(ALLOCATED(a_perp)) DEALLOCATE(a_perp) ALLOCATE( S( NumberOfNodesOnBoundary ), Ns( NumberOfNodesOnBoundary )) IF (NormalFlux) ALLOCATE( a_perp ( NumberOfNodesOnBoundary )) END IF IF (NewTime) THEN NewTime = .FALSE. !----------------------------------------------------------------- ! get some information upon active boundary element and its parent !----------------------------------------------------------------- BoundaryElement => Model % CurrentElement IF ( .NOT. ASSOCIATED(BoundaryElement) ) THEN CALL FATAL('Sea Pressure','No boundary element found') END IF other_body_id = BoundaryElement % BoundaryInfo % outbody IF (other_body_id < 1) THEN ! only one body in calculation ParentElement => BoundaryElement % BoundaryInfo % Right IF ( .NOT. ASSOCIATED(ParentElement) ) ParentElement => BoundaryElement % BoundaryInfo % Left ELSE ! we are dealing with a body-body boundary and assume that the normal is pointing outwards ParentElement => BoundaryElement % BoundaryInfo % Right IF (ParentElement % BodyId == other_body_id) ParentElement => BoundaryElement % BoundaryInfo % Left END IF body_id = ParentElement % BodyId material_id = ListGetInteger(Model % Bodies(body_id) % Values, 'Material', GotIt, UnFoundFatal=UnFoundFatal) ParentMaterial => Model % Materials(material_id) % Values IF ((.NOT. ASSOCIATED(ParentMaterial))) THEN WRITE(Message,'(A,I10,A,I10)')& 'No material values found for body no ', body_id,& ' under material id ', material_id CALL FATAL('Sea Pressure',Message) END IF NParent = ParentElement % Type % NumberOfNodes !------------------------- ! Get material parameters ! Sea level for that time !------------------------- Zsl = GetCReal( ParentMaterial, 'Sea level', GotIt ) IF (.NOT.GotIt) THEN WRITE(Message,'(A)') 'Variable Sea level not found. & &Setting to 0.0' CALL INFO('SeaPressure', Message, level=2) Zsl = 0.0_dp ELSE WRITE(Message,'(A,F10.4)') 'Sea level = ', Zsl CALL INFO('SeaPressure', Message , level = 2) END IF !--------------------------- ! Compute S for new t !--------------------------- CurElement => Model % CurrentElement S = 0.0 DO p = 1, Model % NumberOfBoundaryElements BCElement => GetBoundaryElement(p) BC => GetBC( BCElement ) IF( GetElementFamily(BCElement) == 1 ) CYCLE ComputeS = GetLogical( BC, 'Compute Sea Pressure', GotIt) IF (.Not.GotIt) ComputeS = .FALSE. IF (ComputeS) THEN n = BCElement % Type % NumberOfNodes DO i = 1, n j = BCElement % NodeIndexes (i) IF (DIM==2) THEN S(NodeOnBoundary(j)) = Model % Nodes % y (j) ELSE S(NodeOnBoundary(j)) = Model % Nodes % z (j) END IF END DO END IF END DO Model % CurrentElement => CurElement !---------------------------------------------------------------------------- ! Compute Ns and Flux (melting) for new t ! Restricted to the surface below the shelf ! The melting is not taken into account where dS/dx is infinite (calving front) !---------------------------------------------------------------------------- Ns = 0.0_dp IF (NormalFlux) THEN a_perp = 0.0_dp ALLOCATE( Normal(3, NumberOfNodesOnBoundary)) Normal = 0.0_dp CurElement => Model % CurrentElement DO p = 1, Model % NumberOfBoundaryElements BCElement => GetBoundaryElement(p) BC => GetBC( BCElement ) IF( GetElementFamily(BCElement) == 1 ) CYCLE ComputeS = GetLogical( BC, 'Compute Sea Spring', GotIt) IF (.Not.GotIt) ComputeS = .FALSE. ! we only compute the term Ns.b if the Spring is on SourceFunc = 0.0_dp IF (ComputeS) THEN n = BCElement % Type % NumberOfNodes SourceFunc(1:n) = GetReal( Model % BodyForces(bf_id_FS) % Values, & TRIM(BottomSurfaceName)//' Accumulation', GotIt) CALL GetElementNodes( Nodes , BCElement ) DO i = 1,n j = BCElement % NodeIndexes( i ) Bu = BCElement % Type % NodeU(i) IF ( BCElement % Type % Dimension > 1 ) THEN Bv = BCElement % Type % NodeV(i) ELSE Bv = 0.0D0 END IF Normal(:,NodeOnBoundary(j)) = Normal(:,NodeOnBoundary(j)) + & NormalVector(BCElement, Nodes, Bu, Bv, .TRUE.) a_perp( NodeOnBoundary(j) ) = SourceFunc (i) END DO END IF END DO DO i=1, NumberOfNodesOnBoundary IF (ABS(Normal(DIM,i)) > 1.0e-20_dp) THEN Ns(i) = 1.0_dp + (Normal(1,i)/Normal(DIM,i))**2.0_dp IF (DIM>2) THEN Ns(i) = Ns(i) + (Normal(2,i)/Normal(3,i))**2.0_dp END IF Ns(i) = SQRT(Ns(i)) ELSE Ns(i) = -999.0 END IF END DO DEALLOCATE (Normal) Model % CurrentElement => CurElement END IF ENDIF ! new dt j = NodeOnBoundary( nodenumber ) IF ( NormalFlux .AND. (Ns(j) > 0.0_dp)) THEN pw = -gravity * rhow * (Zsl - S(j) - a_perp(j) * dt * Ns(j) ) ELSE pw = -gravity * rhow * (Zsl - S(j)) END IF IF (pw > 0.0) pw = 0.0 END FUNCTION SeaPressure FUNCTION SeaSpring ( Model, nodenumber, y) RESULT(C) USE types USE CoordinateSystems USE SolverUtils USE ElementDescription USE DefUtils IMPLICIT NONE TYPE(Model_t) :: Model TYPE(Solver_t):: Solver TYPE(Nodes_t), SAVE :: Nodes TYPE(variable_t), POINTER :: Timevar, NormalSolution TYPE(Element_t), POINTER :: BoundaryElement, BCElement, CurElement, ParentElement TYPE(ValueList_t), POINTER :: BC, material, ParentMaterial, BodyForce INTEGER :: NBoundary, NParent, BoundaryElementNode, ParentElementNode, body_id, other_body_id, material_id INTEGER :: nodenumber, NumberOfNodesOnBoundary INTEGER, ALLOCATABLE :: NodeOnBoundary(:) INTEGER :: Nn, i, j, k, p, n, Nmax, bf_id, DIM, OldMeshTag REAL(KIND=dp) :: y, C, t, told, dt, Bu, Bv, aux REAL(KIND=dp) :: rhow, gravity, Nsi, NodeNormal(3) REAL(KIND=dp), ALLOCATABLE :: Ns(:), normal(:,:) LOGICAL :: FirstTime = .TRUE., NewTime, GotIt, ComputeS,MeshChanged=.FALSE. SAVE told, FirstTime, NewTime, Nn, dt, Ns, Bodyforce, DIM SAVE rhow, gravity SAVE NumberOfNodesOnBoundary, NodeOnBoundary, normal,OldMeshTag SAVE NormalSolution Timevar => VariableGet( Model % Variables,'Time') t = TimeVar % Values(1) aux = GetConstReal(Model % Constants, 'Sea Spring Timestep Size', GotIt) IF (GotIt) THEN dt = aux ELSE dt = Model % Solver % dt END IF !Element type 101 doesn't have a parent element, can't enquire SeaLevel !Should only occur during SaveBoundaryValues, so isn't an issue IF(GetElementFamily(Model % CurrentElement) < 2) THEN C = 1.0e20_dp RETURN END IF ! .OR. (NewTime .AND. Model % Mesh % Changed) IF(FirstTime) THEN NewTime = .TRUE. OldMeshTag = Model % Mesh % MeshTag ELSE IF(t > told) THEN NewTime = .TRUE. told = t END IF IF(OldMeshTag .NE. Model % Mesh % MeshTag) THEN OldMeshTag = Model % Mesh % MeshTag MeshChanged = .TRUE. END IF IF(Model % Mesh % Changed) MeshChanged = .TRUE. IF (FirstTime .OR. (NewTime .AND. MeshChanged)) THEN NormalSolution => VariableGet( Model % Variables, 'Normal Vector') IF(.NOT. FirstTime) DEALLOCATE(NodeOnBoundary, Ns) FirstTime = .FALSE. NewTime = .FALSE. ALLOCATE( NodeOnBoundary( Model % Mesh % NumberOfNodes )) n = Model % MaxElementNodes DIM = CoordinateSystemDimension() rhow = GetConstReal( Model % Constants, 'Water Density', GotIt ) IF (.NOT.GotIt) THEN WRITE(Message,'(A)') 'Variable "Water Density" not found in Constants.' CALL FATAL('SeaSpring', Message) ELSE WRITE(Message,'(A,F10.4)') 'Water Density = ', rhow CALL INFO('SeaSpring', Message , level = 20) END IF !----------------------------------------------------------------- ! get some information upon active boundary element and its parent !----------------------------------------------------------------- BoundaryElement => Model % CurrentElement IF ( .NOT. ASSOCIATED(BoundaryElement) ) THEN CALL FATAL('SeaSpring','No boundary element found') END IF other_body_id = BoundaryElement % BoundaryInfo % outbody IF (other_body_id < 1) THEN ! only one body in calculation ParentElement => BoundaryElement % BoundaryInfo % Right IF ( .NOT. ASSOCIATED(ParentElement) ) ParentElement => BoundaryElement % BoundaryInfo % Left ELSE ! we are dealing with a body-body boundary and assume that the normal is pointing outwards ParentElement => BoundaryElement % BoundaryInfo % Right IF (ParentElement % BodyId == other_body_id) ParentElement => BoundaryElement % BoundaryInfo % Left END IF BodyForce => GetBodyForce(ParentElement) bf_id = ListGetInteger( Model % Bodies(1) % Values,& 'Body Force', minv=1, maxv=Model % NumberOFMaterials) IF (DIM==2) THEN !NOT the same keyword if the shape factor is used gravity = -GetConstReal( Model % BodyForces(bf_id) % Values, 'Lateral Friction Gravity 2',Gotit) IF (.NOT. Gotit) THEN gravity = -GetConstReal( Model % BodyForces(bf_id) % Values, 'Flow BodyForce 2',Gotit) END IF ELSE gravity = -GetConstReal( Model % BodyForces(bf_id) % Values, 'Flow BodyForce 3',Gotit) END IF ! Number of node concerned CurElement => Model % CurrentElement NodeOnBoundary = 0 NumberOfNodesOnBoundary = 0 DO p = 1, Model % NumberOfBoundaryElements BCElement => GetBoundaryElement(p) BC => GetBC( BCElement ) IF( GetElementFamily(BCElement) == 1 ) CYCLE ComputeS = GetLogical( BC, 'Compute Sea Spring', GotIt) IF (.Not.GotIt) ComputeS = .FALSE. IF (ComputeS) THEN n = BCElement % Type % NumberOfNodes DO i = 1, n j = BCElement % NodeIndexes (i) IF (NodeOnBoundary(j)==0) THEN NumberOfNodesOnBoundary = NumberOfNodesOnBoundary + 1 NodeOnBoundary(j) = NumberOfNodesOnBoundary END IF END DO END IF END DO Model % CurrentElement => CurElement ALLOCATE( Ns( NumberOfNodesOnBoundary )) ! Compute Ns for new t ALLOCATE( Normal(3, NumberOfNodesOnBoundary)) Ns = 0.0_dp Normal = 0.0_dp CurElement => Model % CurrentElement DO p = 1, Model % NumberOfBoundaryElements BCElement => GetBoundaryElement(p) BC => GetBC( BCElement ) IF( GetElementFamily(BCElement) == 1 ) CYCLE ComputeS = GetLogical( BC, 'Compute Sea Spring', GotIt) IF (.Not.GotIt) ComputeS = .FALSE. IF (ComputeS) THEN CALL GetElementNodes( Nodes , BCElement ) n = BCElement % Type % NumberOfNodes DO i = 1,n j = BCElement % NodeIndexes( i ) Bu = BCElement % Type % NodeU(i) IF ( BCElement % TYPE % DIMENSION > 1 ) THEN Bv = BCElement % Type % NodeV(i) ELSE Bv = 0.0D0 END IF Normal(:,NodeOnBoundary(j)) = Normal(:,NodeOnBoundary(j)) + & NormalVector(BCElement, Nodes, Bu, Bv, .TRUE.) END DO END IF END DO DO i=1, NumberOfNodesOnBoundary IF (ABS(Normal(DIM,i)) > 1.0e-20_dp) THEN Ns(i) = 1.0_dp + (Normal(1,i)/Normal(DIM,i))**2.0_dp IF (DIM>2) THEN Ns(i) = Ns(i) + (Normal(2,i)/Normal(3,i))**2.0_dp END IF Ns(i) = SQRT(Ns(i)) ELSE Ns(i) = -999.0_dp CALL WARN('SeaSpring', 'Lower surface almost is vertically aligned') END IF END DO DEALLOCATE (Normal) Model % CurrentElement => CurElement ENDIF ! new dt GotIt = .FALSE. Nsi = -999.0_dp ! Get consistent normal if it is available on all nodes. ! This is rather dirty since the other stuff is done anyways, even if this would ! concern all the nodes. NodeNormal = ConsistentNormalVector( CurrentModel % Solver, NormalSolution, & Model % CurrentElement, GotIt, Node = NodeNumber ) IF( GotIt ) THEN IF(ABS(NodeNormal(dim)) > 1.0e-20_dp) THEN Nsi = SQRT( 1.0_dp + (SUM(NodeNormal(1:dim-1)**2)) / NodeNormal(dim)**2.0_dp ) GotIt = .TRUE. END IF END IF IF(.NOT. GotIt ) THEN j = NodeOnBoundary( nodenumber ) IF( j > 0 ) Nsi = Ns(j) END IF IF( Nsi > 0.0_dp ) THEN C = gravity * rhow * dt * Nsi ELSE C = 1.0e20_dp END IF END FUNCTION SeaSpring