From 5162ce5386afa9138a6b3af68dc8c1c815f8b725 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 31 Jan 2024 11:29:24 +0200 Subject: [PATCH 01/51] Adding routine for calculating GlaDS cross GL flux (total from both channels and sheet system). --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 363 ++++++++++++++++++++++++ 1 file changed, 363 insertions(+) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 576147f56b..2719b61dd4 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -2417,3 +2417,366 @@ RECURSIVE SUBROUTINE GlaDSsheetThickDummy( Model,Solver,Timestep,TransientSimula RETURN END SUBROUTINE GlaDSsheetThickDummy !------------------------------------------------------------------------------ + +! ****************************************************************************** +! * +! * Authors: Rupert Gladstone +! * Email: RupertGladstone972@gmail.com +! * Web: +! * +! * Original Date: +! * 2022/03/06 +! ***************************************************************************** +!> Solver GlaDS_GLflux +!> +!> Take GlaDS standard output and a grounded mask and calculate the total +!> subglacial outflow across the grounding line on grounding line nodes. +!> +!> The grounded mask is assumed to exist and to have the following properties: +!> Variable name is GroundedMask +!> GroundedMask==1 only on fully grounded nodes +!> GroundedMask==0 only on grounding line nodes +!> +!> GlaDS variable names can be given as follows (default to these values if +!> not prescribed): +!> subglac sheet thickness variable = String "Sheet Thickness" +!> subglac sheet discharge variable = String "Sheet Discharge" +!> subglac channel flux variable = String "Channel Flux" +!> +!> In any case, the above variables need to exist! +!> +!> Limitations: +!> Note that the code currently calculates the flux at the GL based on the +!> assumption that the subglacial water is always flowing from grounded to ocean +!> nodes. If there is inflow from ocean to the subglacial system the cross-GL +!> flux will be overestimated. This could be verified for the channel flux by +!> checking the hydraulic potential at both ends of the edges that are included +!> in the calculation. If the grounded node has a higher value than the GL +!> node then the flow is from grounded to ocean. +!> Checking that sheet discharge is flowing from grounded to ocean nodes is +!> more awkward because we'd need to calculate the direction of the normal to +!> the grounding line. +!> +SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) + + USE DefUtils + USE SolverUtils + IMPLICIT NONE + + ! intent in + TYPE(Model_t) :: Model + TYPE(Solver_t) :: Solver + REAL(KIND=dp) :: dt + LOGICAL :: TransientSimulation + + ! local variables + TYPE(ValueList_t), POINTER :: SolverParams + + TYPE(Element_t), POINTER :: Edge + TYPE(Variable_t), POINTER :: gmVar, channelVar, sheetThickVar, sheetDisVar + LOGICAL :: GotIt, ValidEdge + CHARACTER(LEN=MAX_NAME_LEN):: channelVarName, sheetThickVarName, sheetDisVarName, SolverName + REAL(KIND=dp), POINTER :: gmVals(:), channelVals(:), sheetThickVals(:), sheetDisVals(:) + REAL(KIND=dp), POINTER :: GLfluxVals(:) + REAL(KIND=dp) :: volFluxSheet, volFluxChannel, sheetDisMag + INTEGER, POINTER :: gmPerm(:), channelPerm(:), sheetThickPerm(:), sheetDisPerm(:) + INTEGER, POINTER :: GLfluxPerm(:) + INTEGER :: nn, ee, numNodes + + TYPE(Variable_t), POINTER :: cglfVar, sglfVar + REAL(KIND=dp), POINTER :: cglfVals(:), sglfVals(:) + INTEGER, POINTER :: cglfPerm(:), sglfPerm(:) + + + SolverName = "GlaDS_GLflux" + + CALL Info(SolverName,'Starting subglacial outflow calculation',Level=4) + + SolverParams => GetSolverParams() + + !-------------------------------------------------------------------------------------------- + ! The solver variable will contain the total subglacial outflow on nodes. + ! Units (assuming Elmer/Ice defaults) m^3/a + GLfluxVals => Solver % Variable % Values + GLfluxPerm => Solver % Variable % Perm + + !-------------------------------------------------------------------------------------------- + ! Variables containing the GlaDS sheet thickness and discharge and channel flux + + channelVarName = GetString( SolverParams , 'subglac channel flux variable', GotIt ) + IF (.NOT.GotIt) THEN + CALL Info(SolverName,'>subglac channel flux variable< not found, assuming >Channel Flux<',Level=4) + channelVarName = "Channel Flux" + END IF + channelVar => VariableGet(Model % mesh % Variables,TRIM(channelVarName),UnFoundFatal=.TRUE.) + IF (.NOT.ASSOCIATED(channelVar)) & + CALL FATAL(SolverName,"Variable "//TRIM(channelVarName)//" not found") + channelPerm => channelVar % Perm + channelVals => channelVar % Values + + sheetThickVarName = GetString( SolverParams , 'subglac sheet thickness variable', GotIt ) + IF (.NOT.GotIt) THEN + CALL Info(SolverName,'>subglac sheet thickness variable< not found, assuming >sheet thickness<',Level=4) + sheetThickVarName = "Sheet thickness" + END IF + sheetThickVar => VariableGet(Model % mesh % Variables,TRIM(sheetThickVarName),UnFoundFatal=.TRUE.) + IF (.NOT.ASSOCIATED(sheetThickVar)) & + CALL FATAL(SolverName,"Variable "//TRIM(sheetThickVarName)//" not found") + sheetThickPerm => sheetThickVar % Perm + sheetThickVals => sheetThickVar % Values + + sheetDisVarName = GetString( SolverParams , 'subglac sheet discharge variable', GotIt ) + IF (.NOT.GotIt) THEN + CALL Info(SolverName,'>subglac sheet discharge variable< not found, assuming >sheet discharge<',Level=4) + sheetDisVarName = "sheet discharge" + END IF + sheetDisVar => VariableGet(Model % mesh % Variables,TRIM(sheetDisVarName),UnFoundFatal=.TRUE.) + IF (.NOT.ASSOCIATED(sheetDisVar)) & + CALL FATAL(SolverName,"Variable "//TRIM(sheetDisVarName)//" not found") + sheetDisPerm => sheetDisVar % Perm + sheetDisVals => sheetDisVar % Values + + ! grounded mask name is hard coded + gmVar => VariableGet(Model % mesh % Variables,TRIM("GroundedMask"),UnFoundFatal=.TRUE.) + IF (.NOT.ASSOCIATED(gmVar)) & + CALL FATAL(SolverName,"Variable >GroundedMask< not found") + gmPerm => gmVar % Perm + gmVals => gmVar % Values + + ! The two variables that will contain the sheet and channel fluxes on the GL are also + ! hard coded (well, their names anyway). + sglfVar => VariableGet(Model % mesh % Variables,TRIM("Sheet GL flux"),UnFoundFatal=.TRUE.) + IF (.NOT.ASSOCIATED(sglfVar)) & + CALL FATAL(SolverName,"Variable >Sheet GL flux< not found") + sglfPerm => sglfVar % Perm + sglfVals => sglfVar % Values + cglfVar => VariableGet(Model % mesh % Variables,TRIM("Channel GL flux"),UnFoundFatal=.TRUE.) + IF (.NOT.ASSOCIATED(cglfVar)) & + CALL FATAL(SolverName,"Variable >Channel GL flux< not found") + cglfPerm => cglfVar % Perm + cglfVals => cglfVar % Values + + ! Loop over all nodes + numNodes = Solver % Mesh % Nodes % NumberOfNodes + DO nn = 1, numNodes + + ! We're interested in nodes where the grounded mask is both defined (non-zero permutation) + ! and has value set to zero (the grounding line). + IF (gmPerm(nn).le.0) CYCLE + IF (gmVals(gmPerm(nn)).eq.0) THEN + + ! Sheet discharge multiplied by sheet thickness gives the volume flux from the sheet. + ! We're hard conding the assumption that the sheet discharge is always a 2D vector, + ! which should be safe so long as we always run GlaDS in 2D. + sheetDisMag = ( sheetDisVals( 2*(sheetDisPerm(nn)-1)+1 )**2.0 + & + sheetDisVals( 2*(sheetDisPerm(nn)-1)+2 )**2.0 )**0.5 + volFluxSheet = sheetThickVals(sheetThickPerm(nn)) * sheetDisMag + + volFluxChannel = 0.0 + + ! work out channel flux. + ! loop over all edges... + DO ee=1, Solver % Mesh % NumberOfEdges + Edge => Solver % Mesh % Edges(ee) + IF (.NOT.ASSOCIATED(Edge)) CYCLE + ! ...ignoring edges not entirely on the lower surface... + IF (ANY(gmPerm(Edge % NodeIndexes(1:2)).EQ.0)) CYCLE + ! ... and check whether the edge contains the current node. If so, check whether the + ! other node is grounded. If yes, the edge is valid for calculating GL flux. + ValidEdge = .FALSE. + IF (Edge % NodeIndexes(1).EQ.nn) THEN + IF (gmVals(gmPerm(Edge % NodeIndexes(2))).EQ.1) ValidEdge = .TRUE. + ELSEIF (Edge % NodeIndexes(2).EQ.nn) THEN + IF (gmVals(gmPerm(Edge % NodeIndexes(1))).EQ.1) ValidEdge = .TRUE. + END IF + ! Sum channel flux over valid edges + IF (ValidEdge) THEN + IF (Solver % Mesh % ParallelInfo % EdgeInterface(ee)) THEN + ! halve value for edges at partition boundaries because these will be + ! counted twice + volFluxChannel = volFluxChannel + 0.5*channelVals(channelPerm(numNodes+ee)) + ELSE + volFluxChannel = volFluxChannel + channelVals(channelPerm(numNodes+ee)) + END IF + END IF + END DO + + cglfVals(cglfPerm(nn)) = volFluxChannel + sglfVals(sglfPerm(nn)) = volFluxSheet + + END IF + + END DO + + ! Sum nodal values for nodes that exist on multiple partitions + CALL ParallelSumVector(Solver % Matrix, cglfVals) + + DO nn = 1, numNodes + IF (gmPerm(nn).le.0) CYCLE +! IF (gmVals(gmPerm(nn)).eq.0) GLfluxVals(GLfluxPerm(nn)) = volFluxSheet + volFluxChannel + IF (gmVals(gmPerm(nn)).eq.0) GLfluxVals(GLfluxPerm(nn)) = & + cglfVals(cglfPerm(nn)) + sglfVals(sglfPerm(nn)) + END DO + + NULLIFY(SolverParams) + NULLIFY(GLfluxVals) + NULLIFY(GLfluxPerm) + NULLIFY(gmVals) + NULLIFY(gmPerm) + NULLIFY(sheetDisVals) + NULLIFY(sheetDisPerm) + NULLIFY(sheetThickVals) + NULLIFY(sheetThickPerm) + NULLIFY(channelVals) + NULLIFY(channelPerm) + +END SUBROUTINE GlaDS_GLflux + +! Different ways of calculating a grounded melt rate to pass to GlaDS as a +! volume source. +! +! Notes when using this with a 3D Stokes setup: +! +! Convert a nodal heat to a melt rate at the lower surface of an ice body. +! Uses nodal weights (area weighting) to convert the nodal heat to heat per +! unit area, then convert this to a melt rate. This solver should run on the +! lower surface only. The calculated melt rate is in m/a water equivalent (so +! if you want to use this as a normal velocity condition on the lower surface +! of the ice body you need to use rho_i to convert to m/a ice equivalent). +! +! Note that the nodal heat could be the residual from the temperate ice solver +! or it could come from the friction load (though this ignores GHF and heat +! conducted into the ice, which may approximately balance each other out...). +! +! [Edit: CalculateNodalWeights gives partition boundary artefacts, but the +! forcetostress solver seems to produce weights without these artefacts] +! +! Example .sif parameters: +! +! Constants: +! Latent Heat = 334000.0 ! Joules per kg +! +! solver params: +! variable = GroundedMeltRate +! Mode = "NodalHeat" +! heat variable name = String "Friction Load" +! Weights variable name = String "Friction heating boundary weights" +! +! +! Notes when using this with a 2D SSA setup: +! +! Assuming we don't have nodal heat, we can calculate a friction heat if we +! know about the sliding law and the relevant parameters + + Grounded Melt = Variable ssavelocity 1, ssavelocity 2, beta + Real lua "((tx[0]^2.0+tx[1]^2.0)*10.0^tx[2])/(rhoi*Lf)" + + SSA Mean Density = Real #rhoi + + +! Which law are we using (linear, weertman , coulomb or regularised coulomb) + SSA Friction Law = String "coulomb" + SSA Friction Parameter = Variable "Coulomb As" + Real Lua "tx[0]^(-1/3)" + SSA Friction Maximum Value = Equals "Coulomb C" + SSA Friction Post-Peak = Real 1.0 + SSA Friction Exponent = Real #1.0/n + + +RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) + + USE DefUtils + + IMPLICIT NONE + !------------------------------------------------------------------------------ + ! External variables + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + TYPE(Solver_t), TARGET :: Solver + LOGICAL :: TransientSimulation + REAL(KIND=dp) :: Timestep + + !------------------------------------------------------------------------------ + ! Local variables + !------------------------------------------------------------------------------ + TYPE(ValueList_t), POINTER :: SolverParams + TYPE(Variable_t), POINTER :: MeltVar, WeightsVar, HeatVar, GHFVar + LOGICAL, SAVE :: FirstTime = .TRUE., UseGHF = .FALSE. + LOGICAL :: Found + CHARACTER(LEN=MAX_NAME_LEN) :: MyName = 'GroundedMelt solver', HeatVarName, WeightsVarName, GHFvarName + REAL(KIND=dp),PARAMETER :: rho = 1000.0_dp ! density of pure water + REAL(KIND=dp),PARAMETER :: threshold = 0.001_dp ! threshold friction melt rate for including GHF in melt calc + REAL(KIND=dp), POINTER :: WtVals(:), HeatVals(:), MeltVals(:), GHFVals(:) + REAL(KIND=dp) :: LatHeat, GHFscaleFactor + INTEGER, POINTER :: WtPerm(:), HeatPerm(:), MeltPerm(:), GHFPerm(:) + INTEGER :: nn + + ! IF (FirstTime) THEN + ! CALL CalculateNodalWeights(Solver, .FALSE., VarName='Weights') + ! CALL CalculateNodalWeights(Solver, .FALSE.) + ! CALL CalculateNodalWeights(Solver, .TRUE.) + ! FirstTime = .FALSE. + ! END IF + + SolverParams => GetSolverParams() + + GHFvarName = GetString(SolverParams,'GHF variable name', Found) + IF (Found) THEN + UseGHF = .TRUE. + GHFscaleFactor = GetConstReal( Model % Constants, 'GHF scale factor', Found) + IF(.NOT.Found) GHFscaleFactor = 1.0 + ELSE + UseGHF = .FALSE. + END IF + + LatHeat = GetConstReal( Model % Constants, 'Latent Heat', Found) + IF(.NOT.Found) CALL Fatal(MyName, '>Latent Heat< not found in constants') + + HeatVarName = GetString(SolverParams,'heat variable name', Found) + IF(.NOT.Found) CALL Fatal(MyName, '>Heat variable name< not found in solver params') + WeightsVarName = GetString(SolverParams,'Weights variable name', Found) + IF(.NOT.Found) CALL Fatal(MyName, '>Weights variable name< not found in solver params') + + IF (UseGHF) THEN + GHFVar => VariableGet(Model % Variables, GHFvarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + GHFVals => GHFVar%Values + GHFPerm => GHFVar%Perm + END IF + + HeatVar => VariableGet(Model % Variables, HeatVarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + HeatVals => HeatVar%Values + HeatPerm => HeatVar%Perm + + WeightsVar => VariableGet(Model % Variables, WeightsVarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + WtVals => WeightsVar%Values + WtPerm => WeightsVar%Perm + + MeltVar => Solver%Variable + MeltVals => MeltVar%Values + MeltPerm => MeltVar%Perm + + LoopAllNodes: DO nn=1,Solver % Mesh % NumberOfNodes + + ! + ! MeltRate = Heat / (area * density * latent_heat) + ! + ! Heat is Mega Joules per year. + ! We multiply by 10^6 to convert from Mega Joules to Joules. + ! + IF (MeltPerm(nn).GT.0) THEN + MeltVals(MeltPerm(nn)) = ABS( 1.0e6 * HeatVals(HeatPerm(nn)) ) / ( WtVals(WtPerm(nn)) * rho * LatHeat ) + IF (UseGHF) THEN + ! Scaled GHF is in Mega Joules per m^2 per year. + MeltVals(MeltPerm(nn)) = MeltVals(MeltPerm(nn)) + & + ( GHFVals(GHFPerm(nn))*GHFscaleFactor*1.0e6 ) / ( rho*LatHeat ) + END IF + END IF + + END DO LoopAllNodes + + NULLIFY(HeatVar, HeatVals, HeatPerm, WeightsVar, WtVals, WtPerm, MeltVar, MeltVals, MeltPerm) + IF (UseGHF) THEN + NULLIFY(GHFVar, GHFVals, GHFPerm) + END IF + +END SUBROUTINE GroundedMelt From c26a49d544b6ff66893fb671c6dda8cec07c236e Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 31 Jan 2024 11:51:28 +0200 Subject: [PATCH 02/51] Renamed "workvar" to human readable names --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 134 ++++++++++++------------ 1 file changed, 68 insertions(+), 66 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 2719b61dd4..664264e225 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -72,7 +72,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati TYPE(Nodes_t) :: ElementNodes, EdgeNodes TYPE(Element_t), POINTER :: Element, Edge, Face, Bulk TYPE(ValueList_t), POINTER :: Equation, Material, SolverParams, BodyForce, BC, Constants - TYPE(Variable_t), POINTER :: WorkVar, WorkVar2 + TYPE(Variable_t), POINTER :: ChannelAreaVar, ChannelFluxVar, SheetThicknessVar, GMcheckVar, GroundedMaskVar TYPE(Mesh_t), POINTER :: Mesh INTEGER :: i, j, k, l, m, n, t, iter, body_id, eq_id, material_id, & @@ -297,7 +297,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !------------------------------------------------------------------------------ ! Read physical and numerical constants and initialize !------------------------------------------------------------------------------ - IF (FirstTime) THEN + FirstTime: IF (FirstTime) THEN FirstTime = .FALSE. Constants => GetConstants() @@ -344,38 +344,40 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !doing calving and hydrology and consequently having many meshes Calving = ListGetLogical(Model % Simulation, 'Calving', Found) IF(.NOT.Found) Calving = .FALSE. - IF(Calving) THEN + Calving: IF(Calving) THEN DO i=1,Model % NumberOfSolvers IF(Model % Solvers(i) % Variable % Name == ChannelAreaName) THEN ChannelSolver = i EXIT END IF END DO - WorkVar => VariableGet(Model % Solvers(ChannelSolver) % Mesh& + ChannelAreaVar => VariableGet(Model % Solvers(ChannelSolver) % Mesh& % Variables, ChannelAreaName, ThisOnly=.TRUE.) - ALLOCATE(CAPerm(SIZE(WorkVar % Perm)), CAValues(SIZE(WorkVar % Values))) - CAPerm = WorkVar % Perm - CAValues = WorkVar % Values + ALLOCATE(CAPerm(SIZE(ChannelAreaVar % Perm)), CAValues(SIZE(ChannelAreaVar % Values))) + CAPerm = ChannelAreaVar % Perm + CAValues = ChannelAreaVar % Values CALL VariableAdd(Mesh % Variables, Mesh, Solver,& 'Channel Area', 1, CAValues, CAPerm) - WorkVar => VariableGet(Mesh % Variables, 'Channel Area',& + ChannelAreaVar => VariableGet(Mesh % Variables, 'Channel Area',& ThisOnly=.TRUE.) - ALLOCATE(WorkVar % PrevValues(SIZE(WorkVar % Values),MAX(Solver& + ALLOCATE(ChannelAreaVar % PrevValues(SIZE(ChannelAreaVar % Values),MAX(Solver& % Order, Solver % TimeOrder))) - WorkVar % PrevValues(:,1) = WorkVar % Values + ChannelAreaVar % PrevValues(:,1) = ChannelAreaVar % Values + NULLIFY(ChannelAreaVar) - WorkVar => VariableGet(Model % Solvers(ChannelSolver) % Mesh& + ChannelFluxVar => VariableGet(Model % Solvers(ChannelSolver) % Mesh& % Variables, 'Channel Flux', ThisOnly=.TRUE.) - ALLOCATE(CFPerm(SIZE(WorkVar % Perm)), CFValues(SIZE(WorkVar % Values))) - CFPerm = WorkVar % Perm - CFValues = WorkVar % Values + ALLOCATE(CFPerm(SIZE(ChannelFluxVar % Perm)), CFValues(SIZE(ChannelFluxVar % Values))) + CFPerm = ChannelFluxVar % Perm + CFValues = ChannelFluxVar % Values CALL VariableAdd(Mesh % Variables, Mesh, Solver,& 'Channel Flux', 1, CFValues, CFPerm) - WorkVar => VariableGet(Mesh % Variables, 'Channel Flux',& + ChannelFluxVar => VariableGet(Mesh % Variables, 'Channel Flux',& ThisOnly=.TRUE.) - ALLOCATE(WorkVar % PrevValues(SIZE(WorkVar % Values),MAX(Solver& + ALLOCATE(ChannelFluxVar % PrevValues(SIZE(ChannelFluxVar % Values),MAX(Solver& % Order, Solver % TimeOrder))) - WorkVar % PrevValues(:,1) = WorkVar % Values + ChannelFluxVar % PrevValues(:,1) = ChannelFluxVar % Values + NULLIFY(ChannelFluxVar) !The same for sheet thickness DO i=1,Model % NumberOfSolvers @@ -384,22 +386,22 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati EXIT END IF END DO - WorkVar => VariableGet(Model % Solvers(ThicknessSolver) % Mesh& + SheetThicknessVar => VariableGet(Model % Solvers(ThicknessSolver) % Mesh& % Variables, SheetThicknessName, ThisOnly=.TRUE.) - ALLOCATE(SHPerm(SIZE(WorkVar % Perm)), SHValues(SIZE(WorkVar % Values))) - SHPerm = WorkVar % Perm - SHValues = WorkVar % Values !Needed to reflect initial condition + ALLOCATE(SHPerm(SIZE(SheetThicknessVar % Perm)), SHValues(SIZE(SheetThicknessVar % Values))) + SHPerm = SheetThicknessVar % Perm + SHValues = SheetThicknessVar % Values !Needed to reflect initial condition CALL VariableAdd(Mesh % Variables, Mesh, Solver,& 'Sheet Thickness', 1, SHValues, SHPerm) - WorkVar => VariableGet(Mesh % Variables, 'Sheet Thickness',& + SheetThicknessVar => VariableGet(Mesh % Variables, 'Sheet Thickness',& ThisOnly=.TRUE.) - ALLOCATE(WorkVar % PrevValues(SIZE(WorkVar % Values),MAX(Solver& + ALLOCATE(SheetThicknessVar % PrevValues(SIZE(SheetThicknessVar % Values),MAX(Solver& % Order, Solver % TimeOrder))) - WorkVar % PrevValues(:,1) = WorkVar % Values + SheetThicknessVar % PrevValues(:,1) = SheetThicknessVar % Values !Necessary to ensure initial condition value reflected in PrevValues - WorkVar % PrevValues(:,1) = WorkVar % Values - NULLIFY(WorkVar) - END IF + SheetThicknessVar % PrevValues(:,1) = SheetThicknessVar % Values + NULLIFY(SheetThicknessVar) + END IF Calving ! TODO : implement higher order BDF method BDForder = GetInteger(GetSimulation(),'BDF Order', Found) @@ -408,7 +410,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati WRITE(Message,'(a)') 'Only working for BDF = 1' CALL FATAL(SolverName, Message) END IF - END IF ! FirstTime + END IF FirstTime SolverParams => GetSolverParams() @@ -1079,12 +1081,12 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !hydrology variables IF(Calving) THEN CycleElement = .FALSE. - WorkVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - WorkVar2 => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(WorkVar)) THEN + GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + IF(ASSOCIATED(GMcheckVar)) THEN DO i=1, N - IF(WorkVar % Values(WorkVar % Perm(Element % NodeIndexes(i)))>0.0) THEN - !IF(WorkVar2 % Values(WorkVar2 % Perm(Element % NodeIndexes(i)))<0.0) THEN + IF(GMcheckVar % Values(GMcheckVar % Perm(Element % NodeIndexes(i)))>0.0) THEN + !IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. WSolution(WPerm(Element % NodeIndexes(i))) = 0.0 @@ -1096,9 +1098,9 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END IF END DO END IF - IF(ASSOCIATED(WorkVar2) .AND. .NOT. ASSOCIATED(WorkVar)) THEN + IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN DO i=1, N - IF(WorkVar2 % Values(WorkVar2 % Perm(Element % NodeIndexes(i)))<0.0) THEN + IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. WSolution(WPerm(Element % NodeIndexes(i))) = 0.0 @@ -1109,7 +1111,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END IF END DO END IF - NULLIFY(WorkVar, WorkVar2) + NULLIFY(GMcheckVar, GroundedMaskVar) IF(CycleElement) CYCLE END IF @@ -1170,29 +1172,29 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !hydrology variables IF(Calving) THEN CycleElement = .FALSE. - WorkVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - WorkVar2 => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(WorkVar)) THEN - IF(WorkVar % Values(k)>0.0) THEN !.AND. WorkVar2 % Values(k)<0.0) THEN + GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + IF(ASSOCIATED(GMcheckVar)) THEN + IF(GMcheckVar % Values(k)>0.0) THEN !.AND. GroundedMaskVar % Values(k)<0.0) THEN CycleElement = .TRUE. ThickSolution(k) = 0.0 ThickPrev(k,1) = 0.0 END IF END IF - IF(ASSOCIATED(WorkVar2) .AND. .NOT. ASSOCIATED(WorkVar)) THEN - IF(WorkVar2 % Values(k)<0.0) THEN + IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN + IF(GroundedMaskVar % Values(k)<0.0) THEN CycleElement = .TRUE. ThickSolution(k) = 0.0 ThickPrev(k,1) = 0.0 END IF END IF - WorkVar => VariableGet(Mesh % Variables, "hydraulic potential", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(WorkVar % Values(k)==0.0) THEN + GMcheckVar => VariableGet(Mesh % Variables, "hydraulic potential", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + IF(GMcheckVar % Values(k)==0.0) THEN ThickSolution(k) = 0.0 ThickPrev(k,1) = 0.0 CycleElement = .TRUE. END IF - NULLIFY(WorkVar, WorkVar2) + NULLIFY(GMcheckVar, GroundedMaskVar) IF(CycleElement) CYCLE END IF @@ -1260,12 +1262,12 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !hydrology variables IF(Calving) THEN CycleElement = .FALSE. - WorkVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - WorkVar2 => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(WorkVar)) THEN + GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + IF(ASSOCIATED(GMcheckVar)) THEN DO i=1, n - IF(WorkVar % Values(WorkVar % Perm(Edge % NodeIndexes(i)))>0.0) THEN - !IF(WorkVar2 % Values(WorkVar2 % Perm(Edge % NodeIndexes(i)))<0.0) THEN + IF(GMcheckVar % Values(GMcheckVar % Perm(Edge % NodeIndexes(i)))>0.0) THEN + !IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Edge % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. AreaSolution(AreaPerm(M+t)) = 0.0 QcSolution(QcPerm(M+t)) = 0.0 @@ -1273,16 +1275,16 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END IF END DO END IF - IF(ASSOCIATED(WorkVar2) .AND. .NOT. ASSOCIATED(WorkVar)) THEN + IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN DO i=1,n - IF(WorkVar2 % Values(WorkVar2 % Perm(Edge % NodeIndexes(i)))<0.0) THEN + IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Edge % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. AreaSolution(AreaPerm(M+t)) = 0.0 QcSolution(QcPerm(M+t)) = 0.0 END IF END DO END IF - NULLIFY(WorkVar, WorkVar2) + NULLIFY(GMcheckVar, GroundedMaskVar) IF(CycleElement) CYCLE END IF @@ -1500,12 +1502,12 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !hydrology variables IF(Calving) THEN CycleElement = .FALSE. - WorkVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - WorkVar2 => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(WorkVar)) THEN + GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + IF(ASSOCIATED(GMcheckVar)) THEN DO i=1, n - IF(WorkVar % Values(WorkVar % Perm(Element % NodeIndexes(i)))>0.0) THEN - !IF(WorkVar2 % Values(WorkVar2 % Perm(Element % NodeIndexes(i)))<0.0) THEN + IF(GMcheckVar % Values(GMcheckVar % Perm(Element % NodeIndexes(i)))>0.0) THEN + !IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. DO j=1,dimSheet k = dimSheet*(qPerm(Element % NodeIndexes(i))-1)+j @@ -1517,9 +1519,9 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END IF END DO END IF - IF(ASSOCIATED(WorkVar2) .AND. .NOT. ASSOCIATED(WorkVar)) THEN + IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN DO i=1,n - IF(WorkVar2 % Values(WorkVar2 % Perm(Element % NodeIndexes(i)))<0.0) THEN + IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. DO j=1,dimSheet k = dimSheet*(qPerm(Element % NodeIndexes(i))-1)+j @@ -1530,7 +1532,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END IF END DO END IF - NULLIFY(WorkVar, WorkVar2) + NULLIFY(GMcheckVar, GroundedMaskVar) IF(CycleElement) CYCLE END IF @@ -1572,11 +1574,11 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !CHANGE - to make sure PrevValues for added variables in calving updated IF(Calving) THEN - WorkVar => VariableGet(Mesh % Variables, 'Sheet Thickness',ThisOnly=.TRUE.) - WorkVar % PrevValues(:,1) = WorkVar % Values - WorkVar => VariableGet(Mesh % Variables, 'Channel Area',ThisOnly=.TRUE.) - WorkVar % PrevValues(:,1) = WorkVar % Values - NULLIFY(WorkVar) + SheetThicknessVar => VariableGet(Mesh % Variables, 'Sheet Thickness',ThisOnly=.TRUE.) + SheetThicknessVar % PrevValues(:,1) = SheetThicknessVar % Values + ChannelAreaVar => VariableGet(Mesh % Variables, 'Channel Area',ThisOnly=.TRUE.) + ChannelAreaVar % PrevValues(:,1) = ChannelAreaVar % Values + NULLIFY(SheetThicknessVar, ChannelAreaVar) END IF CONTAINS From e3ea43f95dc5708f4960a8776d85d2bcbc72ef1d Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 31 Jan 2024 13:45:32 +0200 Subject: [PATCH 03/51] tidying up "cycelement" decisions --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 92 +++++++++++++------------ 1 file changed, 47 insertions(+), 45 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 664264e225..5cd6f364d1 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -72,7 +72,8 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati TYPE(Nodes_t) :: ElementNodes, EdgeNodes TYPE(Element_t), POINTER :: Element, Edge, Face, Bulk TYPE(ValueList_t), POINTER :: Equation, Material, SolverParams, BodyForce, BC, Constants - TYPE(Variable_t), POINTER :: ChannelAreaVar, ChannelFluxVar, SheetThicknessVar, GMcheckVar, GroundedMaskVar + TYPE(Variable_t), POINTER :: ChannelAreaVar, ChannelFluxVar, SheetThicknessVar, & + GMcheckVar, GroundedMaskVar, HydPotVar TYPE(Mesh_t), POINTER :: Mesh INTEGER :: i, j, k, l, m, n, t, iter, body_id, eq_id, material_id, & @@ -89,6 +90,9 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati qPerm(:), hstorePerm(:), QcPerm(:), QmPerm(:),& CAPerm(:), CFPerm(:), SHPerm(:) + INTEGER, SAVE :: MaskMode ! which mask(s) to use, detrmined by UseGM and UseGC + INTEGER, PARAMETER, SAVE :: NoMask = 0, GMonly = 1, GConly = 2, GMandGC = 3 + REAL(KIND=dp), POINTER :: HydPot(:), HydPotPrev(:,:), ForceVector(:) REAL(KIND=dp), POINTER :: ThickSolution(:), ThickPrev(:,:), VSolution(:), WSolution(:), & NSolution(:), PwSolution(:), AreaSolution(:), AreaPrev(:,:), ZbSolution(:), & @@ -103,7 +107,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati AllocationsDone = .FALSE., SubroutineVisited = .FALSE., & meltChannels = .TRUE., NeglectH = .TRUE., Calving = .FALSE., & CycleElement=.FALSE., MABool = .FALSE., MaxHBool = .FALSE., LimitEffPres=.FALSE., & - MinHBool=.FALSE. + MinHBool=.FALSE., UseGM=.FALSE., UseGC=.FALSE. LOGICAL, ALLOCATABLE :: IsGhostNode(:), NoChannel(:), NodalNoChannel(:) REAL(KIND=dp) :: NonlinearTol, dt, CumulativeTime, RelativeChange, & @@ -297,7 +301,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !------------------------------------------------------------------------------ ! Read physical and numerical constants and initialize !------------------------------------------------------------------------------ - FirstTime: IF (FirstTime) THEN + IfFirstTime: IF (FirstTime) THEN FirstTime = .FALSE. Constants => GetConstants() @@ -344,7 +348,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !doing calving and hydrology and consequently having many meshes Calving = ListGetLogical(Model % Simulation, 'Calving', Found) IF(.NOT.Found) Calving = .FALSE. - Calving: IF(Calving) THEN + IfCalving: IF(Calving) THEN DO i=1,Model % NumberOfSolvers IF(Model % Solvers(i) % Variable % Name == ChannelAreaName) THEN ChannelSolver = i @@ -401,7 +405,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !Necessary to ensure initial condition value reflected in PrevValues SheetThicknessVar % PrevValues(:,1) = SheetThicknessVar % Values NULLIFY(SheetThicknessVar) - END IF Calving + END IF IfCalving ! TODO : implement higher order BDF method BDForder = GetInteger(GetSimulation(),'BDF Order', Found) @@ -410,7 +414,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati WRITE(Message,'(a)') 'Only working for BDF = 1' CALL FATAL(SolverName, Message) END IF - END IF FirstTime + END IF IfFirstTime SolverParams => GetSolverParams() @@ -1047,7 +1051,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !------------------------------------------------------------------------------ ! Update the Sheet Thickness !------------------------------------------------------------------------------ - DO t=1,Solver % NumberOfActiveElements + Elements: DO t=1,Solver % NumberOfActiveElements Element => GetActiveElement(t,Solver) IF (ParEnv % myPe /= Element % partIndex) CYCLE @@ -1088,7 +1092,6 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF(GMcheckVar % Values(GMcheckVar % Perm(Element % NodeIndexes(i)))>0.0) THEN !IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. - WSolution(WPerm(Element % NodeIndexes(i))) = 0.0 Vvar(Element % NodeIndexes(i)) = 0.0 NSolution(NPerm(Element % NodeIndexes(i))) = 0.0 @@ -1096,13 +1099,12 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati hstoreSolution(hstorePerm(Element % NodeIndexes(i))) = 0.0 !END IF END IF - END DO + END DO END IF IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN DO i=1, N IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. - WSolution(WPerm(Element % NodeIndexes(i))) = 0.0 Vvar(Element % NodeIndexes(i)) = 0.0 NSolution(NPerm(Element % NodeIndexes(i))) = 0.0 @@ -1112,8 +1114,10 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END DO END IF NULLIFY(GMcheckVar, GroundedMaskVar) - IF(CycleElement) CYCLE - END IF + IF (CycleElement) THEN + CYCLE + END IF + END IF CALL GetParametersSheet( Element, Material, N, SheetConductivity, alphas, & betas, Ev, ub, Snn, lr, hr, Ar, ng ) @@ -1162,7 +1166,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF (ASSOCIATED(PwSol)) PwSolution(PwPerm(j)) = pw IF (ASSOCIATED(hstoreSol)) hstoreSolution(hstorePerm(j)) = he END DO - END DO ! Bulk elements + END DO Elements ! Bulk elements ! Loop over all nodes to update ThickSolution DO j = 1, Mesh % NumberOfNodes k = ThickPerm(j) @@ -1177,26 +1181,24 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF(ASSOCIATED(GMcheckVar)) THEN IF(GMcheckVar % Values(k)>0.0) THEN !.AND. GroundedMaskVar % Values(k)<0.0) THEN CycleElement = .TRUE. - ThickSolution(k) = 0.0 - ThickPrev(k,1) = 0.0 END IF END IF IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN IF(GroundedMaskVar % Values(k)<0.0) THEN CycleElement = .TRUE. - ThickSolution(k) = 0.0 - ThickPrev(k,1) = 0.0 END IF END IF - GMcheckVar => VariableGet(Mesh % Variables, "hydraulic potential", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(GMcheckVar % Values(k)==0.0) THEN + HydPotVar => VariableGet(Mesh % Variables, "hydraulic potential", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + IF(HydPotVar % Values(k)==0.0) THEN + CycleElement = .TRUE. + END IF + NULLIFY(GMcheckVar, GroundedMaskVar, HydPotVar) + IF(CycleElement) THEN ThickSolution(k) = 0.0 ThickPrev(k,1) = 0.0 - CycleElement = .TRUE. + CYCLE END IF - NULLIFY(GMcheckVar, GroundedMaskVar) - IF(CycleElement) CYCLE - END IF + END IF IF(MaxHBool) THEN IF (ThickSolution(k)>MaxH) THEN @@ -1247,7 +1249,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati PrevNorm = ChannelAreaNorm() DO iter = 1, NonlinearIter - DO t=1, Mesh % NumberOfEdges + Edges: DO t=1, Mesh % NumberOfEdges Edge => Mesh % Edges(t) IF (.NOT.ASSOCIATED(Edge)) CYCLE IF (ParEnv % PEs > 1) THEN @@ -1269,8 +1271,6 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF(GMcheckVar % Values(GMcheckVar % Perm(Edge % NodeIndexes(i)))>0.0) THEN !IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Edge % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. - AreaSolution(AreaPerm(M+t)) = 0.0 - QcSolution(QcPerm(M+t)) = 0.0 !END IF END IF END DO @@ -1279,14 +1279,16 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati DO i=1,n IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Edge % NodeIndexes(i)))<0.0) THEN CycleElement = .TRUE. - AreaSolution(AreaPerm(M+t)) = 0.0 - QcSolution(QcPerm(M+t)) = 0.0 END IF END DO END IF NULLIFY(GMcheckVar, GroundedMaskVar) - IF(CycleElement) CYCLE - END IF + IF(CycleElement) THEN + CYCLE + AreaSolution(AreaPerm(M+t)) = 0.0 + QcSolution(QcPerm(M+t)) = 0.0 + END IF + END IF EdgeNodes % x(1:n) = Mesh % Nodes % x(Edge % NodeIndexes(1:n)) EdgeNodes % y(1:n) = Mesh % Nodes % y(Edge % NodeIndexes(1:n)) @@ -1407,8 +1409,8 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF ( QcPerm(M+t) <= 0 ) CYCLE QcSolution(QcPerm(M+t)) = Qc END IF - END DO - + END DO Edges + Norm = ChannelAreaNorm() t = Mesh % NumberOfEdges @@ -2669,20 +2671,20 @@ END SUBROUTINE GlaDS_GLflux ! ! Assuming we don't have nodal heat, we can calculate a friction heat if we ! know about the sliding law and the relevant parameters - - Grounded Melt = Variable ssavelocity 1, ssavelocity 2, beta - Real lua "((tx[0]^2.0+tx[1]^2.0)*10.0^tx[2])/(rhoi*Lf)" - - SSA Mean Density = Real #rhoi - - +! +! Grounded Melt = Variable ssavelocity 1, ssavelocity 2, beta +! Real lua "((tx[0]^2.0+tx[1]^2.0)*10.0^tx[2])/(rhoi*Lf)" +! +! SSA Mean Density = Real #rhoi +! +! ! Which law are we using (linear, weertman , coulomb or regularised coulomb) - SSA Friction Law = String "coulomb" - SSA Friction Parameter = Variable "Coulomb As" - Real Lua "tx[0]^(-1/3)" - SSA Friction Maximum Value = Equals "Coulomb C" - SSA Friction Post-Peak = Real 1.0 - SSA Friction Exponent = Real #1.0/n +! SSA Friction Law = String "coulomb" +! SSA Friction Parameter = Variable "Coulomb As" +! Real Lua "tx[0]^(-1/3)" +! SSA Friction Maximum Value = Equals "Coulomb C" +! SSA Friction Post-Peak = Real 1.0 +! SSA Friction Exponent = Real #1.0/n RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) From 53ba4c7466d0eb357412b85be67f0fb050e8ca40 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 31 Jan 2024 14:21:18 +0200 Subject: [PATCH 04/51] Adding new switches (not active yet)... --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 53 ++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 2 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 5cd6f364d1..7a66e50736 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -91,7 +91,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CAPerm(:), CFPerm(:), SHPerm(:) INTEGER, SAVE :: MaskMode ! which mask(s) to use, detrmined by UseGM and UseGC - INTEGER, PARAMETER, SAVE :: NoMask = 0, GMonly = 1, GConly = 2, GMandGC = 3 + INTEGER, PARAMETER :: NoMask = 0, GMonly = 1, GConly = 2, GMandGC = 3 REAL(KIND=dp), POINTER :: HydPot(:), HydPotPrev(:,:), ForceVector(:) REAL(KIND=dp), POINTER :: ThickSolution(:), ThickPrev(:,:), VSolution(:), WSolution(:), & @@ -107,7 +107,8 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati AllocationsDone = .FALSE., SubroutineVisited = .FALSE., & meltChannels = .TRUE., NeglectH = .TRUE., Calving = .FALSE., & CycleElement=.FALSE., MABool = .FALSE., MaxHBool = .FALSE., LimitEffPres=.FALSE., & - MinHBool=.FALSE., UseGM=.FALSE., UseGC=.FALSE. + MinHBool=.FALSE. + LOGICAL, SAVE :: UseGM, UseGC, ZeroSheetAtGL, ZeroSheetWithHP LOGICAL, ALLOCATABLE :: IsGhostNode(:), NoChannel(:), NodalNoChannel(:) REAL(KIND=dp) :: NonlinearTol, dt, CumulativeTime, RelativeChange, & @@ -348,6 +349,54 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati !doing calving and hydrology and consequently having many meshes Calving = ListGetLogical(Model % Simulation, 'Calving', Found) IF(.NOT.Found) Calving = .FALSE. + + ! Default behaviour relating to marine ice sheets and unglaciated grounded areas is to set the + ! following switches to false. The defaults change to true when using Samuel Cook's "Calving" + ! (set in simulation seciton of sif). The defaults will be overwritten for each of the switches + ! that are specified in the solver section of the sif. + + UseGM = GetLogical( SolverParams,'Use GroundedMask', Found ) + IF (.NOT. Found) THEN + IF (Calving) THEN + UseGM = .TRUE. + ELSE + UseGM = .FALSE. + END IF + END IF + + UseGC = GetLogical( SolverParams,'Use GMcheck', Found ) + IF (.NOT. Found) THEN + IF (Calving) THEN + UseGC = .TRUE. + ELSE + UseGC = .FALSE. + END IF + END IF + + ZeroSheetAtGL = GetLogical( SolverParams,'Zero Sheet At GL', Found ) + IF (.NOT. Found) THEN + IF (Calving) THEN + ZeroSheetAtGL = .TRUE. + ELSE + ZeroSheetAtGL = .FALSE. + END IF + END IF + + ZeroSheetWithHP = GetLogical( SolverParams,'Zero Sheet With HP', Found ) + IF (.NOT. Found) THEN + IF (Calving) THEN + ZeroSheetWithHP = .TRUE. + ELSE + ZeroSheetWithHP = .FALSE. + END IF + END IF + + ! set mask mode based on above switches + MaskMode = NoMask + If (UseGM) MaskMode = GMonly + If (UseGC) MaskMode = GConly + If (UseGM.AND.UseGC) MaskMode = GMandGC + IfCalving: IF(Calving) THEN DO i=1,Model % NumberOfSolvers IF(Model % Solvers(i) % Variable % Name == ChannelAreaName) THEN From c9f2a19329cae25467c806d8e44764f7f1f96484 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Mon, 5 Feb 2024 14:32:18 +0200 Subject: [PATCH 05/51] New switches implemented for "calving", and masking code moved to function. --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 340 +++++++++++++----------- 1 file changed, 178 insertions(+), 162 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 7a66e50736..edd64b9cd8 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -90,9 +90,6 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati qPerm(:), hstorePerm(:), QcPerm(:), QmPerm(:),& CAPerm(:), CFPerm(:), SHPerm(:) - INTEGER, SAVE :: MaskMode ! which mask(s) to use, detrmined by UseGM and UseGC - INTEGER, PARAMETER :: NoMask = 0, GMonly = 1, GConly = 2, GMandGC = 3 - REAL(KIND=dp), POINTER :: HydPot(:), HydPotPrev(:,:), ForceVector(:) REAL(KIND=dp), POINTER :: ThickSolution(:), ThickPrev(:,:), VSolution(:), WSolution(:), & NSolution(:), PwSolution(:), AreaSolution(:), AreaPrev(:,:), ZbSolution(:), & @@ -107,10 +104,16 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati AllocationsDone = .FALSE., SubroutineVisited = .FALSE., & meltChannels = .TRUE., NeglectH = .TRUE., Calving = .FALSE., & CycleElement=.FALSE., MABool = .FALSE., MaxHBool = .FALSE., LimitEffPres=.FALSE., & - MinHBool=.FALSE. + MinHBool=.FALSE., CycleNode=.FALSE. LOGICAL, SAVE :: UseGM, UseGC, ZeroSheetAtGL, ZeroSheetWithHP LOGICAL, ALLOCATABLE :: IsGhostNode(:), NoChannel(:), NodalNoChannel(:) + ! For use in masking GlaDS floating shelves. "MASK_HP" is for situations where + ! Hydraulic potential should be set to zero but not the sheet thickness. This is + ! to allow non zero sheet outflow across the grounding line. + INTEGER :: MaskStatus + INTEGER, PARAMETER :: MASK_ALL = 0, MASK_NONE = 1, MASK_HP = 2 + REAL(KIND=dp) :: NonlinearTol, dt, CumulativeTime, RelativeChange, & Norm, PrevNorm, S, C, Qc, MaxArea, MaxH, MinH REAL(KIND=dp), ALLOCATABLE :: MASS(:,:), & @@ -345,58 +348,48 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati WRITE(ZbName,'(A)') 'Zb' END IF - !CHANGE - to get Channel variables added to this solver mesh if - !doing calving and hydrology and consequently having many meshes + ! To get Channel variables added to this solver mesh if doing + ! calving and hydrology and consequently having many meshes Calving = ListGetLogical(Model % Simulation, 'Calving', Found) IF(.NOT.Found) Calving = .FALSE. ! Default behaviour relating to marine ice sheets and unglaciated grounded areas is to set the ! following switches to false. The defaults change to true when using Samuel Cook's "Calving" ! (set in simulation seciton of sif). The defaults will be overwritten for each of the switches - ! that are specified in the solver section of the sif. - + ! that are specified in the solver section of the sif. UseGM = GetLogical( SolverParams,'Use GroundedMask', Found ) IF (.NOT. Found) THEN - IF (Calving) THEN - UseGM = .TRUE. - ELSE - UseGM = .FALSE. - END IF + IF (Calving) THEN + UseGM = .TRUE. + ELSE + UseGM = .FALSE. + END IF END IF - UseGC = GetLogical( SolverParams,'Use GMcheck', Found ) IF (.NOT. Found) THEN - IF (Calving) THEN - UseGC = .TRUE. - ELSE - UseGC = .FALSE. - END IF + IF (Calving) THEN + UseGC = .TRUE. + ELSE + UseGC = .FALSE. + END IF END IF - ZeroSheetAtGL = GetLogical( SolverParams,'Zero Sheet At GL', Found ) IF (.NOT. Found) THEN - IF (Calving) THEN - ZeroSheetAtGL = .TRUE. - ELSE - ZeroSheetAtGL = .FALSE. - END IF + IF (Calving) THEN + ZeroSheetAtGL = .TRUE. + ELSE + ZeroSheetAtGL = .FALSE. + END IF END IF - ZeroSheetWithHP = GetLogical( SolverParams,'Zero Sheet With HP', Found ) IF (.NOT. Found) THEN - IF (Calving) THEN - ZeroSheetWithHP = .TRUE. - ELSE - ZeroSheetWithHP = .FALSE. - END IF + IF (Calving) THEN + ZeroSheetWithHP = .TRUE. + ELSE + ZeroSheetWithHP = .FALSE. + END IF END IF - - ! set mask mode based on above switches - MaskMode = NoMask - If (UseGM) MaskMode = GMonly - If (UseGC) MaskMode = GConly - If (UseGM.AND.UseGC) MaskMode = GMandGC - + IfCalving: IF(Calving) THEN DO i=1,Model % NumberOfSolvers IF(Model % Solvers(i) % Variable % Name == ChannelAreaName) THEN @@ -1129,44 +1122,33 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati N = GetElementNOFNodes(Element) CALL GetElementNodes( ElementNodes ) - !CHANGE - !If calving, cycle elements with ungrounded nodes and zero all - !hydrology variables - IF(Calving) THEN + + IF (UseGM.OR.UseGC) THEN + ! Cycle elements with ungrounded nodes and zero all hydrology variables CycleElement = .FALSE. - GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(GMcheckVar)) THEN - DO i=1, N - IF(GMcheckVar % Values(GMcheckVar % Perm(Element % NodeIndexes(i)))>0.0) THEN - !IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN - CycleElement = .TRUE. - WSolution(WPerm(Element % NodeIndexes(i))) = 0.0 - Vvar(Element % NodeIndexes(i)) = 0.0 - NSolution(NPerm(Element % NodeIndexes(i))) = 0.0 - !PwSolution(PwPerm(Element % NodeIndexes(i))) = 0.0 - hstoreSolution(hstorePerm(Element % NodeIndexes(i))) = 0.0 - !END IF - END IF - END DO - END IF - IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN - DO i=1, N - IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN - CycleElement = .TRUE. - WSolution(WPerm(Element % NodeIndexes(i))) = 0.0 - Vvar(Element % NodeIndexes(i)) = 0.0 - NSolution(NPerm(Element % NodeIndexes(i))) = 0.0 - !PwSolution(PwPerm(Element % NodeIndexes(i))) = 0.0 - hstoreSolution(hstorePerm(Element % NodeIndexes(i))) = 0.0 - END IF - END DO - END IF + + DO i=1, N + MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, Element % NodeIndexes(i)) + SELECT CASE (MaskStatus) + CASE (MASK_ALL) + CycleElement = .TRUE. + WSolution(WPerm(Element % NodeIndexes(i))) = 0.0 + Vvar(Element % NodeIndexes(i)) = 0.0 + NSolution(NPerm(Element % NodeIndexes(i))) = 0.0 + hstoreSolution(hstorePerm(Element % NodeIndexes(i))) = 0.0 + CASE (MASK_HP) + NSolution(NPerm(Element % NodeIndexes(i))) = 0.0 + CASE (MASK_NONE) + CASE DEFAULT + WRITE(Message,'(A)') "MaskStatus not recognised" + CALL FATAL( SolverName, Message) + END SELECT + END DO NULLIFY(GMcheckVar, GroundedMaskVar) IF (CycleElement) THEN CYCLE END IF - END IF + END IF CALL GetParametersSheet( Element, Material, N, SheetConductivity, alphas, & betas, Ev, ub, Snn, lr, hr, Ar, ng ) @@ -1198,13 +1180,11 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati ublr(j) = ub(i)/lr(i) hr2(j) = hr(i) - !CHANGE !To stop it working out values for non-ice covered parts of a !hydromesh in a coupled calving-hydro simulation - IF(Calving) THEN + IF ( ZeroSheetWithHP ) THEN IF(Snn(i)==0.0) THEN Np = 0.0 - !pw = 0.0 he = 0.0 END IF END IF @@ -1216,39 +1196,38 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF (ASSOCIATED(hstoreSol)) hstoreSolution(hstorePerm(j)) = he END DO END DO Elements ! Bulk elements + ! Loop over all nodes to update ThickSolution DO j = 1, Mesh % NumberOfNodes k = ThickPerm(j) IF (k==0) CYCLE - !CHANGE - !If calving, cycle elements with ungrounded nodes and zero all - !hydrology variables - IF(Calving) THEN - CycleElement = .FALSE. - GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(GMcheckVar)) THEN - IF(GMcheckVar % Values(k)>0.0) THEN !.AND. GroundedMaskVar % Values(k)<0.0) THEN - CycleElement = .TRUE. - END IF - END IF - IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN - IF(GroundedMaskVar % Values(k)<0.0) THEN - CycleElement = .TRUE. - END IF - END IF + + CycleNode = .FALSE. + IF (UseGM.OR.UseGC) THEN + ! Cycle ungrounded nodes and zero hydrology variables + MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, k) + SELECT CASE (MaskStatus) + CASE (MASK_ALL) + CycleNode = .TRUE. + CASE (MASK_HP, MASK_NONE) + CASE DEFAULT + WRITE(Message,'(A)') "MaskStatus not recognised" + CALL FATAL( SolverName, Message) + END SELECT + END IF + IF (ZeroSheetWithHP) THEN HydPotVar => VariableGet(Mesh % Variables, "hydraulic potential", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(HydPotVar % Values(k)==0.0) THEN - CycleElement = .TRUE. + IF(HydPotVar % Values(k).EQ.0.0) THEN + CycleNode = .TRUE. END IF - NULLIFY(GMcheckVar, GroundedMaskVar, HydPotVar) - IF(CycleElement) THEN - ThickSolution(k) = 0.0 - ThickPrev(k,1) = 0.0 - CYCLE - END IF - END IF - + NULLIFY(HydPotVar) + END IF + IF (CycleNode) THEN + ThickSolution(k) = 0.0 + ThickPrev(k,1) = 0.0 + CYCLE + END IF + IF(MaxHBool) THEN IF (ThickSolution(k)>MaxH) THEN ThickSolution(k) = MaxH @@ -1308,37 +1287,27 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF (ANY(HydPotPerm(Edge % NodeIndexes(1:n))==0)) CYCLE IF (ALL(NoChannel(Edge % NodeIndexes(1:n)))) CYCLE - !CHANGE - !If calving, cycle elements with ungrounded nodes and zero all - !hydrology variables - IF(Calving) THEN + IF (UseGM.OR.UseGC) THEN + ! Cycle ungrounded nodes and zero hydrology variables CycleElement = .FALSE. - GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(GMcheckVar)) THEN - DO i=1, n - IF(GMcheckVar % Values(GMcheckVar % Perm(Edge % NodeIndexes(i)))>0.0) THEN - !IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Edge % NodeIndexes(i)))<0.0) THEN - CycleElement = .TRUE. - !END IF - END IF - END DO - END IF - IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN - DO i=1,n - IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Edge % NodeIndexes(i)))<0.0) THEN - CycleElement = .TRUE. - END IF - END DO - END IF - NULLIFY(GMcheckVar, GroundedMaskVar) + DO i=1, n + MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, Edge % NodeIndexes(i)) + SELECT CASE (MaskStatus) + CASE (MASK_ALL) + CycleElement = .TRUE. + CASE (MASK_HP, MASK_NONE) + CASE DEFAULT + WRITE(Message,'(A)') "MaskStatus not recognised" + CALL FATAL( SolverName, Message) + END SELECT + END DO IF(CycleElement) THEN - CYCLE AreaSolution(AreaPerm(M+t)) = 0.0 QcSolution(QcPerm(M+t)) = 0.0 + CYCLE END IF - END IF - + END IF + EdgeNodes % x(1:n) = Mesh % Nodes % x(Edge % NodeIndexes(1:n)) EdgeNodes % y(1:n) = Mesh % Nodes % y(Edge % NodeIndexes(1:n)) EdgeNodes % z(1:n) = Mesh % Nodes % z(Edge % NodeIndexes(1:n)) @@ -1549,43 +1518,28 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati n = GetElementNOFNodes(Element) CALL GetElementNodes( ElementNodes ) - !If calving, cycle elements with ungrounded nodes and zero all - !hydrology variables - IF(Calving) THEN + + IF (UseGM.OR.UseGC) THEN + ! Cycle ungrounded nodes and zero hydrology variables CycleElement = .FALSE. - GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(GMcheckVar)) THEN - DO i=1, n - IF(GMcheckVar % Values(GMcheckVar % Perm(Element % NodeIndexes(i)))>0.0) THEN - !IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN - CycleElement = .TRUE. - DO j=1,dimSheet - k = dimSheet*(qPerm(Element % NodeIndexes(i))-1)+j - qSolution(k) = 0.0 - Refq(k) = 0.0 - END DO - EXIT - !END IF - END IF - END DO - END IF - IF(ASSOCIATED(GroundedMaskVar) .AND. .NOT. ASSOCIATED(GMcheckVar)) THEN - DO i=1,n - IF(GroundedMaskVar % Values(GroundedMaskVar % Perm(Element % NodeIndexes(i)))<0.0) THEN - CycleElement = .TRUE. - DO j=1,dimSheet - k = dimSheet*(qPerm(Element % NodeIndexes(i))-1)+j - qSolution(k) = 0.0 - Refq(k) = 0.0 - END DO - EXIT - END IF - END DO - END IF - NULLIFY(GMcheckVar, GroundedMaskVar) + DO i=1, n + MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, Element % NodeIndexes(i)) + SELECT CASE (MaskStatus) + CASE (MASK_ALL) + CycleElement = .TRUE. + DO j=1,dimSheet + k = dimSheet*(qPerm(Element % NodeIndexes(i))-1)+j + qSolution(k) = 0.0 + Refq(k) = 0.0 + END DO + CASE (MASK_HP, MASK_NONE) + CASE DEFAULT + WRITE(Message,'(A)') "MaskStatus not recognised" + CALL FATAL( SolverName, Message) + END SELECT + END DO IF(CycleElement) CYCLE - END IF + END IF ! we need the SheetConductivity, alphas, betas CALL GetParametersSheet( Element, Material, n, SheetConductivity, alphas, & @@ -1634,6 +1588,68 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CONTAINS + ! Use the grounded mask and or grounded mask check to decide how to mask the current node. + ! The following table summarises actions as a function of mask values. + ! + ! GM GC Status Action + !------------------------------------------------- + ! -1 0 Floating (not shelf); don't mask + ! -1 1 FLoating (shelf); mask + ! 0 0 GL (not shelf); don't mask + ! 0 1 GL (shelf); partial mask + ! 1 0 Grounded; don't mask + ! 1 1 Grounded (shelf); Fatal (mask inconsistency) + ! + !---------------------------------------------------------------------------------------------------------- + FUNCTION ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, ii) RESULT( MaskStatus_local ) + + LOGICAL, INTENT(IN) :: UseGM, UseGC, ZeroSheetAtGL + INTEGER, INTENT(IN) :: ii ! node index + + INTEGER :: MaskStatus_local + + MaskStatus_local = MASK_NONE + + IF (UseGM) THEN + GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.TRUE.) + END IF + + IF (UseGC) THEN + GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.TRUE.) + IF (GMcheckVar % Values(GMcheckVar % Perm(ii)).GT.0.0) THEN + IF (UseGM) THEN + IF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).LT.0.0) THEN + MaskStatus_local = MASK_ALL + ELSEIF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).EQ.0.0) THEN + IF (ZeroSheetAtGL) THEN + MaskStatus_local = MASK_HP + ELSE + MaskStatus_local = MASK_ALL + END IF + END IF + END IF + END IF + ELSE + IF (UseGM) THEN + IF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).LT.0.0) THEN + MaskStatus_local = MASK_ALL + ELSEIF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).EQ.0.0) THEN + IF (ZeroSheetAtGL) THEN + MaskStatus_local = MASK_HP + ELSE + MaskStatus_local = MASK_ALL + END IF + END IF + ELSE + WRITE(Message,'(A)') "Function ProcessMasks should not be called when no mask is specified" + CALL FATAL( SolverName, Message) + END IF + END IF + NULLIFY(GMcheckVar, GroundedMaskVar) + + END FUNCTION ProcessMasks + + ! Compute consistent channel norm only considering the edges that also have hydrology defined on the nodes. ! In parallel only consider the edges in the partition where it is active. !---------------------------------------------------------------------------------------------------------- From 9b4e66bb266db1fbdbe5185eaeb6ae1b0371b7e3 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Mon, 5 Feb 2024 19:32:45 +0200 Subject: [PATCH 06/51] Fixed null pointer to solverparams --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index edd64b9cd8..4bf23318d1 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -357,6 +357,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati ! following switches to false. The defaults change to true when using Samuel Cook's "Calving" ! (set in simulation seciton of sif). The defaults will be overwritten for each of the switches ! that are specified in the solver section of the sif. + SolverParams => GetSolverParams() UseGM = GetLogical( SolverParams,'Use GroundedMask', Found ) IF (.NOT. Found) THEN IF (Calving) THEN From 22e8c7e4e36cffea286c258f5179db8f72d937a2 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Mon, 19 Feb 2024 11:09:53 +0200 Subject: [PATCH 07/51] Minor bug fixes re indexing --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 4bf23318d1..782f40e8fd 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -1206,7 +1206,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CycleNode = .FALSE. IF (UseGM.OR.UseGC) THEN ! Cycle ungrounded nodes and zero hydrology variables - MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, k) + MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, j) SELECT CASE (MaskStatus) CASE (MASK_ALL) CycleNode = .TRUE. @@ -1218,7 +1218,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END IF IF (ZeroSheetWithHP) THEN HydPotVar => VariableGet(Mesh % Variables, "hydraulic potential", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(HydPotVar % Values(k).EQ.0.0) THEN + IF(HydPotVar % Values( HydPotVar % perm(j) ).EQ.0.0) THEN CycleNode = .TRUE. END IF NULLIFY(HydPotVar) @@ -1308,7 +1308,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CYCLE END IF END IF - + EdgeNodes % x(1:n) = Mesh % Nodes % x(Edge % NodeIndexes(1:n)) EdgeNodes % y(1:n) = Mesh % Nodes % y(Edge % NodeIndexes(1:n)) EdgeNodes % z(1:n) = Mesh % Nodes % z(Edge % NodeIndexes(1:n)) From db9205340332d02f6934ec1e6ee4074413d8d5ca Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 24 Apr 2024 16:46:01 +0300 Subject: [PATCH 08/51] updating grounded melt solver for GlaDS --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 185 ++++++++++++++---------- 1 file changed, 109 insertions(+), 76 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 782f40e8fd..e0944cb3ca 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -2681,6 +2681,8 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) ! Sum nodal values for nodes that exist on multiple partitions CALL ParallelSumVector(Solver % Matrix, cglfVals) + GLfluxVals = 0.0 + DO nn = 1, numNodes IF (gmPerm(nn).le.0) CYCLE ! IF (gmVals(gmPerm(nn)).eq.0) GLfluxVals(GLfluxPerm(nn)) = volFluxSheet + volFluxChannel @@ -2733,26 +2735,21 @@ END SUBROUTINE GlaDS_GLflux ! Weights variable name = String "Friction heating boundary weights" ! ! -! Notes when using this with a 2D SSA setup: -! -! Assuming we don't have nodal heat, we can calculate a friction heat if we -! know about the sliding law and the relevant parameters -! -! Grounded Melt = Variable ssavelocity 1, ssavelocity 2, beta -! Real lua "((tx[0]^2.0+tx[1]^2.0)*10.0^tx[2])/(rhoi*Lf)" -! -! SSA Mean Density = Real #rhoi -! -! -! Which law are we using (linear, weertman , coulomb or regularised coulomb) -! SSA Friction Law = String "coulomb" -! SSA Friction Parameter = Variable "Coulomb As" -! Real Lua "tx[0]^(-1/3)" -! SSA Friction Maximum Value = Equals "Coulomb C" -! SSA Friction Post-Peak = Real 1.0 -! SSA Friction Exponent = Real #1.0/n - +! Heat is Mega Joules per year. + ! We multiply by 10^6 to convert from Mega Joules to Joules. + ! + + ! Different modes of operation. + ! "heat" - a variable providing nodal heat (e.g. could be residual from temperate ice solver) is used + ! to calculate the melt rate. Weights (based on area) are also needed in this case. + ! + ! MeltRate = Heat / (area * density * latent_heat) + ! + ! "friction" - a sliding velocity variable is provided and used by this routine to calculate basal shear + ! stress, which is then used (along with the effective linear sliding coefficient ("ceff", + ! see SSASolver.F90), to calculate melt based on friction heat. +! RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) USE DefUtils @@ -2769,82 +2766,118 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) !------------------------------------------------------------------------------ ! Local variables !------------------------------------------------------------------------------ - TYPE(ValueList_t), POINTER :: SolverParams - TYPE(Variable_t), POINTER :: MeltVar, WeightsVar, HeatVar, GHFVar + TYPE(ValueList_t), POINTER :: SolverParams, Material + TYPE(Variable_t), POINTER :: MeltVar, WeightsVar, HeatVar, GHFVar, Ceffvar, UbVar LOGICAL, SAVE :: FirstTime = .TRUE., UseGHF = .FALSE. LOGICAL :: Found - CHARACTER(LEN=MAX_NAME_LEN) :: MyName = 'GroundedMelt solver', HeatVarName, WeightsVarName, GHFvarName - REAL(KIND=dp),PARAMETER :: rho = 1000.0_dp ! density of pure water + CHARACTER(LEN=MAX_NAME_LEN) :: MyName = 'Grounded Melt solver', HeatVarName, WeightsVarName, GHFvarName + CHARACTER(LEN=MAX_NAME_LEN) :: MeltMode, CeffVarName, UbVarName + REAL(KIND=dp) :: rho_fw ! density of fresh water REAL(KIND=dp),PARAMETER :: threshold = 0.001_dp ! threshold friction melt rate for including GHF in melt calc - REAL(KIND=dp), POINTER :: WtVals(:), HeatVals(:), MeltVals(:), GHFVals(:) - REAL(KIND=dp) :: LatHeat, GHFscaleFactor - INTEGER, POINTER :: WtPerm(:), HeatPerm(:), MeltPerm(:), GHFPerm(:) + REAL(KIND=dp), POINTER :: WtVals(:), HeatVals(:), MeltVals(:), GHFVals(:), Ceffvals(:), UbVals(:) + REAL(KIND=dp) :: LatHeat, GHFscaleFactor, Ub(1) + INTEGER, POINTER :: WtPerm(:), HeatPerm(:), MeltPerm(:), GHFPerm(:), Ceffperm(:), UbPerm(:) INTEGER :: nn - - ! IF (FirstTime) THEN - ! CALL CalculateNodalWeights(Solver, .FALSE., VarName='Weights') - ! CALL CalculateNodalWeights(Solver, .FALSE.) - ! CALL CalculateNodalWeights(Solver, .TRUE.) - ! FirstTime = .FALSE. - ! END IF + + rho_fw = ListGetConstReal( Model % Constants, 'Fresh Water Density', Found ) + IF (.NOT.Found) CALL FATAL(MyName, 'Constant >Fresh Water Density< not found') + LatHeat = ListGetConstReal( Model % Constants, 'Latent Heat', Found) + IF (.NOT.Found) CALL Fatal(MyName, '>Latent Heat< not found in constants') + + MeltVar => Solver%Variable + MeltVals => MeltVar%Values + MeltPerm => MeltVar%Perm + SolverParams => GetSolverParams() + MeltMode = GetString(SolverParams,'Melt mode', Found) + IF(.NOT.Found) CALL Fatal(MyName, '>Melt mode< not found in solver params') + + SELECT CASE (MeltMode) + + CASE ("heat") + HeatVarName = GetString(SolverParams,'heat variable name', Found) + IF(.NOT.Found) CALL Fatal(MyName, '>Heat variable name< not found in solver params') + WeightsVarName = GetString(SolverParams,'Weights variable name', Found) + IF(.NOT.Found) CALL Fatal(MyName, '>Weights variable name< not found in solver params') + + HeatVar => VariableGet(Model % Variables, HeatVarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + HeatVals => HeatVar%Values + HeatPerm => HeatVar%Perm + + WeightsVar => VariableGet(Model % Variables, WeightsVarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + WtVals => WeightsVar%Values + WtPerm => WeightsVar%Perm + + CASE ("friction") + UbVarName = GetString(SolverParams,'Ub variable name', Found) + IF (.NOT.Found) UbVarName = "SSAVelocity" + CeffVarName = GetString(SolverParams,'Ceff variable name', Found) + IF (.NOT.Found) CeffVarName = "Ceff" + + CeffVar => VariableGet(Model % Variables, CeffVarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + CeffVals => CeffVar%Values + CeffPerm => CeffVar%Perm + + UbVar => VariableGet(Model % Variables, UbVarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + UbVals => UbVar%Values + UbPerm => UbVar%Perm + + IF (UbVar % DOFS .NE. 2) THEN + CALL Fatal(MyName, 'Expecting Ub variable to be 2D') + END IF + ! Material => GetMaterial() ! get sliding velocity from material + + CASE DEFAULT + CALL Fatal(MyName, 'MeltMode not recognised') + + END SELECT + GHFvarName = GetString(SolverParams,'GHF variable name', Found) IF (Found) THEN - UseGHF = .TRUE. - GHFscaleFactor = GetConstReal( Model % Constants, 'GHF scale factor', Found) - IF(.NOT.Found) GHFscaleFactor = 1.0 + UseGHF = .TRUE. + GHFscaleFactor = GetConstReal( Model % Constants, 'GHF scale factor', Found) + IF(.NOT.Found) GHFscaleFactor = 1.0 ELSE - UseGHF = .FALSE. + UseGHF = .FALSE. END IF - - LatHeat = GetConstReal( Model % Constants, 'Latent Heat', Found) - IF(.NOT.Found) CALL Fatal(MyName, '>Latent Heat< not found in constants') - - HeatVarName = GetString(SolverParams,'heat variable name', Found) - IF(.NOT.Found) CALL Fatal(MyName, '>Heat variable name< not found in solver params') - WeightsVarName = GetString(SolverParams,'Weights variable name', Found) - IF(.NOT.Found) CALL Fatal(MyName, '>Weights variable name< not found in solver params') - + IF (UseGHF) THEN - GHFVar => VariableGet(Model % Variables, GHFvarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) - GHFVals => GHFVar%Values - GHFPerm => GHFVar%Perm + GHFVar => VariableGet(Model % Variables, GHFvarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + GHFVals => GHFVar%Values + GHFPerm => GHFVar%Perm END IF - HeatVar => VariableGet(Model % Variables, HeatVarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) - HeatVals => HeatVar%Values - HeatPerm => HeatVar%Perm - - WeightsVar => VariableGet(Model % Variables, WeightsVarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) - WtVals => WeightsVar%Values - WtPerm => WeightsVar%Perm - - MeltVar => Solver%Variable - MeltVals => MeltVar%Values - MeltPerm => MeltVar%Perm - LoopAllNodes: DO nn=1,Solver % Mesh % NumberOfNodes - ! - ! MeltRate = Heat / (area * density * latent_heat) - ! - ! Heat is Mega Joules per year. - ! We multiply by 10^6 to convert from Mega Joules to Joules. - ! - IF (MeltPerm(nn).GT.0) THEN - MeltVals(MeltPerm(nn)) = ABS( 1.0e6 * HeatVals(HeatPerm(nn)) ) / ( WtVals(WtPerm(nn)) * rho * LatHeat ) - IF (UseGHF) THEN - ! Scaled GHF is in Mega Joules per m^2 per year. - MeltVals(MeltPerm(nn)) = MeltVals(MeltPerm(nn)) + & - ( GHFVals(GHFPerm(nn))*GHFscaleFactor*1.0e6 ) / ( rho*LatHeat ) - END IF - END IF + IF (MeltPerm(nn).GT.0) THEN + + SELECT CASE (MeltMode) + CASE ("heat") + MeltVals(MeltPerm(nn)) = ABS( 1.0e6 * HeatVals(HeatPerm(nn)) ) / ( WtVals(WtPerm(nn)) * rho_fw * LatHeat ) + CASE ("friction") + Ub = (UbVals(2*(UbPerm(nn)-1)+1)**2 + UbVals(2*(UbPerm(nn)-1)+2)**2)**0.5 +! Ub(1:1) = ListGetReal( Material, 'Sliding Velocity', 1, [nn], Found, UnfoundFatal = .TRUE. ) + MeltVals(MeltPerm(nn)) = (Ub(1)**2 * CeffVals(CeffPerm(nn)) ) / ( rho_fw * LatHeat ) + END SELECT + + IF (UseGHF) THEN + ! Scaled GHF is in Mega Joules per m^2 per year. + MeltVals(MeltPerm(nn)) = MeltVals(MeltPerm(nn)) + & + ( GHFVals(GHFPerm(nn))*GHFscaleFactor*1.0e6 ) / ( rho_fw*LatHeat ) + END IF + END IF END DO LoopAllNodes - NULLIFY(HeatVar, HeatVals, HeatPerm, WeightsVar, WtVals, WtPerm, MeltVar, MeltVals, MeltPerm) + SELECT CASE(MeltMode) + CASE("heat") + NULLIFY(HeatVar, HeatVals, HeatPerm, WeightsVar, WtVals, WtPerm) + CASE("friction") + NULLIFY(CeffVar, CeffVals, CeffPerm) + END SELECT + NULLIFY(MeltVar, MeltVals, MeltPerm) IF (UseGHF) THEN NULLIFY(GHFVar, GHFVals, GHFPerm) END IF From 34ebbcac6b777ff2bb782944086b69ee82e9d335 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 24 Apr 2024 17:33:22 +0300 Subject: [PATCH 09/51] Adding option to not scale As according to effective pressure when converting Weertman to Coulomb coefficients --- elmerice/Solvers/Weertman2Coulomb.F90 | 44 ++++++++++++++++++++------- 1 file changed, 33 insertions(+), 11 deletions(-) diff --git a/elmerice/Solvers/Weertman2Coulomb.F90 b/elmerice/Solvers/Weertman2Coulomb.F90 index 7792262359..776fc9a4ac 100644 --- a/elmerice/Solvers/Weertman2Coulomb.F90 +++ b/elmerice/Solvers/Weertman2Coulomb.F90 @@ -84,7 +84,8 @@ SUBROUTINE Weertman2CoulombSolver( Model,Solver,dt,TransientSimulation ) tangentialvelocity(3), tangentialvelocitysquared, normal(3), velo(3), MinAs REAL(KIND=dp), POINTER :: CoulombParam(:), lwcValues(:), AsValues(:), EPvalues(:), & FlowValues(:), CValues(:), NormalValues(:) - LOGICAL :: GotIt, UseNormal + REAL(KIND=dp) :: limit, factor + LOGICAL :: GotIt, UseNormal, AsScaling CHARACTER(LEN=MAX_NAME_LEN):: FlowSolverName, Cname, Asname, CoulombVarName, LWCname CHARACTER(LEN=MAX_NAME_LEN):: ConversionMode @@ -157,6 +158,9 @@ SUBROUTINE Weertman2CoulombSolver( Model,Solver,dt,TransientSimulation ) IF (.NOT.GotIt) & CALL FATAL("Weertman2Coulomb",'No "Conversion mode" found') ! + AsScaling = GetLogical(SolverParams, "As Scaling", GotIt) + IF (.NOT.GotIt) & + AsScaling = .TRUE. IF (ConversionMode.EQ."Threshold") THEN BetaSwitch = GetConstReal(SolverParams, "Threshold Sliding Coefficient", GotIt) IF (.NOT.GotIt) & @@ -183,8 +187,7 @@ SUBROUTINE Weertman2CoulombSolver( Model,Solver,dt,TransientSimulation ) CALL FATAL("Weertman2Coulomb",'Variable "FlowVariable" not found') FlowPerm => FlowVariable % Perm FlowValues => FlowVariable % Values - - + ! Loop over all nodes DO nn = 1, Solver % Mesh % Nodes % NumberOfNodes @@ -200,7 +203,6 @@ SUBROUTINE Weertman2CoulombSolver( Model,Solver,dt,TransientSimulation ) END IF END DO - IF (UseNormal) THEN normalvelocity = SUM(normal(1:DIM)*velo(1:DIM))*normal tangentialvelocity = velo - normalvelocity @@ -208,7 +210,7 @@ SUBROUTINE Weertman2CoulombSolver( Model,Solver,dt,TransientSimulation ) tangentialvelocity = velo END IF tangentialvelocitysquared = SUM(tangentialvelocity(1:DIM)*tangentialvelocity(1:DIM)) - + SELECT CASE(ConversionMode) CASE("Threshold","threshold") @@ -236,13 +238,33 @@ SUBROUTINE Weertman2CoulombSolver( Model,Solver,dt,TransientSimulation ) ! (assuming n = 3) AsValues(AsPerm(nn)) = & tangentialvelocitysquared**(-1) * lwcValues(lwcPerm(nn))**(-3.0_dp) - CoulombParam(CoulombPerm(nn)) = tanh(2.0_dp*EPvalues(EPperm(nn))) - AsValues(AsPerm(nn)) = CoulombParam(CoulombPerm(nn)) * AsValues(AsPerm(nn)) + IF (AsScaling) THEN + CoulombParam(CoulombPerm(nn)) = tanh(2.0_dp*EPvalues(EPperm(nn))) + AsValues(AsPerm(nn)) = CoulombParam(CoulombPerm(nn)) * AsValues(AsPerm(nn)) + END IF + + ! Figuring out how to stop C going negative in a consistent way... + ! (in this case modifying As to stop C going negative) + ! Impose this inequality: + ! lwc^3 ub^2 As < 1 + ! => As < 1/(lwc^3 ub^2) + ! Safer... (limit is almost 1) + ! As < limit/(lwc^3 ub^2) + limit = 0.99999999999999_dp + factor = limit/(lwcValues(lwcPerm(nn))**(3.0_dp) * SQRT(tangentialvelocitysquared)**2.0_dp ) + IF ( AsValues(AsPerm(nn)).GT.factor ) THEN + AsValues(AsPerm(nn)) = factor + END IF + + ! now use factor for something slightly different... (the full lwc^3 ub^2 As) + factor = ( lwcValues(lwcPerm(nn))**(3.0_dp) & + * SQRT(tangentialvelocitysquared)**2.0_dp * AsValues(AsPerm(nn)) ) + ! C = u_b.beta.N^(-1).(1 - beta^3.u_b^2.A_s)^(-1/3) + CValues(CPerm(nn)) = SQRT(tangentialvelocitysquared) * lwcValues(lwcPerm(nn)) & + * EPvalues(EPperm(nn))**(-1.0_dp) * (1.0_dp - factor)**(-1.0_dp/3.0_dp) - ! C = u_b.beta.N^(-1).(1 - beta^3.u_b^2.A_s)^(-1/3) - CValues(CPerm(nn)) = SQRT(tangentialvelocitysquared) * lwcValues(lwcPerm(nn)) & - * EPvalues(EPperm(nn))**(-1.0_dp) * (1.0_dp - lwcValues(lwcPerm(nn))**(3.0_dp) & - * SQRT(tangentialvelocitysquared)**2.0_dp * AsValues(AsPerm(nn)) )**(-1.0_dp/3.0_dp) + ! The older way to stop C oging negative (potentialy inconsistent As & C values): + ! IF (factor.GT.limit) factor = limit CASE DEFAULT CALL FATAL("Weertman2Coulomb",'Conversion mode not recognised') From c5aee3014ea7f86974b47be2077a3085c7069b6d Mon Sep 17 00:00:00 2001 From: chekki2mo Date: Thu, 2 May 2024 21:06:13 +0200 Subject: [PATCH 10/51] reduce output print in GroundedSolver --- elmerice/Solvers/GroundedSolver.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index 5ff0d7a52d..e33b093806 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -259,8 +259,9 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) IF (Nn==0) CYCLE IF (ABS(VariableValues(Nn)-1.0_dp) Date: Sat, 4 May 2024 21:21:03 +0300 Subject: [PATCH 11/51] bug fix for nonlinear Budd sliding in SSA --- elmerice/Utils/SSAMaterialModels.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index 9efcc91c57..2992ccc08d 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -147,7 +147,7 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s gravity = ListGetConstReal( Constants, 'Gravity Norm', UnFoundFatal=.TRUE. ) ! calculate haf from N = rho_i g z* qq = ListGetConstReal( Material, 'SSA Haf Exponent', Found, UnFoundFatal=.TRUE.) - hafq = fN / (gravity * rho) ** qq + hafq = ( fN / (gravity * rho) ) ** qq CASE(REG_COULOMB_GAG) fq = ListGetConstReal( Material, 'SSA Friction Post-Peak', Found, UnFoundFatal=.TRUE. ) From c9d7f454410e13d94181d3419505eb0bec2f520a Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 8 May 2024 13:30:31 +0300 Subject: [PATCH 12/51] Add hybrid (between Schoof/Gag and Joughin versions) regularised coulomb sliding law to SSAMaterials --- elmerice/Utils/SSAMaterialModels.F90 | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index 9efcc91c57..50ef065714 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -46,6 +46,7 @@ MODULE SSAMaterialModels !> Return the effective friction coefficient !-------------------------------------------------------------------------------- FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,sealevel,SlipDer) RESULT(Slip) + IMPLICIT NONE REAL(KIND=dp) :: Slip ! the effective friction coefficient TYPE(Element_t), POINTER :: Element ! the current element @@ -58,8 +59,6 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s REAL(KIND=dp) :: rho,rhow,sealevel ! density, sea-water density, sea-level REAL(KIND=dp),OPTIONAL :: SlipDer ! dSlip/du=dSlip/dv if ub=(u^2+v^2)^1/2 ! required to compute the Jacobian - - INTEGER :: iFriction INTEGER, PARAMETER :: LINEAR = 1 INTEGER, PARAMETER :: WEERTMAN = 2 @@ -79,7 +78,7 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s REAL(KIND=dp),DIMENSION(n) :: NodalBeta, NodalGM, NodalBed, NodalLinVelo,NodalC,NodalN REAL(KIND=dp) :: bedrock,Hf,fC,fN,LinVelo - LOGICAL :: Found + LOGICAL :: Found, NeedN ! Sub - element GL parameterisation IF (SEP) THEN @@ -129,15 +128,27 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s END SELECT ! where explicit dependence on effective pressure is present... + NeedN = .FALSE. SELECT CASE (iFriction) + CASE(REG_COULOMB_JOU) + ! This is Eliot Jager's suggested modification to the Joughin form of + ! regularised Coulomb sliding, where the initial coefficient is now + ! multiplied by effective pressure, N + NeedN = ListGetLogical( Material, 'SSA Friction need N', Found) + CALL INFO("SSAEffectiveFriction","> SSA Friction need N < not found, assuming false",level=3) + IF (.NOT. Found) NeedN = .FALSE. CASE(REG_COULOMB_GAG,BUDD) + NeedN = .TRUE. + END SELECT + + IF (NeedN) THEN NSol => VariableGet( CurrentModel % Variables, 'Effective Pressure', UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalN,UElement=Element, UVariable=NSol) MinN = ListGetConstReal( Material, 'SSA Min Effective Pressure', Found, UnFoundFatal=.TRUE.) fN = SUM( NodalN(1:n) * Basis(1:n) ) ! Effective pressure should be >0 (for the friction law) fN = MAX(fN, MinN) - END SELECT + END If ! parameters unique to one sliding parameterisation SELECT CASE (iFriction) @@ -214,9 +225,10 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s CASE(REG_COULOMB_JOU) Slip = beta * ub**(fm-1.0_dp) / (ub + U0)**fm + IF (NeedN) Slip = Slip * fN IF (PRESENT(SlipDer)) SlipDer = Slip2 * Slip * ((fm-1.0_dp) / (ub*ub) - & fm*ub**(-1.0_dp)/(ub+U0)) - + END SELECT END FUNCTION SSAEffectiveFriction From f66e2af9d2d0348a7298955fde6b96f9c9bcd0d0 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 5 Jun 2024 15:47:59 +0300 Subject: [PATCH 13/51] Integrated GMvalid with GroundedSolver. See new notes at start of GroundedSolver.F90 for usage. --- elmerice/Solvers/CMakeLists.txt | 2 +- elmerice/Solvers/GMValid.F90 | 231 --------------- elmerice/Solvers/GroundedSolver.F90 | 416 ++++++++++++++++++++++------ 3 files changed, 329 insertions(+), 320 deletions(-) delete mode 100644 elmerice/Solvers/GMValid.F90 diff --git a/elmerice/Solvers/CMakeLists.txt b/elmerice/Solvers/CMakeLists.txt index a684cd5b83..3d696fa0fc 100644 --- a/elmerice/Solvers/CMakeLists.txt +++ b/elmerice/Solvers/CMakeLists.txt @@ -93,7 +93,7 @@ SET(ElmerIce_SRC ElmerIceUtils.F90 AIFlowSolve_nlD2.F90 AIFlowSolve_nlS2.F90 CalvingFrontAdvance3D.F90 Emergence.F90 SSAmask.F90 GlaDSCoupledSolver.F90 GlaDSchannelSolver.F90 Flotation.F90 BasalMelt3D.F90 CalvingHydroInterp.F90 HydroRestart.F90 - GMValid.F90 Scalar_OUTPUT_Glacier.F90 IcyMaskSolver.F90 + Scalar_OUTPUT_Glacier.F90 IcyMaskSolver.F90 Weertman2Coulomb.F90) SET(ElmerIce_SRC ${ElmerIce_SRC} ./Covarianceutils/CovarianceUtils.F90 ./Covarianceutils/BackgroundErrorCostSolver.F90 ./Covarianceutils/CovarianceVectorMultiplySolver.F90 ./Covarianceutils/GaussianSimulationSolver.F90) diff --git a/elmerice/Solvers/GMValid.F90 b/elmerice/Solvers/GMValid.F90 deleted file mode 100644 index ea7b05f541..0000000000 --- a/elmerice/Solvers/GMValid.F90 +++ /dev/null @@ -1,231 +0,0 @@ -!*****************************************************************************/ -! * -! * Elmer, A Finite Element Software for Multiphysical Problems -! * -! * Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland -! * -! * 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. -! * -! *****************************************************************************/ -! * An improved version of the routine to calculate basal melt rates on -! * ungrounded ice, producing a validity mask instead (1 = ungrounded area -! * connected to the ice front; 0 = isolated patch). -! ****************************************************************************** -! * -! * Authors: Samuel Cook -! * Email: samuel.cook@univ-grenoble-alpes.fr -! * Web: http://www.csc.fi/elmer -! * Address: CSC - IT Center for Science Ltd. -! * Keilaranta 14 -! * 02101 Espoo, Finland -! * -! * Original Date: 08.2019 -! * -! ****************************************************************************/ - - SUBROUTINE GMValid (Model, Solver, dt, TransientSimulation) - USE Types - USE CoordinateSystems - USE DefUtils - USE ElementDescription - USE CalvingGeometry - - IMPLICIT NONE - - TYPE(Model_t) :: Model - TYPE(Solver_t) :: Solver - REAL(KIND=dp) :: dt - LOGICAL :: TransientSimulation - !----------------------------------- - TYPE(Mesh_t), POINTER :: Mesh - TYPE(Matrix_t), POINTER :: Matrix - TYPE(Variable_t), POINTER :: Var, GroundedVar - TYPE(ValueList_t), POINTER :: Params - TYPE(CrevasseGroup3D_t), POINTER :: FloatGroups, CurrentGroup, DelGroup - TYPE(Element_t), POINTER :: Element - TYPE(Nodes_t) :: ElementNodes - TYPE(GaussIntegrationPoints_t) :: IntegStuff - - REAL(KIND=dp) :: GMCheck, SMeltRate, WMeltRate, SStart, SStop, & - TotalArea, TotalBMelt, ElemBMelt, s, t, season,& - SqrtElementMetric,U,V,W,Basis(Model % MaxElementNodes) - INTEGER :: DIM, NoNodes, i,j,n, FaceNodeCount, GroupNodeCount, county, & - Active, ierr, k, FoundNew, AllFoundNew - INTEGER, PARAMETER :: FileUnit = 75 - INTEGER, POINTER :: Perm(:), InvPerm(:), FrontPerm(:)=>NULL(), Neighbours(:,:), & - NeighbourHolder(:), NoNeighbours(:), NodeIndexes(:) - INTEGER, ALLOCATABLE :: AllGroupNodes(:), PartNodeCount(:), AllPartGroupNodes(:), & - disps(:) - LOGICAL :: Found, OutputStats, Visited=.FALSE., Debug, stat, Summer - CHARACTER(LEN=MAX_NAME_LEN) :: SolverName, GMaskVarName, FrontMaskName, OutfileName, mode - - Debug = .FALSE. - - SolverName = "GMValidator" - Params => Solver % Values - Mesh => Solver % Mesh - - DIM = CoordinateSystemDimension() - IF(DIM /= 3) CALL Fatal(SolverName, "This solver only works in 3D!") - - !Identify nodes on the front - FrontMaskName = "Calving Front Mask" - CALL MakePermUsingMask( Model, Solver, Mesh, FrontMaskName, & - .FALSE., FrontPerm, FaceNodeCount) - - !Need the matrix for finding neighbours - Matrix => Solver % Matrix - - Var => Solver % Variable - IF(.NOT. ASSOCIATED(Var)) CALL Fatal(SolverName, "Solver needs a variable!") - Perm => Var % Perm - Var % Values = 0.0_dp - - NoNodes = COUNT(Perm > 0) - - GMaskVarName = ListGetString(Params, "GroundedMask Variable", Found) - IF(.NOT. Found) GMaskVarName = "GroundedMask" - GroundedVar => VariableGet(Mesh % Variables, GMaskVarName, .TRUE., UnfoundFatal=.TRUE.) - - GMCheck = 1.0_dp - - !Set up inverse perm for FindNodeNeighbours - InvPerm => CreateInvPerm(Matrix % Perm) !Create inverse perm for neighbour search - ALLOCATE(Neighbours(Mesh % NumberOfNodes, 10), NoNeighbours(Mesh % NumberOfNodes)) - Neighbours = 0 - - !Find neighbours for each node on the bed - DO i=1, Mesh % NumberOfNodes - IF(Perm(i) <= 0) CYCLE - - NeighbourHolder => FindNodeNeighbours(i, Matrix, & - Matrix % Perm, 1, InvPerm) - - Neighbours(i,1:SIZE(NeighbourHolder)) = NeighbourHolder - NoNeighbours(i) = SIZE(NeighbourHolder) - DEALLOCATE(NeighbourHolder) - END DO - - !Reuse some old calving code - !Find groups of connected floating nodes on the base - FloatGroups => NULL() - CALL FindCrevasseGroups(Mesh, GroundedVar, Neighbours, & - -0.5_dp, FloatGroups) - - !Check groups are valid (connected to front) - CurrentGroup => FloatGroups - DO WHILE(ASSOCIATED(CurrentGroup)) - - CurrentGroup % FrontConnected = .FALSE. - DO i=1, CurrentGroup % NumberOfNodes - - IF(FrontPerm(CurrentGroup % NodeNumbers(i)) > 0) THEN - CurrentGroup % FrontConnected = .TRUE. - EXIT - END IF - END DO - CurrentGroup => CurrentGroup % Next - END DO - - DO k=1,1000 - FoundNew = 0 - !Count and gather nodes from all valid groups - GroupNodeCount = 0 - county = 0 - DO i=1,2 - IF(i==2) ALLOCATE(AllGroupNodes(GroupNodeCount)) - - CurrentGroup => FloatGroups - DO WHILE(ASSOCIATED(CurrentGroup)) - IF(CurrentGroup % FrontConnected) THEN - - IF(i==1) THEN - GroupNodeCount = GroupNodeCount + CurrentGroup % NumberOfNodes - ELSE - DO j=1, CurrentGroup % NumberOfNodes - county = county + 1 - AllGroupNodes(county) = Mesh % ParallelInfo % GlobalDOFs(CurrentGroup % NodeNumbers(j)) - END DO - END IF - END IF - CurrentGroup => CurrentGroup % Next - END DO - END DO - - !Distribute info to/from all partitions about groups connected to front - ALLOCATE(PartNodeCount(ParEnv % PEs)) - - CALL MPI_ALLGATHER(GroupNodeCount, 1, MPI_INTEGER, PartNodeCount, 1, & - MPI_INTEGER, MPI_COMM_WORLD, ierr) - - ALLOCATE(AllPartGroupNodes(SUM(PartNodeCount)), disps(ParEnv % PEs)) - disps(1) = 0 - DO i=2,ParEnv % PEs - disps(i) = disps(i-1) + PartNodeCount(i-1) - END DO - - CALL MPI_ALLGATHERV(AllGroupNodes, GroupNodeCount, MPI_INTEGER, & - AllPartGroupNodes, PartNodeCount, disps, MPI_INTEGER, MPI_COMM_WORLD, ierr) - - !Cycle unconnected groups, looking for partition boundary in connected groups - CurrentGroup => FloatGroups - DO WHILE(ASSOCIATED(CurrentGroup)) - IF(.NOT. CurrentGroup % FrontConnected) THEN - DO i=1,CurrentGroup % NumberOfNodes - - IF(ANY(Mesh % ParallelInfo % GlobalDOFs(CurrentGroup % NodeNumbers(i)) == & - AllPartGroupNodes)) THEN - CurrentGroup % FrontConnected = .TRUE. - FoundNew = 1 - END IF - - END DO - END IF - CurrentGroup => CurrentGroup % Next - END DO - CALL MPI_ALLREDUCE(FoundNew, AllFoundNew, 1, MPI_INTEGER, MPI_MAX, ELMER_COMM_WORLD, ierr) - IF(AllFoundNew == 1) THEN - DEALLOCATE(AllGroupNodes, PartNodeCount, AllPartGroupNodes, disps) - ELSE - EXIT - END IF - END DO !k - - !Cycle all connected groups, setting melt rate - CurrentGroup => FloatGroups - DO WHILE(ASSOCIATED(CurrentGroup)) - IF(CurrentGroup % FrontConnected) THEN - DO i=1,CurrentGroup % NumberOfNodes - Var % Values(Var % Perm(CurrentGroup % NodeNumbers(i))) = GMCheck - END DO - END IF - CurrentGroup => CurrentGroup % Next - END DO - - !Deallocate floatgroups linked list - CurrentGroup => FloatGroups - DO WHILE(ASSOCIATED(CurrentGroup)) - DelGroup => CurrentGroup - CurrentGroup => CurrentGroup % Next - - IF(ASSOCIATED(DelGroup % NodeNumbers)) DEALLOCATE(DelGroup % NodeNumbers) - IF(ASSOCIATED(DelGroup % FrontNodes)) DEALLOCATE(DelGroup % FrontNodes) - IF(ASSOCIATED(DelGroup % BoundaryNodes)) DEALLOCATE(DelGroup % BoundaryNodes) - DEALLOCATE(DelGroup) - END DO - - DEALLOCATE(Neighbours, NoNeighbours, FrontPerm, InvPerm) - END SUBROUTINE GMValid diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index 5ff0d7a52d..e78b8bf227 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -22,44 +22,73 @@ ! *****************************************************************************/ ! ****************************************************************************** ! * -! * Authors: Olivier Gagliardini, Gael Durand +! * Authors: Olivier Gagliardini, Gael Durand, Rupert Gladstone, Samuel Cook ! * Email: ! * Web: http://elmerice.elmerfem.org ! * ! * Original Date: ! * ! ***************************************************************************** -!> Solver for creating a mask on whether the lower side of an ice sheet/shelf is -!> grounded or not. +1=grounded,-1=detached, 0=grounding line (=last grounded node) -SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) -!------------------------------------------------------------------------------ -!****************************************************************************** -! -! For the bottom surface, creates and updates a mask which may be equal to -1, 0 or 1 - -! GroundedMask = + 1 if grounded -! = - 1 if floating -! = 0 if on the grounding line (also grounded) ! -! Consequently, a node is grounded if GroundedMask >= 0 +! Rupert's notes June 2024 (TODO: integrate these into documentation): ! -! y is the vertical in 2D ; z is the vertical in 3D +! Unifying Samuel's code for identifying isolated ungrounded regions with the main +! grounded mask code. ! -! ARGUMENTS: +! Aim: ! -! TYPE(Model_t) :: Model, -! INPUT: All model information (mesh, materials, BCs, etc...) +! 1. All relevant functionality to be accessed through the grounded solver. +! 2. Default behaviour is backward compatible with non-GMvalid grounded solver: +! one grounded mask that allows isolated ungrounded regions. +! 3. New option to provide a second grounded mask in which isolated ungrounded +! regions are removed (unlike Samuel's original, this second mask will +! identify the grounding line itself, i.e. the values of -1, 0, 1 will have +! the same meaning as the original grounded mask). +! +! Additional solver option: +! 'Connected mask name = string xxx' +! This needs to correspond to an existing variable, probably an exported variable. +! Samuel's calving front mask also needs to be specified at the appropriate BC. ! -! TYPE(Solver_t) :: Solver -! INPUT: Linear & nonlinear equation solver options -! -! REAL(KIND=dp) :: dt, -! INPUT: Timestep size for time dependent simulations -! -! LOGICAL :: TransientSimulation -! INPUT: Steady state or transient simulation -! -!****************************************************************************** +! Example. +! Add this to the GroundedSolver: +! Connected mask name = string ConnMask +! Exported Variable 1 = -dofs 1 "ConnMask" +! Add this to the front BC: +! Calving Front Mask = Logical true +! + +!> Solver for creating a mask on whether the lower side of an ice sheet/shelf is +!> grounded or not. +1=grounded,-1=detached, 0=grounding line (=last grounded node) +SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) + !------------------------------------------------------------------------------ + !****************************************************************************** + ! + ! For the bottom surface, creates and updates a mask which may be equal to -1, 0 or 1 + ! + ! GroundedMask = + 1 if grounded + ! = - 1 if floating + ! = 0 if on the grounding line (also grounded) + ! + ! Consequently, a node is grounded if GroundedMask >= 0 + ! + ! y is the vertical in 2D ; z is the vertical in 3D + ! + ! ARGUMENTS: + ! + ! TYPE(Model_t) :: Model, + ! INPUT: All model information (mesh, materials, BCs, etc...) + ! + ! TYPE(Solver_t) :: Solver + ! INPUT: Linear & nonlinear equation solver options + ! + ! REAL(KIND=dp) :: dt, + ! INPUT: Timestep size for time dependent simulations + ! + ! LOGICAL :: TransientSimulation + ! INPUT: Steady state or transient simulation + ! + !****************************************************************************** USE DefUtils IMPLICIT NONE @@ -76,21 +105,22 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) TYPE(Element_t),POINTER :: Element TYPE(ValueList_t), POINTER :: Material, SolverParams - TYPE(Variable_t), POINTER :: PointerToVariable, bedrockVar, FrontVar, LSvar + TYPE(Variable_t), POINTER :: PointerToVariable, bedrockVar, FrontVar, LSvar, ConnMaskVar TYPE(Nodes_t), SAVE :: Nodes LOGICAL :: AllocationsDone = .FALSE., GotIt, stat,UnFoundFatal=.TRUE.,& - AllGrounded = .FALSE., useLSvar = .FALSE. + AllGrounded = .FALSE., useLSvar = .FALSE., & + CheckConn ! check ocean connectivity (creates separate mask without isolated ungrounded regions) - INTEGER :: i, mn, n, t, Nn, istat, DIM, MSum, ZSum, bedrockSource - INTEGER, POINTER :: Permutation(:), bedrockPerm(:), LSvarPerm(:) + INTEGER :: ii, mn, en, t, Nn, istat, DIM, MSum, ZSum, bedrockSource + INTEGER, POINTER :: Permutation(:), bedrockPerm(:), LSvarPerm(:), ConnMaskPerm(:) REAL(KIND=dp), POINTER :: VariableValues(:) REAL(KIND=dp) :: z, toler REAL(KIND=dp), ALLOCATABLE :: zb(:) CHARACTER(LEN=MAX_NAME_LEN) :: SolverName = 'GroundedSolver', bedrockName,& - FrontVarName, LSvarName + FrontVarName, LSvarName, ConnMaskName INTEGER,PARAMETER :: MATERIAL_DEFAULT = 1, MATERIAL_NAMED = 2, VARIABLE = 3 @@ -126,7 +156,15 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) CALL FATAL(SolverName, 'No tolerance given for the Grounded Mask.') END IF - !CHANGE + ConnMaskName = ListGetString(SolverParams, 'Connected mask name',GotIt, UnFoundFatal=.FALSE.) + IF (GotIt) THEN + CheckConn = .TRUE. + ConnMaskVar => VariableGet(Model % Mesh % Variables, ConnMaskName,UnFoundFatal=.TRUE.) + ConnMaskPerm => ConnMaskVar % Perm + ELSE + CheckConn = .FALSE. + END IF + !This to enforce all nodes grounded when doing non-calving hydrology to !restart a calving simulation from AllGrounded = GetLogical(SolverParams, 'All Grounded', GotIt) @@ -159,7 +197,6 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) END IF END IF - !CHANGE !Any variable defined on the calving front FrontVarName = GetString(SolverParams, 'Front Variable', GotIt) IF(GotIt) THEN @@ -174,7 +211,7 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) !-------------------------------------------------------------- DO t = 1, Solver % NumberOfActiveElements Element => GetActiveElement(t) - n = GetElementNOFNodes() + en = GetElementNOFNodes() IF(.NOT. AllGrounded) THEN @@ -182,26 +219,25 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) CASE (VARIABLE) bedrockVar => VariableGet(Model % Mesh % Variables, bedrockName,UnFoundFatal=UnFoundFatal) bedrockPerm => bedrockVar % Perm - zb(1:n) = bedrockVar % values(bedrockPerm(Element % NodeIndexes)) + toler + zb(1:en) = bedrockVar % values(bedrockPerm(Element % NodeIndexes)) + toler NULLIFY(bedrockPerm) NULLIFY(bedrockVar) CASE (MATERIAL_NAMED) Material => GetMaterial( Element ) - zb(1:n) = ListGetReal( Material,bedrockName, n , & + zb(1:en) = ListGetReal( Material,bedrockName, en , & Element % NodeIndexes, GotIt,UnFoundFatal=UnFoundFatal) + toler CASE (MATERIAL_DEFAULT) Material => GetMaterial( Element ) - zb(1:n) = ListGetReal( Material,'Min Zs Bottom',n , & + zb(1:en) = ListGetReal( Material,'Min Zs Bottom',en , & Element % NodeIndexes, GotIt,UnFoundFatal=UnFoundFatal) + toler END SELECT END IF CALL GetElementNodes( Nodes ) - DO i = 1, n - Nn = Permutation(Element % NodeIndexes(i)) + DO ii = 1, en + Nn = Permutation(Element % NodeIndexes(ii)) IF (Nn==0) CYCLE - !CHANGE !To enforce grounding IF(AllGrounded) THEN VariableValues(Nn) = 1.0_dp @@ -211,25 +247,28 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) IF (useLSvar) THEN LSvar => VariableGet(Model % Mesh % Variables, LSvarName, UnFoundFatal=UnFoundFatal) LSvarPerm => LSvar % Perm - z = LSvar % values( LSvarPerm(Element % NodeIndexes(i)) ) + z = LSvar % values( LSvarPerm(Element % NodeIndexes(ii)) ) ELSE IF (DIM == 2) THEN - z = Nodes % y( i ) + z = Nodes % y( ii ) ELSE IF (DIM == 3) THEN - z = Nodes % z( i ) + z = Nodes % z( ii ) END IF END IF ! Geometrical condition. Is the node is above the bedrock ! (plus the tolerance)? Note: zb includes tolerance. - IF (z > zb(i)) THEN + IF (z > zb(ii)) THEN VariableValues(Nn) = -1.0_dp ELSE VariableValues(Nn) = 1.0_dp END IF END DO END DO + + ! Check connectivity of ungrounded regions to the front (previously GMvalid solver) + IF (CheckConn) CALL FrontConn( ) !-------------------------------------------------------------- ! Grounding line loop to label grounded points at grounding Line. @@ -241,77 +280,278 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) ! to 0 (i.e. this node is on the grounding line). DO t = 1, Solver % NumberOfActiveElements Element => GetActiveElement(t) - n = GetElementNOFNodes() + en = GetElementNOFNodes() CALL GetElementNodes( Nodes ) MSum = 0 ZSum = 0 - DO i = 1, n - Nn = Permutation(Element % NodeIndexes(i)) + DO ii = 1, en + Nn = Permutation(Element % NodeIndexes(ii)) IF (Nn==0) CYCLE MSum = MSum + VariableValues(Nn) IF (ABS(VariableValues(Nn)) 0.0) VariableValues(Nn) = 0.0_dp END DO END IF END DO - IF ( ParEnv % PEs>1 ) CALL ParallelSumVector( Solver % Matrix, VariableValues, 1 ) - + IF (CheckConn) THEN + IF ( ParEnv % PEs>1 ) CALL ParallelSumVector( Solver % Matrix, ConnMaskVar % Values, OPER_MIN ) + END IF + IF ( ParEnv % PEs>1 ) CALL ParallelSumVector( Solver % Matrix, VariableValues, OPER_MIN ) + CALL INFO( SolverName , 'Done') - -END SUBROUTINE GroundedSolver -!------------------------------------------------------------------------------ -SUBROUTINE GroundedSolverInit( Model,Solver,dt,TransientSimulation ) -!------------------------------------------------------------------------------ -!****************************************************************************** -! -! for Grounded Mask initialisation purpose -! same method than above -! -!****************************************************************************** - USE DefUtils - - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Solver_t) :: Solver - TYPE(Model_t) :: Model - - REAL(KIND=dp) :: dt - LOGICAL :: TransientSimulation - - CHARACTER(LEN=MAX_NAME_LEN) :: SolverName = 'GroundedSolverInit' - - CALL FATAL( SolverName, 'This solver is deprecated due to code redundancy, & - please GroundedSolver instead' ) + +CONTAINS + + ! *****************************************************************************/ + ! * An improved version of the routine to calculate basal melt rates on + ! * ungrounded ice, producing a validity mask instead (1 = ungrounded area + ! * connected to the ice front; 0 = isolated patch). + ! ****************************************************************************** + ! * + ! * Authors: Samuel Cook + ! * Email: samuel.cook@univ-grenoble-alpes.fr + ! * Web: http://www.csc.fi/elmer + ! * Address: CSC - IT Center for Science Ltd. + ! * Keilaranta 14 + ! * 02101 Espoo, Finland + ! * + ! * Original Date: 08.2019 + ! * + ! ****************************************************************************/ + SUBROUTINE FrontConn () + USE Types + USE CoordinateSystems + USE DefUtils + USE ElementDescription + USE CalvingGeometry + + IMPLICIT NONE + + !----------------------------------- + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Matrix_t), POINTER :: Matrix + TYPE(Variable_t), POINTER :: Var, GroundedVar + TYPE(CrevasseGroup3D_t), POINTER :: FloatGroups, CurrentGroup, DelGroup + TYPE(Element_t), POINTER :: Element + TYPE(Nodes_t) :: ElementNodes + TYPE(GaussIntegrationPoints_t) :: IntegStuff + + REAL(KIND=dp) :: GMCheck, SMeltRate, WMeltRate, SStart, SStop, & + TotalArea, TotalBMelt, ElemBMelt, s, t, season,& + SqrtElementMetric,U,V,W,Basis(Model % MaxElementNodes) + INTEGER :: NoNodes, j, FaceNodeCount, GroupNodeCount, county, & + Active, ierr, kk, FoundNew, AllFoundNew + INTEGER, PARAMETER :: FileUnit = 75, MaxFloatGroups = 1000, MaxNeighbours = 20 + INTEGER, POINTER :: Perm(:), InvPerm(:), FrontPerm(:)=>NULL(), Neighbours(:,:), & + NeighbourHolder(:), NoNeighbours(:), NodeIndexes(:) + INTEGER, ALLOCATABLE :: AllGroupNodes(:), PartNodeCount(:), AllPartGroupNodes(:), & + disps(:) + LOGICAL :: Found, OutputStats, Visited=.FALSE., Debug, stat, Summer + CHARACTER(LEN=MAX_NAME_LEN) :: SolverName, GMaskVarName, FrontMaskName, OutfileName, mode + + Debug = .FALSE. + + SolverName = "GM Front connectivity" + Mesh => Solver % Mesh + + !Identify nodes on the front + FrontMaskName = "Calving Front Mask" + CALL MakePermUsingMask( Model, Solver, Mesh, FrontMaskName, & + .FALSE., FrontPerm, FaceNodeCount) + + !Need the matrix for finding neighbours + Matrix => Solver % Matrix + + IF(.NOT. ASSOCIATED(ConnMaskVar)) CALL Fatal(SolverName, "Front connectivity needs a variable!") + ConnMaskVar % Values = 1.0_dp + + NoNodes = COUNT(ConnMaskPerm > 0) -!------------------------------------------------------------------------------ -END SUBROUTINE GroundedSolverInit -!------------------------------------------------------------------------------ + ! Model, Solver, dt, TransientSimulation, ConnMaskVar +! Var => Solver % Variable +! VariableValues(Nn) = 1.0_dp +! PointerToVariable => Solver % Variable +! Permutation => PointerToVariable % Perm +! VariableValues => PointerToVariable % Values +! GMaskVarName = ListGetString(Params, "GroundedMask Variable", Found) +! IF(.NOT. Found) GMaskVarName = "GroundedMask" +! GroundedVar => VariableGet(Mesh % Variables, GMaskVarName, .TRUE., UnfoundFatal=.TRUE.) + GroundedVar => Solver % Variable + + GMCheck = -1.0_dp + + !Set up inverse perm for FindNodeNeighbours + InvPerm => CreateInvPerm(Matrix % Perm) !Create inverse perm for neighbour search + ALLOCATE(Neighbours(Mesh % NumberOfNodes, MaxNeighbours), NoNeighbours(Mesh % NumberOfNodes)) + Neighbours = 0 + + !Find neighbours for each node on the bed + DO ii = 1, Mesh % NumberOfNodes + IF(ConnMaskPerm(ii) <= 0) CYCLE + + NeighbourHolder => FindNodeNeighbours(ii, Matrix, & + Matrix % Perm, 1, InvPerm) + + Neighbours(ii,1:SIZE(NeighbourHolder)) = NeighbourHolder + NoNeighbours(ii) = SIZE(NeighbourHolder) + DEALLOCATE(NeighbourHolder) + END DO + + !Reuse some old calving code + !Find groups of connected floating nodes on the base + FloatGroups => NULL() + CALL FindCrevasseGroups(Mesh, GroundedVar, Neighbours, & + -0.5_dp, FloatGroups) + + !Check groups are valid (connected to front) + CurrentGroup => FloatGroups + DO WHILE(ASSOCIATED(CurrentGroup)) + CurrentGroup % FrontConnected = .FALSE. + DO ii=1, CurrentGroup % NumberOfNodes + + IF(FrontPerm(CurrentGroup % NodeNumbers(ii)) > 0) THEN + CurrentGroup % FrontConnected = .TRUE. + EXIT + END IF + END DO + CurrentGroup => CurrentGroup % Next + END DO + + DO kk=1,MaxFloatGroups + FoundNew = 0 + !Count and gather nodes from all valid groups + GroupNodeCount = 0 + county = 0 + DO ii=1,2 + IF(ii==2) ALLOCATE(AllGroupNodes(GroupNodeCount)) + CurrentGroup => FloatGroups + DO WHILE(ASSOCIATED(CurrentGroup)) + IF(CurrentGroup % FrontConnected) THEN + IF(ii==1) THEN + GroupNodeCount = GroupNodeCount + CurrentGroup % NumberOfNodes + ELSE + DO j=1, CurrentGroup % NumberOfNodes + county = county + 1 + AllGroupNodes(county) = Mesh % ParallelInfo % GlobalDOFs(CurrentGroup % NodeNumbers(j)) + END DO + END IF + END IF + CurrentGroup => CurrentGroup % Next + END DO + END DO + + !Distribute info to/from all partitions about groups connected to front + ALLOCATE(PartNodeCount(ParEnv % PEs)) + + CALL MPI_ALLGATHER(GroupNodeCount, 1, MPI_INTEGER, PartNodeCount, 1, & + MPI_INTEGER, MPI_COMM_WORLD, ierr) + + ALLOCATE(AllPartGroupNodes(SUM(PartNodeCount)), disps(ParEnv % PEs)) + disps(1) = 0 + DO ii=2,ParEnv % PEs + disps(ii) = disps(ii-1) + PartNodeCount(ii-1) + END DO + + CALL MPI_ALLGATHERV(AllGroupNodes, GroupNodeCount, MPI_INTEGER, & + AllPartGroupNodes, PartNodeCount, disps, MPI_INTEGER, MPI_COMM_WORLD, ierr) + + !Cycle unconnected groups, looking for partition boundary in connected groups + CurrentGroup => FloatGroups + DO WHILE(ASSOCIATED(CurrentGroup)) + IF(.NOT. CurrentGroup % FrontConnected) THEN + DO ii=1,CurrentGroup % NumberOfNodes + + IF(ANY(Mesh % ParallelInfo % GlobalDOFs(CurrentGroup % NodeNumbers(ii)) == & + AllPartGroupNodes)) THEN + CurrentGroup % FrontConnected = .TRUE. + FoundNew = 1 + END IF + + END DO + END IF + CurrentGroup => CurrentGroup % Next + END DO + CALL MPI_ALLREDUCE(FoundNew, AllFoundNew, 1, MPI_INTEGER, MPI_MAX, ELMER_COMM_WORLD, ierr) + IF(AllFoundNew == 1) THEN + DEALLOCATE(AllGroupNodes, PartNodeCount, AllPartGroupNodes, disps) + ELSE + EXIT + END IF + IF (kk.EQ.MaxFloatGroups) CALL FATAL( SolverName, 'Hard coded loop limit reached; needs recoding!' ) + END DO !k + + !Cycle all connected groups, setting melt rate + CurrentGroup => FloatGroups + DO WHILE(ASSOCIATED(CurrentGroup)) + IF(CurrentGroup % FrontConnected) THEN + DO ii=1,CurrentGroup % NumberOfNodes + ConnMaskVar % Values(ConnMaskVar % Perm(CurrentGroup % NodeNumbers(ii))) = GMCheck + END DO + END IF + CurrentGroup => CurrentGroup % Next + END DO + + !Deallocate floatgroups linked list + CurrentGroup => FloatGroups + DO WHILE(ASSOCIATED(CurrentGroup)) + DelGroup => CurrentGroup + CurrentGroup => CurrentGroup % Next + + IF(ASSOCIATED(DelGroup % NodeNumbers)) DEALLOCATE(DelGroup % NodeNumbers) + IF(ASSOCIATED(DelGroup % FrontNodes)) DEALLOCATE(DelGroup % FrontNodes) + IF(ASSOCIATED(DelGroup % BoundaryNodes)) DEALLOCATE(DelGroup % BoundaryNodes) + DEALLOCATE(DelGroup) + END DO + + DEALLOCATE(Neighbours, NoNeighbours, FrontPerm, InvPerm) + END SUBROUTINE FrontConn + +END SUBROUTINE GroundedSolver From 186f498e98a8c8a2de35971911b33eefdc5ffcac Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Sun, 16 Jun 2024 18:12:43 +0300 Subject: [PATCH 14/51] Bug fix 'SSA Friction need N' info statement --- elmerice/Solvers/GroundedSolver.F90 | 2 ++ elmerice/Utils/SSAMaterialModels.F90 | 12 ++++++++++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index e78b8bf227..db65d7b212 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -158,10 +158,12 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) ConnMaskName = ListGetString(SolverParams, 'Connected mask name',GotIt, UnFoundFatal=.FALSE.) IF (GotIt) THEN + CALL INFO( SolverName, '>Connected mask name< found, checking connectivity.',Level=5 ) CheckConn = .TRUE. ConnMaskVar => VariableGet(Model % Mesh % Variables, ConnMaskName,UnFoundFatal=.TRUE.) ConnMaskPerm => ConnMaskVar % Perm ELSE + CALL INFO( SolverName, '>Connected mask name< not found, not using.',Level=5 ) CheckConn = .FALSE. END IF diff --git a/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index 50ef065714..b5f32e541b 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -55,6 +55,7 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s REAL(KIND=dp) :: ub ! the velocity for non-linear friction laws LOGICAL :: SEP ! Sub-Element Parametrisation of the friction LOGICAL :: PartlyGrounded ! is the GL within the current element? + LOGICAL :: FirstTime = .TRUE. REAL(KIND=dp) :: h ! for SEP: the ice thickness at current location REAL(KIND=dp) :: rho,rhow,sealevel ! density, sea-water density, sea-level REAL(KIND=dp),OPTIONAL :: SlipDer ! dSlip/du=dSlip/dv if ub=(u^2+v^2)^1/2 ! required to compute the Jacobian @@ -80,6 +81,8 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s LOGICAL :: Found, NeedN + SAVE FirstTime + ! Sub - element GL parameterisation IF (SEP) THEN GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) @@ -135,8 +138,13 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s ! regularised Coulomb sliding, where the initial coefficient is now ! multiplied by effective pressure, N NeedN = ListGetLogical( Material, 'SSA Friction need N', Found) - CALL INFO("SSAEffectiveFriction","> SSA Friction need N < not found, assuming false",level=3) - IF (.NOT. Found) NeedN = .FALSE. + IF (.NOT. Found) THEN + IF (FirstTime) THEN + CALL INFO("SSAEffectiveFriction","> SSA Friction need N < not found, assuming false",level=3) + FirstTime = .FALSE. + END IF + NeedN = .FALSE. + END IF CASE(REG_COULOMB_GAG,BUDD) NeedN = .TRUE. END SELECT From 9289819b724f9b000461da5fac32b2076105b630 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Mon, 17 Jun 2024 09:53:08 +0300 Subject: [PATCH 15/51] updated info message from GroundedSolver --- elmerice/Solvers/GroundedSolver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index db65d7b212..9e0abc2142 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -158,7 +158,7 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) ConnMaskName = ListGetString(SolverParams, 'Connected mask name',GotIt, UnFoundFatal=.FALSE.) IF (GotIt) THEN - CALL INFO( SolverName, '>Connected mask name< found, checking connectivity.',Level=5 ) + CALL INFO( SolverName, '>Connected mask name< found, connectivity will be checked.',Level=5 ) CheckConn = .TRUE. ConnMaskVar => VariableGet(Model % Mesh % Variables, ConnMaskName,UnFoundFatal=.TRUE.) ConnMaskPerm => ConnMaskVar % Perm From 0839761d6199e7d02ae046fc86688d04099e3c83 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Tue, 18 Jun 2024 11:41:17 +0300 Subject: [PATCH 16/51] Modifying GlaDS to use specified mask instead of compbined hard coded grounded mask and GMcheck options. --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 101 ++++++++++++++++-------- elmerice/Solvers/GroundedSolver.F90 | 10 +-- 2 files changed, 73 insertions(+), 38 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index e0944cb3ca..5d8d131540 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -96,7 +96,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati qSolution(:), hstoreSolution(:), QcSolution(:), QmSolution(:),& CAValues(:), CFValues(:), SHValues(:) - CHARACTER(LEN=MAX_NAME_LEN) :: VariableName, SolverName + CHARACTER(LEN=MAX_NAME_LEN) :: VariableName, SolverName, MaskName CHARACTER(LEN=MAX_NAME_LEN) :: SheetThicknessName, ChannelAreaName, ZbName CHARACTER(LEN=MAX_NAME_LEN) :: methodSheet, methodChannels @@ -105,7 +105,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati meltChannels = .TRUE., NeglectH = .TRUE., Calving = .FALSE., & CycleElement=.FALSE., MABool = .FALSE., MaxHBool = .FALSE., LimitEffPres=.FALSE., & MinHBool=.FALSE., CycleNode=.FALSE. - LOGICAL, SAVE :: UseGM, UseGC, ZeroSheetAtGL, ZeroSheetWithHP + LOGICAL, SAVE :: UseGM, UseGC, AllowSheetAtGL, ZeroSheetWithHP LOGICAL, ALLOCATABLE :: IsGhostNode(:), NoChannel(:), NodalNoChannel(:) ! For use in masking GlaDS floating shelves. "MASK_HP" is for situations where @@ -355,32 +355,38 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati ! Default behaviour relating to marine ice sheets and unglaciated grounded areas is to set the ! following switches to false. The defaults change to true when using Samuel Cook's "Calving" - ! (set in simulation seciton of sif). The defaults will be overwritten for each of the switches + ! (set in simulation section of sif). The defaults will be overwritten for each of the switches ! that are specified in the solver section of the sif. SolverParams => GetSolverParams() + UseGM = GetLogical( SolverParams,'Use GroundedMask', Found ) IF (.NOT. Found) THEN - IF (Calving) THEN - UseGM = .TRUE. - ELSE - UseGM = .FALSE. - END IF + IF (Calving) THEN + UseGM = .TRUE. + ELSE + UseGM = .FALSE. + END IF END IF - UseGC = GetLogical( SolverParams,'Use GMcheck', Found ) - IF (.NOT. Found) THEN - IF (Calving) THEN - UseGC = .TRUE. - ELSE - UseGC = .FALSE. - END IF + IF (UseGM) THEN + MaskName = GetString( SolverParams, 'Mask Name', Found ) + IF (.NOT. Found) THEN + MaskName = "GroundedMask" + END IF END IF - ZeroSheetAtGL = GetLogical( SolverParams,'Zero Sheet At GL', Found ) + + ! END IF +! UseGC = GetLogical( SolverParams,'Use GMcheck', Found ) +! IF (.NOT. Found) THEN +! IF (Calving) THEN +! UseGC = .TRUE. +! ELSE +! UseGC = .FALSE. +! END IF +! END IF + + AllowSheetAtGL = GetLogical( SolverParams,'Allow Sheet At GL', Found ) IF (.NOT. Found) THEN - IF (Calving) THEN - ZeroSheetAtGL = .TRUE. - ELSE - ZeroSheetAtGL = .FALSE. - END IF + AllowSheetAtGL = .TRUE. END IF ZeroSheetWithHP = GetLogical( SolverParams,'Zero Sheet With HP', Found ) IF (.NOT. Found) THEN @@ -1124,12 +1130,12 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CALL GetElementNodes( ElementNodes ) - IF (UseGM.OR.UseGC) THEN + IF (UseGM) THEN ! Cycle elements with ungrounded nodes and zero all hydrology variables CycleElement = .FALSE. DO i=1, N - MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, Element % NodeIndexes(i)) + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, Element % NodeIndexes(i)) SELECT CASE (MaskStatus) CASE (MASK_ALL) CycleElement = .TRUE. @@ -1204,9 +1210,9 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF (k==0) CYCLE CycleNode = .FALSE. - IF (UseGM.OR.UseGC) THEN + IF (UseGM) THEN ! Cycle ungrounded nodes and zero hydrology variables - MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, j) + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, Element % NodeIndexes(i)) SELECT CASE (MaskStatus) CASE (MASK_ALL) CycleNode = .TRUE. @@ -1288,11 +1294,11 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati IF (ANY(HydPotPerm(Edge % NodeIndexes(1:n))==0)) CYCLE IF (ALL(NoChannel(Edge % NodeIndexes(1:n)))) CYCLE - IF (UseGM.OR.UseGC) THEN + IF (UseGM) THEN ! Cycle ungrounded nodes and zero hydrology variables CycleElement = .FALSE. DO i=1, n - MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, Edge % NodeIndexes(i)) + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, Element % NodeIndexes(i)) SELECT CASE (MaskStatus) CASE (MASK_ALL) CycleElement = .TRUE. @@ -1520,11 +1526,11 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati n = GetElementNOFNodes(Element) CALL GetElementNodes( ElementNodes ) - IF (UseGM.OR.UseGC) THEN + IF (UseGM) THEN ! Cycle ungrounded nodes and zero hydrology variables CycleElement = .FALSE. DO i=1, n - MaskStatus = ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, Element % NodeIndexes(i)) + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, Element % NodeIndexes(i)) SELECT CASE (MaskStatus) CASE (MASK_ALL) CycleElement = .TRUE. @@ -1589,6 +1595,35 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CONTAINS + ! Use the grounded mask to decide how to mask the current node. + !---------------------------------------------------------------------------------------------------------- + FUNCTION ProcessMask(MaskName, AllowSheetAtGL, ii) RESULT( MaskStatus_local ) + + CHARACTER(LEN=MAX_NAME_LEN), INTENT(IN) :: MaskName + LOGICAL, INTENT(IN) :: AllowSheetAtGL + INTEGER, INTENT(IN) :: ii ! node index + + INTEGER :: MaskStatus_local + + MaskStatus_local = MASK_NONE + + GroundedMaskVar => VariableGet(Mesh % Variables, MaskName, ThisOnly=.TRUE., UnfoundFatal=.TRUE.) + + IF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).LT.0.0) THEN + MaskStatus_local = MASK_ALL + ELSEIF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).EQ.0.0) THEN + IF (AllowSheetAtGL) THEN + MaskStatus_local = MASK_HP + ELSE + MaskStatus_local = MASK_ALL + END IF + END IF + + NULLIFY(GroundedMaskVar) + + END FUNCTION ProcessMask + + ! Use the grounded mask and or grounded mask check to decide how to mask the current node. ! The following table summarises actions as a function of mask values. ! @@ -1602,9 +1637,9 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati ! 1 1 Grounded (shelf); Fatal (mask inconsistency) ! !---------------------------------------------------------------------------------------------------------- - FUNCTION ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, ii) RESULT( MaskStatus_local ) + FUNCTION ProcessMasks(UseGM, UseGC, AllowSheetAtGL, ii) RESULT( MaskStatus_local ) - LOGICAL, INTENT(IN) :: UseGM, UseGC, ZeroSheetAtGL + LOGICAL, INTENT(IN) :: UseGM, UseGC, AllowSheetAtGL INTEGER, INTENT(IN) :: ii ! node index INTEGER :: MaskStatus_local @@ -1622,7 +1657,7 @@ FUNCTION ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, ii) RESULT( MaskStatus_local IF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).LT.0.0) THEN MaskStatus_local = MASK_ALL ELSEIF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).EQ.0.0) THEN - IF (ZeroSheetAtGL) THEN + IF (AllowSheetAtGL) THEN MaskStatus_local = MASK_HP ELSE MaskStatus_local = MASK_ALL @@ -1635,7 +1670,7 @@ FUNCTION ProcessMasks(UseGM, UseGC, ZeroSheetAtGL, ii) RESULT( MaskStatus_local IF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).LT.0.0) THEN MaskStatus_local = MASK_ALL ELSEIF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).EQ.0.0) THEN - IF (ZeroSheetAtGL) THEN + IF (AllowSheetAtGL) THEN MaskStatus_local = MASK_HP ELSE MaskStatus_local = MASK_ALL diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index 78060c86ce..4fb5bedeab 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -294,7 +294,7 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) IF (ABS(VariableValues(Nn)) Date: Thu, 20 Jun 2024 16:37:28 +0200 Subject: [PATCH 17/51] Documentation Covariance Utils --- .../BackgroundErrorCostSolver.F90 | 26 ++-- .../GaussianSimulationSolver.F90 | 9 +- .../BackgroundErrorCostSolver.md | 140 ++++++++++++++++++ elmerice/Solvers/Documentation/Covariance.md | 20 +++ .../Documentation/CovarianceUtilsModule.md | 9 ++ .../CovarianceVectorMultiplySolver.md | 86 +++++++++++ .../Documentation/GaussianSimulationSolver.md | 92 ++++++++++++ .../Solvers/Documentation/MakeDoc_Adjoint.yml | 1 + .../Documentation/MakeDoc_CovarianceUtils.yml | 26 ++++ elmerice/Solvers/Documentation/README.md | 13 ++ 10 files changed, 404 insertions(+), 18 deletions(-) create mode 100644 elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md create mode 100644 elmerice/Solvers/Documentation/Covariance.md create mode 100644 elmerice/Solvers/Documentation/CovarianceUtilsModule.md create mode 100644 elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md create mode 100644 elmerice/Solvers/Documentation/GaussianSimulationSolver.md create mode 100644 elmerice/Solvers/Documentation/MakeDoc_CovarianceUtils.yml diff --git a/elmerice/Solvers/Covarianceutils/BackgroundErrorCostSolver.F90 b/elmerice/Solvers/Covarianceutils/BackgroundErrorCostSolver.F90 index 9fbc8f9715..2e7d79c2d0 100644 --- a/elmerice/Solvers/Covarianceutils/BackgroundErrorCostSolver.F90 +++ b/elmerice/Solvers/Covarianceutils/BackgroundErrorCostSolver.F90 @@ -1,29 +1,29 @@ -!*********************************************************************************************** +!*********************************************************************************************** ! Compute a cost function from a background as Cost=0.5 * (x-x^b). B^-1 .(x-x^b) -! x is the optimised variable; x^b the background +! x is the optimized variable; x^b the background ! B^1 is the background error covariance matrix: ! here B= S . C . S ! with: -! - S is a diagonale matrix with the standard deviation (assumed constant for now) -! - C is a correlation matix +! - S is a diagonal matrix with the standard deviation (assumed constant for now) +! - C is a correlation matrix ! Available choices for C "Covariance type = String ..." ! - diagonal; i.e. C=I and B=S^2 is diagonal with the variances ! - "full matrix" : C is computed from standard correlation -! functions and inverted using lapack routines +! functions and inverted using Lapack routines ! - "diffusion operator" : C is approximated with the diffusion operator approach -! Current limitaions : +! Current limitations : ! - 2D mesh; TODO to run it on a 2D surface boundary? -! - Serial fro the full-matrix approach +! - Serial for the full-matrix approach ! ! Rq. -! - IF x has DOFs > 1 we apply independandtly the same B^-1 -! - IF 2 instances of the same solver are used in the same .sif mae a -! copy of the lib as things are initialised and saved.... +! - IF x has DOFs > 1 we apply independently the same B^-1 +! - IF 2 instances of the same solver are used in the same .sif make a +! copy of the lib as things are initialized and saved.... ! ! TODO: ! - add mandatory keywords at init, e.g. variable, ... -! -!*********************************************************************************************** +! +!*********************************************************************************************** SUBROUTINE BackgroundErrorCostSolver( Model,Solver,dt,TransientSimulation ) !*********************************************************************************************** USE GeneralUtils @@ -209,7 +209,7 @@ SUBROUTINE BackgroundErrorCostSolver( Model,Solver,dt,TransientSimulation ) ! gradient = SIGMA^1 C^1 SIGMA^1 . (x-x_b) ! gradients are gathered in the optimisation step; so also normalize by One. - DJDValues(DOFS*(DJDPerm(ActiveNodes(1:nn))-1)+i)=DJDValues(DOFS*(DJDPerm(ActiveNodes(1:nn))-1)+i)+ & + DJDValues(DOFS*(DJDPerm(ActiveNodes(1:nn))-1)+i)=DJDValues(DOFS*(DJDPerm(ActiveNodes(1:nn))-1)+i)+ & y(Solver%Variable%Perm(ActiveNodes(1:nn)))/One(Solver%Variable%Perm(ActiveNodes(1:nn))) diff --git a/elmerice/Solvers/Covarianceutils/GaussianSimulationSolver.F90 b/elmerice/Solvers/Covarianceutils/GaussianSimulationSolver.F90 index 132b82801c..9c4ccc1785 100644 --- a/elmerice/Solvers/Covarianceutils/GaussianSimulationSolver.F90 +++ b/elmerice/Solvers/Covarianceutils/GaussianSimulationSolver.F90 @@ -1,5 +1,5 @@ -!*********************************************************************************************** -!*********************************************************************************************** +!*********************************************************************************************** +!*********************************************************************************************** SUBROUTINE GaussianSimulationSolver( Model,Solver,dt,TransientSimulation ) !*********************************************************************************************** USE GeneralUtils @@ -106,7 +106,6 @@ SUBROUTINE GaussianSimulationSolver( Model,Solver,dt,TransientSimulation ) seed = ListGetInteger( SolverParams , 'Random Seed',Found ) IF (Found) call random_seed( put=seed ) CALL random_seed(get=seed) - PRINT *,"SEED",seed(1) deallocate(seed) !Create DOFs random vectors of size n @@ -118,8 +117,8 @@ SUBROUTINE GaussianSimulationSolver( Model,Solver,dt,TransientSimulation ) END DO DO k=1,DOFs - x(Perm(ActiveNodes(1:nn)))=rr(ActiveNodes(1:nn),k) - + x(Perm(ActiveNodes(1:nn)))=rr(ActiveNodes(1:nn),k) + SELECT CASE (CovType) CASE('diagonal') y(:) = std*x(:) diff --git a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md new file mode 100644 index 0000000000..784ecbd4af --- /dev/null +++ b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md @@ -0,0 +1,140 @@ +## Background Error Cost Solver {#Background_Error} + +### General Information +- **Solver Fortran File:** BackgroundErrorCostSolver.F90 +- **Solver Name:** BackgroundErrorCostSolver +- **Required Input Variable(s):** + - Variable: the *active* variable + - Background Variable: A *prior* estimate against which we compare the *active* variable +- **Required Output Variable(s):** + - Cost Variable: global variable containing the *cost* + - Gradient Variable: derivative of the cost w.r.t. the *active* variable +- **Required Input Keywords:** + - **Solver Section**: + - Variable name = *String* : Name of the *active* variable + - Background Variable name = *String* : Name of the *Background Variable* + - Gradient Variable name = *String* : Name of the *Gradient Variable* + - Cost Variable name = *String* : Name of the *Cost Variable* + - Cost Filename = *File* : Cost file name + - Reset Cost Value = *Logical* (Default: True) : Cost and gradient are initialized to 0 if true + - standard deviation = *Real* : the standard deviation $\sigma$ + - Covariance type = *String* : Available choices to construct the covariance matrix + - "diffusion operator" + - "full matrix" + - "diagonal" + - **covariance type specific keywords**: see [CovarianceUtils.md](CovarianceUtils.md) + + +### General Description + +This solver is mainly intended to be used with the adjoint inverse methods implemented in Elmer/Ice (see the corresponding documentations). + +It is an alternative to the *Regularisation* solver that penalizes the fist spatial derivatives of the *active* variable $x$, where $x$ is usually the basal friction coefficient, ice viscosity or bed elevation (see [Adjoint_CostRegSolver.md](Adjoint_CostRegSolver.md)) + +Here the cost is computed as $$Cost=0.5 (x-x^b). B^{-1} .(x-x^b)$$ where: +- $x$ is the *active* variable +- $x^b$ is the *background* variable, i.e. a prior estimate of $x$ +- $B$ is the background error **covariance** matrix, i.e. is described the statics of the *expected* (or *tolerated*) difference between the background $x^b$ and the active variable $x$. + +The gradient of the Cost w.r.t. the *active* variable is then obtained as: +$$dCost/dx=B^{-1}.(x-x_b)$$ + + +This cost function is usually applied in addition of a cost function that penalizes the difference between a diagnostic variable $u(x)$ and its observed counterpart $u^o$, which is general would be written as $$Cost^o=0.5 (u(x)-u^o). R^{-1} .(u(x)-u^o)$$, where $R$ is the observation error correlation matrix. This cost can be computed using e.g. the [Adjoint_CostDiscSolver](Adjoint_CostDiscSolver.md) (restricted to errors that are not spatially correlated, i.e. $R$ is diagonal and contains the observation errors variances) + +If the observation and background errors are gaussian (described by the respective covariance matrices $R$ and $B$), the errors unbiaised and the observation operator is linear, i.e. $u=K.x$, the solution of the variational inverse problem, i.e. finding the minimum of the cost function, solves the Bayesian inference problem. The optimal solution then depends on the confidence that is given to the observation and to the background, which is *parameterized* by the corresponding covariance matrices. Special care must then be taken when prescribing these matrices. + +Providing: +- the input active variable $x$, given by the solver keyword *Variable name* +- a variable containing the background $x^b$, given by the solver keyword *Background Variable name* +- a method and the parameters for the covariance structure, given by the solver keyword *Covariance type* and method specific keywords +this solver computes: +- the *Cost* with is saved in the global cost variable, given by the solver keyword *Cost Variable name* +- the gradient of the cost variable w.r.t. $x$, given by the solver keyword *Cost Variable name* + +The value of the cost a a function of the iteration is save in an ascii file defined by the solver keyword *Cost Filename*. + +### Implementation + +The covariance matrix is of size $n \times n$, with $n$ the number of mesh nodes, is usually full rank, and often poorly known. It is then standard to parameterize this matrix using standard correlation functions $c(d)$ that describe the spatial correlation between 2 points as a function of the distance $d$ between the points. The correlation structure depends then on the correlation function (typical functions are, e.g., the exponential, squared exponential (or gaussian), Matérn functions) which usually depends on a *correlation length scale* or *range*. + +The inverse covariance matrix $B^{-1}$ is factored in the standard form +$$B^{-1}=\Sigma^{-1}. C^{-1} . \Sigma^{-1}$$ +where: +- $\Sigma$ is a diagonal matrix containing the standard deviations, assumed spatially uniforms fro now, i.e. $\Sigma=\sigma I$, with $I$ the identity matrix. +- $C^{-1}$ is the inverse of the correlation matrix whose components are defined using standard correlation functions $c(d)$. + +In general it is not necessary to explicitly compute and store $B$ (or its inverse), and it can be replaced by an equivalent operator. For **Covariance type = String "diffusion operator"**, the operator results from the discretization of a diffusion equation, which can be done efficiently for unstructured meshes with the finite element method. With this method the operator kernel is a correlation function from the Matérn family. The implementation follows Guillet et al. (2019). + +See [CovarianceUtils.md](CovarianceUtils.md) for details on the possible choices to construct $C$. + +### Discussion + + Brasseur et al. (1996) have shown that adding a smoothness constraint that penalizes a combination of the nom and of the spatial derivatives up to order 2, is equivalent, for an infinite domain, to imposing a kernel from the Matérn family with a **smoothness parameter** $\nu=1$. This has been generalized to higher dimensions and derivatives by Barth et al. (2014). Regularisation of inverse problems can often be reinterpreted in the Bayesian framework (Calvetti and Somersalo, 2018), so that the effect of this solver will be similar to the classically used *Regularisation* solver that penalizes he first spatial derivatives, and the choice of the correlation structure and parameters will control the **smoothness** of the inverted field. However this solver is then much more versatile and the parameters have a direct physical interpretation. + + For an application of this method in ice-sheet modeling for the inversion of both basal friction and viscosity in the Antarctic Ice Sheet see e.g. Recinos et al. (2023). + + +### Known Bugs and Limitations + +- Limited to 2D meshes +- Limited to serial if using the "full matrix" covariance method. +- The *diffusion operator* might be inaccurate near the boundaries or for highly distorted elements (see Guillet et al., 2019) +- For the moment the implementation is limited to isotropic covariances with spatially uniform parameters (standard deviation and correlation length scale); but this could be improved (see Guillet et al., 2019) + +### SIF Contents + + +``` +Solver 1 + Equation = String "CostReg" + procedure = "ElmerIceSolvers" "BackgroundErrorCostSolver" + Variable = -nooutput "dumy" + + !# Variable names + Variable Name = String "bed" + Gradient Variable Name = String "bedb" + Background Variable Name = String "bmean" + Cost Variable Name= String "CostValue" + + !# output cost file + Cost Filename = File "CostFile.dat" + + !# True if cost function and gradient must be initialized to 0 in this solve + !# otherwise cost and gradient will be added to the previous Values + !# which is the case if this solver is used after a Cost Solver + !# measuring error w.r.t. observations + Reset Cost Value = Logical False + +!# Covariance types + !############################################################################ + !# keywords for the "diffusion operator" method + !# see CovarianceUtils.md for other choices + !############################################################################ + Covariance type = String "diffusion operator" + + Matern exponent m = Integer $m + correlation range = Real $range + standard deviation = Real $std + +!# The diffusion operator method requires to solve symmetric positive definite +!# linear systems + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Linear System Refactorize = Logical False + Linear System Symmetric = Logical True + Linear System Positive Definite = Logical True + +end +``` +### Examples + + +### References + +- Barth, A., Beckers, J.-M., Troupin, C., Alvera-Azcárate, A., and Vandenbulcke, L.: divand-1.0: n-dimensional variational data analysis for ocean observations, Geosci. Model Dev., 7, 225–241, https://doi.org/10.5194/gmd-7-225-2014, 2014. +- Brasseur, P., Beckers, J.M., Brankart, J.M. and R. Schoenauen, Seasonal temperature and salinity fields in the Mediterranean Sea: Climatological analyses of a historical data set, Deep Sea Research Part I: Oceanographic Research Papers, 43(2), 1996, https://doi.org/10.1016/0967-0637(96)00012-X +- Calvetti D, Somersalo E. Inverse problems: From regularization to Bayesian inference. WIREs Comput Stat., 2018 https://doi.org/10.1002/wics.1427 +- Guillet O., Weaver A.T., Vasseur X., Michel Y., Gratton S., Gurol S. Modelling spatially correlated observation errors in variational data assimilation using a diffusion operator on an unstructured mesh. Q. J. R. Meteorol. Soc., 2019. https://doi.org/10.1002/qj.3537 +- Recinos, B., Goldberg, D., Maddison, J. R., and Todd, J.: A framework for time-dependent ice sheet uncertainty quantification, applied to three West Antarctic ice streams, The Cryosphere, 17, https://doi.org/10.5194/tc-17-4241-2023, 2023. diff --git a/elmerice/Solvers/Documentation/Covariance.md b/elmerice/Solvers/Documentation/Covariance.md new file mode 100644 index 0000000000..b633807a60 --- /dev/null +++ b/elmerice/Solvers/Documentation/Covariance.md @@ -0,0 +1,20 @@ +--- +title: | + | ElmerIce Documentation : + | Spatial correlation modelisation +author: +- F. Gillet-Chaulet +date: +- 20/03/2024 +--- + +## Introduction + + +The solvers: +- [BackgroundErrorCostSolver](#Background_Error) +- [CovarianceVectorMultiplySolver](#Covariance_Vector_product) +- [GaussianSimulationSolver](#Gaussian_simulation) ... + +The module: +- [CovarianceUtils](#Covariance_Module) diff --git a/elmerice/Solvers/Documentation/CovarianceUtilsModule.md b/elmerice/Solvers/Documentation/CovarianceUtilsModule.md new file mode 100644 index 0000000000..0c8c2b9532 --- /dev/null +++ b/elmerice/Solvers/Documentation/CovarianceUtilsModule.md @@ -0,0 +1,9 @@ +## Covariance Utils Module {#Covariance_Module} + +### General Information +- **Fortran Module File:** CovarianceUtils.F90 + + +### General Description + + diff --git a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md new file mode 100644 index 0000000000..8ed20c9e7e --- /dev/null +++ b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md @@ -0,0 +1,86 @@ +## Covariance Vector Multiply Solver {#Covariance_Vector_product} + +### General Information +- **Solver Fortran File:** CovarianceVectorMultiplySolver.F90 +- **Solver Name:** CovarianceVectorMultiplySolver +- **Required Input Variable(s):** + - A nodal input variable $x$ +- **Required Output Variable(s):** + - The product of a covariance matrix with the input variable +- **Required Input Keywords:** + - **Solver Section**: + - Input Variable = *String* : Name of the input variable + - standard deviation = *Real* : the standard deviation $\sigma$ + - Covariance type = *String* : Available choices to construct the covariance matrix + - "diffusion operator" + - "full matrix" + - "diagonal" + - **covariance type specific keywords**: see [CovarianceUtils.md](CovarianceUtils.md) +- **Optional Input Keywords:** + - **Solver Section**: + - Normalize = *Logical*: wether to normalize the output (default: False) + + +### General Description + +Compute the product $$y=C.x$$ +with: +- $x$ and input variable +- $C$ a covariance matrix + +Applications: +- **covariance visualization and code validation**: the spatial correlation function at a given node $z_i$ corresponds to the $i$-th column of the covariance matrix $C$. It can be visualized by plotting the result of applying $C$ to a vector that has a value of one at $z_i$ and a value of zero at all other points (Guillet et al., 2019). +- **Filtering**: When *Normalize = Logical True*, the output is normalized by the results of applying $C$ to a vector full of ones. If the kernel is a Gaussian correlation function, this would be equivalent to applying a Gaussian filter and this will thus smooth the input variable. The Matérn covariance, obtained with the *diffusion operator* method, converges to the Gaussian correlation function when the smoothness parameters $\nu$ tends to infinity. + +### Implementation + +See the generic documentation for [CovarianceUtils.md](CovarianceUtils.md) for details on the possible choices to construct the covariance matrix $C$. + + +### Known Bugs and Limitations + +- Limited to 2D meshes. +- Limited to serial if using the "full matrix" covariance method. + + +### SIF Contents + +``` +Solver 1 + Equation = "Filter" + Variable = "y" + Procedure = "CovarianceVectorMultiplySolver" "CovarianceVectorMultiplySolver" + + input variable = string "x" + + Normalize = Logical True !#(default: False) + +!# Covariance types + !############################################################################ + !# keywords for the "diffusion operator" method + !# see CovarianceUtils.md for other choices + !############################################################################ + Covariance type = String "diffusion operator" + + Matern exponent m = Integer $m + correlation range = Real $range + standard deviation = Real $std + +!# The diffusion operator method requires to solve symmetric positive definite +!# linear systems + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Linear System Refactorize = Logical False + Linear System Symmetric = Logical True + Linear System Positive Definite = Logical True + +end +``` + +### Examples + + +### References + +- Guillet O., Weaver A.T., Vasseur X., Michel Y., Gratton S., Gurol S. Modelling spatially correlated observation errors in variational data assimilation using a diffusion operator on an unstructured mesh. Q. J. R. Meteorol. Soc., 2019. https://doi.org/10.1002/qj.3537 diff --git a/elmerice/Solvers/Documentation/GaussianSimulationSolver.md b/elmerice/Solvers/Documentation/GaussianSimulationSolver.md new file mode 100644 index 0000000000..b1b58ecc80 --- /dev/null +++ b/elmerice/Solvers/Documentation/GaussianSimulationSolver.md @@ -0,0 +1,92 @@ +## Gaussian Simulation Solver {#Gaussian_simulation} + +### General Information +- **Solver Fortran File:** GaussianSimulationSolver.F90 +- **Solver Name:** GaussianSimulationSolver +- **Required Input Variable(s):** + - The *mean* of the distribution as a nodal variable +- **Required Output Variable(s):** + - The main solver variable is a random sample drawn from the given normal distribution +- **Required Input Keywords:** + - **Solver Section**: + - Background Variable name = *String* : Name of the variable that contains the *mean* + - standard deviation = *Real* : the standard deviation $\sigma$ + - Covariance type = *String* : Available choices to construct the covariance matrix + - "diffusion operator" + - "full matrix" + - "diagonal" + - **covariance type specific keywords**: see [CovarianceUtils.md](CovarianceUtils.md) +- **Optional Input Keywords:** + - **Solver Section**: + - Random Seed = *Integer*: a seed to initialize the random generator for repeatability + + +### General Description + +For a random variable $X$ that is normally distributed as $$X \sim \mathcal{N}(x^b,C)$$, with $x^b$ the mean and $C$ the covariance matrix, it is possible to draw non-conditionnal realizations $x^s$ as +$$x^s = x^b + V.z$$ +where: +- $V$ is obtained from a factorization of $C$ as $C=VV^T$, classically a Cholesky factorisation. +- $z$ is a vector of uniformly distributed random numbers with zero mean. + +See e.g. Graham et al., (2017). + +For an application to uncertainty quantification in ice sheet modeling, using the *diffusion operator* covariance type, see Bulthuis and Larour (2022). + +### Implementation + +See the generic documentation for [CovarianceUtils.md](CovarianceUtils.md) for details on the possible choices to construct the covariance matrix $C$ and for the factorization. + +It the solver variable is a vector, each component contains a different realization, otherwise each call to the solver (e.g. during steady-state iterations) will give a different realization. + +### Known Bugs and Limitations + +- Limited to 2D meshes. +- Limited to serial if using the "full matrix" covariance method. +- The *diffusion operator* might be inaccurate near the boundaries or for highly distorted elements (see Guillet et al., 2019) +- For the moment the implementation is limited to isotropic covariances with spatially uniform parameters (standard deviation and correlation length scale); but this could be improved (see Guillet et al., 2019) + +### SIF Contents + +``` +Solver 1 + Equation = "GSim" + Variable = -dofs 1 "xs" + procedure = "ElmerIceSolvers" "GaussianSimulationSolver" + + !# Variable names + Background Variable Name = String "xb" + +!# Covariance types + !############################################################################ + !# keywords for the "diffusion operator" method + !# see CovarianceUtils.md for other choices + !############################################################################ + Covariance type = String "diffusion operator" + + Matern exponent m = Integer $m + correlation range = Real $range + standard deviation = Real $std + +!# The diffusion operator method requires to solve symmetric positive definite +!# linear systems + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Linear System Refactorize = Logical False + Linear System Symmetric = Logical True + Linear System Positive Definite = Logical True + +end +``` + +### Examples + + +### References + +- Bulthuis, K. and Larour, E.: Implementation of a Gaussian Markov random field sampler for forward uncertainty quantification in the Ice-sheet and Sea-level System Model v4.19, Geosci. Model Dev., 15, 1195–1217, https://doi.org/10.5194/gmd-15-1195-2022, 2022 + +- Graham, F. S., Roberts, J. L., Galton-Fenzi, B. K., Young, D., Blankenship, D., and Siegert, M. J.: A high-resolution synthetic bed elevation grid of the Antarctic continent, Earth Syst. Sci. Data, 9, 267–279, https://doi.org/10.5194/essd-9-267-2017, 2017. + +- Guillet O., Weaver A.T., Vasseur X., Michel Y., Gratton S., Gurol S. Modelling spatially correlated observation errors in variational data assimilation using a diffusion operator on an unstructured mesh. Q. J. R. Meteorol. Soc., 2019. https://doi.org/10.1002/qj.3537 diff --git a/elmerice/Solvers/Documentation/MakeDoc_Adjoint.yml b/elmerice/Solvers/Documentation/MakeDoc_Adjoint.yml index cf8cece40e..6ff921b5f2 100644 --- a/elmerice/Solvers/Documentation/MakeDoc_Adjoint.yml +++ b/elmerice/Solvers/Documentation/MakeDoc_Adjoint.yml @@ -18,6 +18,7 @@ input-files: - Adjoint_CostContSolver.md - AdjointSSA_CostFluxDivSolver.md - RegSolvers_part.md +- BackgroundErrorCostSolver.md - Adjoint_CostRegSolver.md - AdjointSSA_CostTaubSolver.md - StokesSolvers_part.md diff --git a/elmerice/Solvers/Documentation/MakeDoc_CovarianceUtils.yml b/elmerice/Solvers/Documentation/MakeDoc_CovarianceUtils.yml new file mode 100644 index 0000000000..941263172a --- /dev/null +++ b/elmerice/Solvers/Documentation/MakeDoc_CovarianceUtils.yml @@ -0,0 +1,26 @@ +## default file to generate documentation from .md files using pandoc +# run: pandoc -d MakeDoc_CovarianceUtils.yml +from: markdown +to: pdf + +output-file: Documentation_CovarianceUtils.pdf + +top-level-division: part + +input-files: +- Covariance.md +- BackgroundErrorCostSolver.md +- GaussianSimulationSolver.md +- CovarianceVectorMultiplySolver.md +- CovarianceUtilsModule.md + +standalone: true + +table-of-contents: true + +number-sections: true + +variables: + documentclass: scrreprt + urlcolor: cyan + #documentclass: report diff --git a/elmerice/Solvers/Documentation/README.md b/elmerice/Solvers/Documentation/README.md index 4b8a643ed8..a7adfc98c0 100644 --- a/elmerice/Solvers/Documentation/README.md +++ b/elmerice/Solvers/Documentation/README.md @@ -50,6 +50,7 @@ Generic Solvers: - [Adjoint_CostDiscSolver](Adjoint_CostDiscSolver.md) - [Adjoint_CostContSolver](Adjoint_CostContSolver.md) - [Adjoint_CostRegSolver](Adjoint_CostRegSolver.md) +- [BackgroundErrorCostSolver](BackgroundErrorCostSolver.md) Stokes Solvers: @@ -75,3 +76,15 @@ Generic user functions: ## Coupled hydrology-plumes-calving This is pretty much the output of Samuel Cook's PhD thesis on 3D coupled modelling of a tidewater glacier, and involves coupling the GlaDS hydrology solvers with Joe Todd's 3D calving solvers, and a new 1D ODE solver for glacial meltwater plumes based on the work of Donald Slater. Several other new solvers are also required to manage the interaction between all these moving parts. If you're interested in using this set-up, a full description, including all necessary solvers, SIF inclusions, and mesh fiddliness, is provided in [CoupledIceHydrologyCalvingPlumesDocumentation](CoupledIceHydrologyCalvingPlumesDocumentation.md)(the individual new solvers are also all documented in their own .md files, which you may find it useful to look at). Note: all the necessary modifications to existing Elmer/Ice solvers are in the distributed versions, so you shouldn't have to do anything not listed in the doc, as long as I've not forgotten to tell you about something important. Any questions, email me at samuel.cook .at. univ-grenoble-alpes.fr + +## Modelling spatial covariance + +Several applications require to model spatial correlation under the form of a covariance matrix: +- [BackgroundErrorCostSolver](BackgroundErrorCostSolver.md): acts as a *regularisation* term in the inverse methods by modelling background error statistics. +- [GaussianSimulationSolver](GaussianSimulationSolver.md): draw spatailly correlated random samples from a uniform distribution. +- [CovarianceVectorMultiplySolver](CovarianceVectorMultiplySolver.md): can be apply as a filter to smooth noisy data. + +These solvers use generic routines implement in the [CovarianceUtilsModule](CovarianceUtilsModule.md). + +A pdf document containing the documentation of these solver and model can be generated using pandoc by running: +> pandoc -d MakeDoc_CovarianceUtils.yml From 957e54caedbfd382420d8d0f84d14f9df5f5becf Mon Sep 17 00:00:00 2001 From: fgillet Date: Mon, 24 Jun 2024 09:28:38 +0200 Subject: [PATCH 18/51] documentation improve documentation CovarianceUtils --- .../BackgroundErrorCostSolver.md | 17 +- elmerice/Solvers/Documentation/Covariance.md | 19 +- .../Documentation/CovarianceUtilsModule.md | 239 ++++++++++++++++++ .../CovarianceVectorMultiplySolver.md | 13 +- .../Documentation/GaussianSimulationSolver.md | 15 +- 5 files changed, 283 insertions(+), 20 deletions(-) diff --git a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md index 784ecbd4af..24cfe92421 100644 --- a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md +++ b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md @@ -22,8 +22,13 @@ - "diffusion operator" - "full matrix" - "diagonal" - - **covariance type specific keywords**: see [CovarianceUtils.md](CovarianceUtils.md) + - **covariance type specific keywords**: see [CovarianceUtils](#Covariance_Module) +### Remark +This documentation contains equations and is part of a generic documentation that can be converted to pdf using pandoc: +``` +> pandoc -d MakeDoc_CovarianceUtils.yml +``` ### General Description @@ -31,7 +36,8 @@ This solver is mainly intended to be used with the adjoint inverse methods imple It is an alternative to the *Regularisation* solver that penalizes the fist spatial derivatives of the *active* variable $x$, where $x$ is usually the basal friction coefficient, ice viscosity or bed elevation (see [Adjoint_CostRegSolver.md](Adjoint_CostRegSolver.md)) -Here the cost is computed as $$Cost=0.5 (x-x^b). B^{-1} .(x-x^b)$$ where: +Here the cost is computed as $$Cost=0.5 (x-x^b). B^{-1} .(x-x^b)$$ where: + - $x$ is the *active* variable - $x^b$ is the *background* variable, i.e. a prior estimate of $x$ - $B$ is the background error **covariance** matrix, i.e. is described the statics of the *expected* (or *tolerated*) difference between the background $x^b$ and the active variable $x$. @@ -45,6 +51,7 @@ This cost function is usually applied in addition of a cost function that penali If the observation and background errors are gaussian (described by the respective covariance matrices $R$ and $B$), the errors unbiaised and the observation operator is linear, i.e. $u=K.x$, the solution of the variational inverse problem, i.e. finding the minimum of the cost function, solves the Bayesian inference problem. The optimal solution then depends on the confidence that is given to the observation and to the background, which is *parameterized* by the corresponding covariance matrices. Special care must then be taken when prescribing these matrices. Providing: + - the input active variable $x$, given by the solver keyword *Variable name* - a variable containing the background $x^b$, given by the solver keyword *Background Variable name* - a method and the parameters for the covariance structure, given by the solver keyword *Covariance type* and method specific keywords @@ -56,17 +63,18 @@ The value of the cost a a function of the iteration is save in an ascii file def ### Implementation -The covariance matrix is of size $n \times n$, with $n$ the number of mesh nodes, is usually full rank, and often poorly known. It is then standard to parameterize this matrix using standard correlation functions $c(d)$ that describe the spatial correlation between 2 points as a function of the distance $d$ between the points. The correlation structure depends then on the correlation function (typical functions are, e.g., the exponential, squared exponential (or gaussian), Matérn functions) which usually depends on a *correlation length scale* or *range*. +The covariance matrix is of size $n \times n$, with $n$ the number of mesh nodes, is usually full rank, and often poorly known. It is then standard to parameterize this matrix using standard correlation functions $c(d)$ that describe the spatial correlation between 2 points as a function of the distance $d$ between the points. The correlation structure depends then on the correlation function (typical functions are, e.g., the exponential, squared exponential (or gaussian), Matérn functions, see [CovarianceUtils](#Covariance_Module)) which usually depends on a *correlation length scale* or *range*. The inverse covariance matrix $B^{-1}$ is factored in the standard form $$B^{-1}=\Sigma^{-1}. C^{-1} . \Sigma^{-1}$$ where: + - $\Sigma$ is a diagonal matrix containing the standard deviations, assumed spatially uniforms fro now, i.e. $\Sigma=\sigma I$, with $I$ the identity matrix. - $C^{-1}$ is the inverse of the correlation matrix whose components are defined using standard correlation functions $c(d)$. In general it is not necessary to explicitly compute and store $B$ (or its inverse), and it can be replaced by an equivalent operator. For **Covariance type = String "diffusion operator"**, the operator results from the discretization of a diffusion equation, which can be done efficiently for unstructured meshes with the finite element method. With this method the operator kernel is a correlation function from the Matérn family. The implementation follows Guillet et al. (2019). -See [CovarianceUtils.md](CovarianceUtils.md) for details on the possible choices to construct $C$. +See [CovarianceUtils](#Covariance_Module) for details on the possible choices to construct $C$. ### Discussion @@ -77,7 +85,6 @@ See [CovarianceUtils.md](CovarianceUtils.md) for details on the possible choices ### Known Bugs and Limitations -- Limited to 2D meshes - Limited to serial if using the "full matrix" covariance method. - The *diffusion operator* might be inaccurate near the boundaries or for highly distorted elements (see Guillet et al., 2019) - For the moment the implementation is limited to isotropic covariances with spatially uniform parameters (standard deviation and correlation length scale); but this could be improved (see Guillet et al., 2019) diff --git a/elmerice/Solvers/Documentation/Covariance.md b/elmerice/Solvers/Documentation/Covariance.md index b633807a60..24ba221aae 100644 --- a/elmerice/Solvers/Documentation/Covariance.md +++ b/elmerice/Solvers/Documentation/Covariance.md @@ -8,13 +8,18 @@ date: - 20/03/2024 --- -## Introduction +## Introduction +This documentation provide the documentation for the following solvers: +- [BackgroundErrorCostSolver](#Background_Error) +- [CovarianceVectorMultiplySolver](#Covariance_Vector_product) +- [GaussianSimulationSolver](#Gaussian_simulation) -The solvers: -- [BackgroundErrorCostSolver](#Background_Error) -- [CovarianceVectorMultiplySolver](#Covariance_Vector_product) -- [GaussianSimulationSolver](#Gaussian_simulation) ... +They are all based on operations involving covariances matrices. Different methods have been implemented to compute or apply covariances matrices. These methods are described in the documentation of the module: +- [CovarianceUtils](#Covariance_Module) -The module: -- [CovarianceUtils](#Covariance_Module) +### Remark +The complete pdf documentation can be obtained using pandoc: +``` +> pandoc -d MakeDoc_CovarianceUtils.yml +``` diff --git a/elmerice/Solvers/Documentation/CovarianceUtilsModule.md b/elmerice/Solvers/Documentation/CovarianceUtilsModule.md index 0c8c2b9532..b708f46006 100644 --- a/elmerice/Solvers/Documentation/CovarianceUtilsModule.md +++ b/elmerice/Solvers/Documentation/CovarianceUtilsModule.md @@ -3,7 +3,246 @@ ### General Information - **Fortran Module File:** CovarianceUtils.F90 +### Remark +This documentation contains equations and is part of a generic documentation that can be converted to pdf using pandoc: +``` +> pandoc -d MakeDoc_CovarianceUtils.yml +``` ### General Description +The *CovarianceUtils* modules contains routines and functions for the generic operations involving a covariance matrix $B$. +In all the implementation we use the following standard factorisations: +$$B = \Sigma C \Sigma$$ +$$B^{-1} = \Sigma^{-1} C^{-1} \Sigma^{-1}$$ +where: +- $C$ is a correlation matrix , +- $\Sigma$ is a diagonal standard deviation matrix. + +This module is used in the following solvers: + +- [BackgroundErrorCostSolver](#Background_Error) +- [CovarianceVectorMultiplySolver](#Covariance_Vector_product) +- [GaussianSimulationSolver](#Gaussian_simulation) + +#### Diffusion operator + +The implementation follows Guillet et al. (2019). See Recinos et al. (2023) and Bulthuis and Larour (2022) for similar methods in the context of ice flow modeling. + +The motivation of the method is that $C$ is a full-rank matrix of size $(n \times n)$, with n the number of mesh nodes, so that in general for large problem directly building $C$ becomes impossible. + +Guillet et al. (2019) show that applying $m$ successive applications of a discretized representation of the operator $I - l^2\nabla^2$ +is equivalent to applying an inverse correlation operator $\mathcal{C}^{-1}$ which as a kernel given by the following Matérn functions: +$$c_{m,l}=\dfrac{2^{2-m}}{(m-2)!} \left ( \dfrac{d}{l} \right )^{m-1} \mathcal{K}_{m-1} (d/l)$$ +where: + +- $\mathcal{K}_{m-1}$ is the modified Bessel function of the second kind of order $m$, +- $d$ is the euclidean distance between 2 points, +- $l$ is a **correlation lenght scale** (or **range**), +- $m$ is a **smoothness** parameter that control the *shape* of the function. + +Remarks: + +- In the literature, the Matérn functions are often defined with the smoothness parameter $\nu$ which can be a real; Here we are restricted to integers an $m=\nu+1$. +- The Matérn functions have two limit cases, the exponential correlation function for $\nu=1/2$ and the squared exponential (or gaussian) correlation function for $\nu \to \infty$. + +For the following, we define the following the mass matrix $M$ and stiffness matrix $K$ discretized by the FEM: +$$M_{ij}=\int_{\Omega} \phi_i \phi_j d\Omega$$ +$$K= l^2 \int_{\Omega} \nabla \phi_i \nabla \phi_j d\Omega$$ + +The [BackgroundErrorCostSolver](#Background_Error) requires the inverse correlation matrix $C^{-1}$ which is discretized as: +$$C^{-1} = \Gamma^{-1}ML^{-1}_M \Gamma^{-1}$$ +with: + +- $\Gamma=\sqrt{(4\pi(m-1))}l I$ is a normalization matrix +- $L^{-1}_M = [M^{-1}(M + K)]^m$ + +The [CovarianceVectorMultiplySolver](#Covariance_Vector_product) requires the correlation matrix $C$ which is discretized as: +$$C = \Gamma L_M M^{-1} \Gamma$$ +with: + $$L_M = [(M + K)^{-1}M]^m$$ + +The [GaussianSimulationSolver](#Gaussian_simulation) requires a square root of $B$ which is obtained from the following factorisation: +$$B=VV^T$$ +with: +$$V= \Sigma \Gamma L^{1/2}_M (M^{-1/2})^T$$ +where: + +- to compute $M^{-1/2}$ we take the *lumped* mass matrix, +- $L^{1/2}_M = [(M + K)^{-1}M]^{m/2}$, so restricting the application to even values of $m$ + +**Remark:** This discretization implies Neumann boundary conditions and it is known that it is inaccurate near the boundaries; cf sec. 3.6 and 5.4 in Guillet et al. (2019). + +Keywords related to this method: + +- the method is chosen with the keyword *Covariance type = String "diffusion operator"* +- the correlation length scale $l$ is assumed uniform and given by the keyword *correlation range = Real* +- the smoothness parameter $m$ is given by the keyword *Matern exponent m = Integer* ($m>2$ for all solvers and m must be even for the GaussianSimulationSolver) +- the standard deviation to build $\Sigma$ is assumed uniform and given by the keyword *standard deviation = Real* + +Limitations: + +- can be used in serial/parallel. +- as only be tested on 2D meshes or on a 2D boundary of a 3D mesh. In the latter case *projection coordinate=Integer* sets the corresponding coordinates to 0, so that the operations are performed in the projected plane; e.g. if *projection coordinate= Integer 3*, the *z-* coordinates are set to 0 to compute the mass and stiffness matrices + + +sif example: +``` +Solver 1 +... + !############################################################################ + !# Covariance types + !############################################################################ + Covariance type = String "diffusion operator" + + Matern exponent m = Integer $m + correlation range = Real $range + standard deviation = Real $std + + !# Whene used as a boundary solver, + !#projection coordinate = Integer ... + +!# The diffusion operator method requires to solve symmetric positive definite +!# linear systems; + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Linear System Refactorize = Logical False + Linear System Symmetric = Logical True + Linear System Positive Definite = Logical True + +end +``` + + +#### Full matrix + +This has been implement mainly for testing/validation on small serial test cases. Here the we build the matrix $C$ using standard analytical correlation functions. + +Operations on $C$ are performed using standard Lapack linear algebra routines: + +- For the [GaussianSimulationSolver](#Gaussian_simulation) with use a Cholesky decomposition using the Lapack routine *dpptrf* +- For the [BackgroundErrorCostSolver](#Background_Error), the inverse is obtained using the lapack routine *dpptri* after the Cholesky factorisation. + +The following correlation functions have been implemented: + +- the exponential: +$$c(d)=exp(-d/l)$$ +- the Gaussian correlation function: +$$c(d)=exp(-d^2/(2l^2))$$ +- the Matérn function for integer values of $\nu$ (*materni*): +$$c(d)=\dfrac{2^{1-\nu}}{(\nu-1)!} \left ( \dfrac{d}{l} \right )^{\nu} \mathcal{K}_{\nu} (d/l)$$ +- Analytical power solution of the Matérn function when $\nu$ is half integer so that $p=\nu-1/2$ is an integer (*maternp*) (rq. p=0 is the exponential): + - p=1 + $$c(d)=(1+d/l)exp(-d/l)$$ + - p=2 + $$c(d)=(1+d/l+d^2/(3l^2))exp(-d/l)$$ + + +**Remark** for *MaternI* the Bessel function $\mathcal{K}$ is obtained by recursion and accuracy for high values of $n$ ($n>10$) has not been tested. + +Keywords related to this method: + +- the method is chosen with the keyword *Covariance type = String "full matrix"* +- the correlation length scale $l$ is assumed uniform and given by the keyword *correlation range = Real* +- The correlation function is given by the keyword *correlation type = String*; possible choices are: + + - *"exponential"* + - *"gaussian"* + - *"materni"* + - *"maternp"* + +- For *materni* the integer value of $\nu$ is given by *MaternI order = Integer* +- For *maternp* the integer value of $p$ is given by *MaternP order = Integer* (restricted to 1 and 2) + + +Limitations: + +- can only be used in serial. +- restricted to relatively small problems +- Can be used as a boundary solver; in this case if the mesh is 3D, only the $x$ and $y$ coordinates are used to compute the euclidean distance. + + +sif example: +``` +Solver 1 +... + !############################################################################ + !# Covariance types + !############################################################################ + Covariance type = String "full matrix" + + correlation range = Real $range + standard deviation = Real $std + + correlation type = Sting "exponential" + #or + # correlation type = Sting "gaussian" + #or + # correlation type = Sting "materni" + # MaternI order = Integer 1 + #or + # correlation type = Sting "maternp" + # MaternI order = Integer 1 + + + # rq. there is no linear system to solve +end +``` + +#### Diagonal + +This is the simple choice, there is no spatial correlation and the covariance matrix is simply $$B=\sigma^2 I$$ + +Keywords related to this method: + +- the method is chosen with the keyword *Covariance type = String "diagonal"* + +``` +Solver 1 +... + !############################################################################ + !# Covariance types + !############################################################################ + Covariance type = String "diagonal" + + standard deviation = Real $std +``` + +### Module functions and subroutines + +Generic routines for the initialisation of the matrices (*D* referring to the *diffusion operator* and *L* to the *full matrix*): +``` +INTERFACE CovarianceInit + MODULE PROCEDURE CovarianceInitD,CovarianceInitL +END INTERFACE +``` + +Generic routines to perform covariance matrix vector multiplications: +``` +INTERFACE CovarianceVectorMultiply + MODULE PROCEDURE CovarianceVectorMultiplyD,CovarianceVectorMultiplyL +END INTERFACE +``` + +Generic routines to perform inverse covariance matrix vector multiplications: +``` +INTERFACE InvCovarianceVectorMultiply + MODULE PROCEDURE InvCovarianceVectorMultiplyD,InvCovarianceVectorMultiplyL +END INTERFACE +``` +Generic routines to perform square-root covariance matrix vector multiplications: +``` +INTERFACE SqrCovarianceVectorMultiply + MODULE PROCEDURE SqrCovarianceVectorMultiplyD,SqrCovarianceVectorMultiplyL +END INTERFACE +``` + +Functions related to the computation of the analytical correlation functions. + +### References + +- Recinos, B., Goldberg, D., Maddison, J. R., and Todd, J.: A framework for time-dependent ice sheet uncertainty quantification, applied to three West Antarctic ice streams, The Cryosphere, 17, https://doi.org/10.5194/tc-17-4241-2023, 2023. +- Bulthuis, K. and Larour, E.: Implementation of a Gaussian Markov random field sampler for forward uncertainty quantification in the Ice-sheet and Sea-level System Model v4.19, Geosci. Model Dev., 15, 1195–1217, https://doi.org/10.5194/gmd-15-1195-2022, 2022 +- Guillet O., Weaver A.T., Vasseur X., Michel Y., Gratton S., Gurol S. Modelling spatially correlated observation errors in variational data assimilation using a diffusion operator on an unstructured mesh. Q. J. R. Meteorol. Soc., 2019. https://doi.org/10.1002/qj.3537 diff --git a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md index 8ed20c9e7e..c3fa1c1720 100644 --- a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md +++ b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md @@ -15,31 +15,38 @@ - "diffusion operator" - "full matrix" - "diagonal" - - **covariance type specific keywords**: see [CovarianceUtils.md](CovarianceUtils.md) + - **covariance type specific keywords**: see [CovarianceUtils](#Covariance_Module) - **Optional Input Keywords:** - **Solver Section**: - Normalize = *Logical*: wether to normalize the output (default: False) +### Remark +This documentation contains equations and is part of a generic documentation that can be converted to pdf using pandoc: +``` +> pandoc -d MakeDoc_CovarianceUtils.yml +``` + ### General Description Compute the product $$y=C.x$$ with: + - $x$ and input variable - $C$ a covariance matrix Applications: + - **covariance visualization and code validation**: the spatial correlation function at a given node $z_i$ corresponds to the $i$-th column of the covariance matrix $C$. It can be visualized by plotting the result of applying $C$ to a vector that has a value of one at $z_i$ and a value of zero at all other points (Guillet et al., 2019). - **Filtering**: When *Normalize = Logical True*, the output is normalized by the results of applying $C$ to a vector full of ones. If the kernel is a Gaussian correlation function, this would be equivalent to applying a Gaussian filter and this will thus smooth the input variable. The Matérn covariance, obtained with the *diffusion operator* method, converges to the Gaussian correlation function when the smoothness parameters $\nu$ tends to infinity. ### Implementation -See the generic documentation for [CovarianceUtils.md](CovarianceUtils.md) for details on the possible choices to construct the covariance matrix $C$. +See the generic documentation for [CovarianceUtils](#Covariance_Module) for details on the possible choices to construct the covariance matrix $C$. ### Known Bugs and Limitations -- Limited to 2D meshes. - Limited to serial if using the "full matrix" covariance method. diff --git a/elmerice/Solvers/Documentation/GaussianSimulationSolver.md b/elmerice/Solvers/Documentation/GaussianSimulationSolver.md index b1b58ecc80..0aa8552e2a 100644 --- a/elmerice/Solvers/Documentation/GaussianSimulationSolver.md +++ b/elmerice/Solvers/Documentation/GaussianSimulationSolver.md @@ -15,17 +15,23 @@ - "diffusion operator" - "full matrix" - "diagonal" - - **covariance type specific keywords**: see [CovarianceUtils.md](CovarianceUtils.md) + - **covariance type specific keywords**: see [CovarianceUtils](#Covariance_Module) - **Optional Input Keywords:** - **Solver Section**: - Random Seed = *Integer*: a seed to initialize the random generator for repeatability +### Remark +This documentation contains equations and is part of a generic documentation that can be converted to pdf using pandoc: +``` +> pandoc -d MakeDoc_CovarianceUtils.yml +``` ### General Description For a random variable $X$ that is normally distributed as $$X \sim \mathcal{N}(x^b,C)$$, with $x^b$ the mean and $C$ the covariance matrix, it is possible to draw non-conditionnal realizations $x^s$ as $$x^s = x^b + V.z$$ -where: +where: + - $V$ is obtained from a factorization of $C$ as $C=VV^T$, classically a Cholesky factorisation. - $z$ is a vector of uniformly distributed random numbers with zero mean. @@ -35,14 +41,13 @@ For an application to uncertainty quantification in ice sheet modeling, using th ### Implementation -See the generic documentation for [CovarianceUtils.md](CovarianceUtils.md) for details on the possible choices to construct the covariance matrix $C$ and for the factorization. +See the generic documentation for [CovarianceUtils](#Covariance_Module) for details on the possible choices to construct the covariance matrix $C$ and for the factorization. It the solver variable is a vector, each component contains a different realization, otherwise each call to the solver (e.g. during steady-state iterations) will give a different realization. ### Known Bugs and Limitations -- Limited to 2D meshes. -- Limited to serial if using the "full matrix" covariance method. +- Limited to serial if using the "full matrix" covariance method. - The *diffusion operator* might be inaccurate near the boundaries or for highly distorted elements (see Guillet et al., 2019) - For the moment the implementation is limited to isotropic covariances with spatially uniform parameters (standard deviation and correlation length scale); but this could be improved (see Guillet et al., 2019) From 5673efad676658771c537c8b30c0799711d22d6e Mon Sep 17 00:00:00 2001 From: fgillet Date: Mon, 24 Jun 2024 14:18:15 +0200 Subject: [PATCH 19/51] add header to solver files --- .../BackgroundErrorCostSolver.F90 | 32 +++++++++- .../Covarianceutils/CovarianceUtils.F90 | 61 ++++++++++++++----- .../CovarianceVectorMultiplySolver.F90 | 39 +++++++++++- .../GaussianSimulationSolver.F90 | 34 +++++++++++ 4 files changed, 148 insertions(+), 18 deletions(-) diff --git a/elmerice/Solvers/Covarianceutils/BackgroundErrorCostSolver.F90 b/elmerice/Solvers/Covarianceutils/BackgroundErrorCostSolver.F90 index 2e7d79c2d0..8809f64165 100644 --- a/elmerice/Solvers/Covarianceutils/BackgroundErrorCostSolver.F90 +++ b/elmerice/Solvers/Covarianceutils/BackgroundErrorCostSolver.F90 @@ -1,3 +1,34 @@ +!/*****************************************************************************/ +! * +! * 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: F. Gillet-Chaulet +! * Web: http://elmerice.elmerfem.org +! * +! * Original Date: 24/06/2024 +! * +! ***************************************************************************** !*********************************************************************************************** ! Compute a cost function from a background as Cost=0.5 * (x-x^b). B^-1 .(x-x^b) ! x is the optimized variable; x^b the background @@ -12,7 +43,6 @@ ! functions and inverted using Lapack routines ! - "diffusion operator" : C is approximated with the diffusion operator approach ! Current limitations : -! - 2D mesh; TODO to run it on a 2D surface boundary? ! - Serial for the full-matrix approach ! ! Rq. diff --git a/elmerice/Solvers/Covarianceutils/CovarianceUtils.F90 b/elmerice/Solvers/Covarianceutils/CovarianceUtils.F90 index 5f2b316c95..97c339593f 100644 --- a/elmerice/Solvers/Covarianceutils/CovarianceUtils.F90 +++ b/elmerice/Solvers/Covarianceutils/CovarianceUtils.F90 @@ -1,3 +1,37 @@ +!/*****************************************************************************/ +! * +! * 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: F. Gillet-Chaulet +! * Web: http://elmerice.elmerfem.org +! * +! * Original Date: 24/06/2024 +! * +! ***************************************************************************** +!*********************************************************************************************** +! Module to deal with covariances matrices +!*********************************************************************************************** MODULE CovarianceUtils USE MainUtils USE DefUtils @@ -31,7 +65,7 @@ SUBROUTINE GetActiveNodesSet(Solver,n,ActiveNodes,InvPerm,PbDim) INTEGER :: t INTEGER :: counter INTEGER,POINTER :: Perm(:) - LOGICAL :: BoundarySolver + LOGICAL :: BoundarySolver IF (.NOT.ASSOCIATED(Solver % Matrix)) & CALL FATAL("GetActiveNodesSet","Matrix must be associated") @@ -39,7 +73,7 @@ SUBROUTINE GetActiveNodesSet(Solver,n,ActiveNodes,InvPerm,PbDim) n = Solver % Matrix % NumberOfRows ALLOCATE(ActiveNodes(n),InvPerm(n)) - + counter = 0 DO t=1,Solver % Mesh % NumberOfNodes IF (Perm(t).LT.1) CYCLE @@ -56,7 +90,7 @@ SUBROUTINE GetActiveNodesSet(Solver,n,ActiveNodes,InvPerm,PbDim) ELSE PbDim = CoordinateSystemDimension() ENDIF - + END SUBROUTINE GetActiveNodesSet !############################################################################################ @@ -173,7 +207,7 @@ SUBROUTINE CovarianceVectorMultiplyD(Solver,MSolver,KMSolver,n,x,y) IF (Cm.LT.2) & CALL FATAL("Covariance"," should be >=2") Crange = ListGetConstReal(SolverParams,"correlation range", UnFoundFatal=.TRUE.) - std = ListGetConstReal(SolverParams,"standard deviation",UnFoundFatal=.TRUE.) + std = ListGetConstReal(SolverParams,"standard deviation",UnFoundFatal=.TRUE.) gamma=sqrt(4*Pi*(Cm-1))*Crange MMatrix => MSolver % Matrix @@ -315,7 +349,7 @@ SUBROUTINE InvCovarianceVectorMultiplyD(Solver,MSolver,KMSolver,n,x,y) IF (Cm.LT.2) & CALL FATAL("Covariance"," should be >=2") Crange = ListGetConstReal(SolverParams,"correlation range", UnFoundFatal=.TRUE.) - std = ListGetConstReal(SolverParams,"standard deviation",UnFoundFatal=.TRUE.) + std = ListGetConstReal(SolverParams,"standard deviation",UnFoundFatal=.TRUE.) gamma=sqrt(4*Pi*(Cm-1))*Crange MMatrix => MSolver % Matrix @@ -368,7 +402,7 @@ END SUBROUTINE InvCovarianceVectorMultiplyD !############################################################################################ !------------------------------------------------------------------------------------------- ! Using the diffusion operator approach; build the required matrices -! +! !------------------------------------------------------------------------------------------- SUBROUTINE CovarianceInitD(Solver,MSolver,KMSolver) TYPE(Solver_t) :: Solver @@ -496,7 +530,7 @@ SUBROUTINE CovarianceInitL(Solver,n,InvPerm,aap,Op,PbDim) TYPE(Solver_t) :: Solver INTEGER,INTENT(IN) :: n INTEGER,INTENT(IN) :: InvPerm(n) - REAL(kind=dp),INTENT(OUT) :: aap(:) + REAL(kind=dp),INTENT(OUT) :: aap(:) INTEGER,INTENT(IN) :: Op !1: correlation matrix ; 2: Cholesky; 3: inverse INTEGER,INTENT(IN) :: PbDim @@ -645,10 +679,10 @@ FUNCTION MaternI(n,x) RESULT(c) END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Modified Bessel function of second kind Kn +! Modified Bessel function of second kind Kn ! Computed from the recursion ! Kn+1 = 2*n/x Kn + Kn-1 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! FUNCTION BesselKn(n,x) RESULT(Kn) REAL(kind=dp) :: Kn INTEGER,INTENT(IN) :: n @@ -682,8 +716,8 @@ FUNCTION BesselKn(n,x) RESULT(Kn) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Modified Bessel function of second kind of order 0, K0 ! Polynomial approximation; cf -! https://www.advanpix.com/2015/11/25/rational-approximations-for-the-modified-bessel-function-of-the-second-kind-k0-for-computations-with-double-precision/ -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! https://www.advanpix.com/2015/11/25/rational-approximations-for-the-modified-bessel-function-of-the-second-kind-k0-for-computations-with-double-precision/ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! FUNCTION BesselK0(x) RESULT(K0) REAL(KIND=dp) :: K0 REAL(KIND=dp), INTENT(IN) :: x @@ -767,7 +801,7 @@ FUNCTION BesselK0(x) RESULT(K0) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Modified Bessel function of second kind of order 1, K1 ! Polynomial approximation; cf -! https://www.advanpix.com/2016/01/05/rational-approximations-for-the-modified-bessel-function-of-the-second-kind-k1-for-computations-with-double-precision/ +! https://www.advanpix.com/2016/01/05/rational-approximations-for-the-modified-bessel-function-of-the-second-kind-k1-for-computations-with-double-precision/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! FUNCTION BesselK1(x) RESULT(K1) REAL(KIND=dp) :: K1 @@ -872,7 +906,7 @@ FUNCTION Polynomial(x,P,n) RESULT(y) END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Integer factorial +! Integer factorial !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function fact(n) implicit none @@ -889,4 +923,3 @@ end function fact END MODULE CovarianceUtils - diff --git a/elmerice/Solvers/Covarianceutils/CovarianceVectorMultiplySolver.F90 b/elmerice/Solvers/Covarianceutils/CovarianceVectorMultiplySolver.F90 index cdba6332bb..efacbf3ff0 100644 --- a/elmerice/Solvers/Covarianceutils/CovarianceVectorMultiplySolver.F90 +++ b/elmerice/Solvers/Covarianceutils/CovarianceVectorMultiplySolver.F90 @@ -1,5 +1,38 @@ -!*********************************************************************************************** -!*********************************************************************************************** +!/*****************************************************************************/ +! * +! * 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: F. Gillet-Chaulet +! * Web: http://elmerice.elmerfem.org +! * +! * Original Date: 24/06/2024 +! * +! ***************************************************************************** +!*********************************************************************************************** +! Comput the product of a covariance matrix with a vector +!*********************************************************************************************** +!*********************************************************************************************** SUBROUTINE CovarianceVectorMultiplySolver( Model,Solver,dt,TransientSimulation ) !*********************************************************************************************** USE GeneralUtils @@ -93,7 +126,7 @@ SUBROUTINE CovarianceVectorMultiplySolver( Model,Solver,dt,TransientSimulation ) allocate(x(nn),y(nn)) IF (Normalize) THEN - allocate(norm(nn)) + allocate(norm(nn)) !input vector x(:) = 1._dp diff --git a/elmerice/Solvers/Covarianceutils/GaussianSimulationSolver.F90 b/elmerice/Solvers/Covarianceutils/GaussianSimulationSolver.F90 index 9c4ccc1785..286f8a2468 100644 --- a/elmerice/Solvers/Covarianceutils/GaussianSimulationSolver.F90 +++ b/elmerice/Solvers/Covarianceutils/GaussianSimulationSolver.F90 @@ -1,3 +1,37 @@ +!/*****************************************************************************/ +! * +! * 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: F. Gillet-Chaulet +! * Web: http://elmerice.elmerfem.org +! * +! * Original Date: 24/06/2024 +! * +! ***************************************************************************** +!*********************************************************************************************** +! Generate random realization from a given covariance matrix +!*********************************************************************************************** !*********************************************************************************************** !*********************************************************************************************** SUBROUTINE GaussianSimulationSolver( Model,Solver,dt,TransientSimulation ) From 677c47649470f370ce79439c4c59a9d4804d40e8 Mon Sep 17 00:00:00 2001 From: fgillet Date: Mon, 24 Jun 2024 14:45:46 +0200 Subject: [PATCH 20/51] Add test cases for CovarianceVectorMutliply --- .../Documentation/CovarianceUtilsModule.md | 2 + .../CovarianceVectorMultiplySolver.md | 6 + .../Tests/CovarianceVector/CMakeLists.txt | 13 ++ .../CovarianceVector/ELMERSOLVER_STARTINFO | 1 + elmerice/Tests/CovarianceVector/Init.F90 | 27 ++++ elmerice/Tests/CovarianceVector/case.sif | 146 ++++++++++++++++++ elmerice/Tests/CovarianceVector/rectangle.grd | 24 +++ elmerice/Tests/CovarianceVector/runTest.cmake | 10 ++ .../Tests/CovarianceVector2/CMakeLists.txt | 13 ++ .../CovarianceVector2/ELMERSOLVER_STARTINFO | 1 + elmerice/Tests/CovarianceVector2/Init.F90 | 27 ++++ elmerice/Tests/CovarianceVector2/TEST.PASSED | 1 + elmerice/Tests/CovarianceVector2/case.sif | 142 +++++++++++++++++ .../Tests/CovarianceVector2/rectangle.grd | 24 +++ .../Tests/CovarianceVector2/runTest.cmake | 10 ++ 15 files changed, 447 insertions(+) create mode 100644 elmerice/Tests/CovarianceVector/CMakeLists.txt create mode 100644 elmerice/Tests/CovarianceVector/ELMERSOLVER_STARTINFO create mode 100644 elmerice/Tests/CovarianceVector/Init.F90 create mode 100644 elmerice/Tests/CovarianceVector/case.sif create mode 100644 elmerice/Tests/CovarianceVector/rectangle.grd create mode 100644 elmerice/Tests/CovarianceVector/runTest.cmake create mode 100644 elmerice/Tests/CovarianceVector2/CMakeLists.txt create mode 100644 elmerice/Tests/CovarianceVector2/ELMERSOLVER_STARTINFO create mode 100644 elmerice/Tests/CovarianceVector2/Init.F90 create mode 100644 elmerice/Tests/CovarianceVector2/TEST.PASSED create mode 100644 elmerice/Tests/CovarianceVector2/case.sif create mode 100644 elmerice/Tests/CovarianceVector2/rectangle.grd create mode 100644 elmerice/Tests/CovarianceVector2/runTest.cmake diff --git a/elmerice/Solvers/Documentation/CovarianceUtilsModule.md b/elmerice/Solvers/Documentation/CovarianceUtilsModule.md index b708f46006..532d30c980 100644 --- a/elmerice/Solvers/Documentation/CovarianceUtilsModule.md +++ b/elmerice/Solvers/Documentation/CovarianceUtilsModule.md @@ -46,6 +46,8 @@ Remarks: - In the literature, the Matérn functions are often defined with the smoothness parameter $\nu$ which can be a real; Here we are restricted to integers an $m=\nu+1$. - The Matérn functions have two limit cases, the exponential correlation function for $\nu=1/2$ and the squared exponential (or gaussian) correlation function for $\nu \to \infty$. +- The Gaussian limit can be approached by setting the range to the Dayley length scale (Guillet et al. (2019) Eq. 7): +$$D=\sqrt{2m-4}l)$$ For the following, we define the following the mass matrix $M$ and stiffness matrix $K$ discretized by the FEM: $$M_{ij}=\int_{\Omega} \phi_i \phi_j d\Omega$$ diff --git a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md index c3fa1c1720..8fc202857f 100644 --- a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md +++ b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md @@ -87,6 +87,12 @@ end ### Examples +- ElmerIce unitary tests: + - [ELMER_TRUNK]/elmerice/Tests/CovarianceVector + - [ELMER_TRUNK]/elmerice/Tests/CovarianceVector2 + + + ### References diff --git a/elmerice/Tests/CovarianceVector/CMakeLists.txt b/elmerice/Tests/CovarianceVector/CMakeLists.txt new file mode 100644 index 0000000000..a0be9efc65 --- /dev/null +++ b/elmerice/Tests/CovarianceVector/CMakeLists.txt @@ -0,0 +1,13 @@ +INCLUDE(${CMAKE_CURRENT_SOURCE_DIR}/../test_macros.cmake) + + +CONFIGURE_FILE(case.sif case.sif COPYONLY) +CONFIGURE_FILE(Init.F90 Init.F90 COPYONLY) + +FILE(COPY ELMERSOLVER_STARTINFO rectangle.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") + +ADD_ELMERICETEST_MODULE(CovarianceVector Init ./Init.F90) + +ADD_ELMERICE_TEST(CovarianceVector) +ADD_ELMERICE_LABEL(CovarianceVector elmerice-fast) +ADD_ELMERICE_LABEL(CovarianceVector CovUtils) diff --git a/elmerice/Tests/CovarianceVector/ELMERSOLVER_STARTINFO b/elmerice/Tests/CovarianceVector/ELMERSOLVER_STARTINFO new file mode 100644 index 0000000000..d21bd7ee27 --- /dev/null +++ b/elmerice/Tests/CovarianceVector/ELMERSOLVER_STARTINFO @@ -0,0 +1 @@ +case.sif diff --git a/elmerice/Tests/CovarianceVector/Init.F90 b/elmerice/Tests/CovarianceVector/Init.F90 new file mode 100644 index 0000000000..8c19d6df9d --- /dev/null +++ b/elmerice/Tests/CovarianceVector/Init.F90 @@ -0,0 +1,27 @@ +! ***************************************************************************** +! Initialize an impulse; i.e.: +! r=1 if distance to prescribed "center" i < 100 APES +! r=0 otherwise +! There should be a node at the center!! +!############################################################################# + FUNCTION Init(Model,nodenumber,xy) RESULT(r) + USE DefUtils + implicit none + !----------------- + TYPE(Model_t) :: Model + INTEGER :: nodenumber + REAL(kind=dp),INTENT(IN) :: xy(4) + REAL(kind=dp) :: r + REAL(kind=dp) :: d + + + d=sqrt((xy(1)-xy(3))**2+(xy(2)-xy(4))**2) + If (d.LT.100*AEPS) THEN + r=1._dp + Else + r=0._dp + End if + + End FUNCTION Init + + diff --git a/elmerice/Tests/CovarianceVector/case.sif b/elmerice/Tests/CovarianceVector/case.sif new file mode 100644 index 0000000000..6065ba4f55 --- /dev/null +++ b/elmerice/Tests/CovarianceVector/case.sif @@ -0,0 +1,146 @@ +!##################################################################### +!# Test covariance vector product +!# Here the vector is initailised to 1 in (0.0,0.0) +!# The result should be the coraviance as a function of the distance +!# (0.0,0.0) +!# +!# Test the results for a gievn set of methods +!# "MaternI" and "diffusion operator" should lead to similar results +!# for the same parameters +!# +!# Rq.: Use different ElmerIceSolvers library files if using the same +!# solver several times as initialised variables are saved +!#################################################################### +!################################################################### +!# Covariance paramteres +!################################################################### +$std=1.0 +$range=0.1 + +$nu=2 +$p=2 + +!##################################################################### +!# +!#################################################################### +Header :: Mesh DB "." "rectangle" + +!##################################################################### +!# +!#################################################################### +Simulation + Max Output Level = 3 + Coordinate System = Cartesian + Simulation Type = Steady + Output Intervals(1) = 1 + Steady State Max Iterations = 1 + !Post File = "impulse1.vtu" +End + +!##################################################################### +!# +!#################################################################### +Body 1 + Equation = 1 + Initial Condition = 1 +End + +!##################################################################### +!# +!#################################################################### +Initial Condition 1 + impulse = Variable Coordinate 1, Coordinate 2, "0.0", "0.0" + Real procedure "Init" "Init" +End + +!################################################################# +!# Equations +!################################################################# +Equation 1 :: Active Solvers(3) = 1 2 3 + +!################################################################# +!# Full-Matrix Matern correlation p=nu-1/2=integer +!################################################################# +Solver 1 + Equation = "MaternPCovariance" + Variable = "CorrMP" + Procedure = "ElmerIceSolvers" "CovarianceVectorMultiplySolver" + + input variable = string "impulse" + + Covariance type = string "Full matrix" + + correlation type = String "MaternP" + + MaternP polynomial order = Integer $p + correlation range = Real $range + standard deviation = Real $std + + + Exported Variable 1 = string "impulse" +End + +!################################################################# +!# Full-Matrix Matern correlation nu=Integer +!################################################################# +Solver 2 + Equation = "MaternICovariance" + Variable = "CorrMI" + Procedure = "ElmerIceSolvers2" "CovarianceVectorMultiplySolver" + + input variable = string "impulse" + + Covariance type = string "Full matrix" + + correlation type = String "MaternI" + MaternI order = Integer $nu + + correlation range = Real $range + standard deviation = Real $std + + +End + +!################################################################# +!# diffusion operator +!################################################################# +Solver 3 + Equation = "MaternOpCovariance" + Variable = "Corrdo" + Procedure = "ElmerIceSolvers3" "CovarianceVectorMultiplySolver" + + input variable = string "impulse" + + Covariance type = String "diffusion operator" + + Matern exponent m = Integer $nu+1 + correlation range = Real $range + standard deviation = Real $std + + + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Linear System Refactorize = Logical False + Linear System Symmetric = Logical True + Linear System Positive Definite = Logical True + + +End +!#################################################################### +!# Boundary condition +!#################################################################### +Boundary Condition 1 + Target Boundaries(4) = 1 2 3 4 +End + +Solver 1 :: Reference Norm = Real 0.17229124 +Solver 1 :: Reference Norm Tolerance = Real 1.0e-4 + +Solver 2 :: Reference Norm = Real 1.51016526E-01 +Solver 2 :: Reference Norm Tolerance = Real 1.0e-4 + +Solver 3 :: Reference Norm = Real 0.15337508 +Solver 3 :: Reference Norm Tolerance = Real 1.0e-4 + + diff --git a/elmerice/Tests/CovarianceVector/rectangle.grd b/elmerice/Tests/CovarianceVector/rectangle.grd new file mode 100644 index 0000000000..c34e587593 --- /dev/null +++ b/elmerice/Tests/CovarianceVector/rectangle.grd @@ -0,0 +1,24 @@ +***** ElmerGrid input file for structured grid generation ***** +Version = 210903 +Coordinate System = Cartesian 2D +Subcell Divisions in 2D = 1 1 +Subcell Limits 1 = -1.0 1.0 +Subcell Limits 2 = -1.0 1.0 +Material Structure in 2D + 1 +End +Materials Interval = 1 1 +Boundary Definitions +! type out int + 1 -1 1 1 + 2 -2 1 1 + 3 -3 1 1 + 4 -4 1 1 +End +Numbering = Horizontal +Coordinate Ratios = 1 +Element Innernodes = False +Element Degree = 1 +Triangles = True +Element Divisions 1 = 20 +Element Divisions 2 = 20 diff --git a/elmerice/Tests/CovarianceVector/runTest.cmake b/elmerice/Tests/CovarianceVector/runTest.cmake new file mode 100644 index 0000000000..d1da81ecba --- /dev/null +++ b/elmerice/Tests/CovarianceVector/runTest.cmake @@ -0,0 +1,10 @@ +INCLUDE(${TEST_SOURCE}/../test_macros.cmake) + +FILE(COPY ${BINARY_DIR}/elmerice/Solvers/ElmerIceSolvers${SHLEXT} DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") +FILE(RENAME ElmerIceSolvers${SHLEXT} ElmerIceSolvers2${SHLEXT}) +FILE(COPY ${BINARY_DIR}/elmerice/Solvers/ElmerIceSolvers${SHLEXT} DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") +FILE(RENAME ElmerIceSolvers${SHLEXT} ElmerIceSolvers3${SHLEXT}) + +EXECUTE_PROCESS(COMMAND ${ELMERGRID_BIN} 1 2 rectangle.grd) + +RUN_ELMERICE_TEST() diff --git a/elmerice/Tests/CovarianceVector2/CMakeLists.txt b/elmerice/Tests/CovarianceVector2/CMakeLists.txt new file mode 100644 index 0000000000..3fc40778e7 --- /dev/null +++ b/elmerice/Tests/CovarianceVector2/CMakeLists.txt @@ -0,0 +1,13 @@ +INCLUDE(${CMAKE_CURRENT_SOURCE_DIR}/../test_macros.cmake) + + +CONFIGURE_FILE(case.sif case.sif COPYONLY) +CONFIGURE_FILE(Init.F90 Init.F90 COPYONLY) + +FILE(COPY ELMERSOLVER_STARTINFO rectangle.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") + +ADD_ELMERICETEST_MODULE(CovarianceVector2 Init ./Init.F90) + +ADD_ELMERICE_TEST(CovarianceVector2) +ADD_ELMERICE_LABEL(CovarianceVector2 elmerice-fast) +ADD_ELMERICE_LABEL(CovarianceVector2 CovUtils) diff --git a/elmerice/Tests/CovarianceVector2/ELMERSOLVER_STARTINFO b/elmerice/Tests/CovarianceVector2/ELMERSOLVER_STARTINFO new file mode 100644 index 0000000000..d21bd7ee27 --- /dev/null +++ b/elmerice/Tests/CovarianceVector2/ELMERSOLVER_STARTINFO @@ -0,0 +1 @@ +case.sif diff --git a/elmerice/Tests/CovarianceVector2/Init.F90 b/elmerice/Tests/CovarianceVector2/Init.F90 new file mode 100644 index 0000000000..8c19d6df9d --- /dev/null +++ b/elmerice/Tests/CovarianceVector2/Init.F90 @@ -0,0 +1,27 @@ +! ***************************************************************************** +! Initialize an impulse; i.e.: +! r=1 if distance to prescribed "center" i < 100 APES +! r=0 otherwise +! There should be a node at the center!! +!############################################################################# + FUNCTION Init(Model,nodenumber,xy) RESULT(r) + USE DefUtils + implicit none + !----------------- + TYPE(Model_t) :: Model + INTEGER :: nodenumber + REAL(kind=dp),INTENT(IN) :: xy(4) + REAL(kind=dp) :: r + REAL(kind=dp) :: d + + + d=sqrt((xy(1)-xy(3))**2+(xy(2)-xy(4))**2) + If (d.LT.100*AEPS) THEN + r=1._dp + Else + r=0._dp + End if + + End FUNCTION Init + + diff --git a/elmerice/Tests/CovarianceVector2/TEST.PASSED b/elmerice/Tests/CovarianceVector2/TEST.PASSED new file mode 100644 index 0000000000..573541ac97 --- /dev/null +++ b/elmerice/Tests/CovarianceVector2/TEST.PASSED @@ -0,0 +1 @@ +0 diff --git a/elmerice/Tests/CovarianceVector2/case.sif b/elmerice/Tests/CovarianceVector2/case.sif new file mode 100644 index 0000000000..516fd699df --- /dev/null +++ b/elmerice/Tests/CovarianceVector2/case.sif @@ -0,0 +1,142 @@ +!##################################################################### +!# Test covariance vector product +!# Here the vector is initailised to 1 in (0.0,0.0) +!# The result should be the coraviance as a function of the distance +!# (0.0,0.0) +!# The Matern function with nu \to \infty whith a rage given by +!# range=l/sqrt(2*(nu+1)-1) +!# should converge to the gaussian correlation c(d)=exp(-d^2/(2l^2) +!# +!# Rq.: Use different ElmerIceSolvers library files if using the same +!# solver several times as initialised variables are saved +!#################################################################### +!################################################################### +!# Covariance paramteres +!################################################################### +$std=1.0 +$range=0.2 + +$nu=10 +$rangem=range/sqrt(2*(nu+1)-1) + +!##################################################################### +!# +!#################################################################### +Header :: Mesh DB "." "rectangle" + +!##################################################################### +!# +!#################################################################### +Simulation + Max Output Level = 3 + Coordinate System = Cartesian + Simulation Type = Steady + Output Intervals(1) = 1 + Steady State Max Iterations = 1 +! Post File = "impulse1.vtu" +End + +!##################################################################### +!# +!#################################################################### +Body 1 + Equation = 1 + Initial Condition = 1 +End + +!##################################################################### +!# +!#################################################################### +Initial Condition 1 + impulse = Variable Coordinate 1, Coordinate 2, "0.0", "0.0" + Real procedure "Init" "Init" +End + +!################################################################# +!# Equations +!################################################################# +Equation 1 :: Active Solvers(3) = 1 2 3 + +!################################################################# +!# Full-Matrix Gaussian correlation function +!################################################################# +Solver 1 + Equation = "MaternPCovariance" + Variable = "CorrGaussian" + Procedure = "ElmerIceSolvers" "CovarianceVectorMultiplySolver" + + input variable = string "impulse" + + Covariance type = string "Full matrix" + + correlation type = String "gaussian" + correlation range = Real $range + standard deviation = Real $std + + Exported Variable 1 = string "impulse" +End + +!################################################################# +!# Full-Matrix Matern correlation nu=Integer +!################################################################# +Solver 2 + Equation = "MaternICovariance" + Variable = "CorrMI" + Procedure = "ElmerIceSolvers2" "CovarianceVectorMultiplySolver" + + input variable = string "impulse" + + Covariance type = string "Full matrix" + + correlation type = String "MaternI" + MaternI order = Integer $nu + + correlation range = Real $rangem + standard deviation = Real $std + + +End + +!################################################################# +!# diffusion operator +!################################################################# +Solver 3 + Equation = "MaternOpCovariance" + Variable = "Corrdo" + Procedure = "ElmerIceSolvers3" "CovarianceVectorMultiplySolver" + + input variable = string "impulse" + + Covariance type = String "diffusion operator" + + Matern exponent m = Integer $nu+1 + correlation range = Real $rangem + standard deviation = Real $std + + + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Linear System Refactorize = Logical False + Linear System Symmetric = Logical True + Linear System Positive Definite = Logical True + + +End +!#################################################################### +!# Boundary condition +!#################################################################### +Boundary Condition 1 + Target Boundaries(4) = 1 2 3 4 +End + +Solver 1 :: Reference Norm = Real 0.16880513 +Solver 1 :: Reference Norm Tolerance = Real 1.0e-4 + +Solver 2 :: Reference Norm = Real 0.16076679 +Solver 2 :: Reference Norm Tolerance = Real 1.0e-4 + +Solver 3 :: Reference Norm = Real 0.16342618 +Solver 3 :: Reference Norm Tolerance = Real 1.0e-4 + + diff --git a/elmerice/Tests/CovarianceVector2/rectangle.grd b/elmerice/Tests/CovarianceVector2/rectangle.grd new file mode 100644 index 0000000000..c34e587593 --- /dev/null +++ b/elmerice/Tests/CovarianceVector2/rectangle.grd @@ -0,0 +1,24 @@ +***** ElmerGrid input file for structured grid generation ***** +Version = 210903 +Coordinate System = Cartesian 2D +Subcell Divisions in 2D = 1 1 +Subcell Limits 1 = -1.0 1.0 +Subcell Limits 2 = -1.0 1.0 +Material Structure in 2D + 1 +End +Materials Interval = 1 1 +Boundary Definitions +! type out int + 1 -1 1 1 + 2 -2 1 1 + 3 -3 1 1 + 4 -4 1 1 +End +Numbering = Horizontal +Coordinate Ratios = 1 +Element Innernodes = False +Element Degree = 1 +Triangles = True +Element Divisions 1 = 20 +Element Divisions 2 = 20 diff --git a/elmerice/Tests/CovarianceVector2/runTest.cmake b/elmerice/Tests/CovarianceVector2/runTest.cmake new file mode 100644 index 0000000000..d1da81ecba --- /dev/null +++ b/elmerice/Tests/CovarianceVector2/runTest.cmake @@ -0,0 +1,10 @@ +INCLUDE(${TEST_SOURCE}/../test_macros.cmake) + +FILE(COPY ${BINARY_DIR}/elmerice/Solvers/ElmerIceSolvers${SHLEXT} DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") +FILE(RENAME ElmerIceSolvers${SHLEXT} ElmerIceSolvers2${SHLEXT}) +FILE(COPY ${BINARY_DIR}/elmerice/Solvers/ElmerIceSolvers${SHLEXT} DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") +FILE(RENAME ElmerIceSolvers${SHLEXT} ElmerIceSolvers3${SHLEXT}) + +EXECUTE_PROCESS(COMMAND ${ELMERGRID_BIN} 1 2 rectangle.grd) + +RUN_ELMERICE_TEST() From d4e5860d227cda8294e51ab6ca8cba2bc9e05f38 Mon Sep 17 00:00:00 2001 From: fgillet Date: Mon, 24 Jun 2024 15:43:24 +0200 Subject: [PATCH 21/51] add test BackgroundErrorCostSolver --- .../BackgroundErrorCostSolver.md | 2 + elmerice/Tests/BackgroundError/CMakeLists.txt | 9 ++ .../BackgroundError/ELMERSOLVER_STARTINFO | 1 + elmerice/Tests/BackgroundError/case.sif | 151 ++++++++++++++++++ elmerice/Tests/BackgroundError/rectangle.grd | 24 +++ elmerice/Tests/BackgroundError/runTest.cmake | 8 + 6 files changed, 195 insertions(+) create mode 100644 elmerice/Tests/BackgroundError/CMakeLists.txt create mode 100644 elmerice/Tests/BackgroundError/ELMERSOLVER_STARTINFO create mode 100644 elmerice/Tests/BackgroundError/case.sif create mode 100644 elmerice/Tests/BackgroundError/rectangle.grd create mode 100644 elmerice/Tests/BackgroundError/runTest.cmake diff --git a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md index 24cfe92421..efdef43895 100644 --- a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md +++ b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md @@ -137,6 +137,8 @@ end ``` ### Examples +- ElmerIce unitary tests: + - [ELMER_TRUNK]/elmerice/Tests/BackgroundError ### References diff --git a/elmerice/Tests/BackgroundError/CMakeLists.txt b/elmerice/Tests/BackgroundError/CMakeLists.txt new file mode 100644 index 0000000000..50fc2c118c --- /dev/null +++ b/elmerice/Tests/BackgroundError/CMakeLists.txt @@ -0,0 +1,9 @@ +INCLUDE(${CMAKE_CURRENT_SOURCE_DIR}/../test_macros.cmake) + +CONFIGURE_FILE(case.sif case.sif COPYONLY) + +FILE(COPY ELMERSOLVER_STARTINFO rectangle.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") + +ADD_ELMERICE_TEST(BackgroundError) +ADD_ELMERICE_LABEL(BackgroundError elmerice-fast) +ADD_ELMERICE_LABEL(BackgroundError CovUtils) diff --git a/elmerice/Tests/BackgroundError/ELMERSOLVER_STARTINFO b/elmerice/Tests/BackgroundError/ELMERSOLVER_STARTINFO new file mode 100644 index 0000000000..d21bd7ee27 --- /dev/null +++ b/elmerice/Tests/BackgroundError/ELMERSOLVER_STARTINFO @@ -0,0 +1 @@ +case.sif diff --git a/elmerice/Tests/BackgroundError/case.sif b/elmerice/Tests/BackgroundError/case.sif new file mode 100644 index 0000000000..03c1098c3e --- /dev/null +++ b/elmerice/Tests/BackgroundError/case.sif @@ -0,0 +1,151 @@ +!##################################################################### +!#################################################################### +!# Test BackgroundErrorCostSolver +!################################################################### +!# Covariance parameters +!################################################################### +$std=1.0 +$range=0.1 +$nu=1 + +!##################################################################### +!# +!#################################################################### +Header :: Mesh DB "." "rectangle" + +!##################################################################### +!# +!#################################################################### +Simulation + Max Output Level = 3 + Coordinate System = Cartesian + Simulation Type = Steady + Output Intervals(1) = 1 + Steady State Max Iterations = 1 + + !Post File = "case.vtu" +End + +!##################################################################### +!# +!#################################################################### +Body 1 + Equation = 1 + Initial Condition = 1 +End + +!##################################################################### +!# +!#################################################################### +Initial Condition 1 + x = Variable Coordinate 1, Coordinate 2 + REAL MATC "sin(2*pi*tx[0])*sin(2*pi*tx[1])" + xb = Real 0.0 +End + +!################################################################# +!# Equations +!################################################################# +Equation 1 :: Active Solvers(3) = 1 2 3 + +!################################################################# +!# Full-Matrix Matern correlation nu=Integer +!################################################################# +Solver 1 + Equation = String "CostReg1" + procedure = "ElmerIceSolvers" "BackgroundErrorCostSolver" + Variable = -nooutput "dumy" + + Variable Name = String "x" + Gradient Variable Name = String "dJdx" + Background Variable Name = String "xb" + Cost Variable Name = String "CostValue" + + !# True if cost function and gradient must be initialised to 0 in this solve + Reset Cost Value = Logical True + + Cost Filename = File "Cost1.dat" + + + Covariance type = String "full matrix" + correlation type = String "MaternI" + MaternI order = Integer $nu + + correlation range = Real $range + standard deviation = Real $std + + Exported Variable 1 = "x" + Exported Variable 2 = "dJdx" + Exported Variable 3 = "xb" + Exported Variable 4 = -global "CostValue" + +End + +!################################################################# +!# diffusion operator +!################################################################# +Solver 2 + Equation = String "CostReg2" + procedure = "ElmerIceSolvers2" "BackgroundErrorCostSolver" + Variable = -nooutput "dumy" + + Variable Name = String "x" + Gradient Variable Name = String "dJdx" + Background Variable Name = String "xb" + Cost Variable Name = String "CostValue" + + !# True if cost function and gradient must be initialised to 0 in this solve + Reset Cost Value = Logical True + + Cost Filename = File "Cost2.dat" + + + Covariance type = String "diffusion operator" + + Matern exponent m = Integer $nu+1 + correlation range = Real $range + standard deviation = Real $std + + + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Linear System Refactorize = Logical False + Linear System Symmetric = Logical True + Linear System Positive Definite = Logical True + +End + +Solver 3 + Equation = SaveScalars + Procedure = "SaveData" "SaveScalars" + + Show Norm Index = Integer 1 + Variable 1 = String "dJdx" + Operator 1 = rms +End + +!#################################################################### +!# Boundary condition +!#################################################################### +Boundary Condition 1 + Target Boundaries(4) = 1 2 3 4 +End + +Solver 3 :: Reference Norm = Real 0.15364309 +Solver 3 :: Reference Norm Tolerance = Real 1E-06 + +Solver 1 :: Exec Solver = always +Solver 2 :: Exec Solver = never +$fprintf( stderr, "TEST CASE 1\n"); +RUN +$fprintf( stderr, "END TEST CASE 1: Target NRM=0.15364309,EPS:1E-06\n" ); + +Solver 3 :: Reference Norm = Real 2.14108182E-01 +Solver 3 :: Reference Norm Tolerance = Real 1E-06 + +Solver 1 :: Exec Solver = never +Solver 2 :: Exec Solver = always +$fprintf( stderr, "TEST CASE 2\n"); +RUN +$fprintf( stderr, "END TEST CASE 2: Target NRM=2.14108182E-01,EPS:1E-06\n" ); diff --git a/elmerice/Tests/BackgroundError/rectangle.grd b/elmerice/Tests/BackgroundError/rectangle.grd new file mode 100644 index 0000000000..c34e587593 --- /dev/null +++ b/elmerice/Tests/BackgroundError/rectangle.grd @@ -0,0 +1,24 @@ +***** ElmerGrid input file for structured grid generation ***** +Version = 210903 +Coordinate System = Cartesian 2D +Subcell Divisions in 2D = 1 1 +Subcell Limits 1 = -1.0 1.0 +Subcell Limits 2 = -1.0 1.0 +Material Structure in 2D + 1 +End +Materials Interval = 1 1 +Boundary Definitions +! type out int + 1 -1 1 1 + 2 -2 1 1 + 3 -3 1 1 + 4 -4 1 1 +End +Numbering = Horizontal +Coordinate Ratios = 1 +Element Innernodes = False +Element Degree = 1 +Triangles = True +Element Divisions 1 = 20 +Element Divisions 2 = 20 diff --git a/elmerice/Tests/BackgroundError/runTest.cmake b/elmerice/Tests/BackgroundError/runTest.cmake new file mode 100644 index 0000000000..bfb1c91176 --- /dev/null +++ b/elmerice/Tests/BackgroundError/runTest.cmake @@ -0,0 +1,8 @@ +INCLUDE(${TEST_SOURCE}/../test_macros.cmake) + +FILE(COPY ${BINARY_DIR}/elmerice/Solvers/ElmerIceSolvers${SHLEXT} DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") +FILE(RENAME ElmerIceSolvers${SHLEXT} ElmerIceSolvers2${SHLEXT}) + +EXECUTE_PROCESS(COMMAND ${ELMERGRID_BIN} 1 2 rectangle.grd) + +RUN_ELMERICE_TEST() From c0c4b80948dd2954fef522b62067112a84e97ed0 Mon Sep 17 00:00:00 2001 From: fgillet Date: Wed, 3 Jul 2024 10:55:09 +0200 Subject: [PATCH 22/51] improve documentation --- .../Documentation/BackgroundErrorCostSolver.md | 2 +- .../Documentation/GaussianSimulationSolver.md | 15 +++++++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md index efdef43895..c9f0f33854 100644 --- a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md +++ b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md @@ -80,7 +80,7 @@ See [CovarianceUtils](#Covariance_Module) for details on the possible choices to Brasseur et al. (1996) have shown that adding a smoothness constraint that penalizes a combination of the nom and of the spatial derivatives up to order 2, is equivalent, for an infinite domain, to imposing a kernel from the Matérn family with a **smoothness parameter** $\nu=1$. This has been generalized to higher dimensions and derivatives by Barth et al. (2014). Regularisation of inverse problems can often be reinterpreted in the Bayesian framework (Calvetti and Somersalo, 2018), so that the effect of this solver will be similar to the classically used *Regularisation* solver that penalizes he first spatial derivatives, and the choice of the correlation structure and parameters will control the **smoothness** of the inverted field. However this solver is then much more versatile and the parameters have a direct physical interpretation. - For an application of this method in ice-sheet modeling for the inversion of both basal friction and viscosity in the Antarctic Ice Sheet see e.g. Recinos et al. (2023). +For an application of this method in ice-sheet modeling for the inversion of both basal friction and viscosity in the Antarctic Ice Sheet see e.g. Recinos et al. (2023): it can easily be shown that their definition of the prior covariance matrix (Eqs. 11 and 12) is equivalent to the *diffusion operator* method with $m=2$, and the definition of the variance and correlation range given by their Eq. 18 and 19. ### Known Bugs and Limitations diff --git a/elmerice/Solvers/Documentation/GaussianSimulationSolver.md b/elmerice/Solvers/Documentation/GaussianSimulationSolver.md index 0aa8552e2a..4589b3ab09 100644 --- a/elmerice/Solvers/Documentation/GaussianSimulationSolver.md +++ b/elmerice/Solvers/Documentation/GaussianSimulationSolver.md @@ -39,12 +39,20 @@ See e.g. Graham et al., (2017). For an application to uncertainty quantification in ice sheet modeling, using the *diffusion operator* covariance type, see Bulthuis and Larour (2022). + ### Implementation See the generic documentation for [CovarianceUtils](#Covariance_Module) for details on the possible choices to construct the covariance matrix $C$ and for the factorization. It the solver variable is a vector, each component contains a different realization, otherwise each call to the solver (e.g. during steady-state iterations) will give a different realization. +If the solver is called several times, e.g. in steady state-iterations a new random varaible will be produced. + +> :warning: This solver depends on the a **random generator**. Elmer always initialize a seed at start-up. +> This seed can be changed with the keyword *Random Number Seed = Integer ...* (default: 314159265) in the **Simulation section**. +> This means that, if the seed is not changed, the solver will produce the same realisation (or serie of realisations) each time. +> A way to change the seed has also been introduced in the solver and can be changed with the keyword *Random Seed = Integer* in the **solver section**. + ### Known Bugs and Limitations - Limited to serial if using the "full matrix" covariance method. @@ -62,6 +70,13 @@ Solver 1 !# Variable names Background Variable Name = String "xb" + +!############################################################################ +!# Seed for the random generator +!# warning: it is initialised to 314159265 during Elmer initilisation!! +!############################################################################ + Random Seed = Integer 314159265 + !# Covariance types !############################################################################ !# keywords for the "diffusion operator" method From bd1dc912cf973943a9b629b580a228cf8511e91a Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 3 Jul 2024 12:44:23 +0300 Subject: [PATCH 23/51] updating GlaDS masking to optionally use the connectivity mask or grounded mask --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 88 ++++--------------------- 1 file changed, 11 insertions(+), 77 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 5d8d131540..171973dec8 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -73,7 +73,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati TYPE(Element_t), POINTER :: Element, Edge, Face, Bulk TYPE(ValueList_t), POINTER :: Equation, Material, SolverParams, BodyForce, BC, Constants TYPE(Variable_t), POINTER :: ChannelAreaVar, ChannelFluxVar, SheetThicknessVar, & - GMcheckVar, GroundedMaskVar, HydPotVar + GroundedMaskVar, HydPotVar TYPE(Mesh_t), POINTER :: Mesh INTEGER :: i, j, k, l, m, n, t, iter, body_id, eq_id, material_id, & @@ -105,7 +105,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati meltChannels = .TRUE., NeglectH = .TRUE., Calving = .FALSE., & CycleElement=.FALSE., MABool = .FALSE., MaxHBool = .FALSE., LimitEffPres=.FALSE., & MinHBool=.FALSE., CycleNode=.FALSE. - LOGICAL, SAVE :: UseGM, UseGC, AllowSheetAtGL, ZeroSheetWithHP + LOGICAL, SAVE :: UseGM, AllowSheetAtGL, ZeroSheetWithHP LOGICAL, ALLOCATABLE :: IsGhostNode(:), NoChannel(:), NodalNoChannel(:) ! For use in masking GlaDS floating shelves. "MASK_HP" is for situations where @@ -160,7 +160,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CCw, lc, Lw, NoChannel, NodalNoChannel, & Channels, meltChannels, NeglectH, BDForder, & Vvar, ublr, hr2, Refq, Nel,& - Calving, Load_h, LimitEffPres + Calving, Load_h, LimitEffPres, MaskName totst = 0.0_dp @@ -374,16 +374,6 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END IF END IF - ! END IF -! UseGC = GetLogical( SolverParams,'Use GMcheck', Found ) -! IF (.NOT. Found) THEN -! IF (Calving) THEN -! UseGC = .TRUE. -! ELSE -! UseGC = .FALSE. -! END IF -! END IF - AllowSheetAtGL = GetLogical( SolverParams,'Allow Sheet At GL', Found ) IF (.NOT. Found) THEN AllowSheetAtGL = .TRUE. @@ -1151,7 +1141,6 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CALL FATAL( SolverName, Message) END SELECT END DO - NULLIFY(GMcheckVar, GroundedMaskVar) IF (CycleElement) THEN CYCLE END IF @@ -1624,67 +1613,6 @@ FUNCTION ProcessMask(MaskName, AllowSheetAtGL, ii) RESULT( MaskStatus_local ) END FUNCTION ProcessMask - ! Use the grounded mask and or grounded mask check to decide how to mask the current node. - ! The following table summarises actions as a function of mask values. - ! - ! GM GC Status Action - !------------------------------------------------- - ! -1 0 Floating (not shelf); don't mask - ! -1 1 FLoating (shelf); mask - ! 0 0 GL (not shelf); don't mask - ! 0 1 GL (shelf); partial mask - ! 1 0 Grounded; don't mask - ! 1 1 Grounded (shelf); Fatal (mask inconsistency) - ! - !---------------------------------------------------------------------------------------------------------- - FUNCTION ProcessMasks(UseGM, UseGC, AllowSheetAtGL, ii) RESULT( MaskStatus_local ) - - LOGICAL, INTENT(IN) :: UseGM, UseGC, AllowSheetAtGL - INTEGER, INTENT(IN) :: ii ! node index - - INTEGER :: MaskStatus_local - - MaskStatus_local = MASK_NONE - - IF (UseGM) THEN - GroundedMaskVar => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.TRUE.) - END IF - - IF (UseGC) THEN - GMcheckVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.TRUE.) - IF (GMcheckVar % Values(GMcheckVar % Perm(ii)).GT.0.0) THEN - IF (UseGM) THEN - IF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).LT.0.0) THEN - MaskStatus_local = MASK_ALL - ELSEIF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).EQ.0.0) THEN - IF (AllowSheetAtGL) THEN - MaskStatus_local = MASK_HP - ELSE - MaskStatus_local = MASK_ALL - END IF - END IF - END IF - END IF - ELSE - IF (UseGM) THEN - IF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).LT.0.0) THEN - MaskStatus_local = MASK_ALL - ELSEIF (GroundedMaskVar % Values(GroundedMaskVar % Perm(ii)).EQ.0.0) THEN - IF (AllowSheetAtGL) THEN - MaskStatus_local = MASK_HP - ELSE - MaskStatus_local = MASK_ALL - END IF - END IF - ELSE - WRITE(Message,'(A)') "Function ProcessMasks should not be called when no mask is specified" - CALL FATAL( SolverName, Message) - END IF - END IF - NULLIFY(GMcheckVar, GroundedMaskVar) - - END FUNCTION ProcessMasks - ! Compute consistent channel norm only considering the edges that also have hydrology defined on the nodes. ! In parallel only consider the edges in the partition where it is active. @@ -2581,6 +2509,7 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) TYPE(Variable_t), POINTER :: gmVar, channelVar, sheetThickVar, sheetDisVar LOGICAL :: GotIt, ValidEdge CHARACTER(LEN=MAX_NAME_LEN):: channelVarName, sheetThickVarName, sheetDisVarName, SolverName + CHARACTER(LEN=MAX_NAME_LEN):: MaskName REAL(KIND=dp), POINTER :: gmVals(:), channelVals(:), sheetThickVals(:), sheetDisVals(:) REAL(KIND=dp), POINTER :: GLfluxVals(:) REAL(KIND=dp) :: volFluxSheet, volFluxChannel, sheetDisMag @@ -2641,8 +2570,13 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) sheetDisPerm => sheetDisVar % Perm sheetDisVals => sheetDisVar % Values - ! grounded mask name is hard coded - gmVar => VariableGet(Model % mesh % Variables,TRIM("GroundedMask"),UnFoundFatal=.TRUE.) + ! grounded mask + MaskName = GetString( SolverParams , 'grounded mask variable', GotIt ) + IF (.NOT.GotIt) THEN + CALL Info(SolverName,'>grounded mask variable< not found, assuming >GroundedMask<',Level=4) + MaskName = "GroundedMask" + END IF + gmVar => VariableGet(Model % mesh % Variables,TRIM(MaskName),UnFoundFatal=.TRUE.) IF (.NOT.ASSOCIATED(gmVar)) & CALL FATAL(SolverName,"Variable >GroundedMask< not found") gmPerm => gmVar % Perm From c1714a7b5375abe0dca4acbacb6358c8e4cd1fa1 Mon Sep 17 00:00:00 2001 From: Morlocke Date: Wed, 3 Jul 2024 14:00:51 +0200 Subject: [PATCH 24/51] A selection of updates to get the calving-hydrology coupled model up-and-running again (more to come over the following weeks) --- elmerice/Solvers/Calving3D.F90 | 7 +++++++ elmerice/Solvers/CalvingGeometry.F90 | 8 ++++++++ elmerice/Solvers/CalvingHydroInterp.F90 | 24 ++++++++++++++---------- elmerice/Solvers/CalvingRemesh.F90 | 7 +++++++ elmerice/Solvers/GlaDSCoupledSolver.F90 | 5 +---- elmerice/Solvers/GroundedSolver.F90 | 2 +- fem/src/MeshUtils.F90 | 21 ++++++++++++++++----- fem/src/ModelDescription.F90 | 7 ++++++- 8 files changed, 60 insertions(+), 21 deletions(-) diff --git a/elmerice/Solvers/Calving3D.F90 b/elmerice/Solvers/Calving3D.F90 index 896273b370..e5ff44d290 100644 --- a/elmerice/Solvers/Calving3D.F90 +++ b/elmerice/Solvers/Calving3D.F90 @@ -358,6 +358,13 @@ SUBROUTINE Find_Calving3D ( Model, Solver, dt, TransientSimulation ) END DO END IF + IF(.NOT. Boss) THEN + ALLOCATE(FaceNodesT % x(1), FaceNodesT % y(1), FaceNodesT % z (1)) + FaceNodesT % x(1) = 0 + FaceNodesT % y(1) = 0 + FaceNodesT % z(1) = 0 + END IF + !Global NodeNumbers CALL MPI_GATHERV(Mesh % ParallelInfo % GlobalDOFs(MyFaceNodeNums),& FaceNodeCount,MPI_INTEGER,& diff --git a/elmerice/Solvers/CalvingGeometry.F90 b/elmerice/Solvers/CalvingGeometry.F90 index c679097f37..790fd56649 100644 --- a/elmerice/Solvers/CalvingGeometry.F90 +++ b/elmerice/Solvers/CalvingGeometry.F90 @@ -2407,8 +2407,16 @@ SUBROUTINE GetDomainEdge(Model, Mesh, TopPerm, OrderedNodes, OrderedNodeNums, Pa ! Gather node coords from all partitions ! Note, they're going into 'UnorderedNodes': though they are ordered ! within their partition, the partitions aren't ordered... + ! For some reason, need to allocate coord lists in non-boss PEs !----------------------------------------------------------- + IF(.NOT. Boss) THEN + ALLOCATE(UnorderedNodes % x(1), UnorderedNodes % y(1), UnorderedNodes % z(1)) + UnorderedNodes % x(1) = 0 + UnorderedNodes % y(1) = 0 + UnorderedNodes % z(1) = 0 + END IF + !Global Node Numbers CALL MPI_GATHERV(Mesh % ParallelInfo % GlobalDOFs(OrderedNodeNums),& NoNodesOnEdge,MPI_INTEGER,& diff --git a/elmerice/Solvers/CalvingHydroInterp.F90 b/elmerice/Solvers/CalvingHydroInterp.F90 index 4b7185575d..b33d240b20 100644 --- a/elmerice/Solvers/CalvingHydroInterp.F90 +++ b/elmerice/Solvers/CalvingHydroInterp.F90 @@ -414,10 +414,10 @@ SUBROUTINE IceToHydroInterp( Model,Solver,Timestep,TransientSimulation ) !END DO !END DO DO i=1, SIZE(WorkVar % Perm) - IF(WorkVar2 % Values(WorkVar2 % Perm(i)) .NE. 0.0) THEN + IF(WorkVar % Perm(i) > 0.0 .AND. WorkVar2 % Perm(i) > 0.0) THEN WorkVar % Values(WorkVar % Perm(i)) = WorkVar % Values(WorkVar % Perm(i))/WorkVar2 % Values(WorkVar2 % Perm(i)) - ELSE - WorkVar % Values(WorkVar % Perm(i)) = 0.0 + !ELSE + !WorkVar % Values(WorkVar % Perm(i)) = 0.0 END IF END DO @@ -452,12 +452,14 @@ SUBROUTINE IceToHydroInterp( Model,Solver,Timestep,TransientSimulation ) IF(.NOT. Found) Threshold = 10000.0 DO i=1, SIZE(WorkVar % Perm) - Dist = (HydroSolver % Mesh % Nodes % x(WorkVar % Perm(i)) -& + IF(WorkVar % Perm(i) > 0.0) THEN + Dist = (HydroSolver % Mesh % Nodes % x(WorkVar % Perm(i)) -& RefNode(1))**2 - Dist = Dist + (HydroSolver % Mesh % Nodes % y(WorkVar % Perm(i)) -& - RefNode(2))**2 - Dist = SQRT(Dist) - IF(Dist > Threshold) WorkVar % Values(WorkVar % Perm(i)) = 1.0 + Dist = Dist + (HydroSolver % Mesh % Nodes % y(WorkVar % Perm(i)) -& + RefNode(2))**2 + Dist = SQRT(Dist) + IF(Dist > Threshold) WorkVar % Values(WorkVar % Perm(i)) = 1.0 + END IF END DO END IF @@ -605,6 +607,7 @@ SUBROUTINE IceToHydroInterp( Model,Solver,Timestep,TransientSimulation ) WorkVar2 => VariableGet(HydroSolver % Mesh % Variables, "HydroWeights", ThisOnly=.TRUE., UnfoundFatal=.TRUE.) !IF(ParEnv % PEs > 1) CALL ParallelSumVector(HydroSolver % Matrix, WorkVar2 % Values) DO i=1,SIZE(WorkVar % Perm) + IF(WorkVar % Perm(i) > 0.0 .AND. WorkVar2 % Perm(i) > 0.0) THEN !Element => HydroSolver % Mesh % Elements(i) !n = GetElementNOFNodes(Element) !DO j=1, n @@ -612,8 +615,9 @@ SUBROUTINE IceToHydroInterp( Model,Solver,Timestep,TransientSimulation ) !WorkVar % Values(WorkVar % Perm(Element % NodeIndexes(j)))*& !WorkVar2 % Values(WorkVar2 % Perm(Element % NodeIndexes(j))) !END DO - WorkVar % Values(WorkVar % Perm(i)) =& - WorkVar % Values(WorkVar % Perm(i))*WorkVar2 % Values(WorkVar2 % Perm(i)) + WorkVar % Values(WorkVar % Perm(i)) =& + WorkVar % Values(WorkVar % Perm(i))*WorkVar2 % Values(WorkVar2 % Perm(i)) + END IF END DO HydroTempResSum = 0.0_dp HydroTempResSum = SUM(WorkVar % Values) diff --git a/elmerice/Solvers/CalvingRemesh.F90 b/elmerice/Solvers/CalvingRemesh.F90 index e49a9c6c92..09d45f0aeb 100644 --- a/elmerice/Solvers/CalvingRemesh.F90 +++ b/elmerice/Solvers/CalvingRemesh.F90 @@ -995,6 +995,13 @@ END SUBROUTINE InterpolateMeshToMesh END DO END IF + IF(.NOT. Boss) THEN + ALLOCATE(FaceNodesT % x(1), FaceNodesT % y(1), FaceNodesT % z(1)) + FaceNodesT % x(1) = 0 + FaceNodesT % y(1) = 0 + FaceNodesT % z(1) = 0 + END IF + !Global NodeNumbers CALL MPI_GATHERV(OldMesh % ParallelInfo % GlobalDOFs(MyFaceNodeNums),& FaceNodeCount,MPI_INTEGER,& diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index e0944cb3ca..b334c844ee 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -301,7 +301,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati AllocationsDone = .TRUE. END IF - + SolverParams => GetSolverParams() !------------------------------------------------------------------------------ ! Read physical and numerical constants and initialize !------------------------------------------------------------------------------ @@ -357,7 +357,6 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati ! following switches to false. The defaults change to true when using Samuel Cook's "Calving" ! (set in simulation seciton of sif). The defaults will be overwritten for each of the switches ! that are specified in the solver section of the sif. - SolverParams => GetSolverParams() UseGM = GetLogical( SolverParams,'Use GroundedMask', Found ) IF (.NOT. Found) THEN IF (Calving) THEN @@ -459,8 +458,6 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati END IF END IF IfFirstTime - SolverParams => GetSolverParams() - NeglectH = GetLogical( SolverParams,'Neglect Sheet Thickness in Potential', Found ) IF ( .NOT.Found ) THEN CALL FATAL(SolverName, 'No >Neglect Sheet Thickness in Potential< found') diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index 78060c86ce..360598b5d9 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -429,7 +429,7 @@ SUBROUTINE FrontConn () GroundedVar => Solver % Variable GMCheck = -1.0_dp - + !Set up inverse perm for FindNodeNeighbours InvPerm => CreateInvPerm(Matrix % Perm) !Create inverse perm for neighbour search ALLOCATE(Neighbours(Mesh % NumberOfNodes, MaxNeighbours), NoNeighbours(Mesh % NumberOfNodes)) diff --git a/fem/src/MeshUtils.F90 b/fem/src/MeshUtils.F90 index 6194cba426..ecc7334d0b 100644 --- a/fem/src/MeshUtils.F90 +++ b/fem/src/MeshUtils.F90 @@ -3027,7 +3027,7 @@ SUBROUTINE NonNodalElements() TYPE(Element_t) :: DummyElement TYPE(ValueList_t), POINTER :: Vlist INTEGER :: inDOFs(10,6) - CHARACTER(MAX_NAME_LEN) :: ElementDef0, ElementDef + CHARACTER(MAX_NAME_LEN) :: ElementDef0, ElementDef, TargetMesh EdgeDOFs => NULL() @@ -3037,15 +3037,26 @@ SUBROUTINE NonNodalElements() DGIndex = 0 - InDofs = 0 + InDofs = -1 InDofs(:,1) = 1 IF ( PRESENT(Def_Dofs) ) THEN inDofs = Def_Dofs ELSE DO s=1,Model % NumberOfSolvers + !Need to only look at solvers that are going to run on this mesh + TargetMesh = ListGetString(Model % Solvers(s) % Values, 'Mesh', GotIt) DO i=1,6 DO j=1,10 - inDofs(j,i) = MAX(Indofs(j,i),MAXVAL(Model % Solvers(s) % Def_Dofs(j,:,i))) + IF(GotIt) THEN + !This assumes your meshes all start '. ' + IF (LEN_TRIM(Model % Solvers(s) % Mesh % Name) > 0) THEN + IF(TRIM(Model % Solvers(s) % Mesh % Name) .NE. TRIM(TargetMesh(2:))) THEN + CYCLE + ELSE + inDofs(j,i) = MAX(Indofs(j,i),MAXVAL(Model % Solvers(s) % Def_Dofs(j,:,i))) + END IF + END IF + END IF END DO END DO END DO @@ -3495,6 +3506,7 @@ SUBROUTINE NonNodalElements() IF(Found) NeedEdges = Stat END IF + IF ( NeedEdges ) THEN CALL Info('NonNodalElements','Requested elements require creation of edges',Level=8) CALL SetMeshEdgeFaceDOFs(Mesh,EdgeDOFs,FaceDOFs,inDOFs) @@ -20999,7 +21011,6 @@ SUBROUTINE SetActiveElementsTable( Model, Solver, MaxDim, CreateInv ) MeshDim = 0 Parallel = ( ParEnv % PEs > 1 ) .AND. ( .NOT. Mesh % SingleMesh ) - DO Sweep = 0, 1 n = 0 DO i=1,Mesh % NumberOfBulkElements + Mesh % NumberOFBoundaryElements @@ -21018,7 +21029,7 @@ SUBROUTINE SetActiveElementsTable( Model, Solver, MaxDim, CreateInv ) END IF END IF END DO - + IF( Sweep == 0 ) THEN Solver % NumberOfActiveElements = n IF( n == 0 ) EXIT diff --git a/fem/src/ModelDescription.F90 b/fem/src/ModelDescription.F90 index 510dd4d348..7fe344e698 100644 --- a/fem/src/ModelDescription.F90 +++ b/fem/src/ModelDescription.F90 @@ -2692,6 +2692,10 @@ FUNCTION LoadModel( ModelName,BoundariesOnly,numprocs,mype,MeshIndex) RESULT( Mo ELSE MeshSolvers(j, i) = .TRUE. END IF + !This seems to be necessary to force DefDofs for the global mesh to not + !update if you have multiple solvers all pointing at the same solver- + !specific mesh + GotMesh = .TRUE. END IF @@ -2765,6 +2769,7 @@ FUNCTION LoadModel( ModelName,BoundariesOnly,numprocs,mype,MeshIndex) RESULT( Mo END IF ! Calling GetDefs fills Def_Dofs arrays: CALL GetDefs( ElementDef, Solver % Def_Dofs, Def_Dofs(:,:), .NOT. GotMesh ) + IF(j>0) THEN ElementDef0 = ElementDef0(j+1:) ELSE @@ -3064,7 +3069,7 @@ FUNCTION LoadModel( ModelName,BoundariesOnly,numprocs,mype,MeshIndex) RESULT( Mo IF ( k<=nlen ) THEN MeshName(i:i) = '/' i = i + 1 - DO WHILE( name(k:k) /= ' ' ) + DO WHILE( i < LEN_TRIM(Name)+1 ) MeshName(i:i) = Name(k:k) k = k + 1 i = i + 1 From 9a39e4075dbabe398cced77d48beadbd3ed11733 Mon Sep 17 00:00:00 2001 From: fgillet Date: Wed, 3 Jul 2024 19:21:22 +0200 Subject: [PATCH 25/51] Update Documentation --- .../Documentation/BackgroundErrorCostSolver.md | 3 +++ .../Solvers/Documentation/CovarianceUtilsModule.md | 13 +++++++++++-- .../Documentation/CovarianceVectorMultiplySolver.md | 2 ++ .../Documentation/GaussianSimulationSolver.md | 2 ++ 4 files changed, 18 insertions(+), 2 deletions(-) diff --git a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md index c9f0f33854..436a2cc091 100644 --- a/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md +++ b/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md @@ -140,6 +140,9 @@ end - ElmerIce unitary tests: - [ELMER_TRUNK]/elmerice/Tests/BackgroundError +- Sensitivity of the mass conservation method to the Regularisation scheme: + - https://gricad-gitlab.univ-grenoble-alpes.fr/gilletcf/CovarianceUtils/-/tree/master/MassConservation + ### References - Barth, A., Beckers, J.-M., Troupin, C., Alvera-Azcárate, A., and Vandenbulcke, L.: divand-1.0: n-dimensional variational data analysis for ocean observations, Geosci. Model Dev., 7, 225–241, https://doi.org/10.5194/gmd-7-225-2014, 2014. diff --git a/elmerice/Solvers/Documentation/CovarianceUtilsModule.md b/elmerice/Solvers/Documentation/CovarianceUtilsModule.md index 532d30c980..abb2fa2c2f 100644 --- a/elmerice/Solvers/Documentation/CovarianceUtilsModule.md +++ b/elmerice/Solvers/Documentation/CovarianceUtilsModule.md @@ -47,7 +47,7 @@ Remarks: - In the literature, the Matérn functions are often defined with the smoothness parameter $\nu$ which can be a real; Here we are restricted to integers an $m=\nu+1$. - The Matérn functions have two limit cases, the exponential correlation function for $\nu=1/2$ and the squared exponential (or gaussian) correlation function for $\nu \to \infty$. - The Gaussian limit can be approached by setting the range to the Dayley length scale (Guillet et al. (2019) Eq. 7): -$$D=\sqrt{2m-4}l)$$ +$$D=\sqrt{2m-4}l$$ For the following, we define the following the mass matrix $M$ and stiffness matrix $K$ discretized by the FEM: $$M_{ij}=\int_{\Omega} \phi_i \phi_j d\Omega$$ @@ -57,7 +57,7 @@ The [BackgroundErrorCostSolver](#Background_Error) requires the inverse correlat $$C^{-1} = \Gamma^{-1}ML^{-1}_M \Gamma^{-1}$$ with: -- $\Gamma=\sqrt{(4\pi(m-1))}l I$ is a normalization matrix +- $\Gamma=\sqrt{4\pi(m-1)}l I$ is a normalization matrix - $L^{-1}_M = [M^{-1}(M + K)]^m$ The [CovarianceVectorMultiplySolver](#Covariance_Vector_product) requires the correlation matrix $C$ which is discretized as: @@ -243,6 +243,15 @@ END INTERFACE Functions related to the computation of the analytical correlation functions. +### Examples + +- ElmerIce unitary tests: + - [ELMER_TRUNK]/elmerice/Tests/CovarianceVector + - [ELMER_TRUNK]/elmerice/Tests/CovarianceVector2 + +- Validation test cases and set-ups: + - https://gricad-gitlab.univ-grenoble-alpes.fr/gilletcf/CovarianceUtils + ### References - Recinos, B., Goldberg, D., Maddison, J. R., and Todd, J.: A framework for time-dependent ice sheet uncertainty quantification, applied to three West Antarctic ice streams, The Cryosphere, 17, https://doi.org/10.5194/tc-17-4241-2023, 2023. diff --git a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md index 8fc202857f..13ab2d994b 100644 --- a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md +++ b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md @@ -91,6 +91,8 @@ end - [ELMER_TRUNK]/elmerice/Tests/CovarianceVector - [ELMER_TRUNK]/elmerice/Tests/CovarianceVector2 +- Validation test cases: + - https://gricad-gitlab.univ-grenoble-alpes.fr/gilletcf/CovarianceUtils/-/tree/master/CovarianceTestCase diff --git a/elmerice/Solvers/Documentation/GaussianSimulationSolver.md b/elmerice/Solvers/Documentation/GaussianSimulationSolver.md index 4589b3ab09..6462a5571d 100644 --- a/elmerice/Solvers/Documentation/GaussianSimulationSolver.md +++ b/elmerice/Solvers/Documentation/GaussianSimulationSolver.md @@ -102,6 +102,8 @@ end ### Examples +- Examples available here: + - https://gricad-gitlab.univ-grenoble-alpes.fr/gilletcf/CovarianceUtils/-/tree/master/GaussianSimulationTestCase ### References From e5d05dbd4b8981d00798878430743b8a247d5dd8 Mon Sep 17 00:00:00 2001 From: fgillet Date: Thu, 4 Jul 2024 09:07:16 +0200 Subject: [PATCH 26/51] Update documentation --- .../Solvers/Documentation/CovarianceVectorMultiplySolver.md | 2 ++ elmerice/examples/Inverse_Methods/README.md | 6 +++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md index 13ab2d994b..4a7c72daae 100644 --- a/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md +++ b/elmerice/Solvers/Documentation/CovarianceVectorMultiplySolver.md @@ -94,6 +94,8 @@ end - Validation test cases: - https://gricad-gitlab.univ-grenoble-alpes.fr/gilletcf/CovarianceUtils/-/tree/master/CovarianceTestCase +- Filtering test case: + - https://gricad-gitlab.univ-grenoble-alpes.fr/gilletcf/CovarianceUtils/-/tree/master/FilterTestCase ### References diff --git a/elmerice/examples/Inverse_Methods/README.md b/elmerice/examples/Inverse_Methods/README.md index a526acc418..1e16abed75 100644 --- a/elmerice/examples/Inverse_Methods/README.md +++ b/elmerice/examples/Inverse_Methods/README.md @@ -1,5 +1,5 @@ # Inverse methods test cases -- Modification date : 28/02/2023 +- Modification date : 04/07/2024 This test cases for the adjoint inverse methods have been updated in April 2020 from the material presented for the @@ -10,6 +10,8 @@ http://elmerfem.org/elmerice/wiki/lib/exe/fetch.php?media=courses:2016_oslo_shal Note that the solvers have been updated so that the implementation differs and use the new solvers for the inverse methods (see documentation [here](https://github.com/ElmerCSC/elmerfem/tree/elmerice/elmerice/Solvers/Documentation)). +A new *Regularisation* solver that can be used to prescribed prior error statistics under the form of a covariance matrix has been introduced in 07/2024. The documentation is available [here](https://github.com/ElmerCSC/elmerfem/blob/elmerice/elmerice/Solvers/Documentation/BackgroundErrorCostSolver.md). A test case for the Mass conservation Method can be found [here](https://gricad-gitlab.univ-grenoble-alpes.fr/gilletcf/CovarianceUtils). + - Content of this directory: - DATA: data sets and processing tools required to run the experiments. @@ -29,3 +31,5 @@ TEST CASES USING THE STOKES SOLVER: TEST CASES FOR THE THICKNESS SOLVER: - MassConservation: Validation of the adjoint of the steady state thickness solver; i.e. the mass conservation method. + + From 600e76882453ec129073750c30e5b0869ede6e49 Mon Sep 17 00:00:00 2001 From: Morlocke Date: Fri, 5 Jul 2024 10:02:17 +0200 Subject: [PATCH 27/51] Further changes to make the calving-hydrology coupling work again - mostly edits to my own janky calving code (also some of Joe's!). --- elmerice/Solvers/Calving3D.F90 | 2 ++ elmerice/Solvers/CalvingGeometry.F90 | 20 +++++++++------- elmerice/Solvers/CalvingHydroInterp.F90 | 22 +++++++++++++++-- elmerice/Solvers/GlaDSCoupledSolver.F90 | 2 +- .../UserFunctions/USF_SourceCalcCalving.F90 | 24 +++++++++++-------- fem/src/InterpVarToVar.F90 | 2 ++ fem/src/SolverUtils.F90 | 2 +- 7 files changed, 52 insertions(+), 22 deletions(-) diff --git a/elmerice/Solvers/Calving3D.F90 b/elmerice/Solvers/Calving3D.F90 index e5ff44d290..b6a4a5a88b 100644 --- a/elmerice/Solvers/Calving3D.F90 +++ b/elmerice/Solvers/Calving3D.F90 @@ -830,6 +830,7 @@ SUBROUTINE Find_Calving3D ( Model, Solver, dt, TransientSimulation ) CrevVar => VariableGet(PlaneMesh % Variables, "ave_cindex", .TRUE.) PCSolver % Variable => CrevVar + PCSolver % Variable % Values => CrevVar % Values PCSolver % Matrix % Perm => CrevVar % Perm !---------------------------------------------------- @@ -1710,6 +1711,7 @@ SUBROUTINE Find_Calving3D ( Model, Solver, dt, TransientSimulation ) FirstTime = .FALSE. + PCSolver % Variable % Values => NULL() PCSolver % Variable => NULL() PCSolver % Matrix % Perm => NULL() CALL FreeMatrix(PCSolver % Matrix) diff --git a/elmerice/Solvers/CalvingGeometry.F90 b/elmerice/Solvers/CalvingGeometry.F90 index 790fd56649..575f984b96 100644 --- a/elmerice/Solvers/CalvingGeometry.F90 +++ b/elmerice/Solvers/CalvingGeometry.F90 @@ -458,15 +458,19 @@ SUBROUTINE CheckCrevasseNodes(Mesh, CrevassePaths, Onleft, OnRight) DO i=1,Mesh % NumberOfBulkElements DO j=1,SIZE(Mesh % Elements(i) % NodeIndexes) IF(RemoveNode(Mesh % Elements(i) % NodeIndexes(j))) THEN - IF(PRESENT(OnLeft) .AND. OnLeft(Mesh % Elements(i) % NodeIndexes(j))) THEN - OnLeft(Mesh % Elements(i) % NodeIndexes(j)) = .FALSE. - OnLeft(ReplaceWithNode(Mesh % Elements(i) % NodeIndexes(j))) = .TRUE. + IF(PRESENT(OnLeft)) THEN + IF(OnLeft(Mesh % Elements(i) % NodeIndexes(j))) THEN + OnLeft(Mesh % Elements(i) % NodeIndexes(j)) = .FALSE. + OnLeft(ReplaceWithNode(Mesh % Elements(i) % NodeIndexes(j))) = .TRUE. + END IF END IF - IF(PRESENT(OnRight) .AND. OnRight(Mesh % Elements(i) % NodeIndexes(j))) THEN - PRINT*, 'replace', Mesh % Elements(i) % NodeIndexes(j),& - ReplaceWithNode(Mesh % Elements(i) % NodeIndexes(j)) - OnRight(Mesh % Elements(i) % NodeIndexes(j)) = .FALSE. - OnRight(ReplaceWithNode(Mesh % Elements(i) % NodeIndexes(j))) = .TRUE. + IF(PRESENT(OnRight)) THEN + IF(OnRight(Mesh % Elements(i) % NodeIndexes(j))) THEN + PRINT*, 'replace', Mesh % Elements(i) % NodeIndexes(j),& + ReplaceWithNode(Mesh % Elements(i) % NodeIndexes(j)) + OnRight(Mesh % Elements(i) % NodeIndexes(j)) = .FALSE. + OnRight(ReplaceWithNode(Mesh % Elements(i) % NodeIndexes(j))) = .TRUE. + END IF END IF Mesh % Elements(i) % NodeIndexes(j) = & ReplaceWithNode(Mesh % Elements(i) % NodeIndexes(j)) diff --git a/elmerice/Solvers/CalvingHydroInterp.F90 b/elmerice/Solvers/CalvingHydroInterp.F90 index b33d240b20..e9a188b3f6 100644 --- a/elmerice/Solvers/CalvingHydroInterp.F90 +++ b/elmerice/Solvers/CalvingHydroInterp.F90 @@ -594,6 +594,22 @@ SUBROUTINE IceToHydroInterp( Model,Solver,Timestep,TransientSimulation ) !Temp residual needs to be conserved. Here, just integrate across all !elements and compare totals, then scale values on hydromesh uniformly to !bring in line with ice mesh + !This first section is due to SolveLinearSystem invalidating the + !temp variables on the hydro mesh. Not really + !sure why it does this, but this fix seems to work without any knock-on + !effects. + WorkVar2 => HydroSolver % Mesh % Variables + DO WHILE (ASSOCIATED(WorkVar2)) + IF (TRIM(WorkVar2 % Name) == 'temp residual') THEN + IF (.NOT. WorkVar2 % Valid) THEN + WorkVar2 % Valid = .TRUE. + WorkVar2 % PrimaryMesh => HydroSolver % Mesh + END IF + EXIT + END IF + WorkVar2 => WorkVar2 % Next + END DO + WorkVar => VariableGet(Model % Mesh % Variables, "temp residual", ThisOnly=.TRUE., UnfoundFatal=.TRUE.) IceTempResSum = 0.0_dp @@ -631,8 +647,10 @@ SUBROUTINE IceToHydroInterp( Model,Solver,Timestep,TransientSimulation ) CALL MPI_Gather(IceTempResSum, 1, MPI_DOUBLE_PRECISION, ParITRS, 1, MPI_DOUBLE_PRECISION, 0, ELMER_COMM_WORLD, ierr) CALL MPI_Gather(HydroTempResSum, 1, MPI_DOUBLE_PRECISION, ParHTRS, 1, MPI_DOUBLE_PRECISION, 0, ELMER_COMM_WORLD, ierr) IF(ParEnv % myPE == 0) THEN - IF(ANINT(SUM(ParITRS)) .NE. ANINT(SUM(ParHTRS))) THEN + IF(INT(ANINT(SUM(ParITRS))) .NE. INT(ANINT(SUM(ParHTRS)))) THEN ScaleFactor = SUM(ParITRS)/SUM(ParHTRS) + ELSE + ScaleFactor = 1.0 END IF END IF CALL MPI_BARRIER(ELMER_COMM_WORLD, ierr) @@ -641,7 +659,7 @@ SUBROUTINE IceToHydroInterp( Model,Solver,Timestep,TransientSimulation ) WorkVar % Values(i) = WorkVar % Values(i)*ScaleFactor END DO ELSE - IF(ANINT(IceTempResSum) .NE. ANINT(HydroTempResSum)) THEN + IF(INT(ANINT(IceTempResSum)) .NE. INT(ANINT(HydroTempResSum))) THEN ScaleFactor = IceTempResSum/HydroTempResSum DO i=1, SIZE(WorkVar % Values) WorkVar % Values(i) = WorkVar % Values(i)*ScaleFactor diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index fe8717c820..37520f9ef3 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -1198,7 +1198,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CycleNode = .FALSE. IF (UseGM) THEN ! Cycle ungrounded nodes and zero hydrology variables - MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, Element % NodeIndexes(i)) + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, j) SELECT CASE (MaskStatus) CASE (MASK_ALL) CycleNode = .TRUE. diff --git a/elmerice/UserFunctions/USF_SourceCalcCalving.F90 b/elmerice/UserFunctions/USF_SourceCalcCalving.F90 index a91395f843..adc82fe6d8 100644 --- a/elmerice/UserFunctions/USF_SourceCalcCalving.F90 +++ b/elmerice/UserFunctions/USF_SourceCalcCalving.F90 @@ -139,17 +139,21 @@ FUNCTION SourceCalc (Model, NodeNumber, SomeVariable) RESULT(Source) !is positive !Here, should therefore all be negative, unless glacier dropped below !absolute zero.... - IF(IMVar % Values(IMVar % Perm(NodeNumber))>=0.0) THEN - InternalMelt = 0.0 + IF(IMVar % Perm(NodeNumber) > 0) THEN + IF(IMVar % Values(IMVar % Perm(NodeNumber))>=0.0) THEN + InternalMelt = 0.0 + ELSE + !Latent heat of fusion of water is 333.55 J/g, so dividing by that gives + ! g of ice melted. + !TempRes in MJ, though (probably), so dividing by 333.55 gives Mg of ice + ! melted + !1 Mg is 1 t, which is 1000 kg, so 1000 l, so 1 m3 (all per year), so + !that's it + !Also need to divide by element area to get m + InternalMelt = (ABS(IMVar % Values(IMVar % Perm(NodeNumber)))/Weights % Values(Weights % Perm(NodeNumber)))/333.55 + END IF ELSE - !Latent heat of fusion of water is 333.55 J/g, so dividing by that gives - ! g of ice melted. - !TempRes in MJ, though (probably), so dividing by 333.55 gives Mg of ice - ! melted - !1 Mg is 1 t, which is 1000 kg, so 1000 l, so 1 m3 (all per year), so - !that's it - !Also need to divide by element area to get m - InternalMelt = (ABS(IMVar % Values(IMVar % Perm(NodeNumber)))/Weights % Values(Weights % Perm(NodeNumber)))/333.55 + InternalMelt = 0.0 END IF ELSE InternalMelt = 0.0 diff --git a/fem/src/InterpVarToVar.F90 b/fem/src/InterpVarToVar.F90 index 5741218328..3f5a9a2440 100644 --- a/fem/src/InterpVarToVar.F90 +++ b/fem/src/InterpVarToVar.F90 @@ -114,6 +114,7 @@ SUBROUTINE InterpolateVartoVarReduced( OldMesh, NewMesh, HeightName, HeightDimen !------------------------------------------------------------------------------ Debug = .FALSE. + Var => VariableGet( NewMesh % Variables, HeightName, ThisOnly = .TRUE. ) ALLOCATE( FoundNodes(NewMesh % NumberOfNodes),& PointLocalDistance(NewMesh % NumberOfNodes)) @@ -614,6 +615,7 @@ SUBROUTINE InterpolateVartoVarReduced( OldMesh, NewMesh, HeightName, HeightDimen DEALLOCATE(astore,vperm,RecvLocalDistance, BetterFound, ProcSend(proc+1) % perm) END DO + Var => VariableGet( NewMesh % Variables, HeightName, ThisOnly = .TRUE. ) DEALLOCATE(PointLocalDistance) IF ( ALLOCATED(Perm) ) DEALLOCATE(Perm,ProcSend) diff --git a/fem/src/SolverUtils.F90 b/fem/src/SolverUtils.F90 index 89ba717959..fc9660c6fc 100644 --- a/fem/src/SolverUtils.F90 +++ b/fem/src/SolverUtils.F90 @@ -9620,7 +9620,7 @@ SUBROUTINE InitializeTimestep( Solver ) !------------------------------------------------------------------------------ IF ( .NOT. ASSOCIATED( Solver % Matrix ) .OR. & - .NOT. ASSOCIATED( Solver % Variable % Values ) ) RETURN + .NOT. ASSOCIATED( Solver % Variable ) ) RETURN IF ( Solver % TimeOrder <= 0 ) RETURN !------------------------------------------------------------------------------ From 3a7e65e0e8e02b39b008ab575cc21a3243317172 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Fri, 5 Jul 2024 15:19:27 +0300 Subject: [PATCH 28/51] Add max N to SSA sliding laws --- elmerice/Solvers/Documentation/SSA.md | 15 +++++++++++---- elmerice/Utils/SSAMaterialModels.F90 | 7 ++++--- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/elmerice/Solvers/Documentation/SSA.md b/elmerice/Solvers/Documentation/SSA.md index 215f49c44f..583a20d61d 100644 --- a/elmerice/Solvers/Documentation/SSA.md +++ b/elmerice/Solvers/Documentation/SSA.md @@ -77,7 +77,7 @@ where *alpha = {(q - 1)^{q-1}}/{q^q}* and *chi = {u_b}/{C^n N^n A_s}* The latter are non-linear and a Newton linearisation can be used. When *u_b = (u^2+v^2)^{1/2}< u_min*, *u_b* in the previous equations is replaced by *u_min*. -The friction law is chosen using the keyword SSA Friction Law, which takes the value Linear, Weertman, coulomb, regularised Coulomb. The other keywords are: +The friction law is chosen using the keyword SSA Friction Law, which takes the value "Linear", "Weertman", "Budd", "regularised Coulomb" (Joughin's version of regularised Coulomb), "coulomb" (Schoof/Gagliardini's original version of regularised Coulomb). The other keywords are: a linear friction law - SSA Friction Parameter → *beta* @@ -92,7 +92,6 @@ a Budd type friction law - SSA Friction Exponent → *m* - SSA Friction Linear Velocity → *u_lin* - SSA Haf Exponent → *q* - - SSA Min Effective Pressure → *N_{min}*, such that *N >= N_{min}* - gravity norm → *g* a regularised Coulomb friction law without explicit effective pressure dependence @@ -100,6 +99,7 @@ a regularised Coulomb friction law without explicit effective pressure dependenc - SSA Friction Exponent → *m* - SSA Friction Linear Velocity → *u_lin* - SSA Friction Threshold Velocity → *u_0* + - SSA Friction need N = Logical (default false) a regularised Coulomb type friction law - SSA Friction Parameter → *beta= {A_s}^{-m}* @@ -107,11 +107,18 @@ a regularised Coulomb type friction law - SSA Friction Linear Velocity → *u_lin* - SSA Friction Post-Peak → *q >= 1* - SSA Friction Maximum Value → *C ~ max bed slope* - - SSA Min Effective Pressure → *N_{min}*, such that *N >= N_{min}* The keywords above that start with "SSA" are set in the material section of the .sif. "gravity norm" is set in the constants section (same usage as for GlaDS). -The Budd paramerisation and the Gagliardini version of the regularised Coulomb sliding parameterisation require the variable "effective pressure" to be present. +The Budd paramerisation and the Gagliardini version of the regularised Coulomb sliding parameterisation require the variable "effective pressure" to be present. +There is also a variant of the Joughin regularised Coulomb sliding law in which effective pressure is required (if SSA Friction need N is set to true). + +Constraining effective pressure + - SSA Min Effective Pressure → *N_{min}*, such that *N >= N_{min}* + - SSA Max Effective Pressure → *N_{max}*, such that *N <= N_{max}* + +Where "effective pressure" is required, the min value above must also be specified and the +max value may optionally be specified. #### Sub-Element grounding line parametrisation diff --git a/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index eb8e75d71f..1e505034f9 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -72,7 +72,7 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s INTEGER, POINTER :: NodeIndexes(:) CHARACTER(LEN=MAX_NAME_LEN) :: Friction REAL(KIND=dp) :: Slip2, gravity, qq, hafq - REAL(KIND=dp) :: fm,fq,MinN,U0 + REAL(KIND=dp) :: fm,fq,MinN,MaxN,U0 REAL(KIND=dp) :: alpha,beta,fB INTEGER :: GLnIP @@ -154,8 +154,9 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s CALL GetLocalSolution( NodalN,UElement=Element, UVariable=NSol) MinN = ListGetConstReal( Material, 'SSA Min Effective Pressure', Found, UnFoundFatal=.TRUE.) fN = SUM( NodalN(1:n) * Basis(1:n) ) - ! Effective pressure should be >0 (for the friction law) - fN = MAX(fN, MinN) + fN = MAX(fN, MinN) ! Effective pressure should be >0 (for the friction law) + MaxN = ListGetConstReal( Material, 'SSA Max Effective Pressure', Found, UnFoundFatal=.FALSE.) + IF (Found) fN = MIN(fN, MaxN) END If ! parameters unique to one sliding parameterisation From f1bfbe1ae8c317e62164708f7d0794b2431c347f Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Mon, 15 Jul 2024 17:06:21 +0300 Subject: [PATCH 29/51] tidying glads GL flux calcs --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 40 ++++++++++++++----------- 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 37520f9ef3..e0701ed916 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -2592,6 +2592,10 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) cglfPerm => cglfVar % Perm cglfVals => cglfVar % Values + ! set to zero to ensure old values at previous GL are not kept. + cglfVals = 0.0 + sglfVals = 0.0 + ! Loop over all nodes numNodes = Solver % Mesh % Nodes % NumberOfNodes DO nn = 1, numNodes @@ -2656,6 +2660,8 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) cglfVals(cglfPerm(nn)) + sglfVals(sglfPerm(nn)) END DO + NULLIFY(cglfVals) + NULLIFY(sglfVals) NULLIFY(SolverParams) NULLIFY(GLfluxVals) NULLIFY(GLfluxPerm) @@ -2689,33 +2695,28 @@ END SUBROUTINE GlaDS_GLflux ! [Edit: CalculateNodalWeights gives partition boundary artefacts, but the ! forcetostress solver seems to produce weights without these artefacts] ! +! Different modes of operation. +! "heat" - a variable providing nodal heat (e.g. could be residual from temperate ice solver) is used +! to calculate the melt rate. Weights (based on area) are also needed in this case. +! +! MeltRate = Heat / (area * density * latent_heat) +! +! "friction" - a sliding velocity variable is provided and used by this routine to calculate basal shear +! stress, which is then used (along with the effective linear sliding coefficient ("ceff", +! see SSASolver.F90), to calculate melt based on friction heat. +! ! Example .sif parameters: ! ! Constants: ! Latent Heat = 334000.0 ! Joules per kg ! -! solver params: +! example solver params: ! variable = GroundedMeltRate -! Mode = "NodalHeat" +! Mode = "heat" ! heat variable name = String "Friction Load" ! Weights variable name = String "Friction heating boundary weights" ! -! -! Heat is Mega Joules per year. - ! We multiply by 10^6 to convert from Mega Joules to Joules. - ! - - ! Different modes of operation. - ! "heat" - a variable providing nodal heat (e.g. could be residual from temperate ice solver) is used - ! to calculate the melt rate. Weights (based on area) are also needed in this case. - ! - ! MeltRate = Heat / (area * density * latent_heat) - ! - ! "friction" - a sliding velocity variable is provided and used by this routine to calculate basal shear - ! stress, which is then used (along with the effective linear sliding coefficient ("ceff", - ! see SSASolver.F90), to calculate melt based on friction heat. -! RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) USE DefUtils @@ -2819,6 +2820,9 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) IF (MeltPerm(nn).GT.0) THEN + ! Heat is assumed to be in units of Mega Joules per year. + ! We multiply by 10^6 to convert from Mega Joules to Joules. + ! (Melt is calculated in m/year). SELECT CASE (MeltMode) CASE ("heat") MeltVals(MeltPerm(nn)) = ABS( 1.0e6 * HeatVals(HeatPerm(nn)) ) / ( WtVals(WtPerm(nn)) * rho_fw * LatHeat ) @@ -2829,7 +2833,7 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) END SELECT IF (UseGHF) THEN - ! Scaled GHF is in Mega Joules per m^2 per year. + ! Scaled GHF is assumed to be given in Mega Joules per m^2 per year. MeltVals(MeltPerm(nn)) = MeltVals(MeltPerm(nn)) + & ( GHFVals(GHFPerm(nn))*GHFscaleFactor*1.0e6 ) / ( rho_fw*LatHeat ) END IF From b77bd363f3c5372d38e3a9c4c71c0196b949f687 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 17 Jul 2024 10:29:58 +0300 Subject: [PATCH 30/51] fix a bug in my earlier modifications based on Samuel's "calving" option (the bug was introduced by my code and occasionally prevented partitions containing sections of grounding lien from having any channel system) --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index e0701ed916..5da4156242 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -1284,7 +1284,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati ! Cycle ungrounded nodes and zero hydrology variables CycleElement = .FALSE. DO i=1, n - MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, Element % NodeIndexes(i)) + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, Edge % NodeIndexes(i)) SELECT CASE (MaskStatus) CASE (MASK_ALL) CycleElement = .TRUE. @@ -2606,7 +2606,7 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) IF (gmVals(gmPerm(nn)).eq.0) THEN ! Sheet discharge multiplied by sheet thickness gives the volume flux from the sheet. - ! We're hard conding the assumption that the sheet discharge is always a 2D vector, + ! We're hard coding the assumption that the sheet discharge is always a 2D vector, ! which should be safe so long as we always run GlaDS in 2D. sheetDisMag = ( sheetDisVals( 2*(sheetDisPerm(nn)-1)+1 )**2.0 + & sheetDisVals( 2*(sheetDisPerm(nn)-1)+2 )**2.0 )**0.5 From b10109190e0febb324b3a27412ad876c359ee5fc Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Thu, 18 Jul 2024 19:29:49 +0300 Subject: [PATCH 31/51] GlaDSCoupledSolver: Bug fix to the looping for averaging the contribution to sheet discharge from different elements. --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 5da4156242..bca91ef56e 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -193,7 +193,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati Mesh => Solver % Mesh DIM = Mesh % MeshDim M = Mesh % NumberOfNodes - + !------------------------------------------------------------------------------ ! Allocate some permanent storage, this is done first time only !------------------------------------------------------------------------------ @@ -366,6 +366,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati UseGM = .FALSE. END IF END IF + IF (UseGM) THEN MaskName = GetString( SolverParams, 'Mask Name', Found ) IF (.NOT. Found) THEN @@ -1486,7 +1487,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati qSolution = 0.0_dp ! Loop over all elements are we need to compute grad(Phi) - DO t=1,Solver % NumberOfActiveElements + ElementsLoop: DO t=1,Solver % NumberOfActiveElements !CHANGE - necessary if using a 2D mesh as is otherwise set to 1 as !boundary elements are last in first loop where it's set dimSheet = Element % TYPE % DIMENSION @@ -1554,18 +1555,15 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati qSolution(k) = qSolution(k) + Discharge(j) END DO END DO - END DO - ! Mean nodal value - DO i=1,n - DO j=1,dimSheet - k = dimSheet*(qPerm(Element % NodeIndexes(i))-1)+j - IF ( Refq(k) > 0.0_dp ) THEN - qSolution(k) = qSolution(k)/Refq(k) - END IF - END DO - END DO + END DO ElementsLoop + DO k=1,SIZE(qSolution) + IF ( Refq(k) > 0.0_dp ) THEN + qSolution(k) = qSolution(k)/Refq(k) + END IF + END DO + END IF SubroutineVisited = .TRUE. @@ -1605,6 +1603,8 @@ FUNCTION ProcessMask(MaskName, AllowSheetAtGL, ii) RESULT( MaskStatus_local ) END IF END IF +! MaskStatus_local = MASK_NONE + NULLIFY(GroundedMaskVar) END FUNCTION ProcessMask From e6a3590028f7328915064299592d0e681d09d6f8 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Fri, 19 Jul 2024 14:16:39 +0300 Subject: [PATCH 32/51] (attempted to) fix calculation of GlaDS sheet contribution to flow across grounding line. --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 104 +++++++++++++++++++++--- 1 file changed, 91 insertions(+), 13 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index bca91ef56e..8efbe53560 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -2509,6 +2509,7 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) CHARACTER(LEN=MAX_NAME_LEN):: MaskName REAL(KIND=dp), POINTER :: gmVals(:), channelVals(:), sheetThickVals(:), sheetDisVals(:) REAL(KIND=dp), POINTER :: GLfluxVals(:) + REAL(KIND=dp) :: x1,x2,y1,y2 REAL(KIND=dp) :: volFluxSheet, volFluxChannel, sheetDisMag INTEGER, POINTER :: gmPerm(:), channelPerm(:), sheetThickPerm(:), sheetDisPerm(:) INTEGER, POINTER :: GLfluxPerm(:) @@ -2516,6 +2517,7 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) TYPE(Variable_t), POINTER :: cglfVar, sglfVar REAL(KIND=dp), POINTER :: cglfVals(:), sglfVals(:) + REAL(KIND=dp) :: EdgeVec(3),SDVec(3),SDVec1(3),SDVec2(3),EdgeSD INTEGER, POINTER :: cglfPerm(:), sglfPerm(:) @@ -2595,22 +2597,76 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) ! set to zero to ensure old values at previous GL are not kept. cglfVals = 0.0 sglfVals = 0.0 + + ! Sheet flux strategy: + ! We take the cross product of the sheet discharge vector with the edge vector for edges + ! that represent a section of grounding line. + ! We assign half of this value to the nodes at either end. + ! Note: sheet discharge needs to be multiplied by a suitable width to give a volume flux, + ! and the above approach provides this. + ! Note that the direction for the GL edge element is arbitrary. We first take the dot product + ! to ascertain whether the angle between the two vectors is less than 90 degrees, and reverse + ! the direction of the GL edge if it isn't. + ! This presumes that the sheet discharge is always going from grounded ice into the ocean. + volFluxSheet = 0.0 + sglfVals = 0.0 + + EdgeLoopForSD: DO ee=1, Solver % Mesh % NumberOfEdges + Edge => Solver % Mesh % Edges(ee) + IF (.NOT.ASSOCIATED(Edge)) CYCLE + ! ...ignoring edges not entirely on the lower surface... + IF (ANY(gmPerm(Edge % NodeIndexes(1:2)).EQ.0)) CYCLE + ! ... and check whether the edge contains 2 GL nodes. + ! If yes, the edge is valid for calculating GL sheet flux. + ValidEdge = .FALSE. + IF ( (gmVals(gmPerm(Edge % NodeIndexes(1))).EQ.0.0) .AND. & + (gmVals(gmPerm(Edge % NodeIndexes(2))).EQ.0.0) ) THEN + ValidEdge = .TRUE. + END IF + IF (ValidEdge) THEN + ! compose edge vector: + x1 = Solver % Mesh % Nodes % x(Edge % NodeIndexes(1)) + y1 = Solver % Mesh % Nodes % y(Edge % NodeIndexes(1)) + x2 = Solver % Mesh % Nodes % x(Edge % NodeIndexes(2)) + y2 = Solver % Mesh % Nodes % y(Edge % NodeIndexes(2)) + EdgeVec(:) = (/x2-x1,y2-y1,0.0_dp/) + ! compose mean sheet dischagre vector (based on nodes at either end): + SDVec1(:) = (/ & + sheetDisVals( 2*(sheetDisPerm(Edge % NodeIndexes(1))-1)+1 ), & + sheetDisVals( 2*(sheetDisPerm(Edge % NodeIndexes(1))-1)+2 ), & + 0.0_dp /) + SDVec2(:) = (/ & + sheetDisVals( 2*(sheetDisPerm(Edge % NodeIndexes(2))-1)+1 ), & + sheetDisVals( 2*(sheetDisPerm(Edge % NodeIndexes(2))-1)+2 ), & + 0.0_dp /) + SDVec = (SDVec1 + SDVec2) * 0.5 + ! Check vectors are within 90 degrees of each other: + IF (DOT_PRODUCT(EdgeVec,SDVec).LT.0.0) THEN + EdgeVec(:) = (/x1-x2,y1-y2,0.0_dp/) + END IF + ! Make scalar product of vectors; add half of this to sheet discharge flux for each node + EdgeSD = CROSS_PRODUCT_MAGNITUDE(EdgeVec,SDVec) + sglfVals(sglfPerm(Edge % NodeIndexes(1))) = sglfVals(sglfPerm(Edge % NodeIndexes(1))) + 0.5*EdgeSD + sglfVals(sglfPerm(Edge % NodeIndexes(2))) = sglfVals(sglfPerm(Edge % NodeIndexes(2))) + 0.5*EdgeSD + END IF + END DO EdgeLoopForSD ! Loop over all nodes numNodes = Solver % Mesh % Nodes % NumberOfNodes - DO nn = 1, numNodes + NodesLoop: DO nn = 1, numNodes ! We're interested in nodes where the grounded mask is both defined (non-zero permutation) ! and has value set to zero (the grounding line). IF (gmPerm(nn).le.0) CYCLE IF (gmVals(gmPerm(nn)).eq.0) THEN - ! Sheet discharge multiplied by sheet thickness gives the volume flux from the sheet. - ! We're hard coding the assumption that the sheet discharge is always a 2D vector, - ! which should be safe so long as we always run GlaDS in 2D. - sheetDisMag = ( sheetDisVals( 2*(sheetDisPerm(nn)-1)+1 )**2.0 + & - sheetDisVals( 2*(sheetDisPerm(nn)-1)+2 )**2.0 )**0.5 - volFluxSheet = sheetThickVals(sheetThickPerm(nn)) * sheetDisMag +! Old code based on wrong assumption about sheet discharge: +! ! Sheet discharge multiplied by sheet thickness gives the volume flux from the sheet. +! ! We're hard coding the assumption that the sheet discharge is always a 2D vector, +! ! which should be safe so long as we always run GlaDS in 2D. +! sheetDisMag = ( sheetDisVals( 2*(sheetDisPerm(nn)-1)+1 )**2.0 + & +! sheetDisVals( 2*(sheetDisPerm(nn)-1)+2 )**2.0 )**0.5 +! volFluxSheet = sheetThickVals(sheetThickPerm(nn)) * sheetDisMag volFluxChannel = 0.0 @@ -2642,22 +2698,23 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) END DO cglfVals(cglfPerm(nn)) = volFluxChannel - sglfVals(sglfPerm(nn)) = volFluxSheet +! sglfVals(sglfPerm(nn)) = volFluxSheet END IF - - END DO + + END DO NodesLoop ! Sum nodal values for nodes that exist on multiple partitions CALL ParallelSumVector(Solver % Matrix, cglfVals) + CALL ParallelSumVector(Solver % Matrix, sglfVals) GLfluxVals = 0.0 DO nn = 1, numNodes IF (gmPerm(nn).le.0) CYCLE -! IF (gmVals(gmPerm(nn)).eq.0) GLfluxVals(GLfluxPerm(nn)) = volFluxSheet + volFluxChannel - IF (gmVals(gmPerm(nn)).eq.0) GLfluxVals(GLfluxPerm(nn)) = & - cglfVals(cglfPerm(nn)) + sglfVals(sglfPerm(nn)) + IF (gmVals(gmPerm(nn)).eq.0) THEN + GLfluxVals(GLfluxPerm(nn)) = cglfVals(cglfPerm(nn)) + sglfVals(sglfPerm(nn)) + END IF END DO NULLIFY(cglfVals) @@ -2674,6 +2731,27 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) NULLIFY(channelVals) NULLIFY(channelPerm) +CONTAINS + + FUNCTION CROSS_PRODUCT_MAGNITUDE(aa, bb) + REAL(KIND=dp) :: CROSS_PRODUCT_MAGNITUDE + REAL(KIND=dp), DIMENSION(3) :: xx + REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: aa, bb + + xx = CROSS_PRODUCT(aa, bb) + CROSS_PRODUCT_MAGNITUDE = ( xx(1)**2.0 + xx(2)**2.0 + xx(3)**2.0 )**0.5 + + END FUNCTION CROSS_PRODUCT_MAGNITUDE + + FUNCTION CROSS_PRODUCT(aa, bb) + REAL(KIND=dp), DIMENSION(3) :: CROSS_PRODUCT + REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: aa, bb + + CROSS_PRODUCT(1) = aa(2) * bb(3) - aa(3) * bb(2) + CROSS_PRODUCT(2) = aa(3) * bb(1) - aa(1) * bb(3) + CROSS_PRODUCT(3) = aa(1) * bb(2) - aa(2) * bb(1) + END FUNCTION CROSS_PRODUCT + END SUBROUTINE GlaDS_GLflux ! Different ways of calculating a grounded melt rate to pass to GlaDS as a From ad89e8018965f308a1551353a6ab50ab14b7a337 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Fri, 26 Jul 2024 12:53:16 +0300 Subject: [PATCH 33/51] Allow both min and max coupled iterations to be specified for GlaDSCoupledSOlver --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 8efbe53560..8843878436 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -79,7 +79,8 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati INTEGER :: i, j, k, l, m, n, t, iter, body_id, eq_id, material_id, & istat, LocalNodes,bf_id, bc_id, DIM, dimSheet, iterC, & NSDOFs, NonlinearIter, GhostNodes, NonlinearIterMin, Ne, BDForder, & - CoupledIter, Nel, ierror, ChannelSolver, FluxVariable, ThicknessSolver, ierr + MinCoupledIter, MaxCoupledIter, Nel, ierror, ChannelSolver, FluxVariable, & + ThicknessSolver, ierr TYPE(Variable_t), POINTER :: HydPotSol TYPE(Variable_t), POINTER :: ThickSol, AreaSol, VSol, WSol, NSol, & @@ -520,13 +521,17 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati 'Nonlinear System Convergence Tolerance', Found ) IF ((.Not.Found).AND.(NonlinearIter>1)) CALL FATAL(SolverName,'Need >Nonlinear System Convergence Tolerance<') - CoupledIter = GetInteger( SolverParams, & + MaxCoupledIter = GetInteger( SolverParams, & 'Coupled Max Iterations', Found) - IF ( .NOT.Found ) CoupledIter = 1 + IF ( .NOT.Found ) MaxCoupledIter = 1 + + MinCoupledIter = GetInteger( SolverParams, & + 'Coupled Min Iterations', Found) + IF ( .NOT.Found ) MinCoupledIter = 2 CoupledTol = GetConstReal( SolverParams, & 'Coupled Convergence Tolerance', Found ) - IF ((.Not.Found).AND.(CoupledIter>1)) CALL FATAL(SolverName,'Need >Nonlinear System Convergence Tolerance<') + IF ((.Not.Found).AND.(MaxCoupledIter>1)) CALL FATAL(SolverName,'Need >Nonlinear System Convergence Tolerance<') ThickSol => VariableGet( Mesh % Variables, SheetThicknessName, UnfoundFatal = .TRUE. ) ThickPerm => ThickSol % Perm @@ -608,7 +613,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati PrevCoupledNorm = ComputeNorm( Solver, SIZE(HydPot), HydPot ) - DO iterC = 1, CoupledIter + DO iterC = 1, MaxCoupledIter !------------------------------------------------------------------------------ ! non-linear system iteration loop @@ -1467,7 +1472,8 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati WRITE( Message, * ) 'COUPLING LOOP (NRM,RELC) : ',iterC, CoupledNorm, RelativeChange CALL Info( SolverName, Message, Level=3 ) - IF ((RelativeChange < CoupledTol).AND. (iterC > 1)) EXIT + IF ((RelativeChange < CoupledTol) .AND. (iterC .GE. MinCoupledIter)) EXIT + END DO ! iterC !-------------------------------------------------------------------------------------------- From ab286f79b7003367f0124daef9299c522d79d73d Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Thu, 8 Aug 2024 16:41:28 +0300 Subject: [PATCH 34/51] Adding connectivity option for grounded mask to remove isolated grounded regions in shelves --- elmerice/Solvers/CalvingGeometry.F90 | 47 +++++++--- elmerice/Solvers/GroundedSolver.F90 | 126 ++++++++++++++++++++++----- 2 files changed, 140 insertions(+), 33 deletions(-) diff --git a/elmerice/Solvers/CalvingGeometry.F90 b/elmerice/Solvers/CalvingGeometry.F90 index 575f984b96..484758be01 100644 --- a/elmerice/Solvers/CalvingGeometry.F90 +++ b/elmerice/Solvers/CalvingGeometry.F90 @@ -1503,41 +1503,62 @@ END SUBROUTINE ZeroPolygon ! Constructs groups of nodes which fall below a given threshold for some variable ! Used with the result of ProjectCalving, it groups nodes which have crevasse ! penetration beyond the threshold. + ! + ! Added August 2024 (RupertGladstone1972@gmail.com): + ! Default is that valid mask values are only below the given threshold (e.g. shelf + ! only). New logical optional argument AboveThreshold_Optional allows this to be + ! reversed such that valid mask values are above the threshold (e.g. grounded) !----------------------------------------------------------------------------- - SUBROUTINE FindCrevasseGroups(Mesh, Variable, Neighbours, Threshold, Groups) + SUBROUTINE FindCrevasseGroups(Mesh, Variable, Neighbours, Threshold, Groups, AboveThreshold_Optional) IMPLICIT NONE - TYPE(Mesh_t), POINTER :: Mesh - TYPE(Variable_t), POINTER :: Variable - INTEGER, POINTER :: Neighbours(:,:) - TYPE(CrevasseGroup3D_t), POINTER :: Groups, CurrentGroup - REAL(KIND=dp) :: Threshold + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Variable_t), POINTER :: Variable + INTEGER, POINTER :: Neighbours(:,:) + TYPE(CrevasseGroup3D_t), POINTER :: Groups + REAL(KIND=dp), INTENT(IN) :: Threshold + LOGICAL, INTENT(IN),OPTIONAL :: AboveThreshold_Optional !--------------------------------------- + TYPE(CrevasseGroup3D_t), POINTER :: CurrentGroup INTEGER :: i, ID REAL(KIND=dp), POINTER :: Values(:) INTEGER, POINTER :: VPerm(:) INTEGER, ALLOCATABLE :: WorkInt(:) LOGICAL, ALLOCATABLE :: Condition(:) - LOGICAL :: First, Debug + LOGICAL :: First, Debug, AboveThreshold Debug = .FALSE. + IF (PRESENT(AboveThreshold_Optional)) THEN + AboveThreshold = AboveThreshold_Optional + ELSE + AboveThreshold = .FALSE. + END IF + Values => Variable % Values VPerm => Variable % Perm ALLOCATE(Condition(Mesh % NumberOfNodes)) DO i=1, Mesh % NumberOfNodes - IF(VPerm(i) <= 0) THEN Condition(i) = .FALSE. - ELSE IF(Values(VPerm(i)) < Threshold) THEN - Condition(i) = .TRUE. ELSE - Condition(i) = .FALSE. + IF (AboveThreshold) THEN + IF (Values(VPerm(i)) .GT. Threshold) THEN + Condition(i) = .TRUE. + ELSE + Condition(i) = .FALSE. + END IF + ELSE + IF (Values(VPerm(i)) .LT. Threshold) THEN + Condition(i) = .TRUE. + ELSE + Condition(i) = .FALSE. + END IF + END IF END IF - END DO - + First = .TRUE. ID = 1 DO i=1,Mesh % NumberOfNodes diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index cf03c169d2..ff088e1eac 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -48,7 +48,20 @@ ! Additional solver option: ! 'Connected mask name = string xxx' ! This needs to correspond to an existing variable, probably an exported variable. -! Samuel's calving front mask also needs to be specified at the appropriate BC. +! Samuel's calving front mask also needs to be specified at the appropriate front +! BC: +! Calving Front Mask = Logical true +! +! August 2024 additional solver option: +! 'Connectivity Mode = string xxx' +! Where options for xxx are 'inland', 'front' (default) or 'combined'. +! If 'inland' is chosen connection to the inland boundary is checked. This means that +! isolated grounded regions of shelf will be omitted from the resulting mask. +! 'combined' utilises both, such that both isolated ungrounded regions upstream of the +! GL and isolated grounded regions downstream of the GL will be ignored. +! If 'inland' or 'combined' are chosen then the inland boundary condition should +! contain: +! Inland Boundary Mask = Logical true ! ! Example. ! Add this to the GroundedSolver: @@ -112,17 +125,18 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) AllGrounded = .FALSE., useLSvar = .FALSE., & CheckConn ! check ocean connectivity (creates separate mask without isolated ungrounded regions) - INTEGER :: ii, mn, en, t, Nn, istat, DIM, MSum, ZSum, bedrockSource + INTEGER :: ii, mn, en, t, Nn, istat, DIM, MSum, ZSum, bedrockSource, ConnectivityMode INTEGER, POINTER :: Permutation(:), bedrockPerm(:), LSvarPerm(:), ConnMaskPerm(:) REAL(KIND=dp), POINTER :: VariableValues(:) REAL(KIND=dp) :: z, toler - REAL(KIND=dp), ALLOCATABLE :: zb(:) + REAL(KIND=dp), ALLOCATABLE :: zb(:), ICMaskVals(:) CHARACTER(LEN=MAX_NAME_LEN) :: SolverName = 'GroundedSolver', bedrockName,& - FrontVarName, LSvarName, ConnMaskName + FrontVarName, LSvarName, ConnMaskName, ConnectivityModeStr INTEGER,PARAMETER :: MATERIAL_DEFAULT = 1, MATERIAL_NAMED = 2, VARIABLE = 3 + INTEGER,PARAMETER :: INLAND = 10, FRONT = 11, COMBINED = 12 SAVE AllocationsDone, DIM, SolverName, zb, toler !------------------------------------------------------------------------------ @@ -166,7 +180,30 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) CALL INFO( SolverName, '>Connected mask name< not found, not using.',Level=5 ) CheckConn = .FALSE. END IF - + + ConnectivityModeStr = ListGetString(SolverParams, 'Connectivity Mode',GotIt, UnFoundFatal=.FALSE.) + IF (GotIt) THEN + CALL INFO( SolverName, '>Connectivity Mode< found.',Level=7 ) + IF (.NOT.CheckConn) THEN + CALL FATAL( SolverName, '>Connectivity Mode< was given but no >connected mask name defined<' ) + END IF + ELSE + IF (CheckConn) THEN + CALL INFO( SolverName, '>Connectivity Mode< not found, assuming >front<.',Level=5 ) + END IF + ConnectivityModeStr = 'front' + END IF + SELECT CASE(ConnectivityModeStr) + CASE("inland") + ConnectivityMode = INLAND + CASE("front") + ConnectivityMode = FRONT + CASE("combined") + ConnectivityMode = COMBINED + CASE DEFAULT + CALL FATAL( SolverName, 'Connectivity Mode not recognised.' ) + END SELECT + !This to enforce all nodes grounded when doing non-calving hydrology to !restart a calving simulation from AllGrounded = GetLogical(SolverParams, 'All Grounded', GotIt) @@ -270,7 +307,32 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) END DO ! Check connectivity of ungrounded regions to the front (previously GMvalid solver) - IF (CheckConn) CALL FrontConn( ) + IF (CheckConn) THEN + SELECT CASE(ConnectivityMode) + + CASE(INLAND) + ALLOCATE(ICMaskVals(SIZE(ConnMaskVar % Values))) + CALL BoundaryConn (INLAND,ICMaskVals) + ConnMaskVar % Values = ICMaskVals * (-1.0) + DEALLOCATE(ICMaskVals) + + CASE(FRONT) + CALL BoundaryConn (FRONT) + + CASE(COMBINED) + ALLOCATE(ICMaskVals(SIZE(ConnMaskVar % Values))) + CALL BoundaryConn (INLAND,ICMaskVals) + CALL BoundaryConn (FRONT) + DO ii = 1, SIZE(ConnMaskVar % Values) + IF (ConnMaskPerm(ii) .LE. 0) CYCLE + IF (ICMaskVals(ConnMaskVar % Perm(ii)).GT.0.0) THEN + ConnMaskVar % Values(ConnMaskVar % Perm(ii)) = -1.0 + END IF + END DO + DEALLOCATE(ICMaskVals) + + END SELECT + END IF !-------------------------------------------------------------- ! Grounding line loop to label grounded points at grounding Line. @@ -354,10 +416,15 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) ! * An improved version of the routine to calculate basal melt rates on ! * ungrounded ice, producing a validity mask instead (1 = ungrounded area ! * connected to the ice front; 0 = isolated patch). + ! * + ! * August 2024 Added option to reverse this and look at connection to inland + ! * boundary instead when creating mask. + ! * Note that some of the variable names still reflect the assumption that we're + ! * testing for connectivity to the ice front (TODO: rename for clarity?) ! ****************************************************************************** ! * ! * Authors: Samuel Cook - ! * Email: samuel.cook@univ-grenoble-alpes.fr + ! * Email: samuel.cook@unil.ch, RupertGladstone1972@gmail.com ! * Web: http://www.csc.fi/elmer ! * Address: CSC - IT Center for Science Ltd. ! * Keilaranta 14 @@ -366,7 +433,7 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) ! * Original Date: 08.2019 ! * ! ****************************************************************************/ - SUBROUTINE FrontConn () + SUBROUTINE BoundaryConn (BoundaryLabel,MaskVals) USE Types USE CoordinateSystems USE DefUtils @@ -374,6 +441,9 @@ SUBROUTINE FrontConn () USE CalvingGeometry IMPLICIT NONE + + INTEGER, INTENT(IN) :: BoundaryLabel + REAL(KIND=dp), DIMENSION(:), INTENT(INOUT), OPTIONAL :: MaskVals !----------------------------------- TYPE(Mesh_t), POINTER :: Mesh @@ -384,9 +454,9 @@ SUBROUTINE FrontConn () TYPE(Nodes_t) :: ElementNodes TYPE(GaussIntegrationPoints_t) :: IntegStuff - REAL(KIND=dp) :: GMCheck, SMeltRate, WMeltRate, SStart, SStop, & - TotalArea, TotalBMelt, ElemBMelt, s, t, season,& - SqrtElementMetric,U,V,W,Basis(Model % MaxElementNodes) + REAL(KIND=dp) :: SMeltRate, WMeltRate, SStart, SStop, & + TotalArea, TotalBMelt, ElemBMelt, s, t, season, threshold, & + SqrtElementMetric,U,V,W,Basis(Model % MaxElementNodes), ConnCheck INTEGER :: NoNodes, j, FaceNodeCount, GroupNodeCount, county, & Active, ierr, kk, FoundNew, AllFoundNew INTEGER, PARAMETER :: FileUnit = 75, MaxFloatGroups = 1000, MaxNeighbours = 20 @@ -394,16 +464,25 @@ SUBROUTINE FrontConn () NeighbourHolder(:), NoNeighbours(:), NodeIndexes(:) INTEGER, ALLOCATABLE :: AllGroupNodes(:), PartNodeCount(:), AllPartGroupNodes(:), & disps(:) - LOGICAL :: Found, OutputStats, Visited=.FALSE., Debug, stat, Summer + LOGICAL :: Found, OutputStats, Visited=.FALSE., Debug, stat, Summer, AboveThreshold CHARACTER(LEN=MAX_NAME_LEN) :: SolverName, GMaskVarName, FrontMaskName, OutfileName, mode Debug = .FALSE. - SolverName = "GM Front connectivity" + SolverName = "Grounded mask connectivity" Mesh => Solver % Mesh !Identify nodes on the front - FrontMaskName = "Calving Front Mask" + SELECT CASE (BoundaryLabel) + CASE(INLAND) + FrontMaskName = "Inland Boundary Mask" + Threshold = 0.5_dp + AboveThreshold = .TRUE. + CASE(FRONT) + FrontMaskName = "Calving Front Mask" + Threshold = -0.5_dp + AboveThreshold = .FALSE. + END SELECT CALL MakePermUsingMask( Model, Solver, Mesh, FrontMaskName, & .FALSE., FrontPerm, FaceNodeCount) @@ -411,8 +490,11 @@ SUBROUTINE FrontConn () Matrix => Solver % Matrix IF(.NOT. ASSOCIATED(ConnMaskVar)) CALL Fatal(SolverName, "Front connectivity needs a variable!") - ConnMaskVar % Values = 1.0_dp - + IF (PRESENT(MaskVals)) THEN + MaskVals = 1.0_dp + ELSE + ConnMaskVar % Values = 1.0_dp + END IF NoNodes = COUNT(ConnMaskPerm > 0) ! Model, Solver, dt, TransientSimulation, ConnMaskVar @@ -428,7 +510,7 @@ SUBROUTINE FrontConn () GroundedVar => Solver % Variable - GMCheck = -1.0_dp + ConnCheck = -1.0_dp !Set up inverse perm for FindNodeNeighbours InvPerm => CreateInvPerm(Matrix % Perm) !Create inverse perm for neighbour search @@ -451,7 +533,7 @@ SUBROUTINE FrontConn () !Find groups of connected floating nodes on the base FloatGroups => NULL() CALL FindCrevasseGroups(Mesh, GroundedVar, Neighbours, & - -0.5_dp, FloatGroups) + threshold, FloatGroups, AboveThreshold) !Check groups are valid (connected to front) CurrentGroup => FloatGroups @@ -535,7 +617,11 @@ SUBROUTINE FrontConn () DO WHILE(ASSOCIATED(CurrentGroup)) IF(CurrentGroup % FrontConnected) THEN DO ii=1,CurrentGroup % NumberOfNodes - ConnMaskVar % Values(ConnMaskVar % Perm(CurrentGroup % NodeNumbers(ii))) = GMCheck + IF (PRESENT(MaskVals)) THEN + MaskVals(ConnMaskVar % Perm(CurrentGroup % NodeNumbers(ii))) = ConnCheck + ELSE + ConnMaskVar % Values(ConnMaskVar % Perm(CurrentGroup % NodeNumbers(ii))) = ConnCheck + END IF END DO END IF CurrentGroup => CurrentGroup % Next @@ -554,7 +640,7 @@ SUBROUTINE FrontConn () END DO DEALLOCATE(Neighbours, NoNeighbours, FrontPerm, InvPerm) - END SUBROUTINE FrontConn + END SUBROUTINE BoundaryConn END SUBROUTINE GroundedSolver From 0516cc9903aefd2199f839e44bd744eaaaecd833 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Fri, 9 Aug 2024 16:38:06 +0300 Subject: [PATCH 35/51] updating connectivity mask options to allow for removal of isolated regions both upstream, and downstream of the GL. --- elmerice/Solvers/GroundedSolver.F90 | 68 ++++++++++------------------- 1 file changed, 23 insertions(+), 45 deletions(-) diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index ff088e1eac..ede353e735 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -130,7 +130,7 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) REAL(KIND=dp), POINTER :: VariableValues(:) REAL(KIND=dp) :: z, toler - REAL(KIND=dp), ALLOCATABLE :: zb(:), ICMaskVals(:) + REAL(KIND=dp), ALLOCATABLE :: zb(:) CHARACTER(LEN=MAX_NAME_LEN) :: SolverName = 'GroundedSolver', bedrockName,& FrontVarName, LSvarName, ConnMaskName, ConnectivityModeStr @@ -311,25 +311,17 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) SELECT CASE(ConnectivityMode) CASE(INLAND) - ALLOCATE(ICMaskVals(SIZE(ConnMaskVar % Values))) - CALL BoundaryConn (INLAND,ICMaskVals) - ConnMaskVar % Values = ICMaskVals * (-1.0) - DEALLOCATE(ICMaskVals) + ConnMaskVar % Values = 1.0_dp + CALL BoundaryConn (INLAND) CASE(FRONT) + ConnMaskVar % Values = 1.0_dp CALL BoundaryConn (FRONT) CASE(COMBINED) - ALLOCATE(ICMaskVals(SIZE(ConnMaskVar % Values))) - CALL BoundaryConn (INLAND,ICMaskVals) + ConnMaskVar % Values = 1.0_dp + CALL BoundaryConn (INLAND) CALL BoundaryConn (FRONT) - DO ii = 1, SIZE(ConnMaskVar % Values) - IF (ConnMaskPerm(ii) .LE. 0) CYCLE - IF (ICMaskVals(ConnMaskVar % Perm(ii)).GT.0.0) THEN - ConnMaskVar % Values(ConnMaskVar % Perm(ii)) = -1.0 - END IF - END DO - DEALLOCATE(ICMaskVals) END SELECT END IF @@ -346,9 +338,9 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) Element => GetActiveElement(t) en = GetElementNOFNodes() CALL GetElementNodes( Nodes ) + MSum = 0 - ZSum = 0 - + ZSum = 0 DO ii = 1, en Nn = Permutation(Element % NodeIndexes(ii)) IF (Nn==0) CYCLE @@ -376,7 +368,7 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) Nn = ConnMaskPerm(Element % NodeIndexes(ii)) IF (Nn==0) CYCLE MSum = MSum + ConnMaskVar % Values(Nn) - IF (ABS(VariableValues(Nn)) Solver % Matrix IF(.NOT. ASSOCIATED(ConnMaskVar)) CALL Fatal(SolverName, "Front connectivity needs a variable!") - IF (PRESENT(MaskVals)) THEN - MaskVals = 1.0_dp - ELSE - ConnMaskVar % Values = 1.0_dp - END IF - NoNodes = COUNT(ConnMaskPerm > 0) - ! Model, Solver, dt, TransientSimulation, ConnMaskVar -! Var => Solver % Variable -! VariableValues(Nn) = 1.0_dp -! PointerToVariable => Solver % Variable -! Permutation => PointerToVariable % Perm -! VariableValues => PointerToVariable % Values - -! GMaskVarName = ListGetString(Params, "GroundedMask Variable", Found) -! IF(.NOT. Found) GMaskVarName = "GroundedMask" -! GroundedVar => VariableGet(Mesh % Variables, GMaskVarName, .TRUE., UnfoundFatal=.TRUE.) + NoNodes = COUNT(ConnMaskPerm > 0) GroundedVar => Solver % Variable - ConnCheck = -1.0_dp - !Set up inverse perm for FindNodeNeighbours InvPerm => CreateInvPerm(Matrix % Perm) !Create inverse perm for neighbour search ALLOCATE(Neighbours(Mesh % NumberOfNodes, MaxNeighbours), NoNeighbours(Mesh % NumberOfNodes)) @@ -612,21 +588,23 @@ SUBROUTINE BoundaryConn (BoundaryLabel,MaskVals) IF (kk.EQ.MaxFloatGroups) CALL FATAL( SolverName, 'Hard coded loop limit reached; needs recoding!' ) END DO !k - !Cycle all connected groups, setting melt rate + !Cycle all connected groups CurrentGroup => FloatGroups DO WHILE(ASSOCIATED(CurrentGroup)) IF(CurrentGroup % FrontConnected) THEN DO ii=1,CurrentGroup % NumberOfNodes - IF (PRESENT(MaskVals)) THEN - MaskVals(ConnMaskVar % Perm(CurrentGroup % NodeNumbers(ii))) = ConnCheck - ELSE - ConnMaskVar % Values(ConnMaskVar % Perm(CurrentGroup % NodeNumbers(ii))) = ConnCheck - END IF + ConnMaskVar % Values(ConnMaskVar % Perm(CurrentGroup % NodeNumbers(ii))) = -1.0_dp + END DO + ELSE + DO ii=1,CurrentGroup % NumberOfNodes + ConnMaskVar % Values(ConnMaskVar % Perm(CurrentGroup % NodeNumbers(ii))) = 1.0_dp END DO END IF CurrentGroup => CurrentGroup % Next END DO + ConnMaskVar % Values = ScaleFactor * ConnMaskVar % Values + !Deallocate floatgroups linked list CurrentGroup => FloatGroups DO WHILE(ASSOCIATED(CurrentGroup)) From 203f4e37d231f69be079d2e97dd22cbb21e28177 Mon Sep 17 00:00:00 2001 From: Morlocke Date: Wed, 14 Aug 2024 14:09:20 +0200 Subject: [PATCH 36/51] Updates to PlumeSolver to fix a case where a plume actually has a co-ordinate of 0 --- elmerice/Solvers/PlumeSolver.F90 | 580 ++++++++++++++++++++++++++++++- 1 file changed, 568 insertions(+), 12 deletions(-) diff --git a/elmerice/Solvers/PlumeSolver.F90 b/elmerice/Solvers/PlumeSolver.F90 index 4e2b316125..ada1e16fb3 100644 --- a/elmerice/Solvers/PlumeSolver.F90 +++ b/elmerice/Solvers/PlumeSolver.F90 @@ -35,7 +35,7 @@ ! ****************************************************************************** ! * ! * Authors: Joe Todd, Samuel Cook -! * Email: samuel.cook@univ-grenoble-alpes.fr +! * Email: sc690@cam.ac.uk ! * Web: http://www.csc.fi/elmer ! * Address: CSC - IT Center for Science Ltd. ! * Keilaranta 14 @@ -158,6 +158,13 @@ END SUBROUTINE PlumeSolver IF(.NOT. Found) PlMode = 'off' PlMode = TRIM(PlMode) + !Potential to turn melt off + IF(.NOT. Calving) THEN + + BGMode = ListGetString( Params, 'Background Melt Mode', Found, UnfoundFatal=.TRUE.) + BGMode = TRIM(BGMode) + END IF + IF(.NOT. ASSOCIATED(Solver % Variable)) CALL Fatal(SolverName, "No variable associated!") MeltRate => Solver % Variable % Values MeltPerm => Solver % Variable % Perm @@ -225,6 +232,25 @@ END SUBROUTINE PlumeSolver IF(.NOT. ASSOCIATED(ElevVar)) CALL Fatal(SolverName,"Couldn't find 'Elevation' variable & &needed to compute background melt rate") + !Get the orientation of the calving front + !TODO: generalize and link + IF(.NOT. Calving) THEN + PArray => ListGetConstRealArray( Params,'Front Orientation', Found, UnfoundFatal=.TRUE.) + DO i=1,3 + FrontOrientation(i) = PArray(i,1) + END DO + + !We can define the plume's position by an initial point (Xs,Ys) and a + !vector (in line with the front) which describes its movement back and forward + !as the front migrates. In this case, the plume is a vertical line + !which moves forwards and backwards (with the front) along the FrontOrientation + !vector. Thus, the normal vector which define's the plume's plane is the reciprocal + !of the FrontOrientation vector (in 2D): + PlumeNormal(1) = FrontOrientation(2) + PlumeNormal(2) = -1.0_dp * FrontOrientation(1) + PlumeNormal(3) = 0.0_dp + END IF + Material => GetMaterial() SeaLevel = GetCReal(Material, 'Sea Level', Found) IF(.NOT. Found) SeaLevel = 0.0_dp @@ -428,7 +454,7 @@ END SUBROUTINE PlumeSolver k=1 PlCount = 0 ALLOCATE(PlPos(SIZE(NearestFrontNodes,1),3), PlFinalQ(SIZE(PlInQ))) - PlPos = 0.0_dp + PlPos = -1E12 PlFinalQ = 0.0_dp DO i=1, SIZE(NearestFrontNodes,1) IF(HydroGLNodes(i) == 0.0) CYCLE @@ -570,14 +596,14 @@ END SUBROUTINE PlumeSolver TempPlZArray(:) = 9999.0 PlMR(:) = -10000.0 TempPlMRArray(:) = -1.0 - PlAxis(:) = 0.0_dp + PlAxis(:) = -1E12 MaxX = -1E16 MaxY = -1E16 MinX = 1E16 MinY = 1E16 DO i=1, SIZE(PlPos,1) - IF(PlPos(i,1) == 0.0) CYCLE + IF(PlPos(i,1) == -1E12) CYCLE IF(PlPos(i,1)>MaxX) MaxX = PlPos(i,1) IF(PlPos(i,1)MaxY) MaxY = PlPos(i,2) @@ -586,6 +612,14 @@ END SUBROUTINE PlumeSolver x = MaxX - MinX y = MaxY - MinY + !There is an implicit assumption here that all your partitions will pick + !the same axis, because tidewater glacier fronts are usually pretty sub- + !linear. However, if the length scale of your partitions is very small + !relative to the scale of variability in the calving front, you might get + !partitions choosing different axes, which will break things. I might + !eventually sort this out properly, but, in the meantime, best thing to + !do is just run on fewer partitions so that each one sees a longer length + !of calving front IF(PlCount>0) THEN IF(x>y) THEN PlAxis(1:PlCount) = PlPos(1:PlCount,1) @@ -602,9 +636,10 @@ END SUBROUTINE PlumeSolver PlMR(1+((i-1)*OutputSize):OutputSize*i) = MROutput(1:OutputSize) END DO ELSE - PlAxis(:) = 0.0 + PlAxis(:) = -1E12 PlZ(:) = 9999.0 PlMR(:) = -10000.0 + AxisIndex = 0 END IF !PRINT *, 'P5',ParEnv % myPE !CALL MPI_BARRIER(ELMER_COMM_WORLD, ierr) @@ -626,9 +661,8 @@ END SUBROUTINE PlumeSolver IF(ParEnv % myPE == 0) THEN j=1 - PRINT *, 'Debug0: ',TempPlCoordArray DO i=1,SIZE(TempPlCoordArray) - IF(TempPlCoordArray(i)==0.0) CYCLE + IF(TempPlCoordArray(i)==-1E12) CYCLE !IF(TempPlCoordArray(i)<1E-16 .AND. TempPlCoordArray(i)>-1E-16) CYCLE PlCoordArray(j,1) = TempPlCoordArray(i) PlCoordArray(j,2) = j @@ -659,7 +693,6 @@ END SUBROUTINE PlumeSolver END DO DEALLOCATE(Row) END IF - IF(ParEnv % myPE == 0) PRINT *, 'Debug00: ',PlCoordArray !CALL MPI_BARRIER(ELMER_COMM_WORLD, ierr) !MPI call to send full final plume arrays to every partition @@ -684,7 +717,530 @@ END SUBROUTINE PlumeSolver BMFromFile = ListGetLogical( Params, "Background Melt From File", Found) IF(.NOT. Found) BMFromFile = .FALSE. AverageMelt = GetLogical( Params, "Scale Melt To Average", Found) - IF(.NOT. Found) AverageMelt = .FALSE. + + IF(.NOT. Calving) THEN + IF(.NOT. Visited) THEN + ALLOCATE(Xs(PlCount), Ys(PlCount), & + PlActive(PlCount), PlStart(PlCount, 10),& + PlStop(PlCount, 10)) + PlActive = .FALSE. + + !Set points to NaN - fill them later by checking for potential point + PlStart = 0.0_dp + PlStart = PlStart / PlStart + PlStop = 0.0_dp + PlStop = PlStop / PlStop + + IF(PlFromFile) THEN + ALLOCATE(ConicalPlumes(PlCount)) + ELSE + ALLOCATE(DmDz(PlCount), DwDz(PlCount), MMR(PlCount), MME(PlCount), W0(PlCount)) + END IF + END IF + + !Leaving this unSAVEd, potential to change number of extruded levels? + ALLOCATE(PlumePoints(PlCount, ExtrudedLevels, 3)) + !NaN, see above + PlumePoints = 0.0_dp + PlumePoints = PlumePoints / PlumePoints + + !Get output file name for stats + OutfileName = ListGetString(Params,"Melt Stats File", OutputStats, UnfoundFatal=.TRUE.) + + !Check for background melt + SELECT CASE(BGMode) + CASE("off") + BMeltSwitch = .FALSE. + CASE("seasonal") + BMeltSwitch = .TRUE. + CASE Default + CALL Fatal(SolverName, "Invalid Background Melt Mode, valid options are 'seasonal' and 'off'.") + END SELECT + + !------------------------------------------------------ + !Determine how the planar (background) plume is defined + !------------------------------------------------------ + IF(BMeltSwitch .AND. .NOT. Visited) THEN + + IF(BMFromFile) THEN + + BMSFile = ListGetString( Params, "Background Melt Summer Input File", UnfoundFatal=.TRUE.) + BMWFile = ListGetString( Params, "Background Melt Winter Input File", UnfoundFatal=.TRUE.) + + BMSummerStart = ListGetConstReal( Params, "Background Melt Summer Start", UnfoundFatal=.TRUE.) + BMSummerStop = ListGetConstReal( Params, "Background Melt Summer Stop", UnfoundFatal=.TRUE.) + + OPEN(UNIT=InputFileUnit, FILE=BMSFile, IOSTAT=ierr) + + !Check file length + Filerows = 0 + DO WHILE(.TRUE.) + READ(InputFileUnit, *,IOSTAT=ierr) dumy + IF(ierr /= 0) EXIT + Filerows = Filerows + 1 + END DO + + REWIND(InputFileUnit) + ALLOCATE( BMeltSummer % z(Filerows),& + BMeltSummer % meltrate(Filerows)) + + DO i=1,Filerows + READ(InputFileUnit, *) BMeltSummer % z(i), BMeltSummer % meltrate(i) + IF(Boss) PRINT *,TRIM(SolverName),': Summer z, melt: ', BMeltSummer % z(i), & + BMeltSummer % meltrate(i) + END DO + CLOSE(InputFileUnit) + + !Check plume definition monotonically increasing in z + DO i=2, FileRows + IF(BMeltSummer % z(i) <= BMeltSummer % z(i-1)) THEN + CALL Fatal(SolverName, "Background Summer Plume definition should be & + &monotonically increasing in z.") + END IF + END DO + + OPEN(UNIT=InputFileUnit, FILE=BMWFile, IOSTAT=ierr) + + !Check file length + Filerows = 0 + DO WHILE(.TRUE.) + READ(InputFileUnit, *,IOSTAT=ierr) dumy + IF(ierr /= 0) EXIT + Filerows = Filerows + 1 + END DO + + REWIND(InputFileUnit) + ALLOCATE( BMeltWinter % z(Filerows),& + BMeltWinter % meltrate(Filerows)) + + DO i=1,Filerows + READ(InputFileUnit, *) BMeltWinter % z(i), BMeltWinter % meltrate(i) + IF(Boss) PRINT *,TRIM(SolverName),': Winter z, melt: ', BMeltWinter % z(i),& + BMeltWinter % meltrate(i) + END DO + CLOSE(InputFileUnit) + + !Check plume definition monotonically increasing in z + DO i=2, FileRows + IF(BMeltWinter % z(i) <= BMeltWinter % z(i-1)) THEN + CALL Fatal(SolverName, "Background Winter Plume definition should be & + &monotonically increasing in z.") + END IF + END DO + + ELSE + BMeltMax = GetConstReal( Params, "Background Melt Max", Found) + IF(.NOT. Found) CALL Fatal(SolverName, "Background melt requested but no& + &'Background Melt Max' Found") + + BMeltMME = GetConstReal( Params, "Background Melt Max Melt Elevation", Found) + IF(.NOT. Found) CALL Fatal(SolverName, "Background melt requested but no& + &'Background Melt Max Melt Elevation' Found") + + BMeltDmDz = GetConstReal( Params, "Background Melt DmDz", Found) + IF(.NOT. Found) CALL Fatal(SolverName, "Background melt requested but no& + &'Background Melt DmDz' Found") + END IF + END IF + + AverageMelt = GetLogical( Params, "Scale Melt To Average", Found) + IF(Found .AND. AverageMelt) THEN + Target_BMelt_Average = GetConstReal( Params, "Average Background Melt Rate", Found) + IF(.NOT. Found) CALL Fatal(SolverName, & + "Requested 'Scale Melt To Average' but no 'Average Background Melt Rate' found.") + Target_PMelt_Average = GetConstReal( Params, "Average Plume Melt Rate", Found) + IF(.NOT. Found) CALL Fatal(SolverName, & + "Requested 'Scale Melt To Average' but no 'Average Plume Melt Rate' found.") + ELSE + AverageMelt = .FALSE. + END IF + + !Find the plume definitions + IF(.NOT. Visited) THEN + DO Pl=1, PlCount + + WRITE(PlumeStr,'(a,i0)') "Plume ",Pl + + WRITE(PlumeStrX,'(a,a)') TRIM(PlumeStr), " X" + WRITE(PlumeStrY,'(a,a)') TRIM(PlumeStr), " Y" + WRITE(PlumeStrStart,'(a,a)') TRIM(PlumeStr), " Start Times" + WRITE(PlumeStrStop,'(a,a)') TRIM(PlumeStr), " Stop Times" + + Xs(Pl) = ListGetConstReal( Params, PlumeStrX, Found, UnfoundFatal=.TRUE.) + Ys(Pl) = ListGetConstReal( Params, PlumeStrY, Found, UnfoundFatal=.TRUE.) + + PArray => ListGetConstRealArray( Params,PlumeStrStart, Found, UnfoundFatal=.TRUE.) + PArray2 => ListGetConstRealArray( Params,PlumeStrStop, Found, UnfoundFatal=.TRUE.) + + IF(SIZE(PArray) /= SIZE(PArray2)) & + CALL Fatal(SolverName, "Plume start and stop array size mismatch") + + DO i=1, SIZE(Parray,1) + PlStart(Pl,i) = PArray(i,1) + PlStop(Pl,i) = PArray2(i,1) + END DO + + IF(PlFromFile) THEN + WRITE(PlumeStrFile,'(a,a)') TRIM(PlumeStr), " Input File" + PlumeFile = ListGetString(Params, PlumeStrFile, UnfoundFatal=.TRUE.) + + OPEN(UNIT=InputFileUnit, FILE=PlumeFile, IOSTAT=ierr) + IF(ierr /= 0) CALL Fatal(SolverName, "Failed to open plume input file") + + !Check file length + Filerows = 0 + DO WHILE(.TRUE.) + READ(InputFileUnit, *,IOSTAT=ierr) dumy + IF(ierr /= 0) EXIT + Filerows = Filerows + 1 + END DO + + REWIND(InputFileUnit) + ALLOCATE( ConicalPlumes(Pl) % z(Filerows),& + ConicalPlumes(Pl) % meltrate(Filerows),& + ConicalPlumes(Pl) % width(Filerows)) + + DO i=1,Filerows + READ(InputFileUnit, *) ConicalPlumes(Pl) % z(i), & + ConicalPlumes(Pl) % meltrate(i), & + ConicalPlumes(Pl) % width(i) + + PRINT *,'Debug, plume info: ',i,ConicalPlumes(Pl) % z(i), & + ConicalPlumes(Pl) % meltrate(i), & + ConicalPlumes(Pl) % width(i) + END DO + CLOSE(InputFileUnit) + + !Check plume definition monotonically increasing in z + DO i=2, FileRows + IF(ConicalPlumes(Pl) % z(i) <= ConicalPlumes(Pl) % z(i-1)) THEN + CALL Fatal(SolverName, "Plume definition should be monotonically increasing in z.") + END IF + END DO + + ELSE + + WRITE(PlumeStrDwDz,'(a,a)') TRIM(PlumeStr), " DwDz" + WRITE(PlumeStrW0,'(a,a)') TRIM(PlumeStr), " Initial Width" + WRITE(PlumeStrDmDz,'(a,a)') TRIM(PlumeStr), " DmDz" + WRITE(PlumeStrMMR,'(a,a)') TRIM(PlumeStr), " Max Melt Rate" + WRITE(PlumeStrMME,'(a,a)') TRIM(PlumeStr), " Max Melt Elevation" + + Dmdz(Pl) = ListGetConstReal( Params, PlumeStrDmdz, Found, UnfoundFatal=.TRUE.) + DwDz(Pl) = ListGetConstReal( Params, PlumeStrDwDz, Found, UnfoundFatal=.TRUE.) + W0(Pl) = ListGetConstReal( Params, PlumeStrW0, Found, UnfoundFatal=.TRUE.) + MME(Pl) = ListGetConstReal( Params, PlumeStrMME, Found, UnfoundFatal=.TRUE.) + MMR(Pl) = ListGetConstReal( Params, PlumeStrMMR, Found, UnfoundFatal=.TRUE.) + END IF + END DO + END IF + + DO Pl=1,PlCount + SELECT CASE(PlMode) + CASE("seasonal") + DO i=1, SIZE(PlStart,2) + IF(ISNAN(PlStart(Pl,i)) .OR. ISNAN(PlStop(Pl,i))) EXIT + + IF((season > PlStart(Pl,i)) .AND. (season < PlStop(Pl,i))) THEN + PlActive(Pl) = .TRUE. + EXIT + ELSE + PlActive(Pl) = .FALSE. + END IF + END DO + PRINT *,'Debug, plume ',Pl,' is active: ',PlActive(Pl) + CASE("off") + PlActive(Pl) = .FALSE. + CASE DEFAULT + CALL Fatal(SolverName, "Unknown plume melt mode, valid options are 'seasonal' and 'off'.") + END SELECT + END DO + + + !---------------------------------------------------------- + ! Strategy: + ! + ! Based on x,y position of plume, find and MPI the projection + ! of that position onto the front. + ! + ! In other words, pass a series of coordinates which define the + ! plumes journey 'up the front' + + IF(Parallel) ALLOCATE(IHavePlume(PlCount), WhoHasPlume(PlCount*ParEnv % PEs), PlumeOwner(PlCount)) + + ALLOCATE(NodeIndexes(4)) !Assume working with side of extruded mesh + + IHavePlume = .FALSE. + WhoHasPlume = .FALSE. + PlumeOwner = -1 + + !------------------------------------------------------------------ + !Find all the element intersections for the each plume's centreline + !If none, this plume doesn't exist in this partition. + !------------------------------------------------------------------ + + DO Pl=1, PlCount + + Found = .FALSE. + county = 0 + + Active = GetNOFActive() + DO j=1,Active + Element => GetActiveElement(j) + IF(Element % TYPE % ElementCode == 101) CYCLE + IF(Element % TYPE % ElementCode /= 404) & + CALL Fatal(SolverName, 'Found a non-404 element, this solver assumes extruded mesh') + + !Determine the two pairs of nodes which each make up a horizontal bar + !Extruded mesh means lower two node indexes = lower two nodes + NodeIndexes = Element % NodeIndexes + CALL Sort( 4, NodeIndexes ) + + DO k=1,2 + + NodeHolder(1,1) = Mesh % Nodes % x(NodeIndexes(k*2 - 1)) + NodeHolder(1,2) = Mesh % Nodes % y(NodeIndexes(k*2 - 1)) + NodeHolder(1,3) = Mesh % Nodes % z(NodeIndexes(k*2 - 1)) + + NodeHolder(2,1) = Mesh % Nodes % x(NodeIndexes(k*2)) + NodeHolder(2,2) = Mesh % Nodes % y(NodeIndexes(k*2)) + NodeHolder(2,3) = Mesh % Nodes % z(NodeIndexes(k*2)) + + !Check for plume presence in this element + CALL PlanePointIntersection((/Xs(Pl), Ys(Pl), 0.0_dp/), PlumeNormal, & + NodeHolder(1,:), NodeHolder(2,:),PlInt, found_intersection) + + IF(found_intersection .AND. & + ( (PlInt(1) > NodeHolder(1,1)) .NEQV. (PlInt(1) > NodeHolder(2,1)) )) THEN + + IHavePlume(Pl) = .TRUE. + IF(.NOT. ANY(PlumePoints(Pl,:,3) == PlInt(3))) THEN + county = county + 1 + IF(county > ExtrudedLevels) & + CALL Fatal(SolverName, "Found too many intersections...") + + PlumePoints(Pl, county, :) = PlInt(:) + END IF + END IF + + END DO + END DO + END DO + + DEALLOCATE(NodeIndexes) + + !Based on the xy position and the frontal geometry, find the plume base (z) + + !MPI comms + IF(Parallel) THEN + + ! - which part has which plumes + CALL MPI_ALLGATHER(IHavePlume, PlCount, MPI_LOGICAL, WhoHasPlume, & + PlCount, MPI_LOGICAL, MPI_COMM_WORLD, ierr) + + DO i=1, ParEnv % PEs + DO j=1,PlCount + IF(.NOT. WhoHasPlume((i-1)*PlCount + j)) CYCLE + + IF(PlumeOwner(j) /= -1) THEN + WRITE(Message,'(a,i0,a,i0,i0)') "Plume ",j," has multiple owners: ",PlumeOwner(j), i + CALL Warn(SolverName, Message) + END IF + PlumeOwner(j) = i + END DO + END DO + + !Potential for plume to have multiple owners - i.e. plume def + !is split over multiple partitions. If this is the case, negotiate here, + !before passing between all parts + DO Pl=1,PlCount + !nan check + IF(((ParEnv % MyPE + 1) == PlumeOwner(Pl)) .AND. & + ANY(PlumePoints(Pl,:,1) /= PlumePoints(Pl,:,1)) ) THEN + + county = COUNT(PlumePoints(Pl,:,1) /= PlumePoints(Pl,:,1)) + ALLOCATE(idx(county),PointStore(county)) + county = 0 + DO i=1,ExtrudedLevels + IF(PlumePoints(Pl,i,1) /= PlumePoints(Pl,i,1)) THEN + county = county + 1 + idx(county) = i + END IF + END DO + + DO i=1,3 + CALL MPI_RECV(PointStore, county, MPI_DOUBLE, MPI_ANY_SOURCE, & + 1000+i, MPI_COMM_WORLD, status, ierr) + PlumePoints(Pl,idx,i) = PointStore + END DO + + DEALLOCATE(PointStore,idx) + + ELSE IF(((ParEnv % MyPE + 1) /= PlumeOwner(Pl)) .AND. & + ANY(PlumePoints(Pl,:,1) == PlumePoints(Pl,:,1)) ) THEN + + county = COUNT(PlumePoints(Pl,:,1) == PlumePoints(Pl,:,1)) + ALLOCATE(idx(county),PointStore(county)) + county = 0 + DO i=1,ExtrudedLevels + IF(PlumePoints(Pl,i,1) == PlumePoints(Pl,i,1)) THEN + county = county + 1 + idx(county) = i + END IF + END DO + + DO i=1,3 + PointStore = PlumePoints(Pl,idx,i) + CALL MPI_SEND(PointStore, county, MPI_DOUBLE, (PlumeOwner(Pl)-1),& + 1000+i, MPI_COMM_WORLD, ierr) + END DO + + DEALLOCATE(PointStore,idx) + END IF + + END DO + + !Pass the plume geometry + DO Pl=1,PlCount + IF(Debug .AND. Boss) PRINT *, 'Plume ',Pl,' in partition: ',PlumeOwner(Pl) + + !Send node x,y,z + CALL MPI_BCast(PlumePoints(Pl,:,1), ExtrudedLevels,& + MPI_DOUBLE, PlumeOwner(Pl)-1, MPI_COMM_WORLD, ierr) + CALL MPI_BCast(PlumePoints(Pl,:,2), ExtrudedLevels,& + MPI_DOUBLE, PlumeOwner(Pl)-1, MPI_COMM_WORLD, ierr) + CALL MPI_BCast(PlumePoints(Pl,:,3), ExtrudedLevels,& + MPI_DOUBLE, PlumeOwner(Pl)-1, MPI_COMM_WORLD, ierr) + END DO + + END IF !parallel + + IF(Boss .AND. Debug) THEN + PRINT *,'Plume x: ', PlumePoints(:,:,1) + PRINT *,'Plume y: ', PlumePoints(:,:,2) + PRINT *,'Plume z: ', PlumePoints(:,:,3) + END IF + + !Cycle nodes on front + DO i=1, Mesh % NumberOfNodes + IF(MeltPerm(i) <= 0) CYCLE + + NodeHolder(1,1) = Mesh % Nodes % x(i) + NodeHolder(1,2) = Mesh % Nodes % y(i) + NodeHolder(1,3) = Mesh % Nodes % z(i) + + !Not submarine + IF(NodeHolder(1,3) > SeaLevel) THEN + CYCLE + END IF + + !-------------------------------------------- + !Get contribution from background melt rate + !-------------------------------------------- + IF(BMeltSwitch) THEN + NodeElev = ElevVar % Values(ElevVar % Perm(i)) + IF(NodeElev < 0.0_dp) NodeElev = 0.0_dp !might be -1.0E-100... + + IF(BMFromFile) THEN + !1D interp from z, melt file + IF(season < BMSummerStart .OR. season > BMSummerStop) THEN + BMeltRate(MeltPerm(i)) = FindPointOnLine(BMeltWinter % z, & + BMeltWinter % meltrate, NodeElev) + ELSE + BMeltRate(MeltPerm(i)) = FindPointOnLine(BMeltSummer % z, & + BMeltSummer % meltrate, NodeElev) + END IF + + PRINT *,'Node: ',i,' z:', Mesh % Nodes % z(i), NodeElev, & + ' background melt: ', BMeltRate(MeltPerm(i)) + ELSE + !Background melt rate increases from zero at elev=0, to BMeltMax @ BMeltMME + !Then it decreases at a fixed dm/dz, until (if) it reaches zero. + IF(NodeElev > BMeltMME) THEN + BMeltRate(MeltPerm(i)) = BMeltMax + BMeltDmDz*(NodeElev - BMeltMME) + IF(BMeltRate(MeltPerm(i)) < 0.0_dp) BMeltRate(MeltPErm(i)) = 0.0_dp + ELSE + BMeltRate(MeltPerm(i)) = BMeltMax * (NodeElev / BMeltMME) + END IF + END IF + END IF + + !---------------------------------- + !Get contributions from each conical plume + !---------------------------------- + Melt = 0.0_dp + + DO Pl=1,PlCount + + IF(.NOT. PlActive(Pl)) CYCLE !plume isn't active + IF(NodeHolder(1,3) < PlumePoints(Pl,1,3)) CYCLE !below plume base + + !Find plume points above and below current node + DO j=2,ExtrudedLevels + IF(NodeHolder(1,3) < PlumePoints(Pl,j,3)) EXIT + END DO + IF(j > ExtrudedLevels) CALL Fatal(SolverName,& + "Didn't anticipate this, plume definition doesn't reach sea level?") + + !Interpolate the plume definition to current point's vertical coordinate + prop = (NodeHolder(1,3) - PlumePoints(Pl,j-1,3)) / & + (PlumePoints(Pl,j,3) - PlumePoints(Pl,j-1,3)) + + NodeHolder(2,1) = (PlumePoints(Pl,j-1,1) * (1-prop)) + (PlumePoints(Pl,j,1) * prop) + NodeHolder(2,2) = (PlumePoints(Pl,j-1,2) * (1-prop)) + (PlumePoints(Pl,j,2) * prop) + NodeHolder(2,3) = (PlumePoints(Pl,j-1,3) * (1-prop)) + (PlumePoints(Pl,j,3) * prop) + + IF( (NodeHolder(1,3) - NodeHolder(2,3)) > 1.0E-10 ) THEN + PRINT *,'points: ', NodeHolder(1,3), NodeHolder(2,3) + CALL Fatal(SolverName, "Error in plume centrepoint calculation") + END IF + !How far from the plume centreline is the point? + hor_dist = ( (NodeHolder(1,1) - NodeHolder(2,1))**2 + & + (NodeHolder(1,2) - NodeHolder(2,2))**2) ** 0.5 + + !How far from the base of the plume? + plume_z = NodeHolder(2,3) - PlumePoints(Pl,1,3) + + IF(PlFromFile) THEN + + xx => ConicalPlumes(Pl) % z + yy => ConicalPlumes(Pl) % meltrate + d0_meltrate = FindPointOnLine(xx, yy, plume_z) + + yy => ConicalPlumes(Pl) % width + plume_width = FindPointOnLine(xx, yy, plume_z) + ELSE + + !Width at base, plus increase through z + plume_width = W0(Pl) + plume_z * DwDz(Pl) + + IF(plume_z < MME(Pl)) THEN + !Below the plume peak melt elev, varies linearly from zero to MMR + prop = plume_z / MME(Pl) + d0_meltrate = prop * MMR(Pl) + ELSE + !Above peak melt elev, drops off at rate DmDz + d0_meltrate = MMR(Pl) + ((plume_z - MME(Pl)) * DmDz(Pl)) + IF(d0_meltrate < 0.0_dp) d0_meltrate = 0.0_dp + END IF + + END IF + + Melt = Melt + d0_meltrate * EXP(-(hor_dist/plume_width)**2.0) + END DO + + PMeltRate(MeltPerm(i)) = Melt + END DO + + !For every node, check for Plume melt exceeding Background melt, and turn off the latter + DO i=1,SIZE(PMeltRate) + IF(PMeltRate(i) > BMeltRate(i)) THEN + BMeltRate(i) = 0.0_dp + ELSE + PMeltRate(i) = 0.0_dp + END IF + END DO + END IF !Not Calving IF(Calving .AND. TotalPlCount > 0) THEN !PRINT *, 'P7',ParEnv % myPE @@ -699,8 +1255,10 @@ END SUBROUTINE PlumeSolver END IF IF(AxisIndex==1) THEN Node = Mesh % Nodes % x(i) - ELSE + ELSE IF(AxisIndex==2) THEN Node = Mesh % Nodes % y(i) + ELSE + CYCLE END IF SearchIndex = 0.0_dp PlDist = 0.0_dp @@ -727,7 +1285,6 @@ END SUBROUTINE PlumeSolver END IF EXIT END DO - PRINT *, 'Debug1: ',SearchIndex,PlCoordArray(1,2) IF(ALL(SearchIndex == 0.0)) THEN !If cycles through whole array without finding plumes to be between; @@ -741,7 +1298,6 @@ END SUBROUTINE PlumeSolver Node = ABS(Mesh % Nodes % z(i)) - PRINT *, 'Debug2: ',SearchIndex,PlCoordArray !(TotalPlCount,2) FPOLZ(:) = ABS(PlZArray(:,SearchIndex(1))) FPOLMR(:) = PlMRArray(:,SearchIndex(1)) ZPointer => FPOLZ From 66182aa65766411575d9c41ba4b91aa1a234c618 Mon Sep 17 00:00:00 2001 From: Morlocke Date: Wed, 14 Aug 2024 14:20:41 +0200 Subject: [PATCH 37/51] Now with all that old code taken out! --- elmerice/Solvers/PlumeSolver.F90 | 554 +------------------------------ 1 file changed, 2 insertions(+), 552 deletions(-) diff --git a/elmerice/Solvers/PlumeSolver.F90 b/elmerice/Solvers/PlumeSolver.F90 index ada1e16fb3..9a9b972103 100644 --- a/elmerice/Solvers/PlumeSolver.F90 +++ b/elmerice/Solvers/PlumeSolver.F90 @@ -35,7 +35,7 @@ ! ****************************************************************************** ! * ! * Authors: Joe Todd, Samuel Cook -! * Email: sc690@cam.ac.uk +! * Email: samuel.cook@fau.de ! * Web: http://www.csc.fi/elmer ! * Address: CSC - IT Center for Science Ltd. ! * Keilaranta 14 @@ -158,13 +158,6 @@ END SUBROUTINE PlumeSolver IF(.NOT. Found) PlMode = 'off' PlMode = TRIM(PlMode) - !Potential to turn melt off - IF(.NOT. Calving) THEN - - BGMode = ListGetString( Params, 'Background Melt Mode', Found, UnfoundFatal=.TRUE.) - BGMode = TRIM(BGMode) - END IF - IF(.NOT. ASSOCIATED(Solver % Variable)) CALL Fatal(SolverName, "No variable associated!") MeltRate => Solver % Variable % Values MeltPerm => Solver % Variable % Perm @@ -231,26 +224,7 @@ END SUBROUTINE PlumeSolver ElevVar => VariableGet(Mesh % Variables, "Elevation", .TRUE.) IF(.NOT. ASSOCIATED(ElevVar)) CALL Fatal(SolverName,"Couldn't find 'Elevation' variable & &needed to compute background melt rate") - - !Get the orientation of the calving front - !TODO: generalize and link - IF(.NOT. Calving) THEN - PArray => ListGetConstRealArray( Params,'Front Orientation', Found, UnfoundFatal=.TRUE.) - DO i=1,3 - FrontOrientation(i) = PArray(i,1) - END DO - - !We can define the plume's position by an initial point (Xs,Ys) and a - !vector (in line with the front) which describes its movement back and forward - !as the front migrates. In this case, the plume is a vertical line - !which moves forwards and backwards (with the front) along the FrontOrientation - !vector. Thus, the normal vector which define's the plume's plane is the reciprocal - !of the FrontOrientation vector (in 2D): - PlumeNormal(1) = FrontOrientation(2) - PlumeNormal(2) = -1.0_dp * FrontOrientation(1) - PlumeNormal(3) = 0.0_dp - END IF - + Material => GetMaterial() SeaLevel = GetCReal(Material, 'Sea Level', Found) IF(.NOT. Found) SeaLevel = 0.0_dp @@ -718,530 +692,6 @@ END SUBROUTINE PlumeSolver IF(.NOT. Found) BMFromFile = .FALSE. AverageMelt = GetLogical( Params, "Scale Melt To Average", Found) - IF(.NOT. Calving) THEN - IF(.NOT. Visited) THEN - ALLOCATE(Xs(PlCount), Ys(PlCount), & - PlActive(PlCount), PlStart(PlCount, 10),& - PlStop(PlCount, 10)) - PlActive = .FALSE. - - !Set points to NaN - fill them later by checking for potential point - PlStart = 0.0_dp - PlStart = PlStart / PlStart - PlStop = 0.0_dp - PlStop = PlStop / PlStop - - IF(PlFromFile) THEN - ALLOCATE(ConicalPlumes(PlCount)) - ELSE - ALLOCATE(DmDz(PlCount), DwDz(PlCount), MMR(PlCount), MME(PlCount), W0(PlCount)) - END IF - END IF - - !Leaving this unSAVEd, potential to change number of extruded levels? - ALLOCATE(PlumePoints(PlCount, ExtrudedLevels, 3)) - !NaN, see above - PlumePoints = 0.0_dp - PlumePoints = PlumePoints / PlumePoints - - !Get output file name for stats - OutfileName = ListGetString(Params,"Melt Stats File", OutputStats, UnfoundFatal=.TRUE.) - - !Check for background melt - SELECT CASE(BGMode) - CASE("off") - BMeltSwitch = .FALSE. - CASE("seasonal") - BMeltSwitch = .TRUE. - CASE Default - CALL Fatal(SolverName, "Invalid Background Melt Mode, valid options are 'seasonal' and 'off'.") - END SELECT - - !------------------------------------------------------ - !Determine how the planar (background) plume is defined - !------------------------------------------------------ - IF(BMeltSwitch .AND. .NOT. Visited) THEN - - IF(BMFromFile) THEN - - BMSFile = ListGetString( Params, "Background Melt Summer Input File", UnfoundFatal=.TRUE.) - BMWFile = ListGetString( Params, "Background Melt Winter Input File", UnfoundFatal=.TRUE.) - - BMSummerStart = ListGetConstReal( Params, "Background Melt Summer Start", UnfoundFatal=.TRUE.) - BMSummerStop = ListGetConstReal( Params, "Background Melt Summer Stop", UnfoundFatal=.TRUE.) - - OPEN(UNIT=InputFileUnit, FILE=BMSFile, IOSTAT=ierr) - - !Check file length - Filerows = 0 - DO WHILE(.TRUE.) - READ(InputFileUnit, *,IOSTAT=ierr) dumy - IF(ierr /= 0) EXIT - Filerows = Filerows + 1 - END DO - - REWIND(InputFileUnit) - ALLOCATE( BMeltSummer % z(Filerows),& - BMeltSummer % meltrate(Filerows)) - - DO i=1,Filerows - READ(InputFileUnit, *) BMeltSummer % z(i), BMeltSummer % meltrate(i) - IF(Boss) PRINT *,TRIM(SolverName),': Summer z, melt: ', BMeltSummer % z(i), & - BMeltSummer % meltrate(i) - END DO - CLOSE(InputFileUnit) - - !Check plume definition monotonically increasing in z - DO i=2, FileRows - IF(BMeltSummer % z(i) <= BMeltSummer % z(i-1)) THEN - CALL Fatal(SolverName, "Background Summer Plume definition should be & - &monotonically increasing in z.") - END IF - END DO - - OPEN(UNIT=InputFileUnit, FILE=BMWFile, IOSTAT=ierr) - - !Check file length - Filerows = 0 - DO WHILE(.TRUE.) - READ(InputFileUnit, *,IOSTAT=ierr) dumy - IF(ierr /= 0) EXIT - Filerows = Filerows + 1 - END DO - - REWIND(InputFileUnit) - ALLOCATE( BMeltWinter % z(Filerows),& - BMeltWinter % meltrate(Filerows)) - - DO i=1,Filerows - READ(InputFileUnit, *) BMeltWinter % z(i), BMeltWinter % meltrate(i) - IF(Boss) PRINT *,TRIM(SolverName),': Winter z, melt: ', BMeltWinter % z(i),& - BMeltWinter % meltrate(i) - END DO - CLOSE(InputFileUnit) - - !Check plume definition monotonically increasing in z - DO i=2, FileRows - IF(BMeltWinter % z(i) <= BMeltWinter % z(i-1)) THEN - CALL Fatal(SolverName, "Background Winter Plume definition should be & - &monotonically increasing in z.") - END IF - END DO - - ELSE - BMeltMax = GetConstReal( Params, "Background Melt Max", Found) - IF(.NOT. Found) CALL Fatal(SolverName, "Background melt requested but no& - &'Background Melt Max' Found") - - BMeltMME = GetConstReal( Params, "Background Melt Max Melt Elevation", Found) - IF(.NOT. Found) CALL Fatal(SolverName, "Background melt requested but no& - &'Background Melt Max Melt Elevation' Found") - - BMeltDmDz = GetConstReal( Params, "Background Melt DmDz", Found) - IF(.NOT. Found) CALL Fatal(SolverName, "Background melt requested but no& - &'Background Melt DmDz' Found") - END IF - END IF - - AverageMelt = GetLogical( Params, "Scale Melt To Average", Found) - IF(Found .AND. AverageMelt) THEN - Target_BMelt_Average = GetConstReal( Params, "Average Background Melt Rate", Found) - IF(.NOT. Found) CALL Fatal(SolverName, & - "Requested 'Scale Melt To Average' but no 'Average Background Melt Rate' found.") - Target_PMelt_Average = GetConstReal( Params, "Average Plume Melt Rate", Found) - IF(.NOT. Found) CALL Fatal(SolverName, & - "Requested 'Scale Melt To Average' but no 'Average Plume Melt Rate' found.") - ELSE - AverageMelt = .FALSE. - END IF - - !Find the plume definitions - IF(.NOT. Visited) THEN - DO Pl=1, PlCount - - WRITE(PlumeStr,'(a,i0)') "Plume ",Pl - - WRITE(PlumeStrX,'(a,a)') TRIM(PlumeStr), " X" - WRITE(PlumeStrY,'(a,a)') TRIM(PlumeStr), " Y" - WRITE(PlumeStrStart,'(a,a)') TRIM(PlumeStr), " Start Times" - WRITE(PlumeStrStop,'(a,a)') TRIM(PlumeStr), " Stop Times" - - Xs(Pl) = ListGetConstReal( Params, PlumeStrX, Found, UnfoundFatal=.TRUE.) - Ys(Pl) = ListGetConstReal( Params, PlumeStrY, Found, UnfoundFatal=.TRUE.) - - PArray => ListGetConstRealArray( Params,PlumeStrStart, Found, UnfoundFatal=.TRUE.) - PArray2 => ListGetConstRealArray( Params,PlumeStrStop, Found, UnfoundFatal=.TRUE.) - - IF(SIZE(PArray) /= SIZE(PArray2)) & - CALL Fatal(SolverName, "Plume start and stop array size mismatch") - - DO i=1, SIZE(Parray,1) - PlStart(Pl,i) = PArray(i,1) - PlStop(Pl,i) = PArray2(i,1) - END DO - - IF(PlFromFile) THEN - WRITE(PlumeStrFile,'(a,a)') TRIM(PlumeStr), " Input File" - PlumeFile = ListGetString(Params, PlumeStrFile, UnfoundFatal=.TRUE.) - - OPEN(UNIT=InputFileUnit, FILE=PlumeFile, IOSTAT=ierr) - IF(ierr /= 0) CALL Fatal(SolverName, "Failed to open plume input file") - - !Check file length - Filerows = 0 - DO WHILE(.TRUE.) - READ(InputFileUnit, *,IOSTAT=ierr) dumy - IF(ierr /= 0) EXIT - Filerows = Filerows + 1 - END DO - - REWIND(InputFileUnit) - ALLOCATE( ConicalPlumes(Pl) % z(Filerows),& - ConicalPlumes(Pl) % meltrate(Filerows),& - ConicalPlumes(Pl) % width(Filerows)) - - DO i=1,Filerows - READ(InputFileUnit, *) ConicalPlumes(Pl) % z(i), & - ConicalPlumes(Pl) % meltrate(i), & - ConicalPlumes(Pl) % width(i) - - PRINT *,'Debug, plume info: ',i,ConicalPlumes(Pl) % z(i), & - ConicalPlumes(Pl) % meltrate(i), & - ConicalPlumes(Pl) % width(i) - END DO - CLOSE(InputFileUnit) - - !Check plume definition monotonically increasing in z - DO i=2, FileRows - IF(ConicalPlumes(Pl) % z(i) <= ConicalPlumes(Pl) % z(i-1)) THEN - CALL Fatal(SolverName, "Plume definition should be monotonically increasing in z.") - END IF - END DO - - ELSE - - WRITE(PlumeStrDwDz,'(a,a)') TRIM(PlumeStr), " DwDz" - WRITE(PlumeStrW0,'(a,a)') TRIM(PlumeStr), " Initial Width" - WRITE(PlumeStrDmDz,'(a,a)') TRIM(PlumeStr), " DmDz" - WRITE(PlumeStrMMR,'(a,a)') TRIM(PlumeStr), " Max Melt Rate" - WRITE(PlumeStrMME,'(a,a)') TRIM(PlumeStr), " Max Melt Elevation" - - Dmdz(Pl) = ListGetConstReal( Params, PlumeStrDmdz, Found, UnfoundFatal=.TRUE.) - DwDz(Pl) = ListGetConstReal( Params, PlumeStrDwDz, Found, UnfoundFatal=.TRUE.) - W0(Pl) = ListGetConstReal( Params, PlumeStrW0, Found, UnfoundFatal=.TRUE.) - MME(Pl) = ListGetConstReal( Params, PlumeStrMME, Found, UnfoundFatal=.TRUE.) - MMR(Pl) = ListGetConstReal( Params, PlumeStrMMR, Found, UnfoundFatal=.TRUE.) - END IF - END DO - END IF - - DO Pl=1,PlCount - SELECT CASE(PlMode) - CASE("seasonal") - DO i=1, SIZE(PlStart,2) - IF(ISNAN(PlStart(Pl,i)) .OR. ISNAN(PlStop(Pl,i))) EXIT - - IF((season > PlStart(Pl,i)) .AND. (season < PlStop(Pl,i))) THEN - PlActive(Pl) = .TRUE. - EXIT - ELSE - PlActive(Pl) = .FALSE. - END IF - END DO - PRINT *,'Debug, plume ',Pl,' is active: ',PlActive(Pl) - CASE("off") - PlActive(Pl) = .FALSE. - CASE DEFAULT - CALL Fatal(SolverName, "Unknown plume melt mode, valid options are 'seasonal' and 'off'.") - END SELECT - END DO - - - !---------------------------------------------------------- - ! Strategy: - ! - ! Based on x,y position of plume, find and MPI the projection - ! of that position onto the front. - ! - ! In other words, pass a series of coordinates which define the - ! plumes journey 'up the front' - - IF(Parallel) ALLOCATE(IHavePlume(PlCount), WhoHasPlume(PlCount*ParEnv % PEs), PlumeOwner(PlCount)) - - ALLOCATE(NodeIndexes(4)) !Assume working with side of extruded mesh - - IHavePlume = .FALSE. - WhoHasPlume = .FALSE. - PlumeOwner = -1 - - !------------------------------------------------------------------ - !Find all the element intersections for the each plume's centreline - !If none, this plume doesn't exist in this partition. - !------------------------------------------------------------------ - - DO Pl=1, PlCount - - Found = .FALSE. - county = 0 - - Active = GetNOFActive() - DO j=1,Active - Element => GetActiveElement(j) - IF(Element % TYPE % ElementCode == 101) CYCLE - IF(Element % TYPE % ElementCode /= 404) & - CALL Fatal(SolverName, 'Found a non-404 element, this solver assumes extruded mesh') - - !Determine the two pairs of nodes which each make up a horizontal bar - !Extruded mesh means lower two node indexes = lower two nodes - NodeIndexes = Element % NodeIndexes - CALL Sort( 4, NodeIndexes ) - - DO k=1,2 - - NodeHolder(1,1) = Mesh % Nodes % x(NodeIndexes(k*2 - 1)) - NodeHolder(1,2) = Mesh % Nodes % y(NodeIndexes(k*2 - 1)) - NodeHolder(1,3) = Mesh % Nodes % z(NodeIndexes(k*2 - 1)) - - NodeHolder(2,1) = Mesh % Nodes % x(NodeIndexes(k*2)) - NodeHolder(2,2) = Mesh % Nodes % y(NodeIndexes(k*2)) - NodeHolder(2,3) = Mesh % Nodes % z(NodeIndexes(k*2)) - - !Check for plume presence in this element - CALL PlanePointIntersection((/Xs(Pl), Ys(Pl), 0.0_dp/), PlumeNormal, & - NodeHolder(1,:), NodeHolder(2,:),PlInt, found_intersection) - - IF(found_intersection .AND. & - ( (PlInt(1) > NodeHolder(1,1)) .NEQV. (PlInt(1) > NodeHolder(2,1)) )) THEN - - IHavePlume(Pl) = .TRUE. - IF(.NOT. ANY(PlumePoints(Pl,:,3) == PlInt(3))) THEN - county = county + 1 - IF(county > ExtrudedLevels) & - CALL Fatal(SolverName, "Found too many intersections...") - - PlumePoints(Pl, county, :) = PlInt(:) - END IF - END IF - - END DO - END DO - END DO - - DEALLOCATE(NodeIndexes) - - !Based on the xy position and the frontal geometry, find the plume base (z) - - !MPI comms - IF(Parallel) THEN - - ! - which part has which plumes - CALL MPI_ALLGATHER(IHavePlume, PlCount, MPI_LOGICAL, WhoHasPlume, & - PlCount, MPI_LOGICAL, MPI_COMM_WORLD, ierr) - - DO i=1, ParEnv % PEs - DO j=1,PlCount - IF(.NOT. WhoHasPlume((i-1)*PlCount + j)) CYCLE - - IF(PlumeOwner(j) /= -1) THEN - WRITE(Message,'(a,i0,a,i0,i0)') "Plume ",j," has multiple owners: ",PlumeOwner(j), i - CALL Warn(SolverName, Message) - END IF - PlumeOwner(j) = i - END DO - END DO - - !Potential for plume to have multiple owners - i.e. plume def - !is split over multiple partitions. If this is the case, negotiate here, - !before passing between all parts - DO Pl=1,PlCount - !nan check - IF(((ParEnv % MyPE + 1) == PlumeOwner(Pl)) .AND. & - ANY(PlumePoints(Pl,:,1) /= PlumePoints(Pl,:,1)) ) THEN - - county = COUNT(PlumePoints(Pl,:,1) /= PlumePoints(Pl,:,1)) - ALLOCATE(idx(county),PointStore(county)) - county = 0 - DO i=1,ExtrudedLevels - IF(PlumePoints(Pl,i,1) /= PlumePoints(Pl,i,1)) THEN - county = county + 1 - idx(county) = i - END IF - END DO - - DO i=1,3 - CALL MPI_RECV(PointStore, county, MPI_DOUBLE, MPI_ANY_SOURCE, & - 1000+i, MPI_COMM_WORLD, status, ierr) - PlumePoints(Pl,idx,i) = PointStore - END DO - - DEALLOCATE(PointStore,idx) - - ELSE IF(((ParEnv % MyPE + 1) /= PlumeOwner(Pl)) .AND. & - ANY(PlumePoints(Pl,:,1) == PlumePoints(Pl,:,1)) ) THEN - - county = COUNT(PlumePoints(Pl,:,1) == PlumePoints(Pl,:,1)) - ALLOCATE(idx(county),PointStore(county)) - county = 0 - DO i=1,ExtrudedLevels - IF(PlumePoints(Pl,i,1) == PlumePoints(Pl,i,1)) THEN - county = county + 1 - idx(county) = i - END IF - END DO - - DO i=1,3 - PointStore = PlumePoints(Pl,idx,i) - CALL MPI_SEND(PointStore, county, MPI_DOUBLE, (PlumeOwner(Pl)-1),& - 1000+i, MPI_COMM_WORLD, ierr) - END DO - - DEALLOCATE(PointStore,idx) - END IF - - END DO - - !Pass the plume geometry - DO Pl=1,PlCount - IF(Debug .AND. Boss) PRINT *, 'Plume ',Pl,' in partition: ',PlumeOwner(Pl) - - !Send node x,y,z - CALL MPI_BCast(PlumePoints(Pl,:,1), ExtrudedLevels,& - MPI_DOUBLE, PlumeOwner(Pl)-1, MPI_COMM_WORLD, ierr) - CALL MPI_BCast(PlumePoints(Pl,:,2), ExtrudedLevels,& - MPI_DOUBLE, PlumeOwner(Pl)-1, MPI_COMM_WORLD, ierr) - CALL MPI_BCast(PlumePoints(Pl,:,3), ExtrudedLevels,& - MPI_DOUBLE, PlumeOwner(Pl)-1, MPI_COMM_WORLD, ierr) - END DO - - END IF !parallel - - IF(Boss .AND. Debug) THEN - PRINT *,'Plume x: ', PlumePoints(:,:,1) - PRINT *,'Plume y: ', PlumePoints(:,:,2) - PRINT *,'Plume z: ', PlumePoints(:,:,3) - END IF - - !Cycle nodes on front - DO i=1, Mesh % NumberOfNodes - IF(MeltPerm(i) <= 0) CYCLE - - NodeHolder(1,1) = Mesh % Nodes % x(i) - NodeHolder(1,2) = Mesh % Nodes % y(i) - NodeHolder(1,3) = Mesh % Nodes % z(i) - - !Not submarine - IF(NodeHolder(1,3) > SeaLevel) THEN - CYCLE - END IF - - !-------------------------------------------- - !Get contribution from background melt rate - !-------------------------------------------- - IF(BMeltSwitch) THEN - NodeElev = ElevVar % Values(ElevVar % Perm(i)) - IF(NodeElev < 0.0_dp) NodeElev = 0.0_dp !might be -1.0E-100... - - IF(BMFromFile) THEN - !1D interp from z, melt file - IF(season < BMSummerStart .OR. season > BMSummerStop) THEN - BMeltRate(MeltPerm(i)) = FindPointOnLine(BMeltWinter % z, & - BMeltWinter % meltrate, NodeElev) - ELSE - BMeltRate(MeltPerm(i)) = FindPointOnLine(BMeltSummer % z, & - BMeltSummer % meltrate, NodeElev) - END IF - - PRINT *,'Node: ',i,' z:', Mesh % Nodes % z(i), NodeElev, & - ' background melt: ', BMeltRate(MeltPerm(i)) - ELSE - !Background melt rate increases from zero at elev=0, to BMeltMax @ BMeltMME - !Then it decreases at a fixed dm/dz, until (if) it reaches zero. - IF(NodeElev > BMeltMME) THEN - BMeltRate(MeltPerm(i)) = BMeltMax + BMeltDmDz*(NodeElev - BMeltMME) - IF(BMeltRate(MeltPerm(i)) < 0.0_dp) BMeltRate(MeltPErm(i)) = 0.0_dp - ELSE - BMeltRate(MeltPerm(i)) = BMeltMax * (NodeElev / BMeltMME) - END IF - END IF - END IF - - !---------------------------------- - !Get contributions from each conical plume - !---------------------------------- - Melt = 0.0_dp - - DO Pl=1,PlCount - - IF(.NOT. PlActive(Pl)) CYCLE !plume isn't active - IF(NodeHolder(1,3) < PlumePoints(Pl,1,3)) CYCLE !below plume base - - !Find plume points above and below current node - DO j=2,ExtrudedLevels - IF(NodeHolder(1,3) < PlumePoints(Pl,j,3)) EXIT - END DO - IF(j > ExtrudedLevels) CALL Fatal(SolverName,& - "Didn't anticipate this, plume definition doesn't reach sea level?") - - !Interpolate the plume definition to current point's vertical coordinate - prop = (NodeHolder(1,3) - PlumePoints(Pl,j-1,3)) / & - (PlumePoints(Pl,j,3) - PlumePoints(Pl,j-1,3)) - - NodeHolder(2,1) = (PlumePoints(Pl,j-1,1) * (1-prop)) + (PlumePoints(Pl,j,1) * prop) - NodeHolder(2,2) = (PlumePoints(Pl,j-1,2) * (1-prop)) + (PlumePoints(Pl,j,2) * prop) - NodeHolder(2,3) = (PlumePoints(Pl,j-1,3) * (1-prop)) + (PlumePoints(Pl,j,3) * prop) - - IF( (NodeHolder(1,3) - NodeHolder(2,3)) > 1.0E-10 ) THEN - PRINT *,'points: ', NodeHolder(1,3), NodeHolder(2,3) - CALL Fatal(SolverName, "Error in plume centrepoint calculation") - END IF - !How far from the plume centreline is the point? - hor_dist = ( (NodeHolder(1,1) - NodeHolder(2,1))**2 + & - (NodeHolder(1,2) - NodeHolder(2,2))**2) ** 0.5 - - !How far from the base of the plume? - plume_z = NodeHolder(2,3) - PlumePoints(Pl,1,3) - - IF(PlFromFile) THEN - - xx => ConicalPlumes(Pl) % z - yy => ConicalPlumes(Pl) % meltrate - d0_meltrate = FindPointOnLine(xx, yy, plume_z) - - yy => ConicalPlumes(Pl) % width - plume_width = FindPointOnLine(xx, yy, plume_z) - ELSE - - !Width at base, plus increase through z - plume_width = W0(Pl) + plume_z * DwDz(Pl) - - IF(plume_z < MME(Pl)) THEN - !Below the plume peak melt elev, varies linearly from zero to MMR - prop = plume_z / MME(Pl) - d0_meltrate = prop * MMR(Pl) - ELSE - !Above peak melt elev, drops off at rate DmDz - d0_meltrate = MMR(Pl) + ((plume_z - MME(Pl)) * DmDz(Pl)) - IF(d0_meltrate < 0.0_dp) d0_meltrate = 0.0_dp - END IF - - END IF - - Melt = Melt + d0_meltrate * EXP(-(hor_dist/plume_width)**2.0) - END DO - - PMeltRate(MeltPerm(i)) = Melt - END DO - - !For every node, check for Plume melt exceeding Background melt, and turn off the latter - DO i=1,SIZE(PMeltRate) - IF(PMeltRate(i) > BMeltRate(i)) THEN - BMeltRate(i) = 0.0_dp - ELSE - PMeltRate(i) = 0.0_dp - END IF - END DO - END IF !Not Calving - IF(Calving .AND. TotalPlCount > 0) THEN !PRINT *, 'P7',ParEnv % myPE !CALL MPI_BARRIER(ELMER_COMM_WORLD, ierr) From c91ae73f33868b7d2fb7f07c654cd5af484db310 Mon Sep 17 00:00:00 2001 From: Morlocke Date: Fri, 16 Aug 2024 13:54:13 +0200 Subject: [PATCH 38/51] Minor tweak to GlaDS and PlumeSolver to allow the plumes to use the new GL flux routine --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 12 ++++++------ elmerice/Solvers/PlumeSolver.F90 | 26 +++++-------------------- 2 files changed, 11 insertions(+), 27 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 8843878436..c5d074ffba 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -2547,7 +2547,7 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) CALL Info(SolverName,'>subglac channel flux variable< not found, assuming >Channel Flux<',Level=4) channelVarName = "Channel Flux" END IF - channelVar => VariableGet(Model % mesh % Variables,TRIM(channelVarName),UnFoundFatal=.TRUE.) + channelVar => VariableGet(Solver % mesh % Variables,TRIM(channelVarName),UnFoundFatal=.TRUE.) IF (.NOT.ASSOCIATED(channelVar)) & CALL FATAL(SolverName,"Variable "//TRIM(channelVarName)//" not found") channelPerm => channelVar % Perm @@ -2558,7 +2558,7 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) CALL Info(SolverName,'>subglac sheet thickness variable< not found, assuming >sheet thickness<',Level=4) sheetThickVarName = "Sheet thickness" END IF - sheetThickVar => VariableGet(Model % mesh % Variables,TRIM(sheetThickVarName),UnFoundFatal=.TRUE.) + sheetThickVar => VariableGet(Solver % mesh % Variables,TRIM(sheetThickVarName),UnFoundFatal=.TRUE.) IF (.NOT.ASSOCIATED(sheetThickVar)) & CALL FATAL(SolverName,"Variable "//TRIM(sheetThickVarName)//" not found") sheetThickPerm => sheetThickVar % Perm @@ -2569,7 +2569,7 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) CALL Info(SolverName,'>subglac sheet discharge variable< not found, assuming >sheet discharge<',Level=4) sheetDisVarName = "sheet discharge" END IF - sheetDisVar => VariableGet(Model % mesh % Variables,TRIM(sheetDisVarName),UnFoundFatal=.TRUE.) + sheetDisVar => VariableGet(Solver % mesh % Variables,TRIM(sheetDisVarName),UnFoundFatal=.TRUE.) IF (.NOT.ASSOCIATED(sheetDisVar)) & CALL FATAL(SolverName,"Variable "//TRIM(sheetDisVarName)//" not found") sheetDisPerm => sheetDisVar % Perm @@ -2581,7 +2581,7 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) CALL Info(SolverName,'>grounded mask variable< not found, assuming >GroundedMask<',Level=4) MaskName = "GroundedMask" END IF - gmVar => VariableGet(Model % mesh % Variables,TRIM(MaskName),UnFoundFatal=.TRUE.) + gmVar => VariableGet(Solver % mesh % Variables,TRIM(MaskName),UnFoundFatal=.TRUE.) IF (.NOT.ASSOCIATED(gmVar)) & CALL FATAL(SolverName,"Variable >GroundedMask< not found") gmPerm => gmVar % Perm @@ -2589,12 +2589,12 @@ SUBROUTINE GlaDS_GLflux( Model,Solver,dt,TransientSimulation ) ! The two variables that will contain the sheet and channel fluxes on the GL are also ! hard coded (well, their names anyway). - sglfVar => VariableGet(Model % mesh % Variables,TRIM("Sheet GL flux"),UnFoundFatal=.TRUE.) + sglfVar => VariableGet(Solver % mesh % Variables,TRIM("Sheet GL flux"),UnFoundFatal=.TRUE.) IF (.NOT.ASSOCIATED(sglfVar)) & CALL FATAL(SolverName,"Variable >Sheet GL flux< not found") sglfPerm => sglfVar % Perm sglfVals => sglfVar % Values - cglfVar => VariableGet(Model % mesh % Variables,TRIM("Channel GL flux"),UnFoundFatal=.TRUE.) + cglfVar => VariableGet(Solver % mesh % Variables,TRIM("Channel GL flux"),UnFoundFatal=.TRUE.) IF (.NOT.ASSOCIATED(cglfVar)) & CALL FATAL(SolverName,"Variable >Channel GL flux< not found") cglfPerm => cglfVar % Perm diff --git a/elmerice/Solvers/PlumeSolver.F90 b/elmerice/Solvers/PlumeSolver.F90 index 9a9b972103..4caa5d2609 100644 --- a/elmerice/Solvers/PlumeSolver.F90 +++ b/elmerice/Solvers/PlumeSolver.F90 @@ -75,14 +75,14 @@ SUBROUTINE Plume (Model, Solver, dt, TransientSimulation) Basis(Model % MaxElementNodes), TotalArea, TotalPMelt, TotalBMelt, & ElemPMelt, ElemBMelt, ElemToeMelt, Target_PMelt_Average, TotalToeMelt, & Target_BMelt_Average, BMelt_Average, PMelt_Average, scale, NodeElev, BMSummerStop, & - BMSummerStart, Season, aboveMelt, meMelt, Dist, MinDist, ChannelQ,& + BMSummerStart, Season, aboveMelt, meMelt, Dist, MinDist,& Q0, Plume1MR, Plume2MR, PlProp, Node, NearestNode(3),& TargetNode(3), MaxX, MinX, MaxY, MinY, PlDist(2), MeshRes, BMRDist,& BMRMinDist, PlDepth, SStart, SStop REAL(KIND=dp), ALLOCATABLE :: Xs(:), Ys(:), DwDz(:), W0(:), DmDz(:), MMR(:), MME(:), & PlumePoints(:,:,:), PlStart(:,:),PlStop(:,:), PointStore(:),& - DistArray(:), PlInQ(:), SheetQ(:), PlFinalQ(:), Zi(:), Xi(:), Ta(:),& + DistArray(:), PlInQ(:), PlFinalQ(:), Zi(:), Xi(:), Ta(:),& Sa(:), PlAxis(:), PlPos(:,:), NearestFrontNodes(:,:),& XArray(:), YArray(:), ZArray(:), PlCoordArray(:,:),& Plz(:), PlMR(:), Row(:), PlZArray(:,:), PlMRArray(:,:),& @@ -397,31 +397,15 @@ END SUBROUTINE PlumeSolver !running along the GL itself (i.e., edges with both nodes on the GL), !but these a) should be prohibited by the BCs and b) are probably !negligible anyway - ALLOCATE(PlInQ(SIZE(HydroGLNodes)), SheetQ(3)) - WorkVar => VariableGet(HydroMesh % Variables, 'channel flux', ThisOnly=.TRUE., UnfoundFatal=.TRUE.) - WorkVar2 => VariableGet(HydroMesh % Variables, 'sheet discharge', ThisOnly=.TRUE., UnfoundFatal=.TRUE.) - WorkVar3 => VariableGet(HydroMesh % Variables, 'sheet thickness', ThisOnly=.TRUE., UnfoundFatal=.TRUE.) + ALLOCATE(PlInQ(SIZE(HydroGLNodes))) + WorkVar => VariableGet(HydroMesh % Variables, 'GlaDS GL Flux', ThisOnly=.TRUE., UnfoundFatal=.TRUE.) j=1 DO i=1, SIZE(HydroGLNodes) - SheetQ = 0.0_dp - ChannelQ = 0.0 IF(HydroGLNodes(i) == 0) THEN PlInQ(i) = 0.0 CYCLE END IF - DO j=1,HydroMesh % NumberOfEdges - Edge => HydroMesh % Edges(j) - IF(ANY(Edge % NodeIndexes(1:2) == HydroGLNodes(i))) THEN - ChannelQ = ChannelQ + WorkVar % Values(WorkVar % Perm(HydroMesh % NumberOfNodes+j)) - ELSE - CYCLE - END IF - END DO - DO j=1,2 - SheetQ(j) = SheetQ(j) + (WorkVar2 % Values(2*(WorkVar2 % Perm(HydroGLNodes(i))-1)+j)) - END DO - SheetQ(3) = SQRT((SheetQ(1)**2)+(SheetQ(2)**2))*WorkVar3 % Values(WorkVar3 % Perm(HydroGLNodes(i))) - PlInQ(i) = ChannelQ + SheetQ(3) + PlInQ(i) = WorkVar % Values(WorkVar % Perm(HydroGLNodes(i))) END DO !Check for multiple entries that have same NearestFrontNode and combine Q From e0e220da205298aad0f94aa8e3a48d36b645d449 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 25 Sep 2024 16:52:59 +0300 Subject: [PATCH 39/51] Added user option to define mask name for SSA sliding (default still GroundedMask) --- elmerice/Utils/SSAMaterialModels.F90 | 42 ++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 9 deletions(-) diff --git a/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index 1e505034f9..39c67c962d 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -66,11 +66,12 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s INTEGER, PARAMETER :: BUDD = 5 INTEGER, PARAMETER :: REG_COULOMB_GAG = 3 ! Schoof 2005 & Gagliardini 2007 INTEGER, PARAMETER :: REG_COULOMB_JOU = 4 ! Joughin 2019 + INTEGER, PARAMETER :: REG_COULOMB_HYB = 6 ! Rupert's Hybrid TYPE(ValueList_t), POINTER :: Material, Constants TYPE(Variable_t), POINTER :: GMSol,BedrockSol,NSol INTEGER, POINTER :: NodeIndexes(:) - CHARACTER(LEN=MAX_NAME_LEN) :: Friction + CHARACTER(LEN=MAX_NAME_LEN) :: Friction, MaskName REAL(KIND=dp) :: Slip2, gravity, qq, hafq REAL(KIND=dp) :: fm,fq,MinN,MaxN,U0 REAL(KIND=dp) :: alpha,beta,fB @@ -82,10 +83,18 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s LOGICAL :: Found, NeedN SAVE FirstTime + + Material => GetMaterial(Element) + + ! Allow user-named grounded mask + MaskName = ListGetString(Material, 'SSA Friction mask name',Found, UnFoundFatal=.FALSE.) + IF (.NOT.Found) THEN + MaskName = 'GroundedMask' + END IF -! Sub - element GL parameterisation + ! Sub - element GL parameterisation IF (SEP) THEN - GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) + GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalGM,UElement=Element,UVariable=GMSol) BedrockSol => VariableGet( CurrentModel % Variables, 'bedrock',UnFoundFatal=.TRUE. ) @@ -93,7 +102,6 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s END IF ! Friction law - Material => GetMaterial(Element) NodeIndexes => Element % NodeIndexes Friction = ListGetString(Material, 'SSA Friction Law',Found, UnFoundFatal=.TRUE.) @@ -258,6 +266,8 @@ FUNCTION ComputeMeanFriction(Element,n,ElementNodes,STDOFs,NodalU,NodalV,NodalZs INTEGER :: GLnIP REAL(KIND=dp) :: sealevel,rhow + TYPE(ValueList_t), POINTER :: Material + CHARACTER(LEN=MAX_NAME_LEN) :: MaskName LOGICAL :: PartlyGroundedElement TYPE(Variable_t),POINTER :: GMSol REAL(KIND=dp) :: NodalGM(n) @@ -266,12 +276,19 @@ FUNCTION ComputeMeanFriction(Element,n,ElementNodes,STDOFs,NodalU,NodalV,NodalZs REAL(KIND=dp) :: h,ub,rho,Velo(2) REAL(KIND=dp) :: area,tb REAL(KIND=dp) :: Ceff - LOGICAL :: stat + LOGICAL :: stat, Found INTEGER :: t + ! Allow user-named grounded mask + Material => GetMaterial(Element) + MaskName = ListGetString(Material, 'SSA Friction mask name',Found, UnFoundFatal=.FALSE.) + IF (.NOT.Found) THEN + MaskName = 'GroundedMask' + END IF + strbasemag=0._dp IF (SEP) THEN - GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) + GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalGM,UElement=Element,UVariable=GMSol) PartlyGroundedElement=(ANY(NodalGM(1:n).GE.0._dp).AND.ANY(NodalGM(1:n).LT.0._dp)) IF (PartlyGroundedElement) THEN @@ -333,22 +350,29 @@ FUNCTION SSAEffectiveBMB(Element,nn,Basis,SEM,BMB,hh,FIPcount,rho,rhow,sealevel, TYPE(ValueList_t), POINTER :: Material TYPE(Variable_t), POINTER :: GMSol,BedrockSol - CHARACTER(LEN=MAX_NAME_LEN) :: MeltParam + CHARACTER(LEN=MAX_NAME_LEN) :: MeltParam, MaskName REAL(KIND=dp),DIMENSION(nn) :: NodalBeta, NodalGM, NodalBed, NodalLinVelo,NodalC REAL(KIND=dp) :: bedrock,Hf LOGICAL :: Found + + Material => GetMaterial(Element) + + ! Allow user-named grounded mask + MaskName = ListGetString(Material, 'SSA Friction mask name',Found, UnFoundFatal=.FALSE.) + IF (.NOT.Found) THEN + MaskName = 'GroundedMask' + END IF ! Sub - element GL parameterisation IF (SEM) THEN - GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) + GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalGM,UElement=Element,UVariable=GMSol ) BedrockSol => VariableGet( CurrentModel % Variables, 'bedrock',UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalBed,UElement=Element,UVariable= BedrockSol ) END IF - Material => GetMaterial(Element) MeltParam = ListGetString(Material, 'SSA Melt Param',Found, UnFoundFatal=.TRUE.) BMBatIP=SUM(Basis(1:nn)*BMB(1:nn)) From 9a05add7c670310b83b934e1cec92be7b8829675 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 25 Sep 2024 18:39:57 +0300 Subject: [PATCH 40/51] Additional hybrid RC sliding parameterisation for SSA --- elmerice/Utils/SSAMaterialModels.F90 | 37 +++++++++++++++++++--------- 1 file changed, 26 insertions(+), 11 deletions(-) diff --git a/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index 39c67c962d..e1dfeab494 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -117,6 +117,8 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s iFriction = REG_COULOMB_GAG CASE('regularized coulomb') iFriction = REG_COULOMB_JOU + CASE('regularized coulomb hybrid') + iFriction = REG_COULOMB_HYB CASE DEFAULT CALL FATAL("SSAEffectiveFriction",'Friction choice not recognised') END SELECT @@ -153,7 +155,7 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s END IF NeedN = .FALSE. END IF - CASE(REG_COULOMB_GAG,BUDD) + CASE(REG_COULOMB_GAG,REG_COULOMB_HYB,BUDD) NeedN = .TRUE. END SELECT @@ -177,16 +179,18 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s qq = ListGetConstReal( Material, 'SSA Haf Exponent', Found, UnFoundFatal=.TRUE.) hafq = ( fN / (gravity * rho) ) ** qq - CASE(REG_COULOMB_GAG) - fq = ListGetConstReal( Material, 'SSA Friction Post-Peak', Found, UnFoundFatal=.TRUE. ) - NodalC = 0.0_dp - NodalC(1:n) = ListGetReal( & - Material, 'SSA Friction Maximum Value', n, NodeIndexes(1:n), Found,& - UnFoundFatal=.TRUE.) - fC = SUM( NodalC(1:n) * Basis(1:n) ) - - CASE(REG_COULOMB_JOU) - U0 = ListGetConstReal( Material, 'SSA Friction Threshold Velocity', Found, UnFoundFatal=.TRUE.) + CASE(REG_COULOMB_GAG,REG_COULOMB_HYB,REG_COULOMB_JOU) + IF (iFriction .NE. REG_COULOMB_JOU) THEN + fq = ListGetConstReal( Material, 'SSA Friction Post-Peak', Found, UnFoundFatal=.TRUE. ) + NodalC = 0.0_dp + NodalC(1:n) = ListGetReal( & + Material, 'SSA Friction Maximum Value', n, NodeIndexes(1:n), Found,& + UnFoundFatal=.TRUE.) + fC = SUM( NodalC(1:n) * Basis(1:n) ) + END IF + IF (iFriction .NE. REG_COULOMB_GAG) THEN + U0 = ListGetConstReal( Material, 'SSA Friction Threshold Velocity', Found, UnFoundFatal=.TRUE.) + END IF END SELECT @@ -240,6 +244,17 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s IF (PRESENT(SlipDer)) SlipDer = Slip2 * Slip * ((fm-1.0_dp) / (ub*ub) - & fm*fq*fB*ub**(fq-2.0_dp)/(1.0_dp+fB*ub**fq)) + ! The sandard "SSA friction parameter" is taken as the effective pressure threshold. + ! Max val is same as REG_COULMB_GAG + ! Threshold vel is same as REG_COULOMB_JOU + CASE(REG_COULOMB_HYB) + IF (fq.NE.1.0_dp) THEN + CALL Fatal('SSAEffectiveFriction','Expecting unity post peak exponent') + END IF + Slip = fC * fN * ub**(fm-1.0_dp) / (ub + (fN/beta)*U0)**fm + ! TODO: + ! IF (PRESENT(SlipDer)) SlipDer = + CASE(REG_COULOMB_JOU) Slip = beta * ub**(fm-1.0_dp) / (ub + U0)**fm IF (NeedN) Slip = Slip * fN From 8938d564868bde758f3494db9fefcd59a49159af Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Thu, 26 Sep 2024 18:51:04 +0300 Subject: [PATCH 41/51] Report SSA friction mask name at info level 5 --- elmerice/Utils/SSAMaterialModels.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index e1dfeab494..382d3c2415 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -91,7 +91,9 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s IF (.NOT.Found) THEN MaskName = 'GroundedMask' END IF - + WRITE( Message, * ) 'Grounded mask name for SSA friction is:', MaskName + CALL INFO("SSAEffectiveFriction", Message, level=5) + ! Sub - element GL parameterisation IF (SEP) THEN GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) @@ -300,7 +302,9 @@ FUNCTION ComputeMeanFriction(Element,n,ElementNodes,STDOFs,NodalU,NodalV,NodalZs IF (.NOT.Found) THEN MaskName = 'GroundedMask' END IF - + WRITE( Message, * ) 'Grounded mask name for SSA friction is:', MaskName + CALL INFO("ComputeMeanFriction", Message, level=5) + strbasemag=0._dp IF (SEP) THEN GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) @@ -375,11 +379,13 @@ FUNCTION SSAEffectiveBMB(Element,nn,Basis,SEM,BMB,hh,FIPcount,rho,rhow,sealevel, Material => GetMaterial(Element) ! Allow user-named grounded mask - MaskName = ListGetString(Material, 'SSA Friction mask name',Found, UnFoundFatal=.FALSE.) + MaskName = ListGetString(Material, 'SSA BMB mask name',Found, UnFoundFatal=.FALSE.) IF (.NOT.Found) THEN MaskName = 'GroundedMask' END IF - + WRITE( Message, * ) 'Grounded mask name for SSA BMB is:', MaskName + CALL INFO("SSAEffectiveBMB", Message, level=5) + ! Sub - element GL parameterisation IF (SEM) THEN GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) From ee057a9c6c85e1200ea0a2a964769c431cb285c6 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Fri, 4 Oct 2024 17:46:45 +0300 Subject: [PATCH 42/51] Allow SSA code to use a different grounded mask by setting "Grounded Mask Variable Name" in constants section. (implemented in SSAmaterial properties, SSA solver and thickness solver; default is GroundedMask for backward compatibility) --- elmerice/Solvers/SSASolver.F90 | 37 ++++++++--- elmerice/Solvers/ThicknessSolver.F90 | 10 ++- elmerice/Utils/SSAMaterialModels.F90 | 96 ++++++++++++++++------------ 3 files changed, 89 insertions(+), 54 deletions(-) diff --git a/elmerice/Solvers/SSASolver.F90 b/elmerice/Solvers/SSASolver.F90 index 862bba0053..a9396477c3 100644 --- a/elmerice/Solvers/SSASolver.F90 +++ b/elmerice/Solvers/SSASolver.F90 @@ -70,8 +70,8 @@ SUBROUTINE SSABasalSolver( Model,Solver,dt,TransientSimulation ) TYPE(Nodes_t) :: ElementNodes TYPE(Element_t),POINTER :: CurrentElement, Element, ParentElement, BoundaryElement TYPE(Matrix_t),POINTER :: StiffMatrix - TYPE(ValueList_t), POINTER :: SolverParams, BodyForce, Material, BC - TYPE(Variable_t), POINTER :: PointerToVariable, ZsSol, ZbSol, VeloSol,strbasemag,Ceff + TYPE(ValueList_t), POINTER :: SolverParams, BodyForce, Material, BC, Constants + TYPE(Variable_t), POINTER :: PointerToVariable, ZsSol, ZbSol, VeloSol, strbasemag, Ceff, GMSol LOGICAL :: AllocationsDone = .FALSE., Found, GotIt, CalvingFront, UnFoundFatal=.TRUE. LOGICAL :: stat @@ -91,15 +91,16 @@ SUBROUTINE SSABasalSolver( Model,Solver,dt,TransientSimulation ) REAL(KIND=dp), ALLOCATABLE :: STIFF(:,:), LOAD(:), FORCE(:), & NodalGravity(:), NodalViscosity(:), NodalDensity(:), & - NodalZs(:), NodalZb(:), NodalU(:), NodalV(:),Basis(:) + NodalZs(:), NodalZb(:), NodalU(:), NodalV(:),Basis(:), NodalGM(:) REAL(KIND=dp) :: DetJ,UnLimit,un,un_max,FillValue - CHARACTER(LEN=MAX_NAME_LEN) :: SolverName, ZsName, ZbName + CHARACTER(LEN=MAX_NAME_LEN) :: SolverName, ZsName, ZbName, MaskName #ifdef USE_ISO_C_BINDINGS REAL(KIND=dp) :: at, at0 #else REAL(KIND=dp) :: at, at0, CPUTime, RealTime #endif + LOGICAL :: PartlyGroundedElement LOGICAL :: SEP ! Sub-element parametrization for Grounding line INTEGER :: GLnIP ! number of Integ. Points for GL Sub-element parametrization @@ -108,7 +109,7 @@ SUBROUTINE SSABasalSolver( Model,Solver,dt,TransientSimulation ) SAVE NodalGravity, NodalViscosity, NodalDensity, & NodalZs, NodalZb, & NodalU, NodalV, & - Basis + Basis, nodalGM !------------------------------------------------------------------------------ PointerToVariable => Solver % Variable @@ -185,13 +186,13 @@ SUBROUTINE SSABasalSolver( Model,Solver,dt,TransientSimulation ) M = Model % Mesh % NumberOfNodes IF (AllocationsDone) DEALLOCATE(FORCE, LOAD, STIFF, NodalGravity, & NodalViscosity, NodalDensity, & - NodalZb, NodalZs, NodalU, NodalV, & + NodalZb, NodalZs, NodalU, NodalV, NodalGM, & ElementNodes % x, & ElementNodes % y, ElementNodes % z ,Basis) ALLOCATE( FORCE(STDOFs*N), LOAD(N), STIFF(STDOFs*N,STDOFs*N), & NodalGravity(N), NodalDensity(N), NodalViscosity(N), & - NodalZb(N), NodalZs(N), NodalU(N), NodalV(N), & + NodalZb(N), NodalZs(N), NodalU(N), NodalV(N), NodalGM(N), & ElementNodes % x(N), ElementNodes % y(N), ElementNodes % z(N), & Basis(N), & STAT=istat ) @@ -534,10 +535,20 @@ SUBROUTINE SSABasalSolver( Model,Solver,dt,TransientSimulation ) End do un=sqrt(un) + PartlyGroundedElement = .FALSE. + IF (SEP) THEN + Constants => GetConstants() + MaskName = ListGetString(Constants,'Grounded Mask Variable Name',UnFoundFatal=.FALSE.,DefValue='GroundedMask') + GMSol => VariableGet( CurrentModel % Variables, MaskName, UnFoundFatal=.TRUE. ) + CALL GetLocalSolution( NodalGM,UElement=Element,UVariable=GMSol) + PartlyGroundedElement=(ANY(NodalGM(1:n).GE.0._dp).AND.ANY(NodalGM(1:n).LT.0._dp)) + END IF + h=MAX(SUM(Basis(1:n)*(NodalZs(1:n)-NodalZb(1:n))),MinH) Ceff%Values(Ceff%Perm(NodeIndexes(i)))= & - SSAEffectiveFriction(Element,n,Basis,un,SEP,.TRUE.,h,SUM(NodalDensity(1:n)*Basis(1:n)),rhow,sealevel) - End do + SSAEffectiveFriction(Element,n,Basis,un,SEP,PartlyGroundedElement,h,SUM(NodalDensity(1:n)*Basis(1:n)),rhow,sealevel) +! SSAEffectiveFriction(Element,n,Basis,un,SEP,.TRUE.,h,SUM(NodalDensity(1:n)*Basis(1:n)),rhow,sealevel) + END DO End IF END DO @@ -596,6 +607,8 @@ SUBROUTINE LocalMatrixUVSSA( STIFF, FORCE, Element, n, Nodes, gravity, & LOGICAL :: Stat, NewtonLin INTEGER :: i, j, t, p, q , dim TYPE(GaussIntegrationPoints_t) :: IP + CHARACTER(LEN=MAX_NAME_LEN) :: MaskName + TYPE(ValueList_t), POINTER :: Constants TYPE(Nodes_t) :: Nodes !------------------------------------------------------------------------------ @@ -608,8 +621,12 @@ SUBROUTINE LocalMatrixUVSSA( STIFF, FORCE, Element, n, Nodes, gravity, & ! Use Newton Linearisation NewtonLin = (Newton.AND.(cm.NE.1.0_dp)) + PartlyGroundedElement = .FALSE. IF (SEP) THEN - GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) + Constants => GetConstants() + MaskName = ListGetString(Constants,'Grounded Mask Variable Name',UnFoundFatal=.FALSE.,DefValue='GroundedMask') + GMSol => VariableGet( CurrentModel % Variables, MaskName, UnFoundFatal=.TRUE. ) +! GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalGM,UElement=Element,UVariable=GMSol) PartlyGroundedElement=(ANY(NodalGM(1:n).GE.0._dp).AND.ANY(NodalGM(1:n).LT.0._dp)) IF (PartlyGroundedElement) THEN diff --git a/elmerice/Solvers/ThicknessSolver.F90 b/elmerice/Solvers/ThicknessSolver.F90 index b4ae53684e..c3ee78ffdf 100644 --- a/elmerice/Solvers/ThicknessSolver.F90 +++ b/elmerice/Solvers/ThicknessSolver.F90 @@ -706,10 +706,15 @@ SUBROUTINE LocalMatrix( STIFF, MASS, FORCE,& INTEGER :: i,j,t,p,q, n,FIPcount REAL(KIND=dp) :: smbE, bmbE, area, MinH REAL(KIND=dp) :: smbAtIP, bmbAtIP, GMatIP, rho, rhow, hh, sealevel,FFI + TYPE(ValueList_t), POINTER :: Constants + CHARACTER(LEN=MAX_NAME_LEN) :: MaskName !------------------------------------------------------------------------------ IF (SEM) THEN - GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) + Constants => GetConstants() + MaskName = ListGetString(Constants,'Grounded Mask Variable Name',UnFoundFatal=.FALSE.,DefValue='GroundedMask') + GMSol => VariableGet( CurrentModel % Variables,MaskName,UnFoundFatal=.TRUE. ) +! GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalGM,UElement=Element,UVariable=GMSol) PartlyGroundedElement=(ANY(NodalGM(1:nCoord).GE.0._dp).AND.ANY(NodalGM(1:nCoord).LT.0._dp)) IF (PartlyGroundedElement) THEN @@ -791,7 +796,8 @@ SUBROUTINE LocalMatrix( STIFF, MASS, FORCE,& ! Numerical integration: ! ---------------------- IF (SEM) THEN - GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) + GMSol => VariableGet( CurrentModel % Variables,MaskName,UnFoundFatal=.TRUE. ) +! GMSol => VariableGet( CurrentModel % Variables, 'GroundedMask',UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalGM,UElement=Element,UVariable=GMSol) CALL GetLocalSolution( NodalThick,UElement=Element,UVariable=Solver % Variable) PartlyGroundedElement=(ANY(NodalGM(1:nCoord).GE.0._dp).AND.ANY(NodalGM(1:nCoord).LT.0._dp)) diff --git a/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index 382d3c2415..b2d42f2871 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -45,12 +45,12 @@ MODULE SSAMaterialModels !-------------------------------------------------------------------------------- !> Return the effective friction coefficient !-------------------------------------------------------------------------------- - FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,sealevel,SlipDer) RESULT(Slip) + FUNCTION SSAEffectiveFriction(Element,nn,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,sealevel,SlipDer) RESULT(Slip) IMPLICIT NONE REAL(KIND=dp) :: Slip ! the effective friction coefficient TYPE(Element_t), POINTER :: Element ! the current element - INTEGER :: n ! number of nodes + INTEGER :: nn ! number of nodes REAL(KIND=dp) :: Basis(:) ! basis functions REAL(KIND=dp) :: ub ! the velocity for non-linear friction laws LOGICAL :: SEP ! Sub-Element Parametrisation of the friction @@ -75,25 +75,26 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s REAL(KIND=dp) :: Slip2, gravity, qq, hafq REAL(KIND=dp) :: fm,fq,MinN,MaxN,U0 REAL(KIND=dp) :: alpha,beta,fB - INTEGER :: GLnIP + INTEGER :: GLnIP,ii - REAL(KIND=dp),DIMENSION(n) :: NodalBeta, NodalGM, NodalBed, NodalLinVelo,NodalC,NodalN + REAL(KIND=dp),DIMENSION(nn) :: NodalBeta, NodalGM, NodalBed, NodalLinVelo,NodalC,NodalN REAL(KIND=dp) :: bedrock,Hf,fC,fN,LinVelo LOGICAL :: Found, NeedN + SAVE FirstTime Material => GetMaterial(Element) ! Allow user-named grounded mask - MaskName = ListGetString(Material, 'SSA Friction mask name',Found, UnFoundFatal=.FALSE.) - IF (.NOT.Found) THEN - MaskName = 'GroundedMask' + Constants => GetConstants() + MaskName = ListGetString(Constants,'Grounded Mask Variable Name',UnFoundFatal=.FALSE.,DefValue='GroundedMask') + IF (FirstTime) THEN + WRITE( Message, * ) 'Grounded mask name for SSA friction is:', MaskName + CALL INFO("SSAEffectiveFriction", Message, level=5) END IF - WRITE( Message, * ) 'Grounded mask name for SSA friction is:', MaskName - CALL INFO("SSAEffectiveFriction", Message, level=5) - + ! Sub - element GL parameterisation IF (SEP) THEN GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) @@ -103,7 +104,7 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s CALL GetLocalSolution( NodalBed,UElement=Element,UVariable= BedrockSol) END IF -! Friction law + ! Friction law NodeIndexes => Element % NodeIndexes Friction = ListGetString(Material, 'SSA Friction Law',Found, UnFoundFatal=.TRUE.) @@ -127,8 +128,8 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s ! coefficient for all friction parameterisations NodalBeta = 0.0_dp - NodalBeta(1:n) = ListGetReal( & - Material, 'SSA Friction Parameter', n, NodeIndexes(1:n), Found,& + NodalBeta(1:nn) = ListGetReal( & + Material, 'SSA Friction Parameter', nn, NodeIndexes(1:nn), Found,& UnFoundFatal=.TRUE.) ! for nonlinear powers of sliding velocity @@ -136,8 +137,8 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s CASE(REG_COULOMB_JOU,REG_COULOMB_GAG,WEERTMAN,BUDD) fm = ListGetConstReal( Material, 'SSA Friction Exponent', Found , UnFoundFatal=.TRUE.) NodalLinVelo = 0.0_dp - NodalLinVelo(1:n) = ListGetReal( & - Material, 'SSA Friction Linear Velocity', n, NodeIndexes(1:n), Found,& + NodalLinVelo(1:nn) = ListGetReal( & + Material, 'SSA Friction Linear Velocity', nn, NodeIndexes(1:nn), Found,& UnFoundFatal=.TRUE.) CASE DEFAULT END SELECT @@ -153,7 +154,6 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s IF (.NOT. Found) THEN IF (FirstTime) THEN CALL INFO("SSAEffectiveFriction","> SSA Friction need N < not found, assuming false",level=3) - FirstTime = .FALSE. END IF NeedN = .FALSE. END IF @@ -165,7 +165,7 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s NSol => VariableGet( CurrentModel % Variables, 'Effective Pressure', UnFoundFatal=.TRUE. ) CALL GetLocalSolution( NodalN,UElement=Element, UVariable=NSol) MinN = ListGetConstReal( Material, 'SSA Min Effective Pressure', Found, UnFoundFatal=.TRUE.) - fN = SUM( NodalN(1:n) * Basis(1:n) ) + fN = SUM( NodalN(1:nn) * Basis(1:nn) ) fN = MAX(fN, MinN) ! Effective pressure should be >0 (for the friction law) MaxN = ListGetConstReal( Material, 'SSA Max Effective Pressure', Found, UnFoundFatal=.FALSE.) IF (Found) fN = MIN(fN, MaxN) @@ -175,7 +175,6 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s SELECT CASE (iFriction) CASE(BUDD) - Constants => GetConstants() gravity = ListGetConstReal( Constants, 'Gravity Norm', UnFoundFatal=.TRUE. ) ! calculate haf from N = rho_i g z* qq = ListGetConstReal( Material, 'SSA Haf Exponent', Found, UnFoundFatal=.TRUE.) @@ -185,10 +184,10 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s IF (iFriction .NE. REG_COULOMB_JOU) THEN fq = ListGetConstReal( Material, 'SSA Friction Post-Peak', Found, UnFoundFatal=.TRUE. ) NodalC = 0.0_dp - NodalC(1:n) = ListGetReal( & - Material, 'SSA Friction Maximum Value', n, NodeIndexes(1:n), Found,& + NodalC(1:nn) = ListGetReal( & + Material, 'SSA Friction Maximum Value', nn, NodeIndexes(1:nn), Found,& UnFoundFatal=.TRUE.) - fC = SUM( NodalC(1:n) * Basis(1:n) ) + fC = SUM( NodalC(1:nn) * Basis(1:nn) ) END IF IF (iFriction .NE. REG_COULOMB_GAG) THEN U0 = ListGetConstReal( Material, 'SSA Friction Threshold Velocity', Found, UnFoundFatal=.TRUE.) @@ -196,14 +195,14 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s END SELECT - Beta=SUM(Basis(1:n)*NodalBeta(1:n)) + Beta=SUM(Basis(1:nn)*NodalBeta(1:nn)) IF (SEP) THEN ! Floating - IF (ALL(NodalGM(1:n).LT.0._dp)) THEN + IF (ALL(NodalGM(1:nn).LT.0._dp)) THEN beta=0._dp ELSE IF (PartlyGrounded) THEN - bedrock = SUM( NodalBed(1:n) * Basis(1:n) ) + bedrock = SUM( NodalBed(1:nn) * Basis(1:nn) ) Hf= rhow * (sealevel-bedrock) / rho if (h.lt.Hf) beta=0._dp END IF @@ -211,7 +210,7 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s Slip2=0.0_dp IF (iFriction .NE. LINEAR) THEN - LinVelo = SUM( NodalLinVelo(1:n) * Basis(1:n) ) + LinVelo = SUM( NodalLinVelo(1:nn) * Basis(1:nn) ) IF ((iFriction == WEERTMAN).AND.(fm==1.0_dp)) iFriction=LINEAR Slip2=1.0_dp IF (ub < LinVelo) then @@ -246,10 +245,10 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s IF (PRESENT(SlipDer)) SlipDer = Slip2 * Slip * ((fm-1.0_dp) / (ub*ub) - & fm*fq*fB*ub**(fq-2.0_dp)/(1.0_dp+fB*ub**fq)) + CASE(REG_COULOMB_HYB) ! The sandard "SSA friction parameter" is taken as the effective pressure threshold. ! Max val is same as REG_COULMB_GAG ! Threshold vel is same as REG_COULOMB_JOU - CASE(REG_COULOMB_HYB) IF (fq.NE.1.0_dp) THEN CALL Fatal('SSAEffectiveFriction','Expecting unity post peak exponent') END IF @@ -262,9 +261,11 @@ FUNCTION SSAEffectiveFriction(Element,n,Basis,ub,SEP,PartlyGrounded,h,rho,rhow,s IF (NeedN) Slip = Slip * fN IF (PRESENT(SlipDer)) SlipDer = Slip2 * Slip * ((fm-1.0_dp) / (ub*ub) - & fm*ub**(-1.0_dp)/(ub+U0)) - - END SELECT + END SELECT + + FirstTime = .FALSE. + END FUNCTION SSAEffectiveFriction !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -283,7 +284,7 @@ FUNCTION ComputeMeanFriction(Element,n,ElementNodes,STDOFs,NodalU,NodalV,NodalZs INTEGER :: GLnIP REAL(KIND=dp) :: sealevel,rhow - TYPE(ValueList_t), POINTER :: Material + TYPE(ValueList_t), POINTER :: Material, Constants CHARACTER(LEN=MAX_NAME_LEN) :: MaskName LOGICAL :: PartlyGroundedElement TYPE(Variable_t),POINTER :: GMSol @@ -295,16 +296,20 @@ FUNCTION ComputeMeanFriction(Element,n,ElementNodes,STDOFs,NodalU,NodalV,NodalZs REAL(KIND=dp) :: Ceff LOGICAL :: stat, Found INTEGER :: t + LOGICAL :: FirstTime = .TRUE. + + SAVE FirstTime ! Allow user-named grounded mask Material => GetMaterial(Element) - MaskName = ListGetString(Material, 'SSA Friction mask name',Found, UnFoundFatal=.FALSE.) - IF (.NOT.Found) THEN - MaskName = 'GroundedMask' - END IF - WRITE( Message, * ) 'Grounded mask name for SSA friction is:', MaskName - CALL INFO("ComputeMeanFriction", Message, level=5) + Constants => GetConstants() + MaskName = ListGetString(Constants,'Grounded Mask Variable Name',UnFoundFatal=.FALSE.,DefValue='GroundedMask') + IF (FirstTime) THEN + WRITE( Message, * ) 'Grounded mask name for SSA friction is:', MaskName + CALL INFO("ComputeMeanFriction", Message, level=5) + END IF + strbasemag=0._dp IF (SEP) THEN GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) @@ -343,6 +348,8 @@ FUNCTION ComputeMeanFriction(Element,n,ElementNodes,STDOFs,NodalU,NodalV,NodalZs strbasemag=tb/area + FirstTime = .FALSE. + END FUNCTION ComputeMeanFriction !-------------------------------------------------------------------------------- @@ -367,25 +374,28 @@ FUNCTION SSAEffectiveBMB(Element,nn,Basis,SEM,BMB,hh,FIPcount,rho,rhow,sealevel, REAL(KIND=dp),INTENT(IN),OPTIONAL :: rho,rhow,sealevel ! to calculate floatation for SEM3 REAL(KIND=dp),INTENT(IN),OPTIONAL :: FAF ! Floating area fraction for SEM1 - TYPE(ValueList_t), POINTER :: Material + TYPE(ValueList_t), POINTER :: Material, Constants TYPE(Variable_t), POINTER :: GMSol,BedrockSol CHARACTER(LEN=MAX_NAME_LEN) :: MeltParam, MaskName REAL(KIND=dp),DIMENSION(nn) :: NodalBeta, NodalGM, NodalBed, NodalLinVelo,NodalC REAL(KIND=dp) :: bedrock,Hf + LOGICAL :: FirstTime = .TRUE. LOGICAL :: Found + SAVE FirstTime + Material => GetMaterial(Element) ! Allow user-named grounded mask - MaskName = ListGetString(Material, 'SSA BMB mask name',Found, UnFoundFatal=.FALSE.) - IF (.NOT.Found) THEN - MaskName = 'GroundedMask' + Constants => GetConstants() + MaskName = ListGetString(Constants,'Grounded Mask Variable Name',UnFoundFatal=.FALSE.,DefValue='GroundedMask') + IF (FirstTime) THEN + WRITE( Message, * ) 'Grounded mask name for SSA BMB is:', MaskName + CALL INFO("SSAEffectiveBMB", Message, level=5) END IF - WRITE( Message, * ) 'Grounded mask name for SSA BMB is:', MaskName - CALL INFO("SSAEffectiveBMB", Message, level=5) - + ! Sub - element GL parameterisation IF (SEM) THEN GMSol => VariableGet( CurrentModel % Variables, MaskName,UnFoundFatal=.TRUE. ) @@ -432,6 +442,8 @@ FUNCTION SSAEffectiveBMB(Element,nn,Basis,SEM,BMB,hh,FIPcount,rho,rhow,sealevel, CALL FATAL("SSAEffectiveBMB",Message) END SELECT + + FirstTime = .FALSE. END FUNCTION SSAEffectiveBMB From 85ff15107249d09c5a35544915e75abb9ee985cb Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 16 Oct 2024 12:36:10 +0300 Subject: [PATCH 43/51] Max sheet thickness for GlaDS applied after sheet thickness update. --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 31 ++++++++++++------------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index c5d074ffba..11545fd9f9 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -102,7 +102,7 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CHARACTER(LEN=MAX_NAME_LEN) :: methodSheet, methodChannels LOGICAL :: Found, FluxBC, Channels, Storage, FirstTime = .TRUE., & - AllocationsDone = .FALSE., SubroutineVisited = .FALSE., & + AllocationsDone = .FALSE., & meltChannels = .TRUE., NeglectH = .TRUE., Calving = .FALSE., & CycleElement=.FALSE., MABool = .FALSE., MaxHBool = .FALSE., LimitEffPres=.FALSE., & MinHBool=.FALSE., CycleNode=.FALSE. @@ -1227,19 +1227,6 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati CYCLE END IF - IF(MaxHBool) THEN - IF (ThickSolution(k)>MaxH) THEN - ThickSolution(k) = MaxH - !ThickPrev(k,1) = 0.0 - END IF - END IF - - IF(MinHBool) THEN - IF (ThickSolution(k) hr2(j)) THEN @@ -1265,6 +1252,20 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati ! Update Vvar Vvar(j) = Vvar(j) * ThickSolution(k) + IF(MaxHBool) THEN + IF (ThickSolution(k)>MaxH) THEN + ThickSolution(k) = MaxH + !ThickPrev(k,1) = 0.0 + END IF + END IF + + IF(MinHBool) THEN + IF (ThickSolution(k) VariableGet(Mesh % Variables, 'Sheet Thickness',ThisOnly=.TRUE.) From d0891c6bd0f4a4584e370d1191fad8cdd9d146e5 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 30 Oct 2024 22:04:17 +0200 Subject: [PATCH 44/51] Allow 3D velocity for calculting sliding speed in grounded melt solver --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 11545fd9f9..eaca00e0b7 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -2825,7 +2825,7 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) REAL(KIND=dp) :: rho_fw ! density of fresh water REAL(KIND=dp),PARAMETER :: threshold = 0.001_dp ! threshold friction melt rate for including GHF in melt calc REAL(KIND=dp), POINTER :: WtVals(:), HeatVals(:), MeltVals(:), GHFVals(:), Ceffvals(:), UbVals(:) - REAL(KIND=dp) :: LatHeat, GHFscaleFactor, Ub(1) + REAL(KIND=dp) :: LatHeat, GHFscaleFactor, Ub INTEGER, POINTER :: WtPerm(:), HeatPerm(:), MeltPerm(:), GHFPerm(:), Ceffperm(:), UbPerm(:) INTEGER :: nn @@ -2874,10 +2874,10 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) UbVals => UbVar%Values UbPerm => UbVar%Perm - IF (UbVar % DOFS .NE. 2) THEN - CALL Fatal(MyName, 'Expecting Ub variable to be 2D') - END IF - ! Material => GetMaterial() ! get sliding velocity from material +! IF (UbVar % DOFS .NE. 2) THEN +! CALL Fatal(MyName, 'Expecting Ub variable to be 2D') +! END IF +! ! Material => GetMaterial() ! get sliding velocity from material CASE DEFAULT CALL Fatal(MyName, 'MeltMode not recognised') @@ -2910,9 +2910,17 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) CASE ("heat") MeltVals(MeltPerm(nn)) = ABS( 1.0e6 * HeatVals(HeatPerm(nn)) ) / ( WtVals(WtPerm(nn)) * rho_fw * LatHeat ) CASE ("friction") - Ub = (UbVals(2*(UbPerm(nn)-1)+1)**2 + UbVals(2*(UbPerm(nn)-1)+2)**2)**0.5 +! Ub = (UbVals(2*(UbPerm(nn)-1)+1)**2 + UbVals(2*(UbPerm(nn)-1)+2)**2)**0.5 ! Ub(1:1) = ListGetReal( Material, 'Sliding Velocity', 1, [nn], Found, UnfoundFatal = .TRUE. ) - MeltVals(MeltPerm(nn)) = (Ub(1)**2 * CeffVals(CeffPerm(nn)) ) / ( rho_fw * LatHeat ) + IF (UbVar % DOFS .EQ. 2) THEN + Ub = (UbVals(2*(UbPerm(nn)-1)+1)**2 + UbVals(2*(UbPerm(nn)-1)+2)**2)**0.5 + ELSE IF (UbVar % DOFS .EQ. 3) THEN + Ub = (UbVals(3*(UbPerm(nn)-1)+1)**2 + UbVals(3*(UbPerm(nn)-1)+2)**2 + UbVals(3*(UbPerm(nn)-1)+3)**2)**0.5 + ELSE + CALL Fatal(MyName, 'Expecting Ub variable to be 2D or 3D') + END IF + + MeltVals(MeltPerm(nn)) = (Ub**2 * CeffVals(CeffPerm(nn)) ) / ( rho_fw * LatHeat ) END SELECT IF (UseGHF) THEN From 03c0035bb6b04c724e66bf451e4fee8977b84373 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 30 Oct 2024 22:04:44 +0200 Subject: [PATCH 45/51] tweaking adaptive timestepping info statements --- fem/src/ElmerSolver.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/fem/src/ElmerSolver.F90 b/fem/src/ElmerSolver.F90 index 1cf4cc98dd..961e673693 100644 --- a/fem/src/ElmerSolver.F90 +++ b/fem/src/ElmerSolver.F90 @@ -3196,7 +3196,9 @@ SUBROUTINE ExecSimulation(TimeIntervals, CoupledMinIter, & StepControl = -1 END IF - WRITE(*,'(a,3e20.12)') 'Adaptive(cum,ddt,err): ', cumtime, ddt, maxerr + WRITE(Message,'(a,3e20.12)') 'Adaptive(cum,ddt,err): ', cumtime, ddt, maxerr + CALL Info(Caller,Message,Level=12) + END DO sSize(1) = dt sTime(1) = s + dt From 797cae6e49132bb8d38ec11ee37741d4362e2694 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 13 Nov 2024 11:42:51 +0200 Subject: [PATCH 46/51] reduced info level of adaptivity info from 12 to 7 --- fem/src/ElmerSolver.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/fem/src/ElmerSolver.F90 b/fem/src/ElmerSolver.F90 index 961e673693..aafae05ba8 100644 --- a/fem/src/ElmerSolver.F90 +++ b/fem/src/ElmerSolver.F90 @@ -3068,7 +3068,7 @@ SUBROUTINE ExecSimulation(TimeIntervals, CoupledMinIter, & IF( .NOT. ASSOCIATED( Solver % Variable ) ) CYCLE IF( .NOT. ASSOCIATED( Solver % Variable % Values ) ) CYCLE - CALL Info(Caller,'Allocating adaptive work space for: '//I2S(i),Level=12) + CALL Info(Caller,'Allocating adaptive work space for: '//I2S(i),Level=7) j = SIZE( Solver % Variable % Values ) ALLOCATE( AdaptVars(i) % Var % Values( j ), STAT=AllocStat ) IF( AllocStat /= 0 ) CALL Fatal(Caller,'Allocation error AdaptVars Values') @@ -3093,7 +3093,7 @@ SUBROUTINE ExecSimulation(TimeIntervals, CoupledMinIter, & ! If the next timestep will not get us home but the next one would ! then split the timestep equally into two parts. IF( dt - CumTime - ddt > 1.0d-12 ) THEN - CALL Info(Caller,'Splitted timestep into two equal parts',Level=12) + CALL Info(Caller,'Splitted timestep into two equal parts',Level=7) ddt = MIN( ddt, ( dt - CumTime ) / 2.0_dp ) END IF END IF @@ -3197,7 +3197,7 @@ SUBROUTINE ExecSimulation(TimeIntervals, CoupledMinIter, & END IF WRITE(Message,'(a,3e20.12)') 'Adaptive(cum,ddt,err): ', cumtime, ddt, maxerr - CALL Info(Caller,Message,Level=12) + CALL Info(Caller,Message,Level=7) END DO sSize(1) = dt From 1ef1cce5c3dea7f20803ab96877561adc1b87d06 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 13 Nov 2024 11:59:26 +0200 Subject: [PATCH 47/51] Allow 4D flow solution to be passed to grounded melt solver (ignores 4th dimension, assumed to be pressure) --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index eaca00e0b7..26cdeacb56 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -2916,8 +2916,11 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) Ub = (UbVals(2*(UbPerm(nn)-1)+1)**2 + UbVals(2*(UbPerm(nn)-1)+2)**2)**0.5 ELSE IF (UbVar % DOFS .EQ. 3) THEN Ub = (UbVals(3*(UbPerm(nn)-1)+1)**2 + UbVals(3*(UbPerm(nn)-1)+2)**2 + UbVals(3*(UbPerm(nn)-1)+3)**2)**0.5 + ELSE IF (UbVar % DOFS .EQ. 4) THEN + Ub = (UbVals(4*(UbPerm(nn)-1)+1)**2 + UbVals(4*(UbPerm(nn)-1)+2)**2 + UbVals(4*(UbPerm(nn)-1)+3)**2)**0.5 + CALL INFO(MyName, 'Sliding velocity is 4D. Ignoring 4th dimension.', level=5 ) ELSE - CALL Fatal(MyName, 'Expecting Ub variable to be 2D or 3D') + CALL Fatal(MyName, 'Expecting Ub variable to be 2D or 3D (or 4D flow solution)') END IF MeltVals(MeltPerm(nn)) = (Ub**2 * CeffVals(CeffPerm(nn)) ) / ( rho_fw * LatHeat ) From 7cd61d8be12ffb7170c325e0fa97fa5ec4f6df53 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 13 Nov 2024 12:10:53 +0200 Subject: [PATCH 48/51] Committing Yu Wang's option to use regularised Coulomb sliding in SSA optimisations --- .../AdjointSSA/AdjointSSA_GradientSolver.F90 | 22 ++++++++++++++----- 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/elmerice/Solvers/AdjointSSA/AdjointSSA_GradientSolver.F90 b/elmerice/Solvers/AdjointSSA/AdjointSSA_GradientSolver.F90 index 318a2eb71d..422821a947 100644 --- a/elmerice/Solvers/AdjointSSA/AdjointSSA_GradientSolver.F90 +++ b/elmerice/Solvers/AdjointSSA/AdjointSSA_GradientSolver.F90 @@ -155,7 +155,7 @@ SUBROUTINE AdjointSSA_GradientSolver( Model,Solver,dt,TransientSimulation ) NodalEtaDer(:),NodalBetaDer(:) INTEGER :: iFriction - REAL(KIND=dp) :: fm + REAL(KIND=dp) :: fm,U0 CHARACTER(LEN=MAX_NAME_LEN) :: Friction CHARACTER(LEN=MAX_NAME_LEN) :: SolverName='AdjointSSA_GradientSolver' #ifdef USE_ISO_C_BINDINGS @@ -406,8 +406,10 @@ SUBROUTINE AdjointSSA_GradientSolver( Model,Solver,dt,TransientSimulation ) fm = 1.0_dp CASE('weertman') iFriction = 2 + CASE('regularized coulomb') + iFriction = 3 CASE DEFAULT - CALL FATAL(SolverName,'Friction should be linear or Weertman') + CALL FATAL(SolverName,'Friction should be linear or Weertman or regularized coulomb') END SELECT @@ -420,6 +422,11 @@ SUBROUTINE AdjointSSA_GradientSolver( Model,Solver,dt,TransientSimulation ) LocalLinVelo(1:n) = ListGetReal(Material, 'SSA Friction Linear Velocity', n, NodeIndexes,UnFoundFatal=.TRUE.) END IF + IF (iFriction == 3) THEN + U0 = ListGetConstReal( Material, 'SSA Friction Threshold Velocity', Found, UnFoundFatal=.TRUE.) + END IF + + IF (SEP) THEN NodalGM(1:n)=GMSol%Values(GMSol%Perm(NodeIndexes(1:n))) NodalBed(1:n)=BedrockSol%Values(BedrockSol%Perm(NodeIndexes(1:n))) @@ -689,7 +696,7 @@ SUBROUTINE LocalMatrixUVSSA( STIFF, FORCE, Element, n, Nodes, gravity, & END DO !i END DO !p - IF ((iFriction == 2).AND.(fm==1.0_dp)) iFriction=1 + IF ((iFriction == 2).AND.(fm==1.0_dp)) iFriction=1 !linear IF (iFriction > 1) THEN LinVelo = SUM( LocalLinVelo(1:n) * Basis(1:n) ) Velo = 0.0_dp @@ -699,7 +706,11 @@ SUBROUTINE LocalMatrixUVSSA( STIFF, FORCE, Element, n, Nodes, gravity, & IF (ub < LinVelo) then ub = LinVelo ENDIF - betab = betab * ub**(fm-1.0_dp) + IF (iFriction == 2) THEN !Weertman + betab = betab * ub**(fm-1.0_dp) + ELSE IF (iFriction == 3) THEN !regularized coulomb + betab = betab * ub**(fm-1.0_dp) / (ub + U0)**fm + END IF END IF IF (SEP) THEN @@ -833,5 +844,4 @@ SUBROUTINE LocalMatrixBCSSA( STIFF, FORCE, Element, n, ENodes, Density, & !------------------------------------------------------------------------------ END SUBROUTINE LocalMatrixBCSSA -END SUBROUTINE AdjointSSA_GradientSolver - +END SUBROUTINE AdjointSSA_GradientSolver \ No newline at end of file From d5f1b2072ef40e94202b6b61c6518a6d770f36c8 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Mon, 23 Dec 2024 11:08:57 +0200 Subject: [PATCH 49/51] resolve minor merge error in GroundedSolver.F90 --- elmerice/Solvers/GroundedSolver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index f27b36ab19..d3516310fd 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -121,8 +121,8 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) TYPE(Variable_t), POINTER :: PointerToVariable, bedrockVar, FrontVar, LSvar, ConnMaskVar TYPE(Nodes_t), SAVE :: Nodes - LOGICAL :: AllocationsDone = .FALSE., GotIt, stat,UnFoundFatal=.TRUE.,& - AllGrounded = .FALSE., useLSvar = .FALSE., Active & + LOGICAL :: AllocationsDone = .FALSE., GotIt, stat, UnFoundFatal=.TRUE.,& + AllGrounded = .FALSE., useLSvar = .FALSE., Active, & CheckConn ! check ocean connectivity (creates separate mask without isolated ungrounded regions) INTEGER :: ii, mn, en, t, Nn, istat, DIM, MSum, ZSum, bedrockSource, ConnectivityMode From 25fff6c161b8729381049184274d972f955581a3 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Thu, 6 Feb 2025 10:59:00 +0200 Subject: [PATCH 50/51] Debug MeshUtils change re InDofs. --- fem/src/MeshUtils.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fem/src/MeshUtils.F90 b/fem/src/MeshUtils.F90 index 9c25264135..a0f27907b6 100644 --- a/fem/src/MeshUtils.F90 +++ b/fem/src/MeshUtils.F90 @@ -3042,10 +3042,10 @@ SUBROUTINE NonNodalElements() IF (LEN_TRIM(Model % Solvers(s) % Mesh % Name) > 0) THEN IF(TRIM(Model % Solvers(s) % Mesh % Name) .NE. TRIM(TargetMesh(2:))) THEN CYCLE - ELSE - inDofs(j,i) = MAX(Indofs(j,i),MAXVAL(Model % Solvers(s) % Def_Dofs(j,:,i))) END IF END IF + ELSE + inDofs(j,i) = MAX(Indofs(j,i),MAXVAL(Model % Solvers(s) % Def_Dofs(j,:,i))) END IF END DO END DO From 41907731df960eb3b8f9b4b76ae62cafdde1d1d7 Mon Sep 17 00:00:00 2001 From: RupertGladstone Date: Wed, 12 Feb 2025 16:49:13 +0200 Subject: [PATCH 51/51] Additional optional hydrology-based checks for calculating grounded melt --- elmerice/Solvers/GlaDSCoupledSolver.F90 | 46 +++++++++++++++++++++---- 1 file changed, 40 insertions(+), 6 deletions(-) diff --git a/elmerice/Solvers/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 26cdeacb56..ae80c29f34 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -2817,18 +2817,20 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) ! Local variables !------------------------------------------------------------------------------ TYPE(ValueList_t), POINTER :: SolverParams, Material - TYPE(Variable_t), POINTER :: MeltVar, WeightsVar, HeatVar, GHFVar, Ceffvar, UbVar + TYPE(Variable_t), POINTER :: MeltVar, WeightsVar, HeatVar, GHFVar, Ceffvar, UbVar, SheetVar, NVar LOGICAL, SAVE :: FirstTime = .TRUE., UseGHF = .FALSE. - LOGICAL :: Found + LOGICAL :: Found, WaterSheetSwitch, EffectivePressureSwitch CHARACTER(LEN=MAX_NAME_LEN) :: MyName = 'Grounded Melt solver', HeatVarName, WeightsVarName, GHFvarName - CHARACTER(LEN=MAX_NAME_LEN) :: MeltMode, CeffVarName, UbVarName + CHARACTER(LEN=MAX_NAME_LEN) :: MeltMode, CeffVarName, UbVarName, WaterSheetName, EffectivePressureName REAL(KIND=dp) :: rho_fw ! density of fresh water REAL(KIND=dp),PARAMETER :: threshold = 0.001_dp ! threshold friction melt rate for including GHF in melt calc REAL(KIND=dp), POINTER :: WtVals(:), HeatVals(:), MeltVals(:), GHFVals(:), Ceffvals(:), UbVals(:) - REAL(KIND=dp) :: LatHeat, GHFscaleFactor, Ub + REAL(KIND=dp), POINTER :: SheetVals(:), NVals(:) + REAL(KIND=dp) :: LatHeat, GHFscaleFactor, Ub, WaterSheetLimit, EffectivePressureLimit INTEGER, POINTER :: WtPerm(:), HeatPerm(:), MeltPerm(:), GHFPerm(:), Ceffperm(:), UbPerm(:) + INTEGER, POINTER :: SheetPerm(:), NPerm(:) INTEGER :: nn - + rho_fw = ListGetConstReal( Model % Constants, 'Fresh Water Density', Found ) IF (.NOT.Found) CALL FATAL(MyName, 'Constant >Fresh Water Density< not found') @@ -2844,6 +2846,23 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) MeltMode = GetString(SolverParams,'Melt mode', Found) IF(.NOT.Found) CALL Fatal(MyName, '>Melt mode< not found in solver params') + WaterSheetLimit = ListGetConstReal(SolverParams,'Water Sheet Limit', WaterSheetSwitch) + WaterSheetName = "Sheet Thickness" + IF (WaterSheetSwitch) THEN + SheetVar => VariableGet(Model % Variables, WaterSheetName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + SheetVals => SheetVar%Values + SheetPerm => SheetVar%Perm + END IF + + EffectivePressureLimit = ListGetConstReal(SolverParams,'Effective Pressure Limit', EffectivePressureSwitch) + EffectivePressureName = "Effective Pressure" + IF (EffectivePressureSwitch) THEN + NVar => VariableGet(Model % Variables, EffectivePressureName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + NVals => NVar%Values + NPerm => NVar%Perm + END IF + + SELECT CASE (MeltMode) CASE ("heat") @@ -2861,6 +2880,7 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) WtPerm => WeightsVar%Perm CASE ("friction") + UbVarName = GetString(SolverParams,'Ub variable name', Found) IF (.NOT.Found) UbVarName = "SSAVelocity" CeffVarName = GetString(SolverParams,'Ceff variable name', Found) @@ -2924,6 +2944,7 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) END IF MeltVals(MeltPerm(nn)) = (Ub**2 * CeffVals(CeffPerm(nn)) ) / ( rho_fw * LatHeat ) + END SELECT IF (UseGHF) THEN @@ -2931,7 +2952,20 @@ RECURSIVE SUBROUTINE GroundedMelt( Model,Solver,Timestep,TransientSimulation ) MeltVals(MeltPerm(nn)) = MeltVals(MeltPerm(nn)) + & ( GHFVals(GHFPerm(nn))*GHFscaleFactor*1.0e6 ) / ( rho_fw*LatHeat ) END IF - END IF + + IF (WaterSheetSwitch) THEN + IF (SheetVals(SheetPerm(nn)) .GT. WaterSheetLimit) THEN + MeltVals(MeltPerm(nn)) = 0.0 + END IF + END IF + + IF (EffectivePressureSwitch) THEN + IF (NVals(NPerm(nn)) .LT. EffectivePressureLimit) THEN + MeltVals(MeltPerm(nn)) = 0.0 + END IF + END IF + + END IF END DO LoopAllNodes