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 diff --git a/elmerice/Solvers/CMakeLists.txt b/elmerice/Solvers/CMakeLists.txt index 9b0563ba77..8a9bf2c586 100644 --- a/elmerice/Solvers/CMakeLists.txt +++ b/elmerice/Solvers/CMakeLists.txt @@ -4,27 +4,27 @@ SET(WITH_ScatteredDataInterpolator FALSE CACHE BOOL "Include ElmerIce ScatteredD MARK_AS_ADVANCED(WITH_ScatteredDataInterpolator) # ---------------------- # -# -- netCDF libraries -- # +# -- NetCDF libraries -- # #----------------------- # MESSAGE(STATUS "------------------------------------------------") -MESSAGE(STATUS "Elmer/Ice package: Looking for [netCDF] & [netCDF Fortran] libraries") +MESSAGE(STATUS "Elmer/Ice package: Looking for [NetCDF] & [NetCDF Fortran] libraries") -FIND_PACKAGE(NETCDF MODULE) +FIND_PACKAGE(NetCDF) -IF(NETCDF_FOUND) +IF(NetCDF_FOUND) SET(HAVE_NETCDF TRUE) MARK_AS_ADVANCED(HAVE_NETCDF) - INCLUDE_DIRECTORIES(${NETCDF_INCLUDE_DIR}) + INCLUDE_DIRECTORIES(${NetCDF_INCLUDE_DIR}) ADD_DEFINITIONS(-DHAVE_NETCDF) - MESSAGE(STATUS " netCDF: " "${NETCDF_FOUND}") - MESSAGE(STATUS " netCDF_INC: " "${NETCDF_INCLUDE_DIR}") - MESSAGE(STATUS " netCDF_LIBS: " "${NETCDF_LIBRARIES}") + MESSAGE(STATUS " NetCDF: " "${NetCDF_FOUND}") + MESSAGE(STATUS " NetCDF_INC: " "${NetCDF_INCLUDE_DIR}") + MESSAGE(STATUS " NetCDF_LIBS: " "${NetCDF_LIBRARIES}") ELSE() - MESSAGE(STATUS "Library not found: netCDF ") - MESSAGE(WARNING " \n Missing: , , \n some functionalities will be disabled") -ENDIF() + MESSAGE(STATUS "Library not found: >NetCDF_FOUND< ") + MESSAGE(WARNING " \n Missing: >NetCDF_INCLUDE_DIR< , >NetCDF_LIBRARY<, >NetCDFF_LIBRARY< \n some functionalities will be disabled") +ENDIF(NetCDF_FOUND) # ---------------------- # # -- HDF5 libraries -- # @@ -60,40 +60,40 @@ ENDIF() SET(CMAKE_Fortran_MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/fmodules CACHE PATH "Directory for Fortran modules") -SET(ElmerIce_SRC ElmerIceUtils.F90 AIFlowSolve_nlD2.F90 AIFlowSolve_nlS2.F90 - CaffeSolver.F90 ComputeDevStress.F90 ComputeEigenValues.F90 - ComputeNormal.F90 ComputeStrainRate.F90 DeformationalHeat.F90 - EPLSolver.F90 FabricSolve.F90 Flowdepth.F90 - ForceToStress.F90 GetHydrostaticLoads.F90 GolfLaw.F90 - GroundedSolver.F90 IntegratedVelocity.F90 IDSSolver.F90 - PorousSolve.F90 pointwise.F90 SIASolver.F90 SSASolver.F90 - ThicknessSolver.F90 TemperateIce.F90 ExportVertically.F90 - AdjointSolver.F90 DJDBeta_Adjoint.F90 DJDmu_Adjoint.F90 - CostSolver_Adjoint.F90 DJDBeta_Robin.F90 DJDmu_Robin.F90 - CostSolver_Robin.F90 m1qn3.F Grid2DInterpolator.F90 +SET(ElmerIce_SRC ElmerIceUtils.F90 AIFlowSolve_nlD2.F90 AIFlowSolve_nlS2.F90 + CaffeSolver.F90 ComputeDevStress.F90 ComputeEigenValues.F90 + ComputeNormal.F90 ComputeStrainRate.F90 DeformationalHeat.F90 + EPLSolver.F90 FabricSolve.F90 Flowdepth.F90 + ForceToStress.F90 GetHydrostaticLoads.F90 GolfLaw.F90 + GroundedSolver.F90 IntegratedVelocity.F90 IDSSolver.F90 + PorousSolve.F90 pointwise.F90 SIASolver.F90 SSASolver.F90 + ThicknessSolver.F90 TemperateIce.F90 ExportVertically.F90 + AdjointSolver.F90 DJDBeta_Adjoint.F90 DJDmu_Adjoint.F90 + CostSolver_Adjoint.F90 DJDBeta_Robin.F90 DJDmu_Robin.F90 + CostSolver_Robin.F90 m1qn3.F Grid2DInterpolator.F90 Optimize_m1qn3Parallel.F90 OutputStrainHeating.F90 UpdateExport.F90 IntegrateVertically.F90 EnthalpySolver.F90 SubShelfMelt.F90 ./Adjoint/Adjoint_LinearSolver.F90 ./Adjoint/Adjoint_CostDiscSolver.F90 - ./Adjoint/Adjoint_CostContSolver.F90 ./Adjoint/Adjoint_CostRegSolver.F90 + ./Adjoint/Adjoint_CostContSolver.F90 ./Adjoint/Adjoint_CostRegSolver.F90 ./Adjoint/Adjoint_GradientValidation.F90 - ./AdjointStokes/AdjointStokes_GradientMu.F90 - ./AdjointStokes/AdjointStokes_GradientBetaSolver.F90 + ./AdjointStokes/AdjointStokes_GradientMu.F90 + ./AdjointStokes/AdjointStokes_GradientBetaSolver.F90 ./AdjointSSA/AdjointSSA_AdjointSolver.F90 ./AdjointSSA/AdjointSSA_CostDiscSolver.F90 ./AdjointSSA/AdjointSSA_CostRegSolver.F90 ./AdjointSSA/AdjointSSA_SSASolver.F90 ./AdjointSSA/AdjointSSA_CostContSolver.F90 ./AdjointSSA/AdjointSSA_CostFluxDivSolver.F90 ./AdjointSSA/AdjointSSA_CostTaubSolver.F90 - ./AdjointSSA/AdjointSSA_GradientSolver.F90 + ./AdjointSSA/AdjointSSA_GradientSolver.F90 ./AdjointThickness/AdjointThickness_GradientSolver.F90 ./AdjointThickness/AdjointThickness_ThicknessSolver.F90 ./Permafrost/PermafrostMaterials.F90 ./Permafrost/Permafrost_Utils.F90 ./Permafrost/Permafrost_HTEQ.F90 ./Permafrost/Permafrost_Darcy.F90 ./Permafrost/Permafrost_solute.F90 ./Permafrost/Permafrost_solid.F90 SurfaceBoundaryEnthalpy.F90 - Calving.F90 FrontDisplacement.F90 - TwoMeshes.F90 ProjectCalving.F90 ComputeCalvingNormal.F90 + Calving.F90 FrontDisplacement.F90 + TwoMeshes.F90 ProjectCalving.F90 ComputeCalvingNormal.F90 CalvingGeometry.F90 Calving3D.F90 Calving3D_lset.F90 CalvingGlacierAdvance3D.F90 CalvingRemesh.F90 - CalvingFrontAdvance3D.F90 Emergence.F90 SSAmask.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 + BasalMelt3D.F90 CalvingHydroInterp.F90 HydroRestart.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) @@ -123,7 +123,7 @@ ENDIF() ADD_LIBRARY(ElmerIceSolvers SHARED ${ElmerIce_SRC}) # Library object -SET_TARGET_PROPERTIES(ElmerIceSolvers PROPERTIES PREFIX "") +SET_TARGET_PROPERTIES(ElmerIceSolvers PROPERTIES PREFIX "") SET_TARGET_PROPERTIES(ElmerIceSolvers PROPERTIES LINKER_LANGUAGE Fortran LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/fem/src/modules @@ -137,7 +137,7 @@ ENDIF() TARGET_LINK_LIBRARIES(ElmerIceSolvers Elmer::MPI_Fortran elmersolver ElmerIceUtils) IF(HAVE_NETCDF) - TARGET_LINK_LIBRARIES(ElmerIceSolvers ${NETCDF_LIBRARIES}) +TARGET_LINK_LIBRARIES(ElmerIceSolvers ${NETCDF_LIBRARIES}) ENDIF() IF(HAVE_HDF5) TARGET_LINK_LIBRARIES(ElmerIceSolvers ${PHDF5_LIBRARIES}) @@ -164,6 +164,6 @@ INSTALL(TARGETS ElmerIceSolvers LIBRARY DESTINATION "share/elmersolver/lib" IF(HAVE_NETCDF) ADD_SUBDIRECTORY(GridDataReader) ENDIF() -IF(WITH_ScatteredDataInterpolator) +IF(WITH_ScatteredDataInterpolator) ADD_SUBDIRECTORY(ScatteredDataInterpolator) ENDIF() diff --git a/elmerice/Solvers/Calving3D.F90 b/elmerice/Solvers/Calving3D.F90 index 38601b81fc..0f519c1bd4 100644 --- a/elmerice/Solvers/Calving3D.F90 +++ b/elmerice/Solvers/Calving3D.F90 @@ -361,6 +361,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,& @@ -826,6 +833,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 !---------------------------------------------------- @@ -1728,6 +1736,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 3ea3e308b7..0ce57f0541 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)) @@ -1499,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 @@ -2407,8 +2432,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..e9a188b3f6 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 @@ -592,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 @@ -605,6 +623,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 +631,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) @@ -627,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) @@ -637,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/CalvingRemesh.F90 b/elmerice/Solvers/CalvingRemesh.F90 index c0edcf350c..ba4dc46a1d 100644 --- a/elmerice/Solvers/CalvingRemesh.F90 +++ b/elmerice/Solvers/CalvingRemesh.F90 @@ -1004,6 +1004,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/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/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/GlaDSCoupledSolver.F90 b/elmerice/Solvers/GlaDSCoupledSolver.F90 index 576147f56b..46726c548c 100644 --- a/elmerice/Solvers/GlaDSCoupledSolver.F90 +++ b/elmerice/Solvers/GlaDSCoupledSolver.F90 @@ -72,13 +72,15 @@ 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, & + GroundedMaskVar, HydPotVar TYPE(Mesh_t), POINTER :: Mesh 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, & @@ -95,17 +97,24 @@ 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 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. + MinHBool=.FALSE., CycleNode=.FALSE. + LOGICAL, SAVE :: UseGM, AllowSheetAtGL, 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(:,:), & @@ -152,7 +161,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 @@ -185,7 +194,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 !------------------------------------------------------------------------------ @@ -293,11 +302,11 @@ RECURSIVE SUBROUTINE GlaDSCoupledsolver( Model,Solver,Timestep,TransientSimulati AllocationsDone = .TRUE. END IF - + SolverParams => GetSolverParams() !------------------------------------------------------------------------------ ! Read physical and numerical constants and initialize !------------------------------------------------------------------------------ - IF (FirstTime) THEN + IfFirstTime: IF (FirstTime) THEN FirstTime = .FALSE. Constants => GetConstants() @@ -340,42 +349,79 @@ 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. - IF(Calving) THEN + + ! 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 section 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 + + IF (UseGM) THEN + MaskName = GetString( SolverParams, 'Mask Name', Found ) + IF (.NOT. Found) THEN + MaskName = "GroundedMask" + END IF + END IF + + AllowSheetAtGL = GetLogical( SolverParams,'Allow Sheet At GL', Found ) + IF (.NOT. Found) THEN + AllowSheetAtGL = .TRUE. + 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 + + IfCalving: 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 +430,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 IfCalving ! TODO : implement higher order BDF method BDForder = GetInteger(GetSimulation(),'BDF Order', Found) @@ -408,9 +454,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 - - SolverParams => GetSolverParams() + END IF IfFirstTime NeglectH = GetLogical( SolverParams,'Neglect Sheet Thickness in Potential', Found ) IF ( .NOT.Found ) THEN @@ -477,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 @@ -565,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 @@ -1045,7 +1093,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 @@ -1074,44 +1122,32 @@ 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) THEN + ! Cycle elements with ungrounded nodes and zero all hydrology variables CycleElement = .FALSE. - WorkVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - WorkVar2 => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(WorkVar)) 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 - 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(WorkVar2) .AND. .NOT. ASSOCIATED(WorkVar)) THEN - DO i=1, N - IF(WorkVar2 % Values(WorkVar2 % 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 + + DO i=1, N + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, 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 + IF (CycleElement) THEN + CYCLE END IF - NULLIFY(WorkVar, WorkVar2) - IF(CycleElement) CYCLE - END IF + END IF CALL GetParametersSheet( Element, Material, N, SheetConductivity, alphas, & betas, Ev, ub, Snn, lr, hr, Ar, ng ) @@ -1143,13 +1179,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 @@ -1160,53 +1194,37 @@ 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) IF (k==0) CYCLE - !CHANGE - !If calving, cycle elements with ungrounded nodes and zero all - !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 - 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 - 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 - ThickSolution(k) = 0.0 - ThickPrev(k,1) = 0.0 - CycleElement = .TRUE. - END IF - NULLIFY(WorkVar, WorkVar2) - IF(CycleElement) CYCLE - END IF - IF(MaxHBool) THEN - IF (ThickSolution(k)>MaxH) THEN - ThickSolution(k) = MaxH - !ThickPrev(k,1) = 0.0 - END IF + CycleNode = .FALSE. + IF (UseGM) THEN + ! Cycle ungrounded nodes and zero hydrology variables + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, j) + 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(MinHBool) THEN - IF (ThickSolution(k) VariableGet(Mesh % Variables, "hydraulic potential", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) + IF(HydPotVar % Values( HydPotVar % perm(j) ).EQ.0.0) THEN + CycleNode = .TRUE. END IF + NULLIFY(HydPotVar) + END IF + IF (CycleNode) THEN + ThickSolution(k) = 0.0 + ThickPrev(k,1) = 0.0 + CYCLE END IF SELECT CASE(methodSheet) @@ -1234,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) Mesh % Edges(t) IF (.NOT.ASSOCIATED(Edge)) CYCLE IF (ParEnv % PEs > 1) THEN @@ -1255,37 +1287,30 @@ 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) THEN + ! Cycle ungrounded nodes and zero hydrology variables CycleElement = .FALSE. - WorkVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - WorkVar2 => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(WorkVar)) 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 - CycleElement = .TRUE. - AreaSolution(AreaPerm(M+t)) = 0.0 - QcSolution(QcPerm(M+t)) = 0.0 - !END IF - END IF - END DO - END IF - IF(ASSOCIATED(WorkVar2) .AND. .NOT. ASSOCIATED(WorkVar)) THEN - DO i=1,n - IF(WorkVar2 % Values(WorkVar2 % 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 + DO i=1, n + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, 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 + ! TODO: + ! The folowing two lines were commented to prevent GL retreat causing instant channel closure. + ! But we need a better solution to this (extrapolate channels from grounded to floating?). + !AreaSolution(AreaPerm(M+t)) = 0.0 + !QcSolution(QcPerm(M+t)) = 0.0 + CYCLE END IF - NULLIFY(WorkVar, WorkVar2) - IF(CycleElement) 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)) @@ -1405,8 +1430,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 @@ -1451,7 +1476,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 !-------------------------------------------------------------------------------------------- @@ -1471,7 +1497,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 @@ -1496,43 +1522,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) THEN + ! Cycle ungrounded nodes and zero hydrology variables CycleElement = .FALSE. - WorkVar => VariableGet(Mesh % Variables, "gmcheck", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - WorkVar2 => VariableGet(Mesh % Variables, "groundedmask", ThisOnly=.TRUE., UnfoundFatal=.FALSE.) - IF(ASSOCIATED(WorkVar)) 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 - 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(WorkVar2) .AND. .NOT. ASSOCIATED(WorkVar)) THEN - DO i=1,n - IF(WorkVar2 % Values(WorkVar2 % 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(WorkVar, WorkVar2) + DO i=1, n + MaskStatus = ProcessMask(MaskName, AllowSheetAtGL, 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, & @@ -1554,33 +1565,60 @@ 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. - !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 + ! 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 + +! MaskStatus_local = MASK_NONE + + NULLIFY(GroundedMaskVar) + + END FUNCTION ProcessMask + + + ! 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. !---------------------------------------------------------------------------------------------------------- @@ -2417,3 +2455,532 @@ 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 + 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(:) + INTEGER :: nn, ee, numNodes + + 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(:) + + + 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(Solver % 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(Solver % 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(Solver % 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 + 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(Solver % mesh % Variables,TRIM(MaskName),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(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(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 + cglfVals => cglfVar % Values + + ! 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 + 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 + +! 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 + + ! 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 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) THEN + GLfluxVals(GLfluxPerm(nn)) = cglfVals(cglfPerm(nn)) + sglfVals(sglfPerm(nn)) + END IF + END DO + + NULLIFY(cglfVals) + NULLIFY(sglfVals) + NULLIFY(SolverParams) + NULLIFY(GLfluxVals) + NULLIFY(GLfluxPerm) + NULLIFY(gmVals) + NULLIFY(gmPerm) + NULLIFY(sheetDisVals) + NULLIFY(sheetDisPerm) + NULLIFY(sheetThickVals) + NULLIFY(sheetThickPerm) + 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 +! 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] +! +! 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 +! +! example solver params: +! variable = GroundedMeltRate +! Mode = "heat" +! heat variable name = String "Friction Load" +! Weights variable name = String "Friction heating boundary weights" +! + +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, Material + TYPE(Variable_t), POINTER :: MeltVar, WeightsVar, HeatVar, GHFVar, Ceffvar, UbVar, SheetVar, NVar + LOGICAL, SAVE :: FirstTime = .TRUE., UseGHF = .FALSE. + LOGICAL :: Found, WaterSheetSwitch, EffectivePressureSwitch + CHARACTER(LEN=MAX_NAME_LEN) :: MyName = 'Grounded Melt solver', HeatVarName, WeightsVarName, GHFvarName + 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), 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') + 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') + + 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") + 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 + ELSE + UseGHF = .FALSE. + END IF + + IF (UseGHF) THEN + GHFVar => VariableGet(Model % Variables, GHFvarName, ThisOnly = .TRUE., UnfoundFatal = .TRUE.) + GHFVals => GHFVar%Values + GHFPerm => GHFVar%Perm + END IF + + LoopAllNodes: DO nn=1,Solver % Mesh % NumberOfNodes + + 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 ) + 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. ) + 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 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 (or 4D flow solution)') + END IF + + MeltVals(MeltPerm(nn)) = (Ub**2 * CeffVals(CeffPerm(nn)) ) / ( rho_fw * LatHeat ) + + END SELECT + + IF (UseGHF) THEN + ! 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 + + 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 + + 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 + +END SUBROUTINE GroundedMelt diff --git a/elmerice/Solvers/GroundedSolver.F90 b/elmerice/Solvers/GroundedSolver.F90 index 4f60de929e..d3516310fd 100644 --- a/elmerice/Solvers/GroundedSolver.F90 +++ b/elmerice/Solvers/GroundedSolver.F90 @@ -22,44 +22,86 @@ ! *****************************************************************************/ ! ****************************************************************************** ! * -! * 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 ! -! y is the vertical in 2D ; z is the vertical in 3D +! Rupert's notes June 2024 (TODO: integrate these into documentation): ! -! ARGUMENTS: +! Unifying Samuel's code for identifying isolated ungrounded regions with the main +! grounded mask code. ! -! TYPE(Model_t) :: Model, -! INPUT: All model information (mesh, materials, BCs, etc...) +! Aim: ! -! TYPE(Solver_t) :: Solver -! INPUT: Linear & nonlinear equation solver options +! 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 front +! BC: +! Calving Front Mask = Logical true ! -! REAL(KIND=dp) :: dt, -! INPUT: Timestep size for time dependent simulations +! 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 ! -! 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,23 +118,25 @@ 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., 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 :: 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, ConnectivityMode + 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, 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 !------------------------------------------------------------------------------ @@ -128,7 +172,40 @@ 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 + 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 + ELSE + 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) @@ -161,7 +238,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 @@ -176,7 +252,7 @@ SUBROUTINE GroundedSolver( Model,Solver,dt,TransientSimulation ) !-------------------------------------------------------------- DO t = 1, Solver % NumberOfActiveElements Element => GetActiveElement(t) - n = GetElementNOFNodes() + en = GetElementNOFNodes() IF(.NOT. AllGrounded) THEN @@ -184,26 +260,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 @@ -213,25 +288,45 @@ 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) THEN + SELECT CASE(ConnectivityMode) + + CASE(INLAND) + ConnMaskVar % Values = 1.0_dp + CALL BoundaryConn (INLAND) + + CASE(FRONT) + ConnMaskVar % Values = 1.0_dp + CALL BoundaryConn (FRONT) + + CASE(COMBINED) + ConnMaskVar % Values = 1.0_dp + CALL BoundaryConn (INLAND) + CALL BoundaryConn (FRONT) + + END SELECT + END IF !-------------------------------------------------------------- ! Grounding line loop to label grounded points at grounding Line. @@ -243,78 +338,289 @@ 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)) + ZSum = 0 + 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 .AND. Active) CALL ParallelSumVector( Solver % Matrix, VariableValues, 1 ) - - 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 + IF (CheckConn) THEN + IF ( ParEnv % PEs>1 .AND. Active) CALL ParallelSumVector( Solver % Matrix, ConnMaskVar % Values, OPER_MIN ) + END IF + IF ( ParEnv % PEs>1 .AND. Active) CALL ParallelSumVector( Solver % Matrix, VariableValues, OPER_MIN ) - CHARACTER(LEN=MAX_NAME_LEN) :: SolverName = 'GroundedSolverInit' + CALL INFO( SolverName , 'Done') + +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). + ! * + ! * 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@unil.ch, RupertGladstone1972@gmail.com + ! * Web: http://www.csc.fi/elmer + ! * Address: CSC - IT Center for Science Ltd. + ! * Keilaranta 14 + ! * 02101 Espoo, Finland + ! * + ! * Original Date: 08.2019 + ! * + ! ****************************************************************************/ + SUBROUTINE BoundaryConn (BoundaryLabel) + USE Types + USE CoordinateSystems + USE DefUtils + USE ElementDescription + USE CalvingGeometry + + IMPLICIT NONE - CALL FATAL( SolverName, 'This solver is deprecated due to code redundancy, & - please GroundedSolver instead' ) + INTEGER, INTENT(IN) :: BoundaryLabel + + !----------------------------------- + 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) :: SMeltRate, WMeltRate, SStart, SStop, ScaleFactor, & + TotalArea, TotalBMelt, ElemBMelt, s, t, season, threshold, & + 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, AboveThreshold + CHARACTER(LEN=MAX_NAME_LEN) :: SolverName, GMaskVarName, FrontMaskName, OutfileName, mode + + Debug = .FALSE. + + SolverName = "Grounded mask connectivity" + Mesh => Solver % Mesh + + !Identify nodes on the front + SELECT CASE (BoundaryLabel) + CASE(INLAND) + FrontMaskName = "Inland Boundary Mask" + Threshold = 0.5_dp + AboveThreshold = .TRUE. + ScaleFactor = -1.0_dp + CASE(FRONT) + FrontMaskName = "Calving Front Mask" + Threshold = -0.5_dp + AboveThreshold = .FALSE. + ScaleFactor = 1.0_dp + END SELECT + 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!") -!------------------------------------------------------------------------------ -END SUBROUTINE GroundedSolverInit -!------------------------------------------------------------------------------ + NoNodes = COUNT(ConnMaskPerm > 0) + GroundedVar => Solver % Variable + + !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, & + threshold, FloatGroups, AboveThreshold) + + !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 + CurrentGroup => FloatGroups + DO WHILE(ASSOCIATED(CurrentGroup)) + IF(CurrentGroup % FrontConnected) THEN + DO ii=1,CurrentGroup % NumberOfNodes + 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)) + 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 BoundaryConn + +END SUBROUTINE GroundedSolver diff --git a/elmerice/Solvers/PlumeSolver.F90 b/elmerice/Solvers/PlumeSolver.F90 index 2f7db7bc76..a9866bcb43 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: samuel.cook@fau.de ! * Web: http://www.csc.fi/elmer ! * Address: CSC - IT Center for Science Ltd. ! * Keilaranta 14 @@ -75,7 +75,7 @@ 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 @@ -85,7 +85,7 @@ SUBROUTINE Plume (Model, Solver, dt, TransientSimulation) 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(:,:),& @@ -227,7 +227,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") - + Material => GetMaterial() SeaLevel = GetCReal(Material, 'Sea Level', Found) IF(.NOT. Found) SeaLevel = 0.0_dp @@ -400,38 +400,22 @@ 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 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 @@ -573,14 +557,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) @@ -589,6 +573,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) @@ -605,9 +597,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) @@ -629,9 +622,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 @@ -662,7 +654,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 @@ -687,7 +678,6 @@ 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(Calving .AND. TotalPlCount > 0) THEN !PRINT *, 'P7',ParEnv % myPE @@ -702,8 +692,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 @@ -730,7 +722,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; @@ -744,7 +735,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 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 086a09b763..7494a48457 100644 --- a/elmerice/Solvers/ThicknessSolver.F90 +++ b/elmerice/Solvers/ThicknessSolver.F90 @@ -714,10 +714,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 @@ -799,7 +804,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/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/elmerice/Utils/SSAMaterialModels.F90 b/elmerice/Utils/SSAMaterialModels.F90 index 2992ccc08d..b2d42f2871 100644 --- a/elmerice/Utils/SSAMaterialModels.F90 +++ b/elmerice/Utils/SSAMaterialModels.F90 @@ -45,53 +45,66 @@ 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 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 - - INTEGER :: iFriction INTEGER, PARAMETER :: LINEAR = 1 INTEGER, PARAMETER :: WEERTMAN = 2 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,U0 + 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 + LOGICAL :: Found, NeedN + + + SAVE FirstTime + + Material => GetMaterial(Element) -! Sub - element GL parameterisation + ! Allow user-named grounded mask + 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 + + ! 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. ) CALL GetLocalSolution( NodalBed,UElement=Element,UVariable= BedrockSol) END IF -! Friction law - Material => GetMaterial(Element) + ! Friction law NodeIndexes => Element % NodeIndexes Friction = ListGetString(Material, 'SSA Friction Law',Found, UnFoundFatal=.TRUE.) @@ -107,14 +120,16 @@ 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 ! 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 @@ -122,54 +137,72 @@ 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 ! where explicit dependence on effective pressure is present... + NeedN = .FALSE. SELECT CASE (iFriction) - CASE(REG_COULOMB_GAG,BUDD) + 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) + IF (.NOT. Found) THEN + IF (FirstTime) THEN + CALL INFO("SSAEffectiveFriction","> SSA Friction need N < not found, assuming false",level=3) + END IF + NeedN = .FALSE. + END IF + CASE(REG_COULOMB_GAG,REG_COULOMB_HYB,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 + 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) + END If ! parameters unique to one sliding parameterisation 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.) 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:nn) = ListGetReal( & + Material, 'SSA Friction Maximum Value', nn, NodeIndexes(1:nn), Found,& + UnFoundFatal=.TRUE.) + 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.) + END IF 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 @@ -177,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 @@ -212,13 +245,27 @@ 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 + 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 IF (PRESENT(SlipDer)) SlipDer = Slip2 * Slip * ((fm-1.0_dp) / (ub*ub) - & fm*ub**(-1.0_dp)/(ub+U0)) END SELECT - + + FirstTime = .FALSE. + END FUNCTION SSAEffectiveFriction !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -237,6 +284,8 @@ FUNCTION ComputeMeanFriction(Element,n,ElementNodes,STDOFs,NodalU,NodalV,NodalZs INTEGER :: GLnIP REAL(KIND=dp) :: sealevel,rhow + TYPE(ValueList_t), POINTER :: Material, Constants + CHARACTER(LEN=MAX_NAME_LEN) :: MaskName LOGICAL :: PartlyGroundedElement TYPE(Variable_t),POINTER :: GMSol REAL(KIND=dp) :: NodalGM(n) @@ -245,12 +294,25 @@ 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 + LOGICAL :: FirstTime = .TRUE. + + SAVE FirstTime + + ! Allow user-named grounded mask + Material => GetMaterial(Element) + 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, '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 @@ -286,6 +348,8 @@ FUNCTION ComputeMeanFriction(Element,n,ElementNodes,STDOFs,NodalU,NodalV,NodalZs strbasemag=tb/area + FirstTime = .FALSE. + END FUNCTION ComputeMeanFriction !-------------------------------------------------------------------------------- @@ -310,24 +374,36 @@ 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 + 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 + 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 ! 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)) @@ -366,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 diff --git a/fem/src/ElmerSolver.F90 b/fem/src/ElmerSolver.F90 index 44bed79a65..97d453417c 100644 --- a/fem/src/ElmerSolver.F90 +++ b/fem/src/ElmerSolver.F90 @@ -3115,7 +3115,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') @@ -3140,7 +3140,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 @@ -3243,7 +3243,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=7) + END DO sSize(1) = dt sTime(1) = s + dt diff --git a/fem/src/InterpVarToVar.F90 b/fem/src/InterpVarToVar.F90 index 8cd00ec9dc..a8cb2a9a8c 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/MeshUtils.F90 b/fem/src/MeshUtils.F90 index 837058d2d5..6fe2bfb374 100644 --- a/fem/src/MeshUtils.F90 +++ b/fem/src/MeshUtils.F90 @@ -3007,7 +3007,7 @@ SUBROUTINE NonNodalElements() INTEGER, POINTER :: EdgeDofs(:), FaceDofs(:) INTEGER :: i, j, k, k2, l, s, n, DGIndex, body_id, body_id0, eq_id, solver_id, el_id, & - mat_id + mat_id, TargetMeshIndex LOGICAL :: NeedEdges, Found, FoundDef0, FoundDef, FoundEq, GotIt, MeshDeps, & FoundEqDefs, FoundSolverDefs(Model % NumberOfSolvers), & FirstOrderElements, InheritDG, Hit, Stat, & @@ -3016,7 +3016,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() @@ -3026,16 +3026,28 @@ SUBROUTINE NonNodalElements() DGIndex = 0 - InDofs = 0 + InDofs = -1 InDofs(:,1) = 1 InDofs(:,4) = -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) + TargetMeshIndex = INDEX(Model % Solvers(s) % Mesh % Name, " ") 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(TargetMeshIndex:))) THEN + CYCLE + 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 END DO @@ -3481,6 +3493,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) @@ -21838,7 +21851,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 @@ -21857,7 +21869,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 0f7bb07ef4..29dc8a2f61 100644 --- a/fem/src/ModelDescription.F90 +++ b/fem/src/ModelDescription.F90 @@ -2709,6 +2709,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 @@ -2782,6 +2786,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 diff --git a/fem/src/SolverUtils.F90 b/fem/src/SolverUtils.F90 index 14e0d0911c..6758f21db1 100644 --- a/fem/src/SolverUtils.F90 +++ b/fem/src/SolverUtils.F90 @@ -9791,7 +9791,8 @@ SUBROUTINE InitializeTimestep( Solver ) !------------------------------------------------------------------------------ IF ( .NOT. ASSOCIATED( Solver % Matrix ) .OR. & - .NOT. ASSOCIATED( Solver % Variable % Values ) ) RETURN + .NOT. ASSOCIATED( Solver % Variable ) ) RETURN + IF ( .NOT. ASSOCIATED( Solver % Variable % Values ) ) RETURN IF ( Solver % TimeOrder <= 0 ) RETURN !------------------------------------------------------------------------------