From 0058c9f50e8d622b2582bb3eec804ed907a197da Mon Sep 17 00:00:00 2001 From: alex-huth Date: Thu, 1 Apr 2021 09:55:58 -0700 Subject: [PATCH] overall cleanup and minor updates to reflect manuscript revisions --- PROG/MPM_Procedures.F90 | 823 +++++---- PROG/MPM_SSA.F90 | 330 ++-- PROG/MPM_Utils.F90 | 1516 +++++++++-------- README.md | 19 +- mismip/damage/README | 2 +- mismip/damage/mismip_creep.sif | 182 +- mismip/damage/mismip_zs.sif | 169 +- mismip/damage/mismip_zs_mod.sif | 169 +- mismip/half_MISMIP_500_orig.grd | 19 +- mismip/steady/README | 2 +- mismip/steady/mismip_makerestart.sif | 20 +- mismip/steady/mismip_steady.sif | 173 +- test1d/README | 2 +- test1d/{Test1D_5km.grd => Test1D_0.625km.grd} | 4 +- test1d/Test1D_1.25km.grd | 25 + test1d/Test1D_5km/mesh.boundary | 182 -- test1d/Test1D_5km/mesh.elements | 90 - test1d/Test1D_5km/mesh.header | 4 - test1d/Test1D_5km/mesh.nodes | 182 -- test1d/USF_1dtest.F90 | 19 +- test1d/frontprop1d/RUN.sh | 42 +- test1d/frontprop1d/frontprop1d.sif | 141 +- test1d/steady1d/RUN.sh | 47 +- test1d/steady1d/steady1d.sif | 182 +- test2d/README | 2 +- test2d/USF_hoop.F90 | 14 +- test2d/hooptest_smpm.sif | 174 +- 27 files changed, 2223 insertions(+), 2311 deletions(-) rename test1d/{Test1D_5km.grd => Test1D_0.625km.grd} (91%) create mode 100644 test1d/Test1D_1.25km.grd delete mode 100644 test1d/Test1D_5km/mesh.boundary delete mode 100644 test1d/Test1D_5km/mesh.elements delete mode 100644 test1d/Test1D_5km/mesh.header delete mode 100644 test1d/Test1D_5km/mesh.nodes diff --git a/PROG/MPM_Procedures.F90 b/PROG/MPM_Procedures.F90 index e7b6c15..fcb2e37 100644 --- a/PROG/MPM_Procedures.F90 +++ b/PROG/MPM_Procedures.F90 @@ -15,7 +15,15 @@ SUBROUTINE MPM_Initialize( Model,Solver,dt,TransientSimulation ) TYPE(Mesh_t), POINTER :: Mesh INTEGER :: dim TYPE(Particle_t), POINTER :: Particles - CHARACTER(LEN=MAX_NAME_LEN) :: SolverName + CHARACTER(LEN=MAX_NAME_LEN) :: SolverName + REAL(KIND=dp) :: Basis(4), dBasisdx(4,3), ddBasisddx(4,3,3), detJ + TYPE(Element_t), POINTER :: Element + INTEGER :: nn,j,t,np,ind,No + LOGICAL :: GotIt,uplag=.FALSE. + LOGICAL :: stat + TYPE(GaussIntegrationPoints_t) :: IP + TYPE(Nodes_t) :: Nodes + INTEGER, POINTER :: NodeIndexes(:) #ifdef USE_ISO_C_BINDINGS REAL(KIND=dp) :: starttime @@ -23,7 +31,7 @@ SUBROUTINE MPM_Initialize( Model,Solver,dt,TransientSimulation ) REAL(KIND=dp) :: starttime #endif - WRITE(SolverName, '(A)') 'MPM_Initialize' + WRITE(SolverName, '(A)') 'MPM_Initialize' Particles => GlobalParticles dim = CoordinateSystemDimension() @@ -53,6 +61,52 @@ SUBROUTINE MPM_Initialize( Model,Solver,dt,TransientSimulation ) CALL GetElemParticles_sMPM(Particles, Model ) END IF + UpLag = ListGetLogical(Solver % Values,'UpLag',GotIt) + IF (UpLag) THEN + PRINT *,'INITIAL UPLAG LAG PARTICLE UPDATES' + Mesh => GetMesh() + Particles % uplag = .TRUE. + + Element => Solver % Mesh % Elements(1) + nn = Element % TYPE % NumberOfNodes + ALLOCATE( Nodes % x(nn), Nodes % y(nn), Nodes % z(nn)) + + Do t=1,Solver % Mesh % NumberOfBulkElements + + Element => Solver % Mesh % Elements(t) + IF ( Element % TYPE % NumberOfNodes .NE. nn) CYCLE + ind = Element % ElementIndex + NodeIndexes => Element % NodeIndexes + Nodes % x(1:nn) = Solver % Mesh % Nodes % x(NodeIndexes) + Nodes % y(1:nn) = Solver % Mesh % Nodes % y(NodeIndexes) + Nodes % z(1:nn) = 0.0_dp + + IP = GaussPoints( Element , np=INT(Particles % elementfraction) ) + + DO j=1,IP % n + stat = ElementInfo( Element, Nodes, IP % U(j), IP % V(j), & + IP % W(j), detJ, Basis, dBasisdx, ddBasisddx, .FALSE. ) + + No = ElemParticles(ind) % p(j) + + Particles % Coordinate(No,1) = SUM( Basis(1:nn) * Nodes % x(1:nn) ) !IP % U(j) + Particles % Coordinate(No,2) = SUM( Basis(1:nn) * Nodes % y(1:nn) ) !IP % V(j) + Particles % PVolume(No) = IP % S(j) * detJ + Particles % GVolume(No) = IP % S(j) * detJ + + ! IF (Particles % PVolume(No) .ne. (Particles % Length(No,1) * Particles % Length(No,2))) THEN + ! print *,'Particles % PVolume(No)',Particles % PVolume(No) + ! print *,'length width',Particles % Length(No,1), Particles % Length(No,2) + ! print *,'larea',Particles % Length(No,1) * Particles % Length(No,2) + ! CALL Fatal(SolverName,'Uplag Volume Error!') + ! ENDIF + END DO + END DO + + DEALLOCATE( Nodes % x, Nodes % y, Nodes % z) + + END IF + IF (Particles % shapefunctions == 'smpm' .AND. Particles % hoop) THEN CALL Info(SolverName,'sMPM hoop: skipping initparticlevars',Level=1) ELSE @@ -69,17 +123,17 @@ END SUBROUTINE MPM_Initialize !> Update material point def grad, gimpm shape, area, position, splitting, etc SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) - USE MPMUtils + USE MPMUtils USE DefUtils USE Lists IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(ValueList_t), POINTER :: Params TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model TYPE(Nodes_t) :: ElementNodes - TYPE(Mesh_t), POINTER :: Mesh + TYPE(Mesh_t), POINTER :: Mesh REAL(KIND=dp) :: dt,rhoi, davsplitthres LOGICAL :: TransientSimulation @@ -94,18 +148,18 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) INTEGER :: maxcplength,maxstretchlength,maxstrain TYPE(Element_t), POINTER :: BulkElement - TYPE(Variable_t), POINTER :: mask + TYPE(Variable_t), POINTER :: mask INTEGER, POINTER :: maskPerm(:) REAL(KIND=dp), POINTER :: maskVal(:) !For use corner update TYPE(Element_t),Pointer :: Element - INTEGER, POINTER :: NodeIndexes(:) + INTEGER, POINTER :: NodeIndexes(:) INTEGER :: ind,nn,selem(4) REAL(KIND=dp) :: xmin,xmax,ymin,ymax,newy,newx,Coord(3),midpcoords(4,3),SqrtElementMetric,& midpvel(2),tl1,tl2,sterm,Basis(4),dBasisdx(4,3),midpcoords2(4,2) Logical :: stat,UseCorners - TYPE(Variable_t), POINTER :: GridVel=>NULL() + TYPE(Variable_t), POINTER :: GridVel=>NULL() SAVE :: gridres,maxlength,maxDPlength,numoflayers,& @@ -120,10 +174,10 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) nn = Model % Mesh % MaxElementNodes - ALLOCATE(ElementNodes % x(nn),ElementNodes % y(nn),ElementNodes % z(nn)) + ALLOCATE(ElementNodes % x(nn),ElementNodes % y(nn),ElementNodes % z(nn)) mask => VariableGet(Model % Mesh % Variables, 'Mask' ) maskPerm => mask % Perm - maskVal => mask % Values + maskVal => mask % Values gridres = Particles % gridres maxlength = Particles % maxlength @@ -138,7 +192,7 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) IF (.NOT. GotIt) UseCorners = .TRUE. IF (UseCorners) THEN - CALL Info( SolverName, 'USING GIMPM CORNER UPDATE', Level=1 ) + CALL Info( SolverName, 'USING GIMPM CORNER UPDATE', Level=1 ) END IF END IF @@ -160,13 +214,13 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) END IF END IF - CALL Info(SolverName,'Updating F, Vol, Lengths, Splitting, and Coords',Level=3) + CALL Info(SolverName,'Updating F, Vol, Lengths, Splitting, and Coords',Level=3) VisitedTimes = VisitedTimes + 1 - SplitP = .FALSE. + SplitP = .FALSE. - maxcalclength = 0.0_dp + maxcalclength = 0.0_dp mincalclength = maxlength dt = Particles % dtime @@ -207,9 +261,9 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) F(1,2) = Particles % F(No,3) F(2,1) = Particles % F(No,4) G = 0.0_dp - G(1,1) = 1.0_dp + dt * Particles % GradVel(No,1) - G(2,2) = 1.0_dp + dt * Particles % GradVel(No,2) - G(1,2) = dt * Particles % GradVel(No,3) + G(1,1) = 1.0_dp + dt * Particles % GradVel(No,1) + G(2,2) = 1.0_dp + dt * Particles % GradVel(No,2) + G(1,2) = dt * Particles % GradVel(No,3) G(2,1) = dt * Particles % GradVel(No,4) !F = MATMUL(G,F) @@ -257,7 +311,7 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) ! "CORNERS" LENGTH UPDATE (here, using midpoints shortcut) ! - Element => Mesh % Elements(ind) + Element => Mesh % Elements(ind) nn = Element % TYPE % NumberOfNodes NodeIndexes => Element % NodeIndexes xmin = MINVAL(Mesh % Nodes % x(NodeIndexes(1:nn))) @@ -324,7 +378,7 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) tl1 = MAXVAL(midpcoords(:,1))-MINVAL(midpcoords(:,1)) tl2 = MAXVAL(midpcoords(:,2))-MINVAL(midpcoords(:,2)) - detF = F(1,1)*F(2,2) - F(1,2)*F(2,1) + detF = F(1,1)*F(2,2) - F(1,2)*F(2,1) sterm = sqrt( (detF * Particles % OrigLength(No,1)*Particles % OrigLength(No,2))/& (tl1*tl2) ) @@ -335,12 +389,12 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) !for debug, mostly. Something is probably wrong if this occurs WRITE( Message, * ) 'ERROR: fixing misshapen particle no...', no - CALL Warn( SolverName, Message ) + CALL Warn( SolverName, Message ) tl1 = MAX(tl1,1.0_dp) tl2 = MAX(tl2,1.0_dp) sterm = sqrt( (detF * Particles % OrigLength(No,1)*Particles % OrigLength(No,2))/& - (tl1*tl2) ) + (tl1*tl2) ) END IF !END "CORNERS" LENGTH UPDATE @@ -359,18 +413,18 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) !U is eigenvalues, Q is eigenvectors (columns) !ascending order (returns smallest eigvalues first) - U = 0.0_dp - CALL Eigen2D(G,U,Q) + U = 0.0_dp + CALL Eigen2D(G,U,Q) U=SQRT(U) ! Update lengths ! Slow version: ! The final form of G is the stretch tensor - ! G = 0.0_dp; G(1,1) = U(1); G(2,2) = U(2) + ! G = 0.0_dp; G(1,1) = U(1); G(2,2) = U(2) ! G = MATMUL(Q,G); G = MATMUL(G,TRANSPOSE(Q)) ! Particles % Length(No,1) = Particles % OrigLength(No,1) * G(1,1) - ! Particles % Length(No,2) = Particles % OrigLength(No,2) * G(2,2) + ! Particles % Length(No,2) = Particles % OrigLength(No,2) * G(2,2) ! Fast version: Particles % Length(No,1) = Particles % OrigLength(No,1) * & @@ -397,7 +451,7 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) Particles % pvolume(No) = Particles % Length(No,1) * Particles % Length(No,2) - IF ( ANY(Particles % Length(No,:) > mlength) ) SplitP = .TRUE. + IF ( ANY(Particles % Length(No,:) > mlength) ) SplitP = .TRUE. !end sMPM or GIMPM END IF @@ -415,15 +469,15 @@ SUBROUTINE ParticleUpdates( Model, Solver, dt, TransientSimulation) WRITE( Message, * ) 'Maximum length of particles', maxcalclength CALL Info( SolverName, Message, Level=1 ) WRITE( Message, * ) 'Minimum length of particles', mincalclength - CALL Info( SolverName, Message, Level=1 ) + CALL Info( SolverName, Message, Level=1 ) - CALL Info(SolverName,'Checking for particle splitting',Level=4) + CALL Info(SolverName,'Checking for particle splitting',Level=4) IF ( SplitP ) THEN CALL ParticleSplitting( Particles, Model, numoflayers ) - CALL Info(SolverName,'Particle Splitting Done',Level=4) + CALL Info(SolverName,'Particle Splitting Done',Level=4) END IF - Particles % mass(:) = Particles % pvolume(:) * Particles % H(:) * Particles % rhoi + Particles % mass(:) = Particles % pvolume(:) * Particles % H(:) * Particles % rhoi !Assign particles to elements IF (Particles % ShapeFunctions == 'gimpm') THEN @@ -454,7 +508,7 @@ SUBROUTINE UpdateLagParticleUpdates( Model, Solver, dt, TransientSimulation) USE MPMUtils IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model REAL(KIND=dp) :: dt @@ -462,7 +516,7 @@ SUBROUTINE UpdateLagParticleUpdates( Model, Solver, dt, TransientSimulation) TYPE(Mesh_t), POINTER :: Mesh INTEGER :: No,nn,j,t,np,ind TYPE(Element_t), POINTER :: Element - REAL(KIND=dp) :: Basis(4), dBasisdx(4,3), ddBasisddx(4,3,3), detJ + REAL(KIND=dp) :: Basis(4), dBasisdx(4,3), ddBasisddx(4,3,3), detJ TYPE(GaussIntegrationPoints_t) :: IP TYPE(Nodes_t) :: Nodes INTEGER, POINTER :: NodeIndexes(:) @@ -476,11 +530,11 @@ SUBROUTINE UpdateLagParticleUpdates( Model, Solver, dt, TransientSimulation) Do t=1,Solver % Mesh % NumberOfBulkElements Element => Solver % Mesh % Elements(t) ind = Element % ElementIndex - IF ( Element % TYPE % NumberOfNodes .NE. 4) CYCLE + IF ( Element % TYPE % NumberOfNodes .NE. 4) CYCLE NodeIndexes => Element % NodeIndexes Nodes % x(1:4) = Solver % Mesh % Nodes % x(NodeIndexes) Nodes % y(1:4) = Solver % Mesh % Nodes % y(NodeIndexes) - Nodes % z(1:4) = 0.0_dp + Nodes % z(1:4) = 0.0_dp IP = GaussPoints( Element , np=INT(Particles % elementfraction) ) @@ -491,14 +545,14 @@ SUBROUTINE UpdateLagParticleUpdates( Model, Solver, dt, TransientSimulation) No = ElemParticles(ind) % p(j) Particles % Coordinate(No,1) = SUM( Basis(1:4) * Nodes % x(1:4) ) !IP % U(j) - Particles % Coordinate(No,2) = SUM( Basis(1:4) * Nodes % y(1:4) ) !IP % V(j) + Particles % Coordinate(No,2) = SUM( Basis(1:4) * Nodes % y(1:4) ) !IP % V(j) Particles % PVolume(No) = IP % S(j) * detJ Particles % GVolume(No) = IP % S(j) * detJ END DO END DO - DEALLOCATE( Nodes % x, Nodes % y, Nodes % z) + DEALLOCATE( Nodes % x, Nodes % y, Nodes % z) END SUBROUTINE UpdateLagParticleUpdates @@ -513,8 +567,8 @@ SUBROUTINE UpdateLagMeshUpdates( Model, Solver, dt, TransientSimulation) IMPLICIT NONE TYPE(Solver_t), TARGET :: Solver - TYPE(Element_t), POINTER :: Element - TYPE(Model_t) :: Model + TYPE(Element_t), POINTER :: Element + TYPE(Model_t) :: Model REAL(KIND=dp) :: dt,x,y,dist LOGICAL :: TransientSimulation,UnFoundFatal=.TRUE. TYPE(Mesh_t), POINTER :: Mesh @@ -527,7 +581,7 @@ SUBROUTINE UpdateLagMeshUpdates( Model, Solver, dt, TransientSimulation) WRITE(SolverName, '(A)') 'Updated Lagrangian Mesh Deformation' - Mesh => GetMesh() + Mesh => GetMesh() dim = CoordinateSystemDimension() @@ -543,7 +597,7 @@ SUBROUTINE UpdateLagMeshUpdates( Model, Solver, dt, TransientSimulation) Element => Solver % Mesh % Elements(t) Model % CurrentElement => Solver % Mesh % Elements(t) nn = GetElementNOFNodes(Element) - NodeIndexes => Element % NodeIndexes + NodeIndexes => Element % NodeIndexes DO jj = 1,nn ii = NodeIndexes(jj) @@ -582,33 +636,55 @@ SUBROUTINE UpdateParticleHandMass( Model, Solver, dt, TransientSimulation) USE DefUtils IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Solver_t), TARGET :: Solver - TYPE(ValueList_t), POINTER :: Params + TYPE(ValueList_t), POINTER :: Params TYPE(Model_t) :: Model - LOGICAL :: TransientSimulation - TYPE(Mesh_t), POINTER :: Mesh - REAL(KIND=dp) :: dt,divu,lc - INTEGER :: No, ii,smoothiters - LOGICAL :: Visited=.FALSE.,GotIt,nohupdate,smoothdam + LOGICAL :: TransientSimulation + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Element_t),POINTER :: Element + TYPE(Nodes_t) :: Nodes + TYPE(Variable_t), POINTER :: GridH + REAL(KIND=dp) :: Basis(4), dBasisdx(4,3), dirichletmax + REAL(KIND=dp) :: dt,divu,lc,Hinterp,GradH(3),tempx, coord(3) + INTEGER :: No, ii,smoothiters,elementind + LOGICAL :: Visited=.FALSE.,GotIt,nohupdate,smoothdam,stat CHARACTER(LEN=MAX_NAME_LEN) :: SolverName - SAVE :: Visited, nohupdate,lc,smoothdam,smoothiters + LOGICAL :: fixh + REAL(KIND=dp) :: cm,secondsperyear,H0,v0,Q0,B0,A,C,EeExp,Acm,m1,m2 + + SAVE :: Visited, nohupdate,lc,smoothdam,smoothiters, fixh, GridH, dirichletmax Particles => GlobalParticles Mesh => GetMesh() WRITE(SolverName, '(A)') 'Update_Particle_H_and_Mass' - CALL Info(SolverName,'Updating Particle H and Mass',Level=3) + CALL Info(SolverName,'Updating Particle H and Mass',Level=3) Params => GetSolverParams() IF( .NOT. Visited ) THEN + fixh = ListGetLogical(Solver % Values,'Fix H',GotIt) + IF (.NOT. GotIt) fixh = .FALSE. + + dirichletmax = GetConstReal(Solver % Values,'dirichlet max x',GotIt) + IF (.not. GotIt) THEN + dirichletmax=5000.0_dp + ENDIF + + + IF (fixh) THEN + GridH => VariableGet( Mesh % Variables, 'Hinit' ) + !GridH => VariableGet( Mesh % Variables, 'SSAVelocity 1' ) + ENDIF + + smoothdam = GetLogical( Params, 'Smooth Full Dam Particles H', GotIt) IF (.NOT. GotIt) THEN smoothdam = .FALSE. - CALL Info(SolverName,'Use smooth full dam particles not specified -- assuming false',Level=4) + CALL Info(SolverName,'Use smooth full dam particles not specified -- assuming false',Level=4) END IF IF (smoothdam) THEN @@ -618,7 +694,7 @@ SUBROUTINE UpdateParticleHandMass( Model, Solver, dt, TransientSimulation) smoothiters = GetInteger( Params,'smoothing iters',GotIt) IF (.NOT. GotIt) CALL Fatal(SolverName,& - 'Need to define "smooth iters = Integer"') + 'Need to define "smooth iters = Integer"') END IF nohupdate = ListGetLogical(Params,'no h update',GotIt) @@ -631,28 +707,96 @@ SUBROUTINE UpdateParticleHandMass( Model, Solver, dt, TransientSimulation) IF (Particles % firsttimestepzero) RETURN END IF - dt = Particles % dtime + dt = Particles % dtime + + IF (fixh) THEN + cm = 1.0_dp/3.0_dp + secondsperyear = 31556926.0_dp + + H0 = GetConstReal( Model % Constants,'H0',GotIt ) + IF (.NOT. GotIt) CALL Fatal('USF_1dtest:', & + 'initH: Need to define "H0 = Real $" in constants') + + v0 = GetConstReal( Model % Constants,'v0',GotIt ) + IF (.NOT. GotIt) CALL Fatal('USF_1dtest:', & + 'initH: Need to define "H0 = Real $" in constants') + + !H0 = 600.0_dp + !v0 = 300.0_dp + Q0 = H0*v0 + B0 = 1.9E8_dp + A = ((B0*1.0E-6_dp)**(-3.0_dp))*secondsperyear !Mpa^(-3) a^(-1) + C = (((910.0_dp*1.0e-6_dp*9.81_dp)/& + (4.0_dp*(A**(-cm))))*(1.0_dp-910.0_dp/1028.0_dp))**3.0_dp + !C is the weertman constant !C =2.45E-18; !m?3 s?1 + + EeExp = (cm-1.0_dp)/2.0_dp + Acm = A**(-cm) + m1 = 4.0_dp*C/Q0 + m2 = 1.0_dp/(H0*H0*H0*H0) + ENDIF IF( .NOT. nohupdate) THEN !regular update, no additional basal melt DO No = 1,Particles % NumberOfParticles - divu = Particles % GradVel(No,1) + Particles % GradVel(No,2) - Particles % H(No) = Particles % H(No) * (-1.0_dp) * & divu * dt + Particles % H(No) + Particles % MB(No) * dt IF (Particles % H(No) < 1.0_dp) Particles % H(No) = 1.0_dp + + IF (fixh) THEN + + ! IF (Particles % ShapeFunctions == 'gimpm' .AND. & + ! Particles % Coordinate(No,1)<0.0_dp .AND. & + ! (Particles % Coordinate(No,1)+Particles % Length(No,1))>0.0_dp) THEN + ! tempx = Particles % Coordinate(No,1) + ! Particles % Coordinate(No,1) = & + ! 0.5_dp*(Particles % Coordinate(No,1)+Particles % Length(No,1)) + ! Coord = GetParticleCoord(Particles,No) + ! ElementInd=Particles % ElementIndex(No) + ! CALL LocateParticleInMeshOctree( ElementInd, Coord(1:3)) + ! IF (ElementInd>0) THEN + ! Element => Mesh % Elements(ElementInd) + ! CALL GetElementNodes(Nodes,Element) + ! stat = sMPMElementInfo( Element, Particles, Model, Nodes, No, & + ! Particles % gridres, Basis,dBasisdx) + ! !CALL GetScalarFieldInMesh(GridH, Element, Basis, Hinterp) + ! !Particles % H(No) = Hinterp + ! CALL GetScalarFieldInMesh(GridH, Element, Basis, Hinterp, dBasisdx, GradH) + ! divu = GradH(1) + ! ELSE + ! divu=0.0_dp + ! ENDIF + ! Particles % Coordinate(No,1)=tempx + + ! ELSE + IF (Particles % Coordinate(No,1)<=0.0_dp) THEN + Particles % H(No) = H0 + ELSE + IF (Particles % Coordinate(No,1) Mesh % Elements(Particles % ElementIndex(No)) + ! CALL GetElementNodes(Nodes,Element) + ! stat = sMPMElementInfo( Element, Particles, Model, Nodes, No, & + ! Particles % gridres, Basis,dBasisdx) + ! CALL GetScalarFieldInMesh(GridH, Element, Basis, Hinterp) + ! Particles % H(No) = Hinterp + Particles % H(No) = (m1*Particles % Coordinate(No,1) + m2)**(-0.25_dp) + END IF + END IF + END IF END DO END IF + IF (Particles % ShapeFunctions == 'gimpm') THEN Particles % pvolume(:) = Particles % Length(:,1)*Particles % Length(:,2) END IF IF (smoothdam) THEN - CALL Info(SolverName,'Smoothing thickness for fully damaged material points',Level=4) + CALL Info(SolverName,'Smoothing thickness for fully damaged material points',Level=4) CALL smoothrupth(Particles, Mesh, lc, smoothiters) END IF @@ -669,63 +813,63 @@ SUBROUTINE UpdateParticleHandMass( Model, Solver, dt, TransientSimulation) END IF - Particles % mass(:) = Particles % pvolume(:) * Particles % H(:) * Particles % rhoi + Particles % mass(:) = Particles % pvolume(:) * Particles % H(:) * Particles % rhoi END SUBROUTINE UpdateParticleHandMass !************************************************************************** !> (Old?) solver to update particle H, Zs, grounded mask, Mass according to mesh -!! Where is this used? +!! Where is this used? SUBROUTINE Update_Particle_H_GZs_GM_Mass_From_Mesh( Model, Solver, dt, TransientSimulation) - USE MPMUtils +USE MPMUtils - IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles - TYPE(Solver_t), TARGET :: Solver - TYPE(ValueList_t), POINTER :: Params - TYPE(Model_t) :: Model - REAL(KIND=dp) :: dt,Hf - LOGICAL :: TransientSimulation - TYPE(Mesh_t), POINTER :: Mesh - INTEGER :: No, ii - LOGICAL :: Visited=.FALSE.,GotIt,nohupdate - CHARACTER(LEN=MAX_NAME_LEN) :: SolverName +IMPLICIT NONE +TYPE(Particle_t), POINTER :: Particles +TYPE(Solver_t), TARGET :: Solver +TYPE(ValueList_t), POINTER :: Params +TYPE(Model_t) :: Model +REAL(KIND=dp) :: dt,Hf +LOGICAL :: TransientSimulation +TYPE(Mesh_t), POINTER :: Mesh +INTEGER :: No, ii +LOGICAL :: Visited=.FALSE.,GotIt,nohupdate +CHARACTER(LEN=MAX_NAME_LEN) :: SolverName - SAVE :: visited, nohupdate +SAVE :: visited, nohupdate + +Particles => GlobalParticles +WRITE(SolverName, '(A)') 'Update_Particle_H_GZs_GM_and_Mass' - Particles => GlobalParticles - WRITE(SolverName, '(A)') 'Update_Particle_H_GZs_GM_and_Mass' +!h and gmsk from mesh to particle +CALL MPMMeshScalarToParticle(Particles, Model, 8) - !h and gmsk from mesh to particle - CALL MPMMeshScalarToParticle(Particles, Model, 8) +IF (Particles % SEP) THEN + DO No = 1, Particles % NumberOfParticles - IF (Particles % SEP) THEN - DO No = 1, Particles % NumberOfParticles + IF (Particles % Gmask(No) > 0.99_dp) THEN + Particles % Gmask(No) = 1.0_dp + ELSE IF (Particles % Gmask(No) < -0.99_dp) THEN + Particles % Gmask(No) = -1.0_dp + ELSE + Hf = Particles % rhow * & + (Particles % sealevel-Particles % bedrock(No)) & + /Particles % rhoi - IF (Particles % Gmask(No) > 0.99_dp) THEN + IF (Particles % H(No) .LT. Hf) THEN Particles % Gmask(No) = 1.0_dp - ELSE IF (Particles % Gmask(No) < -0.99_dp) THEN - Particles % Gmask(No) = -1.0_dp ELSE - Hf = Particles % rhow * & - (Particles % sealevel-Particles % bedrock(No)) & - /Particles % rhoi - - IF (Particles % H(No) .LT. Hf) THEN - Particles % Gmask(No) = 1.0_dp - ELSE - Particles % GMask(No) = -1.0_dp - END IF + Particles % GMask(No) = -1.0_dp END IF + END IF - END DO - END IF + END DO +END IF - Particles % mass(:) = Particles % pvolume(:) * Particles % H(:) * Particles % rhoi +Particles % mass(:) = Particles % pvolume(:) * Particles % H(:) * Particles % rhoi END SUBROUTINE Update_Particle_H_GZs_GM_Mass_From_Mesh @@ -738,10 +882,10 @@ SUBROUTINE ParticlesToMesh( Model, Solver, dt, TransientSimulation) USE MPMUtils IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model - REAL(KIND=dp) :: dt,dirichletmax + REAL(KIND=dp) :: dt,dirichletmax,dirichletmin LOGICAL :: TransientSimulation,Visited=.FALSE.,GotIt,Test1D=.FALSE. CHARACTER(LEN=MAX_NAME_LEN) :: SolverName TYPE(Variable_t), POINTER :: H,Hi,Vel1,Vel1i @@ -750,7 +894,7 @@ SUBROUTINE ParticlesToMesh( Model, Solver, dt, TransientSimulation) INTEGER :: i SAVE :: Visited,SolverName,Test1D,H,HPerm,HVal,Hi,HiPerm,HiVal,Vel1,Vel1Perm,& - Vel1Val,Vel1i,Vel1iPerm,Vel1iVal,dirichletmax + Vel1Val,Vel1i,Vel1iPerm,Vel1iVal,dirichletmax,dirichletmin Particles => GlobalParticles @@ -763,14 +907,16 @@ SUBROUTINE ParticlesToMesh( Model, Solver, dt, TransientSimulation) PRINT *,'' IF (Particles % weighth) THEN - CALL Info(SolverName,'Weighting H',Level=3) + CALL Info(SolverName,'Weighting H',Level=3) ELSE - CALL Info(SolverName,'Not Weighting H',Level=3) + CALL Info(SolverName,'Not Weighting H',Level=3) END IF PRINT *,'' Test1D = ListGetLogical(Solver % Values,'Test1D',GotIt) - IF (.NOT. GotIt) Test1D = .FALSE. + IF (.NOT. GotIt) Test1D = .FALSE. + + IF (Test1D) THEN @@ -791,26 +937,40 @@ SUBROUTINE ParticlesToMesh( Model, Solver, dt, TransientSimulation) Vel1iVal => Vel1i % Values dirichletmax = GetConstReal(Solver % Values,'dirichlet max x',GotIt) + IF (.not. GotIt) THEN + dirichletmax=-HUGE(1.0_dp) + ENDIF + + dirichletmin = GetConstReal(Solver % Values,'dirichlet min x',GotIt) + IF (.not. GotIt) THEN + dirichletmin=HUGE(1.0_dp) + ENDIF + + PRINT *,'dirichlet min max',dirichletmin,dirichletmax + END IF Visited = .TRUE. END IF - CALL Info(SolverName,'Updating Mesh H, Binit, Velocity',Level=3) + + CALL Info(SolverName,'Updating Mesh H, Binit, Velocity',Level=3) CALL MPMParticlesToNodes( Particles, Model, 2) CALL Info(SolverName,'Done Updating Mesh H, Binit, Velocity',Level=3) IF (Test1D) THEN - Do i = 1,Model % Mesh % NumberOfNodes IF (Model % Mesh % Nodes % x(i) <= dirichletmax) THEN HVal(HPerm(i)) = HiVal(HiPerm(i)) Vel1Val(Vel1Perm(i)) = Vel1iVal(Vel1iPerm(i)) END IF - + IF (Model % Mesh % Nodes % x(i) >= dirichletmin) THEN + HVal(HPerm(i)) = HiVal(HiPerm(i)) + !Vel1Val(Vel1Perm(i)) = Vel1iVal(Vel1iPerm(i)) + END IF END DO END IF @@ -832,11 +992,11 @@ SUBROUTINE MeshToParticles( Model, Solver, dt, TransientSimulation) USE MPMUtils IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(ValueList_t), POINTER :: Params TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model - REAL(KIND=dp) :: dt + REAL(KIND=dp) :: dt LOGICAL :: TransientSimulation CHARACTER(LEN=MAX_NAME_LEN) :: SolverName @@ -848,9 +1008,9 @@ SUBROUTINE MeshToParticles( Model, Solver, dt, TransientSimulation) ! 3D viscosity from temperature, if needed: IF ((.NOT. Particles % constlintemp) .AND. (.NOT. Particles % useconsttemp)) THEN - CALL Info(SolverName,'interpolation of bz to ungrounding particles...',Level=1) - CALL MPMMeshVectorToParticle(Particles, Model, 5,2 ) - CALL Info(SolverName,'interpolation done',Level=1) + CALL Info(SolverName,'interpolation of bz to ungrounding particles...',Level=3) + CALL MPMMeshVectorToParticle(Particles, Model, 5,2 ) + CALL Info(SolverName,'interpolation done',Level=3) END IF END SUBROUTINE MeshToParticles @@ -865,17 +1025,17 @@ SUBROUTINE MeshDamageToParticle(Model, Solver, dt, TransientSimulation) USE Lists IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model REAL(KIND=dp) :: dt,divu - TYPE(Element_t), POINTER :: Element + TYPE(Element_t), POINTER :: Element LOGICAL :: TransientSimulation TYPE(Mesh_t), POINTER :: Mesh INTEGER :: No, ii, elem LOGICAL :: Visited=.FALSE.,GotIt CHARACTER(LEN=MAX_NAME_LEN) :: SolverName - TYPE(Variable_t), POINTER :: DVar + TYPE(Variable_t), POINTER :: DVar INTEGER, POINTER :: DPerm(:) REAL(KIND=dp), POINTER :: DValues(:) REAL(KIND=dp) :: Basis(4),dBasisdx(4,3),Coord(3) @@ -888,7 +1048,7 @@ SUBROUTINE MeshDamageToParticle(Model, Solver, dt, TransientSimulation) Particles % Dav = 0.0_dp DVar => VariableGet(Model % Mesh % Variables, 'damage' ) DValues => DVar % Values - DPerm => DVar % Perm + DPerm => DVar % Perm DO No = 1,Particles % NumberOfParticles Coord = GetParticleCoord(Particles,No) @@ -920,7 +1080,7 @@ SUBROUTINE SaveParticleData( Model,Solver,dt,TransientSimulation ) TYPE(Model_t) :: Model REAL(KIND=dp) :: dt, SaveInterval,SaveStep,EndTime,AlwaysSaveTime,ymax LOGICAL :: TransientSimulation - TYPE(ValueList_t), POINTER :: Params + TYPE(ValueList_t), POINTER :: Params LOGICAL :: Found,UseInterval,GotIt,UseAlwaysSaveTime,savetimestep,& UseMismipFinalDamSave,mismipfinalsave INTEGER :: VisitedTimes = 0, OutputInterval,No @@ -953,7 +1113,7 @@ SUBROUTINE SaveParticleData( Model,Solver,dt,TransientSimulation ) OutputDirectory = GetString( Solver % Values,'Filename Directory') FileNamePrefix = GetString( Solver % Values,'Filename Prefix') - FileName = TRIM(OutputDirectory)// '' //TRIM(FilenamePrefix)// '.result' + FileName = TRIM(OutputDirectory)// '' //TRIM(FilenamePrefix)// '.result' SaveStep = 0.0_dp @@ -963,7 +1123,7 @@ SUBROUTINE SaveParticleData( Model,Solver,dt,TransientSimulation ) UseAlwaysSaveTime = GetLogical( Params, 'Use Always Save Time', GotIt ) IF (.NOT. GotIt) THEN Call Warn('SaveParticleData',& - 'Did not specify "Use Always Save Time" in Params so setting to false') + 'Did not specify "Use Always Save Time" in Params so setting to false') UseAlwaysSaveTime = .FALSE. END IF @@ -972,7 +1132,7 @@ SUBROUTINE SaveParticleData( Model,Solver,dt,TransientSimulation ) AlwaysSaveTime = GetCReal( Params,'Always Save Time', GotIt) IF (.NOT. GotIt) THEN Call Warn('SaveParticleData',& - 'Did not specify "Always Save Time = Real" in Params so will not use!') + 'Did not specify "Always Save Time = Real" in Params so will not use!') UseAlwaysSaveTime = .FALSE. END IF END IF @@ -981,7 +1141,7 @@ SUBROUTINE SaveParticleData( Model,Solver,dt,TransientSimulation ) UseMismipFinalDamSave = GetLogical( Params, 'Use MISMIP Final Damage Save', GotIt ) IF (.NOT. GotIt) THEN Call Warn('SaveParticleData',& - 'Did not specify "Use MISMIP Final Damage Save" in Params so setting to false') + 'Did not specify "Use MISMIP Final Damage Save" in Params so setting to false') UseMismipFinalDamSave = .FALSE. END IF @@ -1053,7 +1213,7 @@ SUBROUTINE SaveParticleData( Model,Solver,dt,TransientSimulation ) ELSEIF (UseAlwaysSaveTime .AND. Particles % time >= AlwaysSaveTime) THEN savetimestep = .TRUE. ELSEIF (mismipfinalsave) THEN - savetimestep = .TRUE. + savetimestep = .TRUE. ELSE savetimestep = .FALSE. END IF @@ -1114,7 +1274,7 @@ FUNCTION MPMTimestep( Model ) RESULT( dt ) REAL(KIND=dp), POINTER :: TimestepSizes(:,:) REAL(KIND=dp) :: dt0,prevdt LOGICAL :: GotIt - TYPE(Particle_t), POINTER :: Particles => NULL() + TYPE(Particle_t), POINTER :: Particles => NULL() SAVE :: VisitedTimes,Mesh @@ -1122,7 +1282,7 @@ FUNCTION MPMTimestep( Model ) RESULT( dt ) IF (VisitedTimes == 0) THEN Mesh => GetMesh() - vtime = VariableGet(Mesh % Variables, 'time') + vtime => VariableGet(Mesh % Variables, 'time') vtime % Values(1) = 0.0_dp Particles % time = 0.0_dp @@ -1148,7 +1308,7 @@ FUNCTION SSATimestep( Model ) RESULT( dt ) USE Types USE Lists USE DefUtils - USE MPMUtils + USE MPMUtils IMPLICIT NONE @@ -1161,12 +1321,12 @@ FUNCTION SSATimestep( Model ) RESULT( dt ) REAL(KIND=dp), POINTER :: TimestepSizes(:,:),VValues(:) INTEGER, POINTER :: VPerm(:) LOGICAL :: Found,usesteady - TYPE(Particle_t), POINTER :: Particles => NULL() + TYPE(Particle_t), POINTER :: Particles => NULL() - SAVE :: VisitedTimes,mult,usesteady,steadytimestep,gridres,cflconstant + SAVE :: VisitedTimes,mult,usesteady,steadytimestep,gridres,cflconstant - Particles => GlobalParticles + Particles => GlobalParticles IF (VisitedTimes == 0) THEN @@ -1224,14 +1384,14 @@ FUNCTION SSATimestep( Model ) RESULT( dt ) CALL Info('','',Level=1) CALL Info('','',Level=1) - WRITE(Message,'(a,I10)') 'Timestep',VisitedTimes + WRITE(Message,'(a,I10)') 'Timestep',VisitedTimes CALL Info('SSATimestep',Message,Level=1) - - WRITE(Message,'(a,ES12.3)') 'dt',dt + + WRITE(Message,'(a,ES12.3)') 'dt',dt + CALL Info('SSATimestep',Message,Level=2) + + WRITE(Message,'(a,ES12.3)') 'Time',Particles % Time CALL Info('SSATimestep',Message,Level=1) - - WRITE(Message,'(a,ES12.3)') 'Time',Particles % Time - CALL Info('SSATimestep',Message,Level=1) CALL Info('','',Level=1) @@ -1239,11 +1399,33 @@ FUNCTION SSATimestep( Model ) RESULT( dt ) !CALL Info( 'ssa timestep',Message, Level=1 ) CALL ListAddConstReal(Model % Simulation,'res: ssa timestep',dt) - CALL ListAddConstReal(Model % Simulation,'res: MPM timestep',dt) + CALL ListAddConstReal(Model % Simulation,'res: MPM timestep',dt) END FUNCTION SSATimestep !************************************************************************** +!coordinate x,ssavelocity x, InitCoord1 +FUNCTION MoveMeshUpLag( Model,nodenumber,VarIn ) RESULT( VarOut ) + USE Types + USE Lists + USE MPMUtils + + IMPLICIT NONE + + TYPE(Model_t) :: Model + REAL(KIND=dp) :: dt + INTEGER :: nodenumber + REAL(KIND=dp) :: VarIn(3),VarOut + TYPE(Particle_t), POINTER :: Particles => NULL() + + Particles => GlobalParticles + + dt = Particles % dtime + + VarOut = (VarIn(1) + VarIn(2)*dt) - VarIn(3) + +END FUNCTION MoveMeshUpLag + !> The 3-D SSA-MPM creep damage solver. !! CAUTION: There are several experimental functions in this solver. @@ -1309,13 +1491,13 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) REAL(KIND=dp) :: maxdDsave,targetdd,ddscale,nonlocskip,cflconstant REAL(KIND=dp) :: DS(2,2) - LOGICAL :: larcenfmel + LOGICAL :: larcenfmel #ifdef USE_ISO_C_BINDINGS REAL(KIND=dp) :: starttime, endtime,time2s,time2e #else REAL(KIND=dp) :: starttime, endtime,time2s,time2e -#endif +#endif SAVE :: Visited, RKM, maxgiventimestep, maxalloweddD,& @@ -1329,7 +1511,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) maxddsave,defaultcriticaldamage,troubleshoot,ddscalevec,& targetdd,nldDthres, zerostresscompare, & nonlocskip,usenonlocskip,cflconstant,suture,& - larcenfmel + larcenfmel Params => GetSolverParams() @@ -1444,11 +1626,11 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) 'Need to define "sthresborstad=Real $sthresborstad" in constants') kparam = GetConstReal( Model % Constants, 'kparam', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName,& - 'Need to define "kparam=Real $kparam" in constants') + 'Need to define "kparam=Real $kparam" in constants') END IF - !Ellipse nonlocal scheme, similar to Giry 2011. + !Ellipse nonlocal scheme, similar to Giry 2011. useellipse = GetLogical( Params,'Use Ellipse',GotIt) IF (.NOT. GotIt) THEN Call Warn(SolverName,& @@ -1576,7 +1758,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) rupttol = GetCReal( Params,'Ruptured Damage convergence tolerance',GotIt) IF (.NOT. GotIt) CALL Fatal(SolverName, & - 'Need to define "Ruptured Damage convergence tolerance = Real $Dtol"') + 'Need to define "Ruptured Damage convergence tolerance = Real $Dtol"') ALLOCATE( layerdone(numlayers) ) ALLOCATE(zref(numlayers)) @@ -1618,7 +1800,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) !!!!------------------------------------ END FIRST TIME ONLY -------------------------------!!!!! - CALL Info(SolverName,'Updating Particle Damage',Level=3) + CALL Info(SolverName,'Updating Particle Damage',Level=3) starttime = RealTime() @@ -1663,16 +1845,16 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) DO No = 1,NoParticles !----------- can this particle be skipped? -------------! - IF (Particles % damstatus(No) == 1 .AND. Particles % useriftdmax) CYCLE + IF (Particles % damstatus(No) == 1 .AND. Particles % useriftdmax) CYCLE IF (.NOT. allowgrounded) THEN IF (Particles % Gmask(No) < 0.0_dp) CYCLE END IF IF (Particles % nodamregion) THEN - IF ( (Particles % Coordinate(No,1) < Particles % ndxmax) .AND. & + IF ( (Particles % Coordinate(No,1) < Particles % ndxmax) .AND. & (Particles % Coordinate(No,1) > Particles % ndxmin) ) THEN - IF ( (Particles % Coordinate(No,2) < Particles % ndymax) .AND. & + IF ( (Particles % Coordinate(No,2) < Particles % ndymax) .AND. & (Particles % Coordinate(No,2) > Particles % ndymin) ) THEN Particles % Damage(No,:,:) = 0.0_dp Particles % Dav(No,:) = 0.0_dp @@ -1683,9 +1865,9 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) IF (Particles % restrictdam) THEN IF (Particles % Coordinate(No,1) < Particles % rdxmin) CYCLE - IF (Particles % Coordinate(No,1) > Particles % rdxmax) CYCLE + IF (Particles % Coordinate(No,1) > Particles % rdxmax) CYCLE IF (Particles % Coordinate(No,2) < Particles % rdymin) CYCLE - IF (Particles % Coordinate(No,2) > Particles % rdymax) CYCLE + IF (Particles % Coordinate(No,2) > Particles % rdymax) CYCLE END IF @@ -1725,7 +1907,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) IF (UseBorstad) THEN DO No = 1,NoParticles - IF (Particles % xpic(No,6) == zero) CYCLE + IF (Particles % xpic(No,6) == zero) CYCLE srthres = (stressthres/Particles % Binit(No))**n CALL BorstadDamage(Particles, No, srthres, Particles % GradVel(No,:),Particles % dD(No,1,1),n,kparam) @@ -1747,10 +1929,10 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) Particles % xpic(:,3) = 0.0_dp Particles % xpic(:,4) = numlayers - !debugging + !debugging Particles % equaleigcount = 0 - IF (maxalloweddD > zero) THEN + IF (maxalloweddD > zero) THEN DO No = 1, NoParticles @@ -1843,33 +2025,33 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) !EeExp = (1.0_dp-n)/(2.0_dp * n) !EFexp = -1.0_dp/n - RHS = (Ee**EeExp) * (Particles % EF(No)**EFexp ) + RHS = (Ee**EeExp) * (Particles % EF(No)**EFexp ) IF (Particles % Gmask(No) < 0.0_dp) THEN zs = Particles % H(No)+Particles % Bedrock(No) ELSE !particle surface height - !zsRHS = (1.0_dp - rhoi/rhow) + !zsRHS = (1.0_dp - rhoi/rhow) zs = Particles % H(No)*zsRHS END IF !----------------------------------------------------------------------! !--------- calculate change in damage ----------! - !----------------------------------------------------------------------! + !----------------------------------------------------------------------! !These calculations are done for each vertical layer of the particle. !This code currently assumes damage should nucleate at the surface or base !of the shelf and propagate towards the center. A layer will not damage !unless all other layers above or below the layer are damaged. - !Calculations are performed on each layer starting from the basal layer + !Calculations are performed on each layer starting from the basal layer !and looping towards the surface layer. However, if one of these layers !accumulates no damage, the loop is restarted, but now working from !surface layer towards the bottom layer. This surface-to-base loop ends !when a layer is reached that either: - !-accumulates no damage + !-accumulates no damage !-has already been processed from the basal-to-surface loop !This way, we don't have to process the middle layers that won't accumulate !damage, resulting in significantly faster code (especially if most of the @@ -1945,15 +2127,21 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) !NO BASAL WATER PRESSURE ! Pw = 0.0_dp Particles % pressure1 = rhoitimesgravity * (zs-z) + !Particles % P_i = Particles % pressure1 + !Particles % P_w = 0.0 ELSE !BASAL WATER PRESSURE !Pw = rhowtimesgravity * (0.0_dp-z) !pressure1 = (rhoitimesgravity * (zs-z)) - Pw + !Particles % P_i = rhoitimesgravity * (zs-z) + IF (usewp) THEN Particles % pressure1 = rhoitimesgravity*(zs-z) + rhowtimesgravity*z + !Particles % P_w = rhowtimesgravity * z ELSE Particles % pressure1 = rhoitimesgravity * (zs-z) + !Particles % P_w = 0.0_dp END IF END IF @@ -1965,7 +2153,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) !introduce some noise on the stress threshold: u = EvenRandom() - v = EvenRandom() + v = EvenRandom() sigmath_var = ABS(0+sthresmod*SQRT(-2.0_dp*LOG((one-u)))*COS(2.0_dp*nbrPi*v)) Particles % sthresmod = Particles % sthres * (one+sigmath_var) @@ -2014,7 +2202,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) TTT = D(1)+dD(1)+D(2)+dD(2) DDD = (D(1)+dD(1))*(D(2)+dD(2))-(D(4)+dD(4))*(D(4)+dD(4)) - eigdmax = 0.5_dp*TTT+sqrt(0.25_dp*TTT*TTT-DDD) + eigdmax = 0.5_dp*TTT+sqrt(0.25_dp*TTT*TTT-DDD) usewp = .TRUE. END IF @@ -2058,7 +2246,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) !either restrict the timestep based on the change in vertically integrated damage !or the change in damage of any layer EDIT: always dvert int now - IF (Particles % damstatus(No)<1 ) THEN + IF (Particles % damstatus(No)<1 ) THEN CALL GetMaxdDPrincipalDamageVert(Particles,No,numlayers,pddmax) @@ -2077,7 +2265,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) Particles % dtime = Particles % dtime/1.5_dp restart=.TRUE. - dt = Particles % dtime + dt = Particles % dtime PRINT *,'Damage dt',dt PRINT *,'Restart due to No',No @@ -2242,8 +2430,8 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) !This is the old nonlocal scheme, which should no longer be called !by default !TODO: clean this up - - CALL Info(SolverName,'Start Nonlocal Damage',Level=3) + + CALL Info(SolverName,'Start Nonlocal Damage',Level=3) CALL nonlocalintegraldD(Particles, numlayers, & INT(count), lc, gaussk, gridres,vertlc) CALL Info(SolverName,'Nonlocal Damage Done',Level=3) @@ -2291,8 +2479,8 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) !ISOTROPIC (gamma == 0) - Particles % Damage(No,ii,1:3) = Particles % Damage(No,ii,1) + & - Particles % dD(No,ii,1) + Particles % Damage(No,ii,1:3) = Particles % Damage(No,ii,1:3) + & + Particles % dD(No,ii,1:3) IF (Particles % Damage(No,ii,1) < Particles % mindam ) THEN Particles % Damage(No,ii,:) = 0.0_dp @@ -2442,7 +2630,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) WHERE (Particles % Damage(No,:,:) .NE. Particles % Damage(No,:,:)) & Particles % Damage(No,:,:) = 0.0_dp - CALL VertIntDamFromVisc(Particles, No, numlayers,Model) + CALL VertIntDamFromVisc(Particles, No, numlayers,Model) END IF END DO @@ -2464,7 +2652,7 @@ SUBROUTINE UpdateCreepDamage( Model,Solver,dt,TransientSimulation ) Particles % currentgamma = Particles % gamma IF (lc>0.0_dp ) THEN - ddmax = MAXVAL(ABS(Particles % dD(:,:,:))) + ddmax = MAXVAL(ABS(Particles % dD(:,:,:))) PRINT *,'Max particle layer dD over current timestep after nonlocal: ', ddmax PRINT *,' ' END IF @@ -2562,7 +2750,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) REAL(KIND=dp) :: starttime, endtime,time2s,time2e #else REAL(KIND=dp) :: starttime, endtime,time2s,time2e -#endif +#endif SAVE :: Visited, RKM, maxgiventimestep, maxalloweddD,& @@ -2675,7 +2863,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) END IF - CriticalDamage = Particles % CriticalDav + CriticalDamage = Particles % CriticalDav MinSRInv = Particles % criticalshearrate rhow = Particles % rhow @@ -2737,7 +2925,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) IF (maxeig >= Particles % criticaldav) THEN ! Particles % prupt = .TRUE. - Particles % damstatus(No) = 1 + Particles % damstatus(No) = 1 Particles % Dav(No,1:3) = Particles % riftdmax Particles % Dav(No,4) = 0.0_dp Particles % damstatus(No) = 1 @@ -2745,12 +2933,12 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) END IF END DO - Visited = .TRUE. + Visited = .TRUE. END IF !!!!------------------------------------ END FIRST TIME ONLY -------------------------------!!!!! - CALL Info(SolverName,'Updating Particle Damage Modified Zero Stress',Level=3) + CALL Info(SolverName,'Updating Particle Damage Modified Zero Stress',Level=3) starttime = RealTime() @@ -2812,9 +3000,9 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) END IF IF (Particles % nodamregion) THEN - IF ( (Particles % Coordinate(No,1) < Particles % ndxmax) .AND. & + IF ( (Particles % Coordinate(No,1) < Particles % ndxmax) .AND. & (Particles % Coordinate(No,1) > Particles % ndxmin) ) THEN - IF ( (Particles % Coordinate(No,2) < Particles % ndymax) .AND. & + IF ( (Particles % Coordinate(No,2) < Particles % ndymax) .AND. & (Particles % Coordinate(No,2) > Particles % ndymin) ) THEN Particles % Damage(No,:,:) = 0.0_dp Particles % Dav(No,:) = 0.0_dp @@ -2825,9 +3013,9 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) IF (Particles % restrictdam) THEN IF (Particles % Coordinate(No,1) < Particles % rdxmin) CYCLE - IF (Particles % Coordinate(No,1) > Particles % rdxmax) CYCLE + IF (Particles % Coordinate(No,1) > Particles % rdxmax) CYCLE IF (Particles % Coordinate(No,2) < Particles % rdymin) CYCLE - IF (Particles % Coordinate(No,2) > Particles % rdymax) CYCLE + IF (Particles % Coordinate(No,2) > Particles % rdymax) CYCLE END IF IF ((Particles % Status(No) == PARTICLE_LOST) & @@ -2859,7 +3047,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) pSR = 0.0_dp - IF (maxalloweddD > zero) THEN + IF (maxalloweddD > zero) THEN DO No = 1, NoParticles @@ -2881,7 +3069,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) !----------------------------------------------------------------------! !--------- calculate change in damage ----------! - !----------------------------------------------------------------------! + !----------------------------------------------------------------------! !particle strain rates pSR(1,1) = Particles % GradVel(No,1) @@ -2979,7 +3167,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) END IF - IF (zsonly) RHS = 0.0_dp + IF (zsonly) RHS = 0.0_dp dD = zero D(1:4) = Particles % Dav(No,1:4) @@ -3039,7 +3227,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) IF (Particles % dD(No,2,1) < 1.0_dp) Particles % dD(No,2,1) = 1.0_dp END IF - Particles % prupt = .FALSE. + Particles % prupt = .FALSE. Particles % dD(No,1,1:4) = dD(1:4) @@ -3071,14 +3259,14 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) ! IF (usemelt .AND. Particles % Gmask(No) >= 0.0_dp) THEN ! Particles % MB(No) = Particles % MB(No)+meltmb !5 !.0_dp - ! END IF + ! END IF IF (ABS(maxdD) > maxalloweddd) THEN maxdD = 0.0_dp Particles % dtime = Particles % dtime/1.5_dp restart=.TRUE. - dt = Particles % dtime + dt = Particles % dtime PRINT *,'Damage dt',dt PRINT *,'Restart due to No',No @@ -3217,7 +3405,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) Df(2,2) = Particles % dD(No,1,2) Df(1,2) = Particles % dD(No,1,4) Df(2,1) = Df(1,2) - CALL Eigen2DSym_TryGenFirst(Df,EigVal,EigVec) + CALL Eigen2DSym_TryGenFirst(Df,EigVal,EigVec) Particles % dbassis(No) = EigVal(2)/dt END IF @@ -3226,7 +3414,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) Df(1,2) = Particles % Dav(No,4) Df(2,1) = Df(1,2) - CALL Eigen2DSym_TryGenFirst(Df,EigVal,EigVec) + CALL Eigen2DSym_TryGenFirst(Df,EigVal,EigVec) IF (EigVal(2) > Particles % riftDmax) EigVal(2) = Particles % Riftdmax IF (EigVal(2) < 0.0_dp) EigVal(2) = 0.0_dp @@ -3236,13 +3424,13 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) !rotate back w = EigVal(1)*EigVec(1,1) x = EigVal(2)*EigVec(1,2) - y = EigVal(1)*EigVec(2,1) + y = EigVal(1)*EigVec(2,1) z = EigVal(2)*EigVec(2,2) Particles % Dav(No,1) = EigVec(1,1)*w + EigVec(1,2)*x Particles % Dav(No,2) = EigVec(2,1)*y + EigVec(2,2)*z Particles % Dav(No,4) = EigVec(2,1)*w + EigVec(2,2)*x - Particles % Dav(No,3) = 0.0_dp + Particles % Dav(No,3) = 0.0_dp IF (EigVal(2)>=Particles % criticaldav) THEN EigVal(2) = Particles % RiftDmax @@ -3264,7 +3452,7 @@ SUBROUTINE UpdateDamageModifiedZeroStress( Model,Solver,dt,TransientSimulation ) IF (lc>0.0_dp ) THEN - ddmax = MAXVAL(ABS(Particles % dD(:,:,:))) + ddmax = MAXVAL(ABS(Particles % dD(:,:,:))) PRINT *,'Max particle dD over current timestep after nonlocal: ', ddmax PRINT *,' ' END IF @@ -3286,7 +3474,7 @@ SUBROUTINE SaveMaxFrontX_1Dtest( Model, Solver, dt, TransientSimulation) USE MPMUtils IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model REAL(KIND=dp) :: dt,maxx,fx,H,vel,gradvel @@ -3300,8 +3488,7 @@ SUBROUTINE SaveMaxFrontX_1Dtest( Model, Solver, dt, TransientSimulation) Particles => GlobalParticles WRITE(SolverName, '(A)') 'SaveMaxFrontX' - CALL Info(SolverName,'Saving Max Front X',Level=3) - + CALL Info(SolverName,'Saving Max Front X',Level=3) IF( .NOT. Visited ) THEN @@ -3347,8 +3534,14 @@ SUBROUTINE SaveMaxFrontX_1Dtest( Model, Solver, dt, TransientSimulation) CLOSE(10) END IF - PRINT *,'Time',Particles % time - PRINT *,'maxx',maxx + IF (ABS(Particles % time - 300.0_dp) < 0.5_dp*dt) THEN + PRINT *,'' + PRINT *,'sf,gridres,ppe',Particles % Shapefunctions, Particles % gridres, Particles % elementfraction + PRINT *,'Time',Particles % time + PRINT *,'maxx',maxx + PRINT *,'end diff, % gridres',maxx-1.770500136335967e+05,(maxx-1.770500136335967e+05)/Particles % gridres + PRINT *,'' + END IF END SUBROUTINE SaveMaxFrontX_1Dtest @@ -3360,10 +3553,10 @@ SUBROUTINE SaveParticleLoc_1Dtest( Model, Solver, dt, TransientSimulation) USE MeshUtils USE SolverUtils USE Lists - USE GeneralUtils + USE GeneralUtils IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model REAL(KIND=dp) :: dt,count,fx,h,vel,gradvel,nearest,miny,closestx,targetinitloc @@ -3378,7 +3571,7 @@ SUBROUTINE SaveParticleLoc_1Dtest( Model, Solver, dt, TransientSimulation) REAL(KIND=dp) :: currenttime #else REAL(KIND=dp) :: currenttime -#endif +#endif SAVE :: Visited, OutputDirectory,FileNamePrefix,FileName,whichno,savehvelgradveltime,& minx,maxx @@ -3386,10 +3579,10 @@ SUBROUTINE SaveParticleLoc_1Dtest( Model, Solver, dt, TransientSimulation) Particles => GlobalParticles WRITE(SolverName, '(A)') 'SaveParticleLoc' - CALL Info(SolverName,'Saving Particle Location',Level=3) + CALL Info(SolverName,'Saving Particle Location',Level=3) - IF( .NOT. Visited ) THEN + IF( .NOT. Visited ) THEN OutputDirectory = GetString( Solver % Values,'Filename Directory') FileNamePrefix = GetString( Solver % Values,'Filename Prefix') @@ -3465,7 +3658,7 @@ SUBROUTINE SaveParticleLoc_1Dtest( Model, Solver, dt, TransientSimulation) END IF IF (Particles % shapefunctions == 'gimpm') THEN - pxmin = Particles % Coordinate(No,1) - Particles % Length(No,1)/2.0_dp + pxmin = Particles % Coordinate(No,1) - Particles % Length(No,1)/2.0_dp pxmax = Particles % Coordinate(No,1) + Particles % Length(No,1)/2.0_dp totvol = pxmax-pxmin @@ -3489,7 +3682,7 @@ SUBROUTINE SaveParticleLoc_1Dtest( Model, Solver, dt, TransientSimulation) END IF M = M + Particles % Mass(No)*scale - KE = KE + 0.5_dp*Particles % Mass(No)*scale*Particles % Velocity(No,1)*Particles % Velocity(No,1) + KE = KE + 0.5_dp*Particles % Mass(No)*scale*Particles % Velocity(No,1)*Particles % Velocity(No,1) END DO IF (count>0) THEN @@ -3524,8 +3717,6 @@ SUBROUTINE SaveParticleLoc_1Dtest( Model, Solver, dt, TransientSimulation) END SUBROUTINE SaveParticleLoc_1Dtest -!> Several different measures of stress error are saved here. The one used in the -!! paper is W_T_E SUBROUTINE SteadyStressError_1Dtest( Model, Solver, dt, TransientSimulation) USE MPMUtils @@ -3533,37 +3724,44 @@ SUBROUTINE SteadyStressError_1Dtest( Model, Solver, dt, TransientSimulation) USE MeshUtils USE SolverUtils USE Lists - USE GeneralUtils + USE GeneralUtils IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model + TYPE(Mesh_t), POINTER :: Mesh LOGICAL :: TransientSimulation - INTEGER :: No - LOGICAL :: Visited=.FALSE. + INTEGER :: No,i + LOGICAL :: Visited=.FALSE.,Found REAL(KIND=dp) :: dt CHARACTER(LEN=MAX_NAME_LEN) :: OutputDirectory,FileNamePrefix,FileName,SolverName REAL(KIND=dp) :: miny,minx,maxx,cm,secondsperyear,H0,v0,Q0,B0,A,C,EeExp,Axm,m1,m2,acm - REAL(KIND=dp) :: count,RMSnum_Tau,RMSnum_RTau,tot_P_Tau,tot_P_Rtau + REAL(KIND=dp) :: count,RMSnum_Tau,RMSnum_RTau,RMSnum_V,tot_P_Tau,tot_P_Rtau REAL(KIND=dp) :: Exx,Ee,P_Tau,P_RTau,vol1d,Ha,A_Tau,A_RTau,totvolT,totvolRT - REAL(KIND=dp) :: RMS_Tau,RMS_RTau + REAL(KIND=dp) :: RMS_Tau,RMS_RTau,RMS_V REAL(KIND=dp) :: mean_P_Tau,mean_P_RTau,T_SS_tot,RT_SS_tot,T_SS_RES,RT_SS_RES REAL(KIND=dp) :: RR_T,RR_RT REAL(KIND=dp) :: NW_T_E,NW_RT_E,W_T_E,W_RT_E,W_T_E_b,W_RT_E_b REAL(KIND=dp) :: RSE_T,RSE_RT,nonanT,nonanRT,minsrinvsquared,nancount - + REAL(KIND=dp) :: Va,xdiff,VL2,TauL2, W_V_E_b, totvolV, nonanV, RVE !, maxvelerror, maxtauerror + REAL(KIND=dp) :: RMSnum_Tau_W,RMSdenom_Tau_W,RMSnum_V_W,RMSdenom_V_W,Vtot,Vp + REAL(KIND=dp) :: RMSnum_V_W_M,RMSdenom_V_W_M + TYPE(Variable_t), POINTER :: VelVar + INTEGER, POINTER :: VelPerm(:) + REAL(KIND=dp), POINTER :: VelVal(:) SAVE :: Visited, OutputDirectory,FileNamePrefix,FileName,miny,minx,maxx,& cm,secondsperyear,H0,v0,Q0,B0,A,C,EeExp,Acm,m1,m2,minsrinvsquared Particles => GlobalParticles - WRITE(SolverName, '(A)') 'SaveParticleLoc' + WRITE(SolverName, '(A)') 'SteadyStressError_1Dtest' - CALL Info(SolverName,'Saving Particle Location',Level=3) + CALL Info(SolverName,'Saving Particle Stats',Level=3) + Mesh => GetMesh() - IF( .NOT. Visited ) THEN + IF( .NOT. Visited ) THEN OutputDirectory = GetString( Solver % Values,'Filename Directory') FileNamePrefix = GetString( Solver % Values,'Filename Prefix') @@ -3577,14 +3775,33 @@ SUBROUTINE SteadyStressError_1Dtest( Model, Solver, dt, TransientSimulation) minx = 0.0_dp maxx = 250000.0_dp + minx = GetConstReal(Solver % Values,'minx',Found) + IF (.not. Found) THEN + minx=0.0_dp + ENDIF + + maxx = GetConstReal(Solver % Values,'maxx',Found) + IF (.not. Found) THEN + maxx=250000.0_dp + ENDIF + MinSRInvSquared = Particles % criticalshearrate * Particles % criticalshearrate !ANALYTICAL STUFF cm = 1.0_dp/3.0_dp secondsperyear = 31556926.0_dp - H0 = 600.0_dp - v0 = 300.0_dp + !H0 = 600.0_dp + !v0 = 300.0_dp + + H0 = GetConstReal( Model % Constants,'H0',Found ) + IF (.NOT. Found) CALL Fatal('USF_1dtest:', & + 'initH: Need to define "H0 = Real $" in constants') + + v0 = GetConstReal( Model % Constants,'v0',Found ) + IF (.NOT. Found) CALL Fatal('USF_1dtest:', & + 'initH: Need to define "H0 = Real $" in constants') + Q0 = H0*v0 B0 = 1.9E8_dp A = ((B0*1.0E-6_dp)**(-3.0_dp))*secondsperyear !Mpa^(-3) a^(-1) @@ -3594,7 +3811,7 @@ SUBROUTINE SteadyStressError_1Dtest( Model, Solver, dt, TransientSimulation) EeExp = (cm-1.0_dp)/2.0_dp Acm = A**(-cm) - m1 = 4.0_dp*C/Q0 + m1 = 4.0_dp*C/Q0 m2 = 1.0_dp/(H0*H0*H0*H0) @@ -3602,59 +3819,73 @@ SUBROUTINE SteadyStressError_1Dtest( Model, Solver, dt, TransientSimulation) END IF - count = 0.0_dp - RMSnum_Tau = 0.0_dp - RMSnum_RTau = 0.0_dp - tot_P_Tau = 0.0_dp - tot_P_RTau = 0.0_dp - nancount = 0.0_dp + VelVar => VariableGet( Model % Mesh % Variables, 'SSAVelocity 1') + VelPerm => VelVar % Perm + VelVal => VelVar % Values + + nancount=0 + + RMSnum_Tau_W = 0.0_dp + RMSdenom_Tau_W = 0.0_dp + + RMSnum_V_W = 0.0_dp + RMSdenom_V_W = 0.0_dp + + !mesh version + RMSnum_V_W_M = 0.0_dp + RMSdenom_V_W_M = 0.0_dp + Vtot = 0.0_dp !XPIC AND dD are simply used for storage here, and have nothing to do with the !xpic routine nor the damage solver in this context Particles % xpic = 0.0_dp Particles % dD = 0.0_dp + DO i = 1,Mesh % NumberOfNodes + IF (Mesh % Nodes % x(i) >= minx .AND. Mesh % Nodes % x(i)<=maxx) THEN + Ha = (m1*Mesh % Nodes % x(i) + m2)**(-0.25_dp) + Va = Q0/Ha + Vp = VelVal(VelPerm(i)) + RMSnum_V_W_M = RMSnum_V_W_M + (Va-Vp)*(Va-Vp) + RMSdenom_V_W_M = RMSdenom_V_W_M + Va*Va + END IF + END DO + + + DO No = 1,Particles % NumberOfParticles + IF (Particles % Coordinate(No,1) < minx) CYCLE IF (Particles % Coordinate(No,1) > maxx) CYCLE - IF (Particles % Coordinate(No,2) > miny) CYCLE IF (Particles % ShapeFunctions == 'gimpm') THEN IF (Particles % Coordinate(No,1) + 0.5_dp*Particles % Length(No,1) > maxx) CYCLE IF (Particles % Coordinate(No,1) - 0.5_dp*Particles % Length(No,1) < minx) CYCLE END IF + + vol1d = Particles % pvolume(No) + + !----------particle stresses----- Exx = Particles % GradVel(No,1) Ee = Exx*Exx - IF (Ee < MinSRInvSquared) THEN - Ee = MinSRInvSquared - END IF - - !dev stress - P_Tau = Acm*(Ee**EeExp)*Exx - !resistive stress - P_RTau = 2.0_dp*P_Tau*Particles % H(No) - - vol1d = Particles % pvolume(No)/Particles % Length(No,2) + IF (Ee < MinSRInvSquared) Ee = MinSRInvSquared - Particles % xpic(No,2) = P_Tau - Particles % xpic(No,3) = P_RTau - Particles % dD(No,1,2) = vol1d + P_Tau = Acm*(Ee**EeExp)*Exx !dev stress !------analytical stresses------- Ha = (m1*Particles % Coordinate(No,1) + m2)**(-0.25_dp) + !Velocity + Va = Q0/Ha Exx = C*Ha*Ha*Ha Ee = Exx*Exx !dev stress A_Tau = Acm*(Ee**EeExp)*Exx - !resistive stress - A_RTau = 2.0_dp*A_Tau*Ha - IF ((A_Tau .NE. A_Tau) .OR. (P_Tau .NE. P_Tau)) THEN nancount = nancount + 1 @@ -3662,127 +3893,31 @@ SUBROUTINE SteadyStressError_1Dtest( Model, Solver, dt, TransientSimulation) END IF + Vp = Particles % Velocity(No,1) !For RMS: RMSnum_Tau = RMSnum_Tau + (A_Tau-P_Tau)*(A_Tau-P_Tau) RMSnum_RTau = RMSnum_RTau + (A_RTau-P_RTau)*(A_RTau-P_RTau) + RMSnum_V = RMSnum_V + (Va-Vp)*(Va-Vp) - !For R Squared: - tot_P_Tau = tot_P_Tau + P_Tau - tot_P_RTau = tot_P_RTau + P_RTau + RMSnum_Tau_W = RMSnum_Tau_W + vol1d*((A_Tau-P_Tau)*(A_Tau-P_Tau)) + RMSdenom_Tau_W = RMSdenom_Tau_W + vol1d*A_Tau*A_Tau - !Miscellaneous - Particles % XPIC(No,4) = A_Tau-P_Tau - Particles % XPIC(No,5) = A_RTau-P_RTau - Particles % XPIC(No,6) = A_Tau - Particles % dD(No,1,1) = A_RTau + RMSnum_V_W = RMSnum_V_W + vol1d*(Va-Vp)*(Va-Vp) + RMSdenom_V_W = RMSdenom_V_W + vol1d*Va*Va - count = count+1.0_dp - Particles % xpic(No,1) = 1.0_dp + Vtot = Vtot + vol1d + ! IF (Particles % ShapeFunctions == 'gimpm') THEN + ! Particles % Strain(No,1) = ((A_Tau-P_Tau)*(A_Tau-P_Tau))/(A_Tau*A_Tau) + ! Particles % Strain(No,2) = ((Va-Vp)*(Va-Vp))/(Va*Va) + ! ENDIF END DO - !-----RMS----- - RMS_Tau = sqrt(RMSnum_Tau/count) - RMS_RTau = sqrt(RMSnum_RTau/count) - - !-----R Squared----- - mean_P_Tau = tot_P_Tau/count - mean_P_RTau = tot_P_RTau/count - WHERE (Particles % xpic(:,1) == 1.0_dp) - Particles % xpic(:,2) = Particles % xpic(:,2)-mean_P_Tau - Particles % xpic(:,3) = Particles % xpic(:,3)-mean_P_RTau - END WHERE - - T_SS_tot = SUM(Particles % xpic(:,2)*Particles % xpic(:,2)) - RT_SS_tot = SUM(Particles % xpic(:,3)*Particles % xpic(:,3)) - T_SS_RES = SUM(Particles % xpic(:,4)*Particles % xpic(:,4)) - RT_SS_RES = SUM(Particles % xpic(:,5)*Particles % xpic(:,5)) - - RR_T = 1.0_dp - T_SS_RES/T_SS_tot - RR_RT = 1.0_dp - RT_SS_RES/RT_SS_tot - - - !----Stress Error, Weighted, like Bing et al 2019 BC paper ---- - - W_T_E_b = 0.0_dp - W_RT_E_b = 0.0_dp - totvolT = 0.0_dp - totvolRT = 0.0_dp - nonanT = 0.0_dp - nonanRT = 0.0_dp - - DO No = 1,Particles % NumberOfParticles - - IF (Particles % xpic(No,1) .NE. 1.0_dp) CYCLE - - !relative stress error at material point: - IF (Particles % xpic(No,6) .NE. 0.0_dp) THEN - RSE_T = (ABS(Particles % xpic(No,4))/ABS(Particles % xpic(No,6)))*Particles % dD(No,1,2) - IF (RSE_T == RSE_T) THEN - W_T_E_b = W_T_E_b + RSE_T - totvolT = totvolT + Particles % dD(No,1,2) - ELSE - nonanT = nonanT + 1 - END IF - END IF - - IF (Particles % dD(No,1,1) .NE. 0.0_dp) THEN - RSE_RT = (ABS(Particles % xpic(No,5))/ABS(Particles % dD(No,1,1)))*Particles % dD(No,1,2) - IF (RSE_RT == RSE_RT) THEN - W_RT_E_b = W_RT_E_b + RSE_RT - totvolRT = totvolRT + Particles % dD(No,1,2) - ELSE - nonanRT = nonanRT + 1 - END IF - END IF - END DO - - W_T_E_b = W_T_E_b/totvolT - W_RT_E_b = W_RT_E_b/totvolRT - - - - !---Stress Error, Not Weighted ---- - !num = sum(sqrt((data-actual)**2)*vol) - !denom = sum(sqrt(actual**2)*vol) - - !ABS( actual tau - particle tau) - Particles % xpic(:,4) = ABS(Particles % xpic(:,4)) - !ABS( actual Rtau - particle Rtau) - Particles % xpic(:,5) = ABS(Particles % xpic(:,5)) - !ABS( actual tau) - Particles % xpic(:,6) = ABS(Particles % xpic(:,6)) - !ABS( actual RTau) - Particles % dD(:,1,1) = ABS(Particles % dD(:,1,1)) - - NW_T_E = SUM(Particles % xpic(:,4))/SUM(Particles % xpic(:,6)) - NW_RT_E = SUM(Particles % xpic(:,6))/SUM(Particles % dD(:,1,1)) - - - - !----Stress Error, Weighted ---- - !ABS( actual tau - particle tau) * vol - Particles % xpic(:,4) = Particles % xpic(:,4) * Particles % dD(:,1,2) - !ABS( actual Rtau - particle Rtau) * vol - Particles % xpic(:,5) = Particles % xpic(:,5) * Particles % dD(:,1,2) - !ABS( actual tau) * vol - Particles % xpic(:,6) = Particles % xpic(:,6) * Particles % dD(:,1,2) - !ABS( actual RTau) * vol - Particles % dD(:,1,1) = Particles % dD(:,1,1) * Particles % dD(:,1,2) - - W_T_E = SUM(Particles % xpic(:,4))/SUM(Particles % xpic(:,6)) - W_RT_E = SUM(Particles % xpic(:,6))/SUM(Particles % dD(:,1,1)) - - - Particles % xpic = 0.0_dp - Particles % dD = 0.0_dp - - - OPEN (10, FILE=FileName,POSITION='APPEND') - WRITE (10,'(11ES19.12,3F4.1)') & - Particles % time, RMS_Tau, RMS_RTau, RR_T, RR_RT, NW_T_E, & - NW_RT_E, W_T_E, W_RT_E, W_T_E_b, W_RT_E_b,nonanT,nonanRT,nancount + OPEN (10, FILE=FileName,POSITION='APPEND') + WRITE (10,'(8ES19.12)') & + Particles % time, RMSnum_Tau_W,RMSdenom_Tau_W,RMSnum_V_W,RMSdenom_V_W,& + RMSnum_V_W_M,RMSdenom_V_W_M,Vtot CLOSE(10) END SUBROUTINE SteadyStressError_1Dtest @@ -3802,7 +3937,7 @@ SUBROUTINE AdvectRiftsTest( Model,Solver,dt,TransientSimulation ) IMPLICIT NONE TYPE(Solver_t), TARGET :: Solver TYPE(Model_t) :: Model - TYPE(Element_t), POINTER :: BulkElement + TYPE(Element_t), POINTER :: BulkElement REAL(KIND=dp) :: dt, PVal, Basis(4),xt(4),SqrtElementMetric,Coord(3) REAL(KIND=dp) :: xnodes(4),ynodes(4),scale,xmin LOGICAL :: TransientSimulation @@ -3814,10 +3949,10 @@ SUBROUTINE AdvectRiftsTest( Model,Solver,dt,TransientSimulation ) TYPE(Valuelist_t), POINTER :: Params LOGICAL :: GotIt,InterpToParticles,Stat TYPE(Particle_t), POINTER :: Particles - INTEGER, POINTER :: NodeIndexes(:) + INTEGER, POINTER :: NodeIndexes(:) - Particles => GlobalParticles - Params => GetSolverParams() + Particles => GlobalParticles + Params => GetSolverParams() Mesh => Solver % Mesh dim = CoordinateSystemDimension() @@ -3869,7 +4004,7 @@ SUBROUTINE AdvectRiftsTest( Model,Solver,dt,TransientSimulation ) Particles % usetracer = .TRUE. DO No = 1,Particles % NumberOfParticles - BulkElement => Model % Mesh % Elements(Particles % ElementIndex(No) ) + BulkElement => Model % Mesh % Elements(Particles % ElementIndex(No) ) Coord = GetParticleCoord( Particles, No) stat = ParticleElementInfo( BulkElement, Coord, & SqrtElementMetric, Basis ) diff --git a/PROG/MPM_SSA.F90 b/PROG/MPM_SSA.F90 index 66431db..251979d 100644 --- a/PROG/MPM_SSA.F90 +++ b/PROG/MPM_SSA.F90 @@ -3,7 +3,7 @@ !! for the MPM version is that particles (material points) serve as the integration !! points. Variables that update each iteration are mapped to material points in the !! subroutine UpdateSSAParticleVals. Matrix assembly using the particles occurs in -!! subroutine LocalMatrixUVSSAMPM. Optionally, matrix assembly for some parts of the domain may +!! subroutine LocalMatrixUVSSAMPM. Optionally, matrix assembly for some parts of the domain may !! be performed using the usual FEM routines (LocalMatrixUVSSAFEM, and when using damage, !! LocalMatrixUVSSAFEMDamage) when MPM isn't necessary for the entire ice domain. The FEM subroutines !! are also called for bulk element matrix assembly at the ice front (see Huth et al 2020, Part I). @@ -22,11 +22,11 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) ! ! ARGUMENTS: ! - ! TYPE(Model_t) :: Model, + ! TYPE(Model_t) :: Model, ! INPUT: All model information (mesh, materials, BCs, etc...) ! ! TYPE(Solver_t) :: Solver - ! INPUT: Linear & nonlinear equation solver options + ! INPUT: Linear & nonlinear equation solver options ! ! REAL(KIND=dp) :: dt, ! INPUT: Timestep size for time dependent simulations @@ -121,6 +121,8 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) INTEGER, POINTER :: BTrackPerm(:),mfperm(:),bmperm(:),opperm(:) REAL(KIND=dp), POINTER :: BtrackVal(:),mf(:) ,bmval(:), op(:) + REAL(KIND=dp) :: a_cm,a_secondsperyear,a_H0,a_v0,a_Q0,a_B0,a_A,a_C,a_EeExp,a_Acm,a_m1,a_m2 + SAVE rhow,sealevel, gravity, rhoi, gridres, NodalDensity,zssurf,convbefzs SAVE STIFF, LOAD, FORCE, AllocationsDone, DIM, SolverName, ElementNodes SAVE NodalU, NodalV, NodalD, NodeIndexes, NodalH,CriticalDav,Visited, count @@ -170,16 +172,16 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) MP % DSRxx => Particles % dD(1:NoP,1,1) MP % DSRyy => Particles % dD(1:NoP,1,2) - MP % DSRxy => Particles % dD(1:NoP,1,3) + MP % DSRxy => Particles % dD(1:NoP,1,3) MP % eta => Particles % dD(1:NoP,1,4) MP % muder => Particles % dD(1:NoP,2,1) - MP % slip => Particles % dD(1:NoP,2,2) + MP % slip => Particles % dD(1:NoP,2,2) MP % driveforce => Particles % dD(1:NoP,2,3:4) MP % GradVel => Particles % dD(:,3,1:4) MP % GridVelocity => Particles % dD(:,4,1:2) - + MP % Ezz => Particles % dD(1:NoP,4,3) MP % Exy => Particles % dD(1:NoP,4,4) @@ -231,7 +233,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) CALL Info(SolverName,'MPM interpolation of gradvel to particles...',Level=4) !3 is a dummy - CALL MPMMeshVectorToParticle(Particles, Model, 1,3 ) + CALL MPMMeshVectorToParticle(Particles, Model, 1,3 ) CALL Info(SolverName,'interpolation done',Level=4) !gradzs and falpha to particles @@ -311,7 +313,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) END IF END DO - j = 0 + j = 0 DO i = ElemFirst,ElemLast j=j+1 Element => Mesh % Elements( i ) @@ -367,7 +369,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) ! Vplus is just used for storage purposes Vstore => VariableGet(Model % Mesh % Variables, 'Vplus' ) - IF (.NOT. ASSOCIATED(Vstore)) CALL Fatal(SolverName,'Vplus does not exist ') + IF (.NOT. ASSOCIATED(Vstore)) CALL Fatal(SolverName,'Vplus does not exist ') VstorePerm => Vstore % Perm VstoreVal => Vstore % Values @@ -530,7 +532,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) M = Model % Mesh % NumberOfNodes - IF (AllocationsDone) DEALLOCATE(FORCE, LOAD, STIFF, & + IF (AllocationsDone) DEALLOCATE(FORCE, LOAD, STIFF, & NodalH, NodalGravity,NodalViscosity,& !NodalBTrack,NodalBM,& NodalZb, NodalZs, NodalBeta, NodalLinVelo, NodalGM,& NodalBed,NodalU, NodalV, NodalDensity, ElementNodes % x, & @@ -542,7 +544,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) END IF - ALLOCATE( FORCE(STDOFs*N), LOAD(N), STIFF(STDOFs*N,STDOFs*N), & + ALLOCATE( FORCE(STDOFs*N), LOAD(N), STIFF(STDOFs*N,STDOFs*N), & NodalH(N), NodalGravity(N), NodalViscosity(N), & !NodalBTrack(N),NodalBM(N),& NodalZb(N), NodalZs(N),NodalBeta(N), NodalLinVelo(N), & NodalGM(N),NodalBed(N),NodalU(N), NodalV(N), NodalDensity(N), & @@ -602,9 +604,9 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) END IF ! Read the Viscosity exponent m in MMaterial Section - ! Same definition as NS Solver in Elmer - n=1/m , A = 1/ (2 eta^n) + ! Same definition as NS Solver in Elmer - n=1/m , A = 1/ (2 eta^n) cn = GetConstReal( Model % Constants, 'Viscosity Exponent', GotIt ) - IF (.NOT. GotIt) CALL Fatal(Solvername,'Need to define "Viscosity Exponent = Real $1/n" in constants') + IF (.NOT. GotIt) CALL Fatal(Solvername,'Need to define "Viscosity Exponent = Real $1/n" in constants') MinSRInv = GetConstReal( Model % Constants, 'Critical Shear Rate', GotIt ) IF (.NOT. GotIt) CALL Fatal(Solvername,'Need to define "Critical Shear Rate = Real $1crit" in constants') @@ -616,9 +618,9 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) END DO Material => GetMaterial(Element) - Friction = GetString(Material, 'SSA Friction Law', Found) + Friction = GetString(Material, 'SSA Friction Law', Found) IF (.NOT.Found) CALL FATAL(SolverName,'Could not find Material keyword >SSA Friction Law<') - SELECT CASE(Friction) + SELECT CASE(Friction) CASE('linear') iFriction = 1 fm = 1.0_dp @@ -708,7 +710,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) minN,LinVelo,PostPeak,FricMaxVal,sealevel,& newton,usezerostressdamage,count,applyzerostress,UseFemMinMax,& FemMinX,FemMaxX,gridres,zssurf) - + !------------------------------------------------------------------------------- @@ -764,10 +766,10 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) !----------------------------------- FEM STUFF -------------------------------------! IF (ElemTrack(ei) % Status == FEM .OR. UseFem) THEN - Friction = GetString(Material, 'SSA Friction Law', Found) + Friction = GetString(Material, 'SSA Friction Law', Found) IF (.NOT.Found) & CALL FATAL(SolverName,'Could not find Material keyword >SSA Friction Law<') - SELECT CASE(Friction) + SELECT CASE(Friction) CASE('linear') iFriction = 1 fm = 1.0_dp @@ -818,7 +820,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) NodalBed(1:n)=BedrockSol%Values(BedrockSol%Perm(NodeIndexes(1:n))) ENDIF - IF (ElemTrack(ei) % Status == FEM .OR. UseFem) THEN + IF (ElemTrack(ei) % Status == FEM .OR. UseFem) THEN IF (Particles % usedamage) THEN @@ -905,7 +907,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) BC => GetBC() IF (.NOT.ASSOCIATED( BC ) ) CYCLE - CalvingFront=.False. + CalvingFront=.False. CalvingFront = ListGetLogical( BC, 'Calving Front', GotIt ) @@ -998,8 +1000,8 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) 'Nonlinear System Relaxation Factor', NewRelax ) WRITE( Message, * ) 'New Relaxation Factor : ', NewRelax - CALL Info(SolverName, Message, Level=1 ) - RelaxationAdapted = .TRUE. + CALL Info(SolverName, Message, Level=1 ) + RelaxationAdapted = .TRUE. END IF GOTO 100 END IF @@ -1021,9 +1023,9 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) CALL Info(Solvername,'interpolation done',Level=4) ELSE CALL Info(Solvername,& - 'interpolation of gradvel and gridvel to particles',Level=4) + 'interpolation of gradvel and gridvel to particles',Level=4) CALL MPMMeshVectorToParticle(Particles, Model, 1, 3 ) - CALL Info(Solvername,'interpolation done',Level=4) + CALL Info(Solvername,'interpolation done',Level=4) END IF @@ -1033,7 +1035,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) !Halve the relaxation factor. Hopefully, now it will converge. !Otherwise, will try to convert to purely picard iterations !until convergence... - IF (VisitedAdaptRelax .AND. UNorm> StartNewtonNorm*NormMultThres) THEN + IF (VisitedAdaptRelax .AND. UNorm> StartNewtonNorm*NormMultThres) THEN !Here, vstoreval is used for storage VariableValues(STDOFs*(Permutation(:)-1)+1) = VstoreVal(2*(VstorePerm(:)-1)+1) @@ -1043,20 +1045,20 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) Particles % GridVelocity(:,1:2) = MP % GridVelocity(:,1:2) IF (.NOT. RelaxationAdapted) THEN - CALL Info(Solvername,'SOL DIVERGING, HALVING RELAXATION AND RESTARTING NEWTON ITERS',Level=1) + CALL Info(Solvername,'SOL DIVERGING, HALVING RELAXATION AND RESTARTING NEWTON ITERS',Level=1) NewRelax = SaveRelax*0.5_dp CALL ListAddConstReal( Solver % Values, & 'Nonlinear System Relaxation Factor', NewRelax ) WRITE( Message, * ) 'New Relaxation Factor : ', NewRelax - CALL Info(SolverName, Message, Level=1 ) + CALL Info(SolverName, Message, Level=1 ) RelaxationAdapted = .TRUE. Newton = .TRUE. GOTO 300 ELSE - CALL Info(Solvername,'SOL DIVERGING AGAIN, RESTARTING FROM VEL = 0',Level=1) + CALL Info(Solvername,'SOL DIVERGING AGAIN, RESTARTING FROM VEL = 0',Level=1) VariableValues = 0.0_dp restarted = .TRUE. @@ -1084,7 +1086,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) IF (AdaptRelaxation .AND. (.NOT. VisitedAdaptRelax) ) THEN MP % GradVel(:,1:4) = Particles % GradVel(:,1:4) - MP % GridVelocity(:,1:2) = Particles % GridVelocity(:,1:2) + MP % GridVelocity(:,1:2) = Particles % GridVelocity(:,1:2) !Vstore just used for storage VstoreVal(2*(VstorePerm(:)-1)+1) = VariableValues(STDOFs*(Permutation(:)-1)+1) @@ -1124,17 +1126,17 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) Particles % zsmaxdd = MAXVAL(Particles % damage(:,3,2)-Particles % damage(:,3,1)) WRITE( Message, * ) 'Maximum zero stress damage increase : ', Particles % zsmaxdd - CALL Info(SolverName, Message, Level=1 ) + CALL Info(SolverName, Message, Level=1 ) END IF !----------------------------------------------------------------------------! ! SOLUTION CONVERGED: END LOOP NON-LINEAR ITERATIONS - !----------------------------------------------------------------------------! + !----------------------------------------------------------------------------! CALL Info(Solvername,'MPM interpolation of converged grid velocity to particles...',Level=4) CALL MPMMeshVectorToParticle(Particles, Model, 3, count) - CALL Info(Solvername,'interpolation done',Level=4) + CALL Info(Solvername,'interpolation done',Level=4) Particles % dd = 0.0_dp !Particles % xpic = 0.0_dp @@ -1205,10 +1207,10 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) diff = (depth(ii) - ds)/inc IF (ii == numlayers .AND. diff == 0.0_dp) EXIT IF (diff < 0.0_dp) THEN - Particles % damage(No,ii,1) = Particles % DmaxI + Particles % damage(No,ii,1) = Particles % DmaxI ELSE IF (diff <= 0.5_dp) THEN - Particles % damage(No,ii,1) = Particles % damage(No,ii,1) + 0.5_dp-diff + Particles % damage(No,ii,1) = Particles % damage(No,ii,1) + 0.5_dp-diff ELSE IF (ii+1 .NE. numlayers) THEN Particles % damage(No,ii+1,1) = (Particles % damage(No,ii+1,1)-1.0_dp) + 1.5_dp-diff @@ -1230,7 +1232,7 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) strainrate(1,1) = Particles % Dav(No,1) strainrate(2,2) = Particles % Dav(No,2) strainrate(1,2) = Particles % Dav(No,4) - strainrate(2,1) = strainrate(1,2) + strainrate(2,1) = strainrate(1,2) CALL Eigen2DSym_TryGenFirst(strainrate,EigVals,EigenVec) DO ii = 1,Particles % numberofparticlelayers @@ -1241,12 +1243,12 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) ww = EigVals(1)*EigenVec(1,1) xx = EigVals(2)*EigenVec(1,2) - yy = EigVals(1)*EigenVec(2,1) + yy = EigVals(1)*EigenVec(2,1) zz = EigVals(2)*EigenVec(2,2) Particles % damage(No,ii,1) = EigenVec(1,1)*ww + EigenVec(1,2)*xx Particles % damage(No,ii,2) = EigenVec(2,1)*yy + EigenVec(2,2)*zz - Particles % damage(No,ii,3) = EigVals(1) + Particles % damage(No,ii,3) = EigVals(1) Particles % damage(No,ii,4) = EigenVec(2,1)*ww + EigenVec(2,2)*xx END DO END IF @@ -1263,18 +1265,64 @@ SUBROUTINE MPM_SSA( Model,Solver,dt,TransientSimulation ) !------------------------------------------------------------------------------ IF (count == 0 .AND. Particles % firsttimestepzero) THEN - !if dt is zero on the first timestep (useful for initialization), use PIC + !if dt is zero on the first timestep (useful for initialization), use PIC CALL Info(Solvername,'PIC particle update on first timestep',Level=3) Particles % Velocity = Particles % GridVelocity Particles % NextCoordinate = Particles % GridVelocity IF (Particles % analytictest) THEN - Pval = rhoi * (rhow-rhoi)/rhow - Particles % Velocity(:,1) = ((Pval * Gravity * Particles % H(:)/ & - (4.0_dp * Particles % Binit(:)))**(3.0_dp)) * Particles % Coordinate(:,1) + ! Pval = rhoi * (rhow-rhoi)/rhow + ! Particles % Velocity(:,1) = ((Pval * Gravity * Particles % H(:)/ & + ! (4.0_dp * Particles % Binit(:)))**(3.0_dp)) * Particles % Coordinate(:,1) + ! Particles % Velocity(:,2) = 0.0_dp + ! Particles % GridVelocity = Particles % Velocity + + !Analytical 1D solution on first timestep... + + PRINT *,'ANALYTICAL 1D SOLUTION ON FIRST TIMESTEP' + + a_H0 = GetConstReal( Model % Constants,'H0',GotIt ) + IF (.NOT. GotIt) CALL Fatal('USF_1dtest:', & + 'initH: Need to define "H0 = Real $" in constants') + + a_v0 = GetConstReal( Model % Constants,'v0',GotIt ) + IF (.NOT. GotIt) CALL Fatal('USF_1dtest:', & + 'initH: Need to define "H0 = Real $" in constants') + + a_cm = 1.0_dp/3.0_dp + a_secondsperyear = 31556926.0_dp + !a_H0 = 600.0_dp + !a_v0 = 300.0_dp + a_Q0 = a_H0*a_v0 + a_B0 = 1.9E8_dp + a_A = ((a_B0*1.0E-6_dp)**(-3.0_dp))*a_secondsperyear !Mpa^(-3) a^(-1) + a_C = (((910.0_dp*1.0e-6_dp*9.81_dp)/& + (4.0_dp*(a_A**(-a_cm))))*(1.0_dp-910.0_dp/1028.0_dp))**3.0_dp + !C is the weertman constant !C =2.45E-18; !m?3 s?1 + + a_EeExp = (a_cm-1.0_dp)/2.0_dp + a_Acm = a_A**(-a_cm) + a_m1 = 4.0_dp*a_C/a_Q0 + a_m2 = 1.0_dp/(a_H0*a_H0*a_H0*a_H0) + + DO No = 1,Particles % NumberOfParticles + IF (Particles % Coordinate(No,1)<0.0_dp) THEN + Particles % H(No) = a_H0 + Particles % Velocity(No,1)=a_v0 + Particles % GradVel(No,1) = 0.0_dp + ELSE + Particles % H(No) = (a_m1*Particles % Coordinate(No,1) + a_m2)**(-0.25_dp) + Particles % Velocity(No,1) = a_Q0/Particles % H(No) + Particles % GradVel(No,1) = a_C * Particles % H(No)**(3.0_dp) + ENDIF + END DO + + Particles % Gradvel(:,2) = 0.0_dp Particles % Velocity(:,2) = 0.0_dp Particles % GridVelocity = Particles % Velocity + Particles % NextCoordinate = Particles % Velocity + END IF ELSE !if timestep > 1 and/or dt > 0 @@ -1443,7 +1491,7 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & reweightmpm,fpgroundonly,visited,applyzerostress INTEGER :: i, j, t, p, q , dim, No,ind,mm,sf,count2 TYPE(Nodes_t) :: Nodes - TYPE(GaussIntegrationPoints_t) :: IP + TYPE(GaussIntegrationPoints_t) :: IP REAL(KIND=dp) :: bfscale(2) REAL(KIND=dp),POINTER :: h,Dxx,Dyy,Dzz,Dxy,& @@ -1458,7 +1506,7 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & REAL(KIND=dp) :: t1,t2,tp,tm #else REAL(KIND=dp) :: t1,t2,tp,tm -#endif +#endif STIFF = 0.0_dp @@ -1530,18 +1578,18 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & h => Particles % H(No) - Dxx => MP % Dxx(No) - Dyy => MP % Dyy(No) - Dzz => MP % Dzz(No) - Dxy => MP % Dxy(No) + Dxx => MP % Dxx(No) + Dyy => MP % Dyy(No) + Dzz => MP % Dzz(No) + Dxy => MP % Dxy(No) DSRxx => MP % DSRxx(No) - DSRyy => MP % DSRyy(No) - DSRxy => MP % DSRxy(No) - eta => MP % eta(No) - muder => MP % muder(No) - slip => MP % slip(No) - driveforce => MP % driveforce(No,1:2) + DSRyy => MP % DSRyy(No) + DSRxy => MP % DSRxy(No) + eta => MP % eta(No) + muder => MP % muder(No) + slip => MP % slip(No) + driveforce => MP % driveforce(No,1:2) IF (iFriction>1) THEN @@ -1551,7 +1599,7 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & END IF IF ((iFriction == 2).AND.(fm==1.0_dp)) iFriction=1 - IF (iFriction==1) fNewtonLin = .FALSE. + IF (iFriction==1) fNewtonLin = .FALSE. StrainA=0.0_dp StrainB=0.0_dp @@ -1588,7 +1636,7 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & 0.5_dp*dBasisdx2(q,1)*Dxy) * dBasisdx(p,2) A(1,2) = (dBasisdx2(q,2)*(1.0_dp-Dzz) - 0.5_dp*dBasisdx2(q,1)*Dxy) * dBasisdx(p,1) + & - (-0.5_dp*dBasisdx2(q,2)*Dxy + 0.25_dp*dBasisdx2(q,1)*(2.0_dp-Dxx-Dyy)) * dBasisdx(p,2) + (-0.5_dp*dBasisdx2(q,2)*Dxy + 0.25_dp*dBasisdx2(q,1)*(2.0_dp-Dxx-Dyy)) * dBasisdx(p,2) A(2,1) = (dBasisdx2(q,1)*(1.0_dp-Dzz) - 0.5_dp*dBasisdx2(q,2)*Dxy)*dBasisdx(p,2) + & (-0.5_dp*dBasisdx2(q,1)*Dxy + 0.25_dp*dBasisdx2(q,2)*(2.0_dp-Dxx-Dyy))*dBasisdx(p,1) @@ -1606,8 +1654,8 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & Slip * Basis2(q) * Basis(p) * detJ DO j=1,STDOFs - STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) = STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) +& - A(i,j) * detJ + STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) = STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) +& + A(i,j) * detJ END DO END DO @@ -1626,7 +1674,7 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & IF (STDOFs.EQ.1) THEN Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) +& detJ * 2.0_dp * h * StrainA(1,1) *dBasisdx(p,1) * & - muder * 2.0_dp * DSRxx * dBasisdx2(q,1) + muder * 2.0_dp * DSRxx * dBasisdx2(q,1) ELSE IF (STDOFs.EQ.2) THEN Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) +& detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & @@ -1634,19 +1682,19 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & dBasisdx2(q,1)+DSRxy*dBasisdx2(q,2)) Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+2) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+2) +& - detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & + detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & (StrainB(1,1)+StrainB(1,2))*dBasisdx(p,2)) * muder *((2.0_dp*DSRyy+DSRxx)*& dBasisdx2(q,2)+DSRxy*dBasisdx2(q,1)) Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+1) +& - detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & + detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & (StrainB(2,1)+StrainB(2,2))*dBasisdx(p,1)) * muder *((2.0_dp*DSRxx+DSRyy)*& - dBasisdx2(q,1)+DSRxy*dBasisdx2(q,2)) + dBasisdx2(q,1)+DSRxy*dBasisdx2(q,2)) Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+2) = Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+2) +& detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & (StrainB(2,1)+StrainB(2,2))*dBasisdx(p,1)) * muder *((2.0_dp*DSRyy+DSRxx)*& - dBasisdx2(q,2)+DSRxy*dBasisdx2(q,1)) + dBasisdx2(q,2)+DSRxy*dBasisdx2(q,1)) END IF END IF @@ -1654,7 +1702,7 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & DO i=1,STDOFs - FORCE((STDOFs)*(p-1)+i) = FORCE((STDOFs)*(p-1)+i) - & + FORCE((STDOFs)*(p-1)+i) = FORCE((STDOFs)*(p-1)+i) - & driveforce(i) * detJ * Basis(p) @@ -1662,13 +1710,13 @@ SUBROUTINE LocalMatrixUVSSAMPM( STIFF, FORCE, Element, n, Nodes, g, & IF ((fNewtonLin).AND.(iFriction>1)) THEN DO i=1,STDOFs - FORCE((STDOFs)*(p-1)+i) = FORCE((STDOFs)*(p-1)+i) + & - Slip2 * Velo(i) * ub * ub * detJ * Basis(p) + FORCE((STDOFs)*(p-1)+i) = FORCE((STDOFs)*(p-1)+i) + & + Slip2 * Velo(i) * ub * ub * detJ * Basis(p) END DO END IF END DO END DO - + IF (NewtonLin) THEN @@ -1708,10 +1756,10 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & TYPE(Element_t), POINTER :: Element LOGICAL :: Newton !------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), ddBasisddx(n,3,3), detJ + REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), ddBasisddx(n,3,3), detJ REAL(KIND=dp) :: g, rho, eta, h, dhdx, dhdy , muder REAL(KIND=dp) :: beta, LinVelo, fC, fN, Velo(2), ub, alpha, fB - REAL(KIND=dp) :: gradS(2), A(2,2), StrainA(2,2), StrainB(2,2), Exx, Eyy, Exy, Ezz, Ee, MinSRInv ,MinH + REAL(KIND=dp) :: gradS(2), A(2,2), StrainA(2,2), StrainB(2,2), Exx, Eyy, Exy, Ezz, Ee, MinSRInv ,MinH REAL(KIND=dp) :: Jac(2*n,2*n), SOL(2*n), Slip, Slip2 LOGICAL :: Stat, NewtonLin, fNewtonLIn INTEGER :: i, j, t, p, q , dim @@ -1775,7 +1823,7 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & IF (STDOFs == 2) Velo(2) = SUM(LocalV(1:n) * Basis(1:n)) ub = SQRT(Velo(1)*Velo(1)+Velo(2)*Velo(2)) Slip2=1.0_dp - IF (ub < LinVelo) then + IF (ub < LinVelo) then ub = LinVelo Slip2=0.0_dp ENDIF @@ -1791,7 +1839,7 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & fC = FricMaxVal bedrock = SUM( NodalBed(1:n) * Basis(1:n) ) - Hf= rhow * (sealevel-bedrock) / rho + Hf= rhow * (sealevel-bedrock) / rho Hf = MAX(0.0_dp,Hf) fN = rho*g*(h-Hf) @@ -1804,7 +1852,7 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & Slip = beta fNewtonLin = .FALSE. ELSE IF (iFriction==2) THEN - Slip = beta * ub**(fm-1.0_dp) + Slip = beta * ub**(fm-1.0_dp) Slip2 = Slip2*Slip*(fm-1.0_dp)/(ub*ub) ELSE IF (iFriction==3) THEN IF (PostPeak.NE.1.0_dp) THEN @@ -1819,7 +1867,7 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & END IF !------------------------------------------------------------------------------ - ! In the non-linear case, effective viscosity + ! In the non-linear case, effective viscosity IF (cm.NE.1.0_dp) THEN Exx = SUM(LocalU(1:n)*dBasisdx(1:n,1)) Eyy = 0.0_dp @@ -1864,7 +1912,7 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & A = 0.0_dp DO p=1,n DO q=1,n - A(1,1) = 2.0_dp*dBasisdx(q,1)*dBasisdx(p,1) + A(1,1) = 2.0_dp*dBasisdx(q,1)*dBasisdx(p,1) IF (STDOFs.EQ.2) THEN A(1,1) = A(1,1) + 0.5_dp*dBasisdx(q,2)*dBasisdx(p,2) @@ -1875,15 +1923,15 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & 0.5_dp*dBasisdx(q,2)*dBasisdx(p,1) A(2,2) = 2.0*dBasisdx(q,2)*dBasisdx(p,2) +& - 0.5_dp*dBasisdx(q,1)*dBasisdx(p,1) + 0.5_dp*dBasisdx(q,1)*dBasisdx(p,1) END IF A = 2.0_dp * h * eta * A DO i=1,STDOFs STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+i) = STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+i) +& Slip * Basis(q) * Basis(p) * IP % S(t) * detJ DO j=1,STDOFs - STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) = STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) +& - A(i,j) * IP % S(t) * detJ + STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) = STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) +& + A(i,j) * IP % S(t) * detJ END DO END DO @@ -1900,23 +1948,23 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & IF (STDOFs.EQ.1) THEN Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) +& IP % S(t) * detJ * 2.0_dp * h * StrainA(1,1)*dBasisdx(p,1) * & - muder * 2.0_dp * Exx*dBasisdx(q,1) + muder * 2.0_dp * Exx*dBasisdx(q,1) ELSE IF (STDOFs.EQ.2) THEN Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) +& IP % S(t) * detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & - (StrainB(1,1)+StrainB(1,2))*dBasisdx(p,2)) * muder *((2.0_dp*Exx+Eyy)*dBasisdx(q,1)+Exy*dBasisdx(q,2)) + (StrainB(1,1)+StrainB(1,2))*dBasisdx(p,2)) * muder *((2.0_dp*Exx+Eyy)*dBasisdx(q,1)+Exy*dBasisdx(q,2)) Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+2) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+2) +& - IP % S(t) * detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & - (StrainB(1,1)+StrainB(1,2))*dBasisdx(p,2)) * muder *((2.0_dp*Eyy+Exx)*dBasisdx(q,2)+Exy*dBasisdx(q,1)) + IP % S(t) * detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & + (StrainB(1,1)+StrainB(1,2))*dBasisdx(p,2)) * muder *((2.0_dp*Eyy+Exx)*dBasisdx(q,2)+Exy*dBasisdx(q,1)) Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+1) +& - IP % S(t) * detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & - (StrainB(2,1)+StrainB(2,2))*dBasisdx(p,1)) * muder *((2.0_dp*Exx+Eyy)*dBasisdx(q,1)+Exy*dBasisdx(q,2)) + IP % S(t) * detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & + (StrainB(2,1)+StrainB(2,2))*dBasisdx(p,1)) * muder *((2.0_dp*Exx+Eyy)*dBasisdx(q,1)+Exy*dBasisdx(q,2)) Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+2) = Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+2) +& IP % S(t) * detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & - (StrainB(2,1)+StrainB(2,2))*dBasisdx(p,1)) * muder *((2.0_dp*Eyy+Exx)*dBasisdx(q,2)+Exy*dBasisdx(q,1)) + (StrainB(2,1)+StrainB(2,2))*dBasisdx(p,1)) * muder *((2.0_dp*Eyy+Exx)*dBasisdx(q,2)+Exy*dBasisdx(q,1)) END IF END IF @@ -1930,7 +1978,7 @@ SUBROUTINE LocalMatrixUVSSAFEM( STIFF, FORCE, Element, n, Nodes, gravity, & IF ((fNewtonLin).AND.(iFriction>1)) THEN DO i=1,STDOFs - FORCE((STDOFs)*(p-1)+i) = FORCE((STDOFs)*(p-1)+i) + & + FORCE((STDOFs)*(p-1)+i) = FORCE((STDOFs)*(p-1)+i) + & Slip2 * Velo(i) * ub * ub * IP % s(t) * detJ * Basis(p) !was basis END DO @@ -1966,7 +2014,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, Viscosity(:), LocalZb(:), LocalZs(:), & LocalU(:), LocalV(:) , LocalBeta(:), & LocalLinVelo(:),LocalD(:,:) - REAL(KIND=dp) :: NodalGM(:),NodalBed(:) + REAL(KIND=dp) :: NodalGM(:),NodalBed(:) LOGICAL :: SEP,PartlyGroundedElement REAL(KIND=dp) :: rhow,fricmaxval,minn REAL(KIND=dp) :: Bedrock,Hf @@ -1975,10 +2023,10 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, TYPE(Element_t), POINTER :: Element LOGICAL :: Newton !------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), ddBasisddx(n,3,3), detJ + REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), ddBasisddx(n,3,3), detJ REAL(KIND=dp) :: g, rho, eta, h, dhdx, dhdy , muder REAL(KIND=dp) :: beta, LinVelo, fC, fN, Velo(2), ub, alpha, fB - REAL(KIND=dp) :: gradS(2), A(2,2), StrainA(2,2), StrainB(2,2), Exx, Eyy, Exy, Ezz, Ee, MinSRInv ,MinH + REAL(KIND=dp) :: gradS(2), A(2,2), StrainA(2,2), StrainB(2,2), Exx, Eyy, Exy, Ezz, Ee, MinSRInv ,MinH REAL(KIND=dp) :: Jac(2*n,2*n), SOL(2*n), Slip, Slip2 REAL(KIND=dp) :: Dxx,Dyy,Dzz,Dxy,exxd1m1,eyyd2m1,ezzd3m1,exyd4,DSRxx,DSRyy,DSRxy LOGICAL :: Stat, NewtonLin, fNewtonLIn @@ -1987,7 +2035,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, TYPE(Nodes_t) :: Nodes INTEGER :: ind,No LOGICAL :: reweightmpm - REAL(KIND=dp) :: Area,scale,mpmweight + REAL(KIND=dp) :: Area,scale,mpmweight !------------------------------------------------------------------------------ dim = CoordinateSystemDimension() @@ -2045,7 +2093,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, IF (STDOFs == 2) Velo(2) = SUM(LocalV(1:n) * Basis(1:n)) ub = SQRT(Velo(1)*Velo(1)+Velo(2)*Velo(2)) Slip2=1.0_dp - IF (ub < LinVelo) then + IF (ub < LinVelo) then ub = LinVelo Slip2=0.0_dp ENDIF @@ -2061,7 +2109,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, fC = FricMaxVal bedrock = SUM( NodalBed(1:n) * Basis(1:n) ) - Hf= rhow * (sealevel-bedrock) / rho + Hf= rhow * (sealevel-bedrock) / rho Hf = MAX(0.0_dp,Hf) fN = rho*g*(h-Hf) @@ -2074,7 +2122,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, Slip = beta fNewtonLin = .FALSE. ELSE IF (iFriction==2) THEN - Slip = beta * ub**(fm-1.0_dp) + Slip = beta * ub**(fm-1.0_dp) Slip2 = Slip2*Slip*(fm-1.0_dp)/(ub*ub) ELSE IF (iFriction==3) THEN IF (PostPeak.NE.1.0_dp) THEN @@ -2089,7 +2137,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, END IF !------------------------------------------------------------------------------ - ! In the non-linear case, effective viscosity + ! In the non-linear case, effective viscosity IF (cm.NE.1.0_dp) THEN Exx = SUM(LocalU(1:n)*dBasisdx(1:n,1)) Eyy = 0.0_dp @@ -2170,7 +2218,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, (-0.5_dp*dBasisdx(q,1)*Dxy + 0.25_dp*dBasisdx(q,2)*(2.0_dp-Dxx-Dyy))*dBasisdx(p,1) A(2,2) = (dBasisdx(q,2)*(2.0_dp-Dyy-Dzz)-0.5_dp*dBasisdx(q,1)*Dxy)*dBasisdx(p,2) + & - (0.25_dp*dBasisdx(q,1)*(2.0_dp-Dxx-Dyy) - 0.5_dp*dBasisdx(q,2)*Dxy ) *dBasisdx(p,1) + (0.25_dp*dBasisdx(q,1)*(2.0_dp-Dxx-Dyy) - 0.5_dp*dBasisdx(q,2)*Dxy ) *dBasisdx(p,1) END IF A = 2.0_dp * h * eta * A @@ -2180,8 +2228,8 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+i) = STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+i) +& Slip * Basis(q) * Basis(p) * IP % S(t) * detJ DO j=1,STDOFs - STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) = STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) +& - A(i,j) * IP % S(t) * detJ + STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) = STIFF((STDOFs)*(p-1)+i,(STDOFs)*(q-1)+j) +& + A(i,j) * IP % S(t) * detJ END DO END DO @@ -2198,7 +2246,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, IF (STDOFs.EQ.1) THEN Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) +& detJ * 2.0_dp * h * StrainA(1,1) *dBasisdx(p,1) * & - muder * 2.0_dp * DSRxx * dBasisdx(q,1) + muder * 2.0_dp * DSRxx * dBasisdx(q,1) ELSE IF (STDOFs.EQ.2) THEN Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+1) +& detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & @@ -2206,19 +2254,19 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, dBasisdx(q,1)+DSRxy*dBasisdx(q,2)) Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+2) = Jac((STDOFs)*(p-1)+1,(STDOFs)*(q-1)+2) +& - detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & + detJ * 2.0_dp * h * ((StrainA(1,1)+StrainA(1,2))*dBasisdx(p,1)+ & (StrainB(1,1)+StrainB(1,2))*dBasisdx(p,2)) * muder *((2.0_dp*DSRyy+DSRxx)*& dBasisdx(q,2)+DSRxy*dBasisdx(q,1)) Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+1) = Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+1) +& - detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & + detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & (StrainB(2,1)+StrainB(2,2))*dBasisdx(p,1)) * muder *((2.0_dp*DSRxx+DSRyy)*& - dBasisdx(q,1)+DSRxy*dBasisdx(q,2)) + dBasisdx(q,1)+DSRxy*dBasisdx(q,2)) Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+2) = Jac((STDOFs)*(p-1)+2,(STDOFs)*(q-1)+2) +& detJ * 2.0_dp * h * ((StrainA(2,1)+StrainA(2,2))*dBasisdx(p,2)+ & (StrainB(2,1)+StrainB(2,2))*dBasisdx(p,1)) * muder *((2.0_dp*DSRyy+DSRxx)*& - dBasisdx(q,2)+DSRxy*dBasisdx(q,1)) + dBasisdx(q,2)+DSRxy*dBasisdx(q,1)) END IF END IF @@ -2232,7 +2280,7 @@ SUBROUTINE LocalMatrixUVSSAFEMDamage( STIFF, FORCE, Element, n, Nodes, gravity, IF ((fNewtonLin).AND.(iFriction>1)) THEN DO i=1,STDOFs - FORCE((STDOFs)*(p-1)+i) = FORCE((STDOFs)*(p-1)+i) + & + FORCE((STDOFs)*(p-1)+i) = FORCE((STDOFs)*(p-1)+i) + & Slip2 * Velo(i) * ub * ub * IP % s(t) * detJ * Basis(p) !was basis END DO @@ -2259,7 +2307,7 @@ END SUBROUTINE LocalMatrixUVSSAFEMDamage !> Here, matrix assembly for boundaries is the same for MPM as FEM SUBROUTINE LocalMatrixBCSSA( STIFF, FORCE, Element, n, ENodes, rhoi, & - g, LocalZb, LocalZs, rhow, sealevel,MinH ) + g, LocalZb, LocalZs, rhow, sealevel,MinH ) !------------------------------------------------------------------------------ USE TYPES USE DefUtils @@ -2291,18 +2339,18 @@ SUBROUTINE LocalMatrixBCSSA( STIFF, FORCE, Element, n, ENodes, rhoi, & ! h_im = max(0.0_dp , h * (rhoi/rhow) ) - h = LocalZs(i)-LocalZb(i) + h = LocalZs(i)-LocalZb(i) h = max(h,MinH) - h_im = max(0.0_dp,sealevel-LocalZb(i)) + h_im = max(0.0_dp,sealevel-LocalZb(i)) alpha=0.5_dp * g * (rhoi * h*h - rhow * h_im*h_im) FORCE(i) = FORCE(i) + alpha END DO - ! 2D-SSA Case : force distributed along the line + ! 2D-SSA Case : force distributed along the line ! This will work in DIM=3D only if working with Extruded Mesh and Preserve - ! Baseline as been set to True to keep the 1D-BC + ! Baseline as been set to True to keep the 1D-BC ELSE IF (STDOFs==2) THEN IP = GaussPoints( Element ) @@ -2319,7 +2367,7 @@ SUBROUTINE LocalMatrixBCSSA( STIFF, FORCE, Element, n, ENodes, rhoi, & h = SUM( (LocalZs(1:n)-LocalZb(1:n)) * Basis(1:n)) h_im = max(0.0_dp , SUM( (sealevel-LocalZb(1:n)) * Basis(1:n)) ) - ! h_im = max(0.0_dp , h * (rhoi/rhow) ) + ! h_im = max(0.0_dp , h * (rhoi/rhow) ) alpha=0.5_dp * g * (rhoi * h*h - rhow * h_im*h_im) @@ -2334,12 +2382,12 @@ SUBROUTINE LocalMatrixBCSSA( STIFF, FORCE, Element, n, ENodes, rhoi, & DO p=1,n DO i=1,STDOFs - FORCE(STDOFs*(p-1)+i) = FORCE(STDOFs*(p-1)+i) +& + FORCE(STDOFs*(p-1)+i) = FORCE(STDOFs*(p-1)+i) +& alpha * Normal(i) * IP % s(t) * detJ * Basis(p) END DO END DO END DO - ELSE + ELSE CALL FATAL('SSASolver-SSABasalSolver','Do not work for STDOFs <> 1 or 2') END IF @@ -2373,7 +2421,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& REAL(KIND=dp) :: cm, fm, fq, TempParams(18), OrigParams(18),Normal(2),norm,d1prev TYPE(Element_t), POINTER :: Element TYPE(Variable_t), POINTER :: GridVel,GridH - REAL(KIND=dp) :: Zs,GradZs(3),Vel(3),GradVel(3,3),noforce + REAL(KIND=dp) :: Zs,GradZs(3),Vel(3),GradVel(3,3),noforce LOGICAL :: Newton,reducedam,SEP TYPE(Model_t) :: Model REAL(KIND=dp) :: II(3,3),ID(3,3),DSR(3,3),Coord(3),LocalCoord(3),& @@ -2443,7 +2491,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& !MP % Dxx => Particles % dD(1:NoP,6,1) !MP % Dyy => Particles % dD(1:NoP,6,2) !MP % Dzz => Particles % dD(1:NoP,6,3) - !MP % Dxy => Particles % dD(1:NoP,6,4) + !MP % Dxy => Particles % dD(1:NoP,6,4) Particles % dD(1:NoP,6,1:4) = Particles % Dav(1:NoP,1:4) !END IF @@ -2469,7 +2517,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& ELSE !use particle velocity from previous timestep for friction MP % Velo(1:NoP,1) = Particles % Velocity(1:NoP,1) - MP % Velo(1:NoP,2) = Particles % Velocity(1:NoP,2) + MP % Velo(1:NoP,2) = Particles % Velocity(1:NoP,2) END IF MP % ub(1:NoP) = SQRT( MP % Velo(1:NoP,1) * MP % Velo(1:NoP,1) & @@ -2493,7 +2541,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& !------------------------------------------------------------------------------ ! In the non-linear case, effective viscosity - !your binit is B = A**(-1/n). + !your binit is B = A**(-1/n). MP % eta(1:NoP) = Particles % Binit(1:NoP) * (Particles % EF(1:NoP) * 2.0_dp)**(-1.0_dp * cm) @@ -2518,7 +2566,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& ! IF (Ee < MinSRInv*MinSRInv) THEN ! Ee = MinSRInv*MinSRInv ! muder = 0.0_dp - ! END IF + ! END IF WHERE (MP % Ee < MinSRInv*MinSRInv) MP % muder = 0.0_dp MP % Ee = MinSRInv*MinSRInv @@ -2555,9 +2603,9 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& IF (ApplyZeroStress .AND. Particles % Damstatus(No) .NE. 1) THEN - IF (Particles % gamma == 0.0_dp) THEN + IF (Particles % gamma == 0.0_dp) THEN Tau(1,1) = 2.0_dp * Exx + Eyy - Tau(2,2) = 2.0_dp * Eyy + Exx + Tau(2,2) = 2.0_dp * Eyy + Exx Tau(1,2) = Exy Tau(2,1) = Exy @@ -2593,25 +2641,25 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& denom = one/( Dxy*Dxy + Dxx + Dyy -Dxx*Dyy - one) t1d2m1 = Tau(1,1)*(Dyy-one)*denom t2d1m1 = Tau(2,2)*(Dxx-one)*denom - t3od3m1 = two*eta*onethird * (exxd1m1+eyyd2m1-two*ezzd3m1+two*exyd4)/(Dzz-one) + t3od3m1 = two*eta*onethird * (exxd1m1+eyyd2m1-two*ezzd3m1+two*exyd4)/(Dzz-one) d4t4 = Tau(1,2)*Dxy*denom - Etau(1,1) = onethird*(two*t1d2m1 - t2d1m1 +t3od3m1 -d4t4) - Etau(2,2) = onethird*(-t1d2m1 + two*t2d1m1 +t3od3m1 -d4t4) + Etau(1,1) = onethird*(two*t1d2m1 - t2d1m1 +t3od3m1 -d4t4) + Etau(2,2) = onethird*(-t1d2m1 + two*t2d1m1 +t3od3m1 -d4t4) ! Etau(3,3) = onethird*(-t1d2m1 - t2d1m1 - two*t3od3m1 + two*d4t4) Etau(1,2) = half*denom*(Tau(1,2)*(Dxx+Dyy-two) - Dxy*(Tau(1,1)+Tau(2,2))) - Etau(2,1) = Etau(1,2) + Etau(2,1) = Etau(1,2) Tau(1,1) = 2.0_dp * ETau(1,1) + ETau(2,2) - Tau(2,2) = 2.0_dp * ETau(2,2) + ETau(1,1) + Tau(2,2) = 2.0_dp * ETau(2,2) + ETau(1,1) - Tau(1,2) = Etau(1,2) - Tau(2,1) = Tau(1,2) + Tau(1,2) = Etau(1,2) + Tau(2,1) = Tau(1,2) IF (count == 0) THEN - IF (Particles % damage(No,3,3) == 0.0_dp) THEN + IF (Particles % damage(No,3,3) == 0.0_dp) THEN CALL Eigen2DSym_TryGenFirst(Tau,EigValues,EigenVec) Particles % damage(No,3,3) = 1.0_dp @@ -2659,7 +2707,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& DDD = MATMUL(MATMUL(TRANSPOSE(EigenVec),DDD),EigenVec) Tau = MATMUL(MATMUL(TRANSPOSE(EigenVec),Tau),EigenVec) - ETau = MATMUL(MATMUL(TRANSPOSE(EigenVec),ETau),EigenVec) + ETau = MATMUL(MATMUL(TRANSPOSE(EigenVec),ETau),EigenVec) IF (DDD(1,1) > DDD(2,2)) THEN EigValues(2) = Tau(1,1) @@ -2707,9 +2755,9 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& ds = (h * tp)/(Q + (tp-tau2)) IF (ds .NE. ds) ds = (h * tp)/(Q + (tp-tau2) +eps1) - !only basal crevasses + !only basal crevasses db = rho*(H*tp - hab*Q)/(Q*(rhow-rho)+(tp-tau2)*rho) - IF (db .NE. db) db = rho*(H+tp - hab*Q)/(Q*(rhow-rho)+(tp-tau2)*rho + eps1) + IF (db .NE. db) db = rho*(H+tp - hab*Q)/(Q*(rhow-rho)+(tp-tau2)*rho + eps1) ELSE !both surface and basal crevasses @@ -2729,7 +2777,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& IF (ds .NE. ds) ds = 0.0_dp END IF - !only basal crevasses + !only basal crevasses db = rho*(H*tp - hab*Q)/(Q*(rhow-rho)+tp*rho) IF (db .NE. db) THEN db = rho*(H+tp - hab*Q)/(Q*(rhow-rho)+tp*rho + eps1) @@ -2755,25 +2803,25 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& IF (dtot .NE. dtot) dtot = 0.0_dp - dtot = MAX(0.0_dp,MIN(dtot,h*Particles % riftdmax)) + dtot = MAX(0.0_dp,MIN(dtot,h*Particles % riftdmax)) !damage(No,3,1) is the max principal damage from the last step IF (dtot/h >= Particles % damage(No,3,1)) THEN Particles % damage(No,3,2) = dtot/H - IF (Particles % gamma > 0.0_dp) THEN + IF (Particles % gamma > 0.0_dp) THEN EigValues(2) = dtot/H EigValues(1) = 0.0_dp ww = EigValues(1)*EigenVec(1,1) xx = EigValues(2)*EigenVec(1,2) - yy = EigValues(1)*EigenVec(2,1) + yy = EigValues(1)*EigenVec(2,1) zz = EigValues(2)*EigenVec(2,2) Particles % Dav(No,1) = EigenVec(1,1)*ww + EigenVec(1,2)*xx Particles % Dav(No,2) = EigenVec(2,1)*yy + EigenVec(2,2)*zz Particles % Dav(No,4) = EigenVec(2,1)*ww + EigenVec(2,2)*xx - Particles % Dav(No,3) = 0.0_dp !dtot/H + Particles % Dav(No,3) = 0.0_dp !dtot/H ELSE Particles % Dav(No,1:3) = dtot/h Particles % Dav(No,4) = 0.0_dp @@ -2792,7 +2840,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& tp = tp*(1.0_dp-Particles % damage(No,3,2))/H ds = tp/(rhoi * g) - ds = MAX(ds,zero) + ds = MAX(ds,zero) db = (rhoi/(rhow-rhoi)) * ( ds -hab) db = MAX(db,zero) Particles % damage(No,1,1) = ds @@ -2801,7 +2849,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& END IF END IF - Particles % dD(No,6,1:4) = Particles % Dav(No,1:4) + Particles % dD(No,6,1:4) = Particles % Dav(No,1:4) END IF END DO !end of loop @@ -2813,7 +2861,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& IF (iFriction > 1) THEN IF (iFriction ==2 ) THEN - MP % Slip = MP % Slip * MP % ub**(fm-1.0_dp) + MP % Slip = MP % Slip * MP % ub**(fm-1.0_dp) MP % Slip2 = MP % Slip2 * MP % Slip * & (fm-1.0_dp)/(MP % ub * MP % ub) @@ -2836,7 +2884,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& MP % Slip = (MP % slip) * (MP % ub)**(fm-1.0_dp) / (1.0_dp + (MP % fB) * (MP % ub)**PostPeak)**fm MP % Slip2 = (MP % Slip2) * (MP % Slip) * ((fm-1.0_dp) / ((MP % ub) * (MP % ub)) - & - fm*PostPeak*(MP % fB)*(MP % ub)**(PostPeak-2.0_dp)/(1.0_dp+(MP % fB)*(MP % ub)**PostPeak)) + fm*PostPeak*(MP % fB)*(MP % ub)**(PostPeak-2.0_dp)/(1.0_dp+(MP % fB)*(MP % ub)**PostPeak)) END IF END IF @@ -2845,10 +2893,10 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& IF (NewtonLin) THEN - !slow way + !slow way ! ID = 0.0_dp ! ID(1,1) = Particles % Dav(No,1) !Dxx - ! ID(2,1) = Particles % Dav(No,4); ID(1,2) = Particles % Dav(No,4) !Dxy + ! ID(2,1) = Particles % Dav(No,4); ID(1,2) = Particles % Dav(No,4) !Dxy ! ID(2,2) = Particles % Dav(No,2) !Dyy ! ID(3,3) = Particles % Dav(No,3) !Dzz ! ID = II - ID @@ -2856,7 +2904,7 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& ! !DSR = deviatoric damage eff strain rate tensor ! DSR = 0.0_dp ! DSR(1,1) = Exx; DSR(2,2) = Eyy; DSR(3,3) = Ezz - ! DSR(2,1) = Exy; DSR(1,2) = Exy + ! DSR(2,1) = Exy; DSR(1,2) = Exy ! DSR = (MATMUL(ID,DSR) + MATMUL(DSR,ID)) ! DSR = 0.5_dp*(DSR - (II * ( ( DSR(1,1)+DSR(2,2)+DSR(3,3) )/3.0_dp) ) ) @@ -2880,8 +2928,8 @@ SUBROUTINE UpdateSSAParticleVals( NoP, g, rho, rhow,& END IF !driveforce - MP % driveforce(1:NoP,1) = rho*g*Particles % H(1:NoP)*Particles % GradZs(1:NoP,1) - MP % driveforce(1:NoP,2) = rho*g*Particles % H(1:NoP)*Particles % GradZs(1:NoP,2) + MP % driveforce(1:NoP,1) = rho*g*Particles % H(1:NoP)*Particles % GradZs(1:NoP,1) + MP % driveforce(1:NoP,2) = rho*g*Particles % H(1:NoP)*Particles % GradZs(1:NoP,2) END SUBROUTINE UpdateSSAParticleVals diff --git a/PROG/MPM_Utils.F90 b/PROG/MPM_Utils.F90 index 4e91e93..1ab287a 100644 --- a/PROG/MPM_Utils.F90 +++ b/PROG/MPM_Utils.F90 @@ -22,16 +22,16 @@ MODULE MPMUtils IMPLICIT NONE TYPE Particle_t - INTEGER :: Dim, NumberOfParticles=0, MaxNumberOfParticles=0,rkmsteps + INTEGER :: Dim, NumberOfParticles=0, MaxNumberOfParticles=0,rkmsteps REAL(KIND=dp) :: time, dtime, nextdtime !damage stuff - REAL(KIND=dp) :: psr(3,3),pressure1,RHS,dvdxmdudy + REAL(KIND=dp) :: psr(3,3),pressure1,RHS,dvdxmdudy !, P_i, P_w REAL(KIND=dp) :: CurrentEVal(3),CurrentEVect(2,2) REAL(KIND=dp), POINTER :: Coordinate(:,:) => NULL() - REAL(KIND=dp), POINTER :: NextCoordinate(:,:) => NULL() + REAL(KIND=dp), POINTER :: NextCoordinate(:,:) => NULL() INTEGER, POINTER :: Status(:) => NULL() INTEGER, POINTER :: ElementIndex(:) => NULL() @@ -67,7 +67,7 @@ MODULE MPMUtils REAL(KIND=dp) :: simtime,firstsimtime,& dsyevtimepd,dsyevtimeet,generaltimepd,generaltimeet,& ttime1,ttime2,fpdtime,dddttime,times,timee -#endif +#endif INTEGER :: NumberOfTemperatureLayers,buffer,& @@ -79,34 +79,34 @@ MODULE MPMUtils usegiveneta,setyvelzero,usebcforprevvel,usestaticparticles,UseHBC,& usesavedbasis,uplag,velocitydependentfriction,coulombfriction,& useisodam,peig,femforallnotfull,lmod,modifiedmurakami,& - restrictdam,rkmcritdam,nodzz,usedavtensor,& + restrictdam,rkmcritdam,nodzz,forcedzz,usedavtensor,& fixdavdirections,nodamregion,frontmelange,noxpiconbounds,analytictest,& firsttimestepzero,isorift,dmaxII_dom,& flipvelfric,weighth,trackstrain,& - alwayssplitfour,savedDscale,usedamscale,FEMifGrounded,steadyalbrecht,nodaminflow,& + alwayssplitfour,savedDscale,usedamscale,FEMifGrounded,nodaminflow,& binitlowerboundfromfirsttimestep,alwaysfemfront,prupt,noevolveruptlayers,& outputdbassis,mix49,Usedamage,mismipmelt2,IncNumPAtStart,UseOnePPC,simpleinitdam,& MISMIP,useriftdmax,nospin,trackdamstrain,initriftdam,& hoop,unstructuredmesh,& initcrack,noriftbounduntilfullsep,efboundsfromfirsttimestep,& useriftmelange,gradualdyz,& - larcmelfracmod,LarCFixDavTest,LarCDamTraj,usetracer + larcmelfracmod,LarCFixDavTest,LarCDamTraj,usetracer,usetruecauchydamage REAL(KIND=dp) :: icrackwidth,icrackx1,icrackx2,icracky1,icracky2 LOGICAL, POINTER :: UseInterpElem(:) => NULL() - LOGICAL, POINTER :: Static(:) => NULL() + LOGICAL, POINTER :: Static(:) => NULL() REAL(KIND=dp), POINTER :: Damage(:,:,:) => NULL() REAL(KIND=dp), POINTER :: dD(:,:,:) => NULL() - REAL(KIND=dp), POINTER :: damstrain(:) => NULL() - REAL(KIND=dp), POINTER :: F(:,:) => NULL() + REAL(KIND=dp), POINTER :: damstrain(:) => NULL() + REAL(KIND=dp), POINTER :: F(:,:) => NULL() REAL(KIND=dp), POINTER :: Dav(:,:) => NULL() REAL(KIND=dp), POINTER :: GradVel(:,:) => NULL() REAL(KIND=dp), POINTER :: GradZs(:,:) => NULL() - REAL(KIND=dp), POINTER :: GradH(:,:) => NULL() + REAL(KIND=dp), POINTER :: GradH(:,:) => NULL() REAL(KIND=dp), POINTER :: Velocity(:,:) => NULL() - REAL(KIND=dp), POINTER :: GridVelocity(:,:) => NULL() + REAL(KIND=dp), POINTER :: GridVelocity(:,:) => NULL() REAL(KIND=dp), POINTER :: Length(:,:) => NULL() REAL(KIND=dp), POINTER :: OrigLength(:,:) => NULL() REAL(KIND=dp), POINTER :: Bz(:,:) => NULL() @@ -115,7 +115,7 @@ MODULE MPMUtils REAL(KIND=dp), POINTER :: GMask(:) => NULL() REAL(KIND=dp), POINTER :: Bedrock(:) => NULL() REAL(KIND=dp), POINTER :: MB(:) => NULL() - REAL(KIND=dp), POINTER :: Binit(:) => NULL() + REAL(KIND=dp), POINTER :: Binit(:) => NULL() REAL(KIND=dp), POINTER :: FP(:) => NULL() REAL(KIND=dp), POINTER :: H(:) => NULL() REAL(KIND=dp), POINTER :: GVolume(:) => NULL() @@ -154,10 +154,10 @@ MODULE MPMUtils REAL(KIND=dp), POINTER :: ub(:) => NULL() REAL(KIND=dp), POINTER :: driveforce(:,:) => NULL() REAL(KIND=dp), POINTER :: GradVel(:,:) => NULL() - REAL(KIND=dp), POINTER :: GridVelocity(:,:) => NULL() + REAL(KIND=dp), POINTER :: GridVelocity(:,:) => NULL() REAL(KIND=dp), POINTER :: Velo(:,:) => NULL() ! REAL(KIND=dp), POINTER :: falpha => NULL !not used in this version - + END type MPforSSA_t @@ -180,14 +180,14 @@ MODULE MPMUtils INTEGER :: ddlayfrombottom1 INTEGER :: ddlayfromtop1 INTEGER :: ddlayfrombottom2 - INTEGER :: ddlayfromtop2 + INTEGER :: ddlayfromtop2 END TYPE ElementTrack_t TYPE :: SSAHInterpolationNodes_t INTEGER :: NumberOfNodes - INTEGER, allocatable :: Node(:) - INTEGER, allocatable :: ClosestParticle(:) - REAL(KIND=dp), allocatable :: Distance(:) + INTEGER, allocatable :: Node(:) + INTEGER, allocatable :: ClosestParticle(:) + REAL(KIND=dp), allocatable :: Distance(:) END TYPE SSAHInterpolationNodes_t @@ -200,13 +200,13 @@ MODULE MPMUtils INTEGER, PARAMETER :: & - + PARTICLE_ALLOCATED = 1, & PARTICLE_ACTIVE = 2, & PARTICLE_FIXEDCOORD = 3, & PARTICLE_LEAVING = 4, & PARTICLE_LOST = 5, & - + EMPTY = 1, & IGNORE = 2, & NOTFULL = 3, & @@ -225,8 +225,8 @@ MODULE MPMUtils CONTAINS - !> Gets the elements where the particle is located - FUNCTION GetParticleElement(Particles, No) RESULT ( Index ) + !> Gets the elements where the particle is located + FUNCTION GetParticleElement(Particles, No) RESULT ( Index ) TYPE(Particle_t), POINTER :: Particles INTEGER :: No INTEGER :: Index @@ -234,11 +234,11 @@ FUNCTION GetParticleElement(Particles, No) RESULT ( Index ) Index = Particles % ElementIndex(No) END FUNCTION GetParticleElement - !> Gets the Cartesian coordinates for a particle - FUNCTION GetParticleCoord(Particles, No) RESULT ( Coord ) + !> Gets the Cartesian coordinates for a particle + FUNCTION GetParticleCoord(Particles, No) RESULT ( Coord ) TYPE(Particle_t), POINTER :: Particles INTEGER :: No - REAL(KIND=dp) :: Coord(3) + REAL(KIND=dp) :: Coord(3) INTEGER :: dim Coord(3) = 0.0_dp @@ -251,7 +251,7 @@ END FUNCTION GetParticleCoord !> Gets the Status for a particle !! 1. PARTICLE_ALLOCATED; 2. PARTICLE_ACTIVE; 3. PARTICLE_FIXEDCOORD !! 4. PARTICLE_LEAVING; 5. PARTICLE_LOST - FUNCTION GetParticleStatus(Particles,No) RESULT ( Status ) + FUNCTION GetParticleStatus(Particles,No) RESULT ( Status ) TYPE(Particle_t), POINTER :: Particles INTEGER :: No INTEGER :: Status @@ -289,7 +289,7 @@ END FUNCTION coordsinelement FUNCTION GetParticleVolumeInElement(Particles,No,Element,Model) RESULT (Volume) TYPE(Particle_t), POINTER :: Particles TYPE(Element_t), POINTER :: Element - TYPE(Model_t) :: Model + TYPE(Model_t) :: Model INTEGER, POINTER :: NodeIndexes(:) INTEGER :: No,nn REAL(KIND=dp) :: Volume,Coord(3),xmin,xmax,ymin,ymax,LX,LY,N,S,E,W @@ -339,10 +339,10 @@ FUNCTION sMPMElementInfoFromCoords( Particles, Model, Nodes, h, & IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles TYPE(Model_t) :: Model - TYPE(Nodes_t) :: Nodes + TYPE(Nodes_t) :: Nodes REAL(KIND=dp) :: Basis(4),dBasisdx(4,3),Sv(4,2),dSv(4,2),diff(4,2) REAL(KIND=dp) :: one=1.0_dp,two = 2.0_dp,coord(2) - REAL(KIND=dp) :: h,oogr,e,n,half=0.5_dp,midx,midy + REAL(KIND=dp) :: h,oogr,e,n,half=0.5_dp,midx,midy LOGICAL :: Stat diff(:,1) = coord(1) - Nodes % x @@ -352,7 +352,7 @@ FUNCTION sMPMElementInfoFromCoords( Particles, Model, Nodes, h, & dSv = -sign( dSv,diff); midx = MINVAL(Nodes % x) + half*h - midy = MINVAL(Nodes % y) + half*h + midy = MINVAL(Nodes % y) + half*h oogr = two/h e = oogr*(coord(1)-midx) @@ -396,10 +396,10 @@ FUNCTION sMPMElementInfo( Element,Particles, Model, Nodes, No, h, & TYPE(Particle_t), POINTER :: Particles TYPE(Element_t), POINTER :: Element TYPE(Model_t) :: Model - TYPE(Nodes_t) :: Nodes + TYPE(Nodes_t) :: Nodes INTEGER :: No REAL(KIND=dp) :: Basis(4),dBasisdx(4,3),ddBasisddx(4,3,3),Sv(4,2),dSv(4,2),diff(4,2) - REAL(KIND=dp) :: one=1.0_dp,two = 2.0_dp,half=0.5_dp + REAL(KIND=dp) :: one=1.0_dp,two = 2.0_dp,half=0.5_dp REAL(KIND=dp) :: h,oogr,e,n,midx,midy,detj,Coord(3) LOGICAL :: Stat,Visited=.FALSE. TYPE(GaussIntegrationPoints_t) :: IP @@ -417,13 +417,13 @@ FUNCTION sMPMElementInfo( Element,Particles, Model, Nodes, No, h, & Visited = .TRUE. END IF - IP = GaussPoints( Element , np=INT(Particles % elementfraction) ) + IP = GaussPoints( Element , np=INT(Particles % elementfraction) ) stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & IP % W(t), detJ, Basis, dBasisdx, ddBasisddx, .FALSE. ) t = t+1 - IF (t>Particles % elementfraction) t = 1 + IF (t>Particles % elementfraction) t = 1 RETURN END IF @@ -436,7 +436,7 @@ FUNCTION sMPMElementInfo( Element,Particles, Model, Nodes, No, h, & ddBasisddx = 0.0_dp RETURN - END IF + END IF diff(:,1) = Particles % Coordinate(No,1) - Nodes % x diff(:,2) = Particles % Coordinate(No,2) - Nodes % y @@ -445,7 +445,7 @@ FUNCTION sMPMElementInfo( Element,Particles, Model, Nodes, No, h, & dSv = -sign( dSv,diff) midx = MINVAL(Nodes % x) + half*h - midy = MINVAL(Nodes % y) + half*h + midy = MINVAL(Nodes % y) + half*h oogr = two/h e = oogr*(Particles % Coordinate(No,1)-midx) @@ -463,7 +463,7 @@ FUNCTION sMPMElementInfo( Element,Particles, Model, Nodes, No, h, & Sv(:,2) = one+n END WHERE - Sv = Sv*half + Sv = Sv*half WHERE(ABS(Sv)>one) dSv = -dSv @@ -483,7 +483,7 @@ FUNCTION GIMPMElementInfoFromCoords( Particles, Model, Nodes, No, h, & IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles TYPE(Model_t) :: Model - TYPE(Nodes_t) :: Nodes + TYPE(Nodes_t) :: Nodes INTEGER :: No,j,k,iter REAL(KIND=dp) :: Basis(4),dBasisdx(4,3),Sv(4,2),dSv(4,2),diff(4,2) REAL(KIND=dp), DIMENSION (2) :: t1,t2,t3,t4,t5,t6,lp @@ -496,12 +496,12 @@ FUNCTION GIMPMElementInfoFromCoords( Particles, Model, Nodes, No, h, & lp = 0.5_dp * Particles % Length(No,1:2) - t1 = -h - lp - t2 = -h + lp - t3 = -lp - t4 = lp - t5 = h - lp - t6 = h + lp + t1 = -h - lp + t2 = -h + lp + t3 = -lp + t4 = lp + t5 = h - lp + t6 = h + lp Sv = 0.0_dp dSv = 0.0_dp @@ -510,7 +510,7 @@ FUNCTION GIMPMElementInfoFromCoords( Particles, Model, Nodes, No, h, & diff(:,2) = Particles % Coordinate(No,2) - Nodes % y - DO j = 1,2 + DO j = 1,2 DO k = 1,4 !basis @@ -553,7 +553,7 @@ FUNCTION GIMPMElementInfo( pperm, Particles, Model,Element, Nodes, No, & TYPE(Element_t), TARGET :: Element TYPE(Element_t), POINTER :: PointElement TYPE(Nodes_t), OPTIONAL :: Nodes - REAL(KIND=dp) :: detj + REAL(KIND=dp) :: detj REAL(KIND=dp) :: Basis(4),pg(2),nx(4),ny(4), & pl(2),Lg(2),Ll(2),E1(2),E2(2),Sa(2),Sb(2),dSa(2),dSb(2) REAL(KIND=dp) :: weight,nxmax,nxmin,nymax,nymin,Sx,dSx,Sy,dSy,& @@ -588,7 +588,7 @@ FUNCTION GIMPMElementInfo( pperm, Particles, Model,Element, Nodes, No, & Basis(:) = 0.0_dp dBasisdx(:,:) = 0.0_dp - nn = Element % Type % NumberOfNodes + nn = Element % Type % NumberOfNodes NodeIndexes => Element % NodeIndexes nx(1:nn) = Model % Mesh % Nodes % x(NodeIndexes) @@ -609,7 +609,7 @@ FUNCTION GIMPMElementInfo( pperm, Particles, Model,Element, Nodes, No, & Lg(1) = Particles % Length(No,1) Lg(2) = Particles % Length(No,2) - scale = 1.0_dp + scale = 1.0_dp IF (calcscale) THEN IF (Particles % Status(No) >= PARTICLE_LEAVING) THEN @@ -627,7 +627,7 @@ FUNCTION GIMPMElementInfo( pperm, Particles, Model,Element, Nodes, No, & N = Particles % Coordinate(No,2) + Particles % Length(No,2)/2.0_dp S = Particles % Coordinate(No,2) - Particles % Length(No,2)/2.0_dp E = Particles % Coordinate(No,1) + Particles % Length(No,1)/2.0_dp - W = Particles % Coordinate(No,1) - Particles % Length(No,1)/2.0_dp + W = Particles % Coordinate(No,1) - Particles % Length(No,1)/2.0_dp IF (nxmax < pg(1)) THEN ! rc(2) = 1 @@ -703,7 +703,7 @@ FUNCTION GIMPMElementInfo( pperm, Particles, Model,Element, Nodes, No, & IF ( PRESENT(dBasisdx) ) THEN dSa(k) = ( E1(k) - E2(k) ) / ( 2.0_dp * Lg(k) ) - dSb(k) = ( E2(k) - E1(k) ) / ( 2.0_dp * Lg(k) ) + dSb(k) = ( E2(k) - E1(k) ) / ( 2.0_dp * Lg(k) ) END IF END DO @@ -741,7 +741,7 @@ END FUNCTION GIMPMElementInfo !************************************************************************** - !> linspace function (as in MATLAB) + !> linspace function (as in MATLAB) SUBROUTINE linspace(from, to, array) REAL(KIND=dp), intent(in) :: from, to REAL(KIND=dp), intent(out) :: array(:) @@ -769,7 +769,7 @@ END SUBROUTINE linspace !! Defines some global particle constants so that we can keep things clean and !! avoid calling them for multiple subroutines !! CAUTION: Some of these global parameters may no longer be actively used - SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) + SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) IMPLICIT NONE TYPE(Model_t) :: Model @@ -779,7 +779,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) REAL(KIND=dp) :: MinCoord(3), MaxCoord(3), s(3) INTEGER :: ierr LOGICAL :: GotIt - CHARACTER(LEN=MAX_NAME_LEN) :: SolverName + CHARACTER(LEN=MAX_NAME_LEN) :: SolverName WRITE(SolverName, '(A)') 'InitializeParticles: SetParticlePreliminaries' @@ -798,7 +798,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) Particles % dim = Mesh % Meshdim END IF - ! Create list of faces / edges + ! Create list of faces / edges !Mesh => GetMesh() CALL FindMeshEdges( Mesh, .FALSE.) IF ( ParEnv % PEs > 1 ) THEN @@ -813,12 +813,12 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) PRINT *,'' PRINT *,'' PRINT *,'' - PRINT *,'' + PRINT *,'' PRINT *,'SHAPE FUNCTIONS: ',Particles % ShapeFunctions PRINT *,'' PRINT *,'' PRINT *,'' - PRINT *,'' + PRINT *,'' Particles % DamageModel = ListGetString( Model % Constants,'Damage Model',GotIt ) @@ -873,6 +873,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) ELSE Particles % trackstrain = .TRUE. END IF + !Particles % trackstrain = .TRUE. Particles % usetracer = GetLogical( Model % Constants, & 'Use Tracer', GotIt ) @@ -880,7 +881,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) CALL Warn(SolverName, & 'Use Tracer not defined, assume false!') Particles % usetracer = .FALSE. - END IF + END IF Particles % alwayssplitfour = .FALSE. @@ -927,7 +928,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) Particles % k2 = GetConstReal( Model % Constants, 'k2', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName,& - 'Need to define "k2=Real $" in constants') + 'Need to define "k2=Real $" in constants') Particles % gamma = GetConstReal( Model % Constants, 'gamma', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName,& @@ -1041,16 +1042,24 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) Particles % noDzz = .FALSE. END IF + Particles % forceDzz = GetLogical( Model % Constants, & + 'Force Dzz', GotIt ) + IF (.NOT. GotIt) THEN + CALL Warn(SolverName, & + 'Force Dzz not defined, assume false!') + Particles % forceDzz = .FALSE. + END IF + Particles % unstructuredmesh = GetLogical( Model % Constants, 'Unstructured mesh',GotIt) IF (.NOT. GotIt) Particles % unstructuredmesh = .FALSE. - + Particles % hoop = GetLogical( Model % Constants, 'hoop', GotIt ) IF (.NOT. GotIt) Particles % hoop = .FALSE. IF (Particles % hoop) THEN Particles % unstructuredmesh = .TRUE. END IF - + Particles % nospin = GetLogical( Model % Constants, 'no damage spin', GotIt ) IF (.NOT. GotIt) Particles % nospin = .FALSE. @@ -1184,7 +1193,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) IF (Particles % shapefunctions .NE. 'gimpm') THEN CALL Warn(SolverName,'Saved basis only works with gimpm, setting false!!') - Particles % usesavedbasis = .FALSE. + Particles % usesavedbasis = .FALSE. END IF Particles % uplag = .FALSE. @@ -1218,7 +1227,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) IF (Particles % useisodam) THEN Particles % initDmax = GetConstReal( Model % Constants, 'Iso Max Damage', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName,& - 'If using Iso dam Need to define "Iso Max Damage=Real $" in constants') + 'If using Iso dam Need to define "Iso Max Damage=Real $" in constants') END IF @@ -1256,7 +1265,15 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) IF (.NOT. GotIt) THEN CALL Warn(SolverName, & 'Use Modified Murakami not found, assume false!') - Particles % modifiedmurakami = .False. + Particles % modifiedmurakami = .False. + END IF + + Particles % usetruecauchydamage = GetLogical( Model % Constants, & + 'Use True Cauchy Damage', GotIt ) + IF (.NOT. GotIt) THEN + CALL Warn(SolverName, & + 'Use True Cauchy Damage not found, assume false!') + Particles % usetruecauchydamage = .False. END IF @@ -1346,14 +1363,14 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) 'Need to define "icrack y2=Real $" in constants') Particles % bcracklayers = GetInteger( Model % Constants, & - 'basalcrack layers', GotIt ) + 'basalcrack layers', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & 'Need to define "Number of basalcrack Layers = Integer $" in constants') Particles % dbcracklayers = GetInteger( Model % Constants, & - 'diffuse basalcrack layers', GotIt ) + 'diffuse basalcrack layers', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & - 'Need to define "Number of diffuse basalcrack Layers = Integer $" in constants') + 'Need to define "Number of diffuse basalcrack Layers = Integer $" in constants') END IF @@ -1379,7 +1396,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) END IF !dont allow EF (the mesh-based enhancement factor) on a particle decrease - !below what existed at the first timestep + !below what existed at the first timestep Particles % efboundsfromfirsttimestep = GetLogical( Model % Constants, & 'EF bounds from First Timestep', GotIt ) IF (.NOT. GotIt) THEN @@ -1443,13 +1460,13 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) Particles % NumberOfTemperatureLayers = GetInteger( Model % Constants, & - 'Number of Temperature Layers', GotIt ) + 'Number of Temperature Layers', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & 'Need to define "Number of Temperature Layers = Real $" in constants') Particles % NumberOfParticleLayers = GetInteger( Model % Constants, & - 'Number of Particle Layers', GotIt ) + 'Number of Particle Layers', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & 'Need to define "Number of Particle Layers = Real $" in constants') @@ -1458,7 +1475,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) CALL Warn(Solvername,& 'Automatically increasing number of particle layers to 8, as required') END IF - + IF (Particles % DamageModel == 'zero stress') THEN Particles % NumberOfParticleLayers = Particles % NumberOfTemperatureLayers @@ -1505,7 +1522,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) Particles % maxGLlength = GetConstReal( Model % Constants, & 'Maximum Grounding Line Particle Length', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & - 'Need to define "Maximum Grounding Line Particle Length = Real $" in constants') + 'Need to define "Maximum Grounding Line Particle Length = Real $" in constants') Particles % davsplitthres = GetConstReal( Model % Constants, 'Dav Split Threshold', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & @@ -1513,7 +1530,7 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) Particles % buffer = GetInteger( Model % Constants, 'Number of Buffer Particles', GotIt ) - IF (.NOT. GotIt) Particles % buffer = 0 + IF (.NOT. GotIt) Particles % buffer = 0 Particles % DInitTolerance = GetConstReal( Model % Constants, 'Dinit Tolerance', GotIt ) @@ -1593,26 +1610,26 @@ SUBROUTINE SetMPMParticlePreliminaries(Particles,Model,dim) IF (.NOT. GotIt) THEN CALL Warn(SolverName,& 'Did not specify "Use SEP = Logical" in constants, so assuming false!!') - Particles % SEP = .FALSE. + Particles % SEP = .FALSE. END IF Particles % SimpleAdvectTest = GetLogical( Model % Constants, 'SimpleAdvectTest', GotIt) IF (.NOT. GotIt) THEN CALL Warn(SolverName,& 'Did not specify "SimmpleAdvectTest = Logical" in constants, so assuming false!!') - Particles % SimpleAdvectTest = .FALSE. + Particles % SimpleAdvectTest = .FALSE. END IF Particles % IncNumPAtStart = GetLogical( Model % Constants, & 'Increase Number Of Particles At Start', GotIt) IF (.NOT. GotIt) THEN - Particles % IncNumPAtStart = .TRUE. + Particles % IncNumPAtStart = .TRUE. END IF Particles % UseOnePPC = GetLogical( Model % Constants, & 'Use One PPC Edit', GotIt) IF (.NOT. GotIt) THEN - Particles % UseOnePPC = .False. + Particles % UseOnePPC = .False. END IF @@ -1639,7 +1656,7 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles INTEGER, OPTIONAL :: InitParticles LOGICAL, OPTIONAL :: AppendParticles TYPE(Model_t) :: Model - TYPE(ValueList_t), POINTER :: Params, BodyForce + TYPE(ValueList_t), POINTER :: Params, BodyForce TYPE(Variable_t), POINTER :: Var TYPE(Element_t), POINTER :: CurrentElement,Element TYPE(Mesh_t), POINTER :: Mesh @@ -1728,7 +1745,7 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles END IF ! Now decide on the number of particles. - !------------------------------------------------------------------------- + !------------------------------------------------------------------------- frac = Particles % elementfraction @@ -1759,7 +1776,7 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles ! If there are no particles in this partition, nothing to do - !------------------------------------------------------------------------- + !------------------------------------------------------------------------- IF( NewParticles == 0 ) RETURN IF (Particles % IncNumPAtStart) THEN @@ -1874,7 +1891,7 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles Nodes % z(1:n) = 0.0_dp stat = sMPMElementInfo( CurrentElement, Particles, Model, Nodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) CALL GetScalarFieldInMesh(GridH, CurrentElement, Basis, H) Particles % H(No) = H @@ -1891,7 +1908,7 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles Particles % F(No,1) = 1.0_dp Particles % F(No,2) = 1.0_dp Particles % ElementIndex(No) = ElementInd - Particles % InterpElem(No) = ElementInd + Particles % InterpElem(No) = ElementInd END DO @@ -1901,14 +1918,14 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles END IF PRINT *,'number of particles after start', No-1 - + RETURN END IF - + ! Allocate particles - !------------------------------------------------------------------------- + !------------------------------------------------------------------------- - CALL AllocateParticles( Particles, Model, LastParticle ) + CALL AllocateParticles( Particles, Model, LastParticle ) Particles % NumberOfParticles = LastParticle @@ -1988,19 +2005,19 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles xmove = -loc ELSE IF (ii == 5) THEN ymove = 0.0_dp - xmove = 0.0_dp + xmove = 0.0_dp ELSE IF (ii==6) THEN ymove = 0.0_dp - xmove = loc + xmove = loc ELSE IF (ii==7) THEN ymove = -loc - xmove = -loc + xmove = -loc ELSE IF (ii==8) THEN ymove = -loc - xmove = 0.0_dp + xmove = 0.0_dp ELSE IF (ii==9) THEN ymove = -loc - xmove = loc + xmove = loc END IF IF( j > Mesh % NumberOfBulkElements ) THEN @@ -2064,7 +2081,7 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles IF (ANY(Mesh % Nodes % x(NodeIndexes(1:n)) CurrentElement % NodeIndexes n = CurrentElement % TYPE % NumberOfNodes Coordinate(k,1) = SUM( Mesh % Nodes % x(NodeIndexes ) ) / n + xmove + gridres - Coordinate(k,2) = SUM( Mesh % Nodes % y(NodeIndexes ) ) / n + ymove + Coordinate(k,2) = SUM( Mesh % Nodes % y(NodeIndexes ) ) / n + ymove IF( dim == 3 ) Coordinate(k,3) = SUM( Mesh % Nodes % z(NodeIndexes ) ) / n END DO - Coordinate(:,1) = Coordinate(:,1) - loc + Coordinate(:,1) = Coordinate(:,1) - loc END IF END DO @@ -2176,7 +2193,7 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles xmove = 0.0_dp -stag ELSE IF (ii==9) THEN ymove = -loc - xmove = loc -stag + xmove = loc -stag END IF IF( j > Mesh % NumberOfBulkElements ) THEN @@ -2218,11 +2235,11 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles NodeIndexes => CurrentElement % NodeIndexes n = CurrentElement % TYPE % NumberOfNodes Coordinate(k,1) = SUM( Mesh % Nodes % x(NodeIndexes ) ) / n + xmove + gridres - Coordinate(k,2) = SUM( Mesh % Nodes % y(NodeIndexes ) ) / n + ymove + Coordinate(k,2) = SUM( Mesh % Nodes % y(NodeIndexes ) ) / n + ymove IF( dim == 3 ) Coordinate(k,3) = SUM( Mesh % Nodes % z(NodeIndexes ) ) / n END DO - Coordinate(:,1) = Coordinate(:,1) - loc + Coordinate(:,1) = Coordinate(:,1) - loc END IF END DO @@ -2288,7 +2305,7 @@ SUBROUTINE InitializeParticles( Particles, Model, InitParticles, AppendParticles xmove = loc4 ELSE IF (ii==16) THEN ymove = loc4 - xmove = loc4 + xmove = loc4 END IF IF( j > Mesh % NumberOfBulkElements ) THEN @@ -2329,7 +2346,7 @@ END SUBROUTINE InitializeParticles !>MakeInterpLayers holds the interpolation map and functions to !!interpolate between the temperature layers !!(e.g. variable Temperature with dofs = # temperature layers) - !!particle layers (# of particles layers is specified in constants). + !!particle layers (# of particles layers is specified in constants). !!InterpLayers % Map(particlelayer,1) and InterpLayers % Map(particlelayer,2) give the !!two temperature layers that a particle layers lies between. !!InterpLayers % InterpFun(particlelayer,1) and InterpLayers % InterpFun(particlelayer,2) @@ -2339,13 +2356,13 @@ SUBROUTINE MakeInterpLayers(Particles, Model) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles - TYPE(Model_t) :: Model + TYPE(Model_t) :: Model INTEGER :: numoflayers1,numoflayers2,H1,H2,ii,jj,I REAL(KIND = dp), POINTER :: x1(:),x2(:),z1(:),z2(:),interp1(:),interp2(:) REAL(KIND = dp) :: H,intsize1,intsize2 INTEGER, POINTER :: L1(:),L2(:) LOGICAL :: GotIt - CHARACTER(LEN=MAX_NAME_LEN) :: SolverName + CHARACTER(LEN=MAX_NAME_LEN) :: SolverName WRITE(SolverName, '(A)') 'MakeInterpLayers' @@ -2365,7 +2382,7 @@ SUBROUTINE MakeInterpLayers(Particles, Model) z1 = intsize1*(DBLE(x1)-1.0_dp) !spacing 2 (damage) - ALLOCATE(x2(numoflayers2),z2(numoflayers2)) + ALLOCATE(x2(numoflayers2),z2(numoflayers2)) H2 = numoflayers2-1 @@ -2375,7 +2392,7 @@ SUBROUTINE MakeInterpLayers(Particles, Model) !interpolation vars ALLOCATE(interp1(numoflayers2),interp2(numoflayers2)) - ALLOCATE(L1(numoflayers2),L2(numoflayers2)) + ALLOCATE(L1(numoflayers2),L2(numoflayers2)) DO ii = 1,numoflayers2 DO jj = 2,numoflayers1 @@ -2393,7 +2410,7 @@ SUBROUTINE MakeInterpLayers(Particles, Model) END DO InterpLayers % NumOfTLayers = numoflayers1 - InterpLayers % NumOfDLayers = numoflayers2 + InterpLayers % NumOfDLayers = numoflayers2 ALLOCATE(InterpLayers % Map(numoflayers2,2), InterpLayers % InterpFun(numoflayers2,2)) @@ -2404,15 +2421,15 @@ SUBROUTINE MakeInterpLayers(Particles, Model) PRINT *,'max map1',MAXVAL(InterpLayers % Map(:,1)) PRINT *,'min map2',MINVAL(InterpLayers % Map(:,2)) - PRINT *,'max map2',MAXVAL(InterpLayers % Map(:,2)) + PRINT *,'max map2',MAXVAL(InterpLayers % Map(:,2)) InterpLayers % InterpFun(:,1) = interp1 InterpLayers % InterpFun(:,2) = interp2 DEALLOCATE(x1,z1) - DEALLOCATE(x2,z2) + DEALLOCATE(x2,z2) DEALLOCATE(interp1,interp2) - DEALLOCATE(L1,L2) + DEALLOCATE(L1,L2) END SUBROUTINE MakeInterpLayers @@ -2428,7 +2445,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles TYPE(Solver_t), TARGET :: Solver - TYPE(Nodes_t) :: ElementNodes + TYPE(Nodes_t) :: ElementNodes TYPE(Model_t) :: Model TYPE(Element_t), POINTER :: BulkElement TYPE(Mesh_t), POINTER :: Mesh @@ -2449,8 +2466,8 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) fricparam,efparam,mbparam,sealevel,Hf,static,dscale,LarCRiftWidth REAL(KIND=dp) :: EigenVec(2,2),EigVals(2),strainrate(2,2),ww,xx,yy,zz,en LOGICAL :: Stat,GotIt,LarC,NoInitDam,LarCDamTraj,noprevdamatrift,& - ConstantMB,ConstantEF,ConstantFric,testfedit,testpass,bumptest - REAL(KIND=dp) :: xbump,hbump,abump,bbump,cbump,ge + ConstantMB,ConstantEF,ConstantFric,testfedit,testpass,bumptest,test1d + REAL(KIND=dp) :: xbump,hbump,abump,bbump,cbump,ge CHARACTER(LEN=MAX_NAME_LEN) :: VariableName,SolverName REAL(KIND=dp) :: cm,eta,Exx,Eyy,Ezz,Exy,Ee,Tau(3,3),tp,TT,DD,Q,Qw,dw,hab,dtot,ds,db @@ -2458,12 +2475,18 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) LOGICAL :: damrift,isodamatrift,pir REAL(KIND=dp) :: dsave,cslope,ang,DDD(2,2),rot(2,2) + INTEGER :: i + REAL(KIND=dp) :: dirichletmax + TYPE(Variable_t), POINTER :: GH,GHi,GVel1,GVel1i + REAL(KIND=dp), POINTER :: GHVal(:),GHiVal(:),GVel1Val(:),GVel1iVal(:) + INTEGER, POINTER :: GHPerm(:),GHiPerm(:),GVel1Perm(:),GVel1iPerm(:) + Params => GetSolverParams() Mesh => GetMesh() n = Mesh % MaxElementNodes - WRITE(SolverName, '(A)') 'InitParticleVars' + WRITE(SolverName, '(A)') 'InitParticleVars' ALLOCATE(ElementNodes % x(n),ElementNodes % y(n),ElementNodes % z(n)) @@ -2472,11 +2495,11 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) CriticalDamage = Particles % isodamcritdam !initDmax CriticalDav = Particles % isodamcritdav - !initDmax + !initDmax ELSE Dmax = Particles % DmaxI CriticalDamage = Particles % CriticalDamage - CriticalDav = Particles % CriticalDav + CriticalDav = Particles % CriticalDav END IF @@ -2538,6 +2561,12 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) Particles % initriftdam = .FALSE. END IF + test1d = GetLogical( Params,'Test1d',GotIt) + IF (.NOT. GotIt) THEN + Call Warn(SolverName,& + 'Did not specify "Test1d = Logical" in Params, so assuming false!!') + test1d = .FALSE. + END IF testpass = GetLogical( Params,'Test Pass',GotIt) IF (.NOT. GotIt) THEN @@ -2565,7 +2594,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) IF( GotIt ) THEN GridStatic => VariableGet( Mesh % Variables, TRIM(VariableName) ) IF(.NOT. ASSOCIATED( GridStatic ) ) THEN - CALL Fatal(SolverName,'Static Particle variable does not exist: '//TRIM(VariableName)) + CALL Fatal(SolverName,'Static Particle variable does not exist: '//TRIM(VariableName)) END IF END IF IF (.NOT. GotIt) CALL Fatal(SolverName, & @@ -2577,7 +2606,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) IF( GotIt ) THEN GridInvVisc => VariableGet( Mesh % Variables, TRIM(VariableName) ) IF(.NOT. ASSOCIATED( GridInvVisc ) ) THEN - CALL Fatal(SolverName,'InvVisc variable does not exist: '//TRIM(VariableName)) + CALL Fatal(SolverName,'InvVisc variable does not exist: '//TRIM(VariableName)) END IF END IF IF (.NOT. GotIt) CALL Fatal(SolverName, & @@ -2605,7 +2634,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) GridH => VariableGet( Mesh % Variables, TRIM(VariableName) ) IF(.NOT. ASSOCIATED( GridH ) ) THEN CALL Fatal(SolverName, & - 'Thickness variable does not exist: '//TRIM(VariableName)) + 'Thickness variable does not exist: '//TRIM(VariableName)) END IF END IF IF (.NOT. GotIt) CALL Fatal(SolverName, & @@ -2618,7 +2647,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) GridFP => VariableGet( Mesh % Variables, TRIM(VariableName) ) IF(.NOT. ASSOCIATED( GridFP ) ) THEN CALL Fatal(SolverName, & - 'Friction Parameter does not exist: '//TRIM(VariableName)) + 'Friction Parameter does not exist: '//TRIM(VariableName)) END IF END IF IF (.NOT. GotIt) CALL Fatal(SolverName, & @@ -2631,7 +2660,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) GridZs => VariableGet( Mesh % Variables, TRIM(VariableName) ) IF(.NOT. ASSOCIATED( GridZs ) ) THEN CALL Fatal(SolverName, & - 'Surface Height Variable does not exist: '//TRIM(VariableName)) + 'Surface Height Variable does not exist: '//TRIM(VariableName)) END IF END IF IF (.NOT. GotIt) CALL Fatal(SolverName, & @@ -2643,7 +2672,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) GridDMask => VariableGet( Mesh % Variables, TRIM(VariableName) ) IF(.NOT. ASSOCIATED( GridDMask ) ) THEN CALL Fatal(SolverName, & - 'Damage Mask Variable does not exist: '//TRIM(VariableName)) + 'Damage Mask Variable does not exist: '//TRIM(VariableName)) END IF END IF IF (.NOT. GotIt) CALL Fatal(SolverName, & @@ -2656,7 +2685,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) GridEF => VariableGet( Mesh % Variables, TRIM(VariableName) ) IF(.NOT. ASSOCIATED( GridEF ) ) THEN CALL Fatal(SolverName, & - 'EF Variable does not exist: '//TRIM(VariableName)) + 'EF Variable does not exist: '//TRIM(VariableName)) END IF END IF IF (.NOT. GotIt) CALL Fatal(SolverName, & @@ -2665,9 +2694,29 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) VariableName = ListGetString(Params,'Bedrock Variable Name',GotIt) IF( GotIt ) THEN - GridBed => VariableGet( Mesh % Variables, TRIM(VariableName) ) + GridBed => VariableGet( Mesh % Variables, TRIM(VariableName) ) END IF + IF (test1d) THEN + GHi => VariableGet(Model % Mesh % Variables, 'Hinit' ) + GHiPerm => GHi % Perm + GHiVal => GHi % Values + + GVel1i => VariableGet(Model % Mesh % Variables, 'InitVel 1' ) + GVel1iPerm => GVel1i % Perm + GVel1iVal => GVel1i % Values + + GVel1 => VariableGet(Model % Mesh % Variables, 'SSAVelocity 1' ) + GVel1Perm => GVel1 % Perm + GVel1Val => GVel1 % Values + + GH => VariableGet(Model % Mesh % Variables, 'H' ) + GHPerm => GH % Perm + GHVal => GH % Values + + dirichletmax = GetConstReal(Solver % Values,'dirichlet max x',GotIt) + ENDIF + ALLOCATE( Basis(n), dBasisdx(n, 3),newviscz(layers),Dam(layers) ) @@ -2712,7 +2761,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) ELSE IF (frac == 9.0_dp) THEN Particles % Length(:,:) = gridres/3.0_dp ELSE IF (frac == 16.0_dp) THEN - Particles % Length(:,:) = gridres/4.0_dp + Particles % Length(:,:) = gridres/4.0_dp ELSE CALL Fatal(SolverName, & 'Particle Element Fraction can currently only be 16,9,4, or 1') @@ -2745,7 +2794,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) ELSE IF (frac == 16.0_dp) THEN Particles % PVolume = (gridres/4.0_dp)*(gridres/4.0_dp) Particles % GVolume = Particles % PVolume - ELSE + ELSE CALL Fatal(SolverName, & 'Particle Element Fraction can currently only be 16,9,4, or 1') END IF @@ -2761,10 +2810,10 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) NodeIndexes => BulkElement % NodeIndexes nn = BulkElement % TYPE % NumberofNodes - CALL GetElementNodes(ElementNodes,BulkElement) + CALL GetElementNodes(ElementNodes,BulkElement) stat = sMPMElementInfo( BulkElement,Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) CALL GetScalarFieldInMesh(GridDmask, BulkElement, Basis, Dmask ) @@ -2780,7 +2829,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) !get temperature PRINT *,'interpolating temperature to particles...' CALL MPMMeshVectorToParticle( Particles, Model, 5, 1) - PRINT *,'temperature interpolation complete.' + PRINT *,'temperature interpolation complete.' END IF DO No = 1, NoParticles @@ -2799,10 +2848,10 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) NodeIndexes => BulkElement % NodeIndexes nn = BulkElement % TYPE % NumberofNodes - CALL GetElementNodes(ElementNodes,BulkElement) + CALL GetElementNodes(ElementNodes,BulkElement) stat = sMPMElementInfo( BulkElement, Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) IF( .NOT. stat ) THEN CALL Warn(SolverName,'Particle not in element') @@ -2834,7 +2883,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) IF (.NOT. ConstantEF) THEN CALL GetScalarFieldInMesh(GridEF, BulkElement, Basis, EF ) ! Particles % EF(No) = MIN(EF,1.0_dp) - Particles % EF(No) = MAX(EF,0.0_dp) + Particles % EF(No) = MAX(EF,0.0_dp) END IF @@ -2861,9 +2910,33 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) Particles % F(No,1) = 1.0_dp Particles % F(No,2) = 1.0_dp Particles % F(No,3) = 0.0_dp - Particles % F(No,4) = 0.0_dp + Particles % F(No,4) = 0.0_dp H = MAX(H,1.0_dp) + + ! IF (test1d) THEN + ! cm = 1.0_dp/3.0_dp + ! secondsperyear = 31556926.0_dp + ! H0 = 600.0_dp + ! v0 = 300.0_dp + ! Q0 = H0*v0 + ! B0 = 1.9E8_dp + ! A = ((B0*1.0E-6_dp)**(-3.0_dp))*secondsperyear !Mpa^(-3) a^(-1) + ! C = (((910.0_dp*1.0e-6_dp*9.81_dp)/& + ! (4.0_dp*(A**(-cm))))*(1.0_dp-910.0_dp/1028.0_dp))**3.0_dp + ! !C is the weertman constant !C =2.45E-18; !m?3 s?1 + ! EeExp = (cm-1.0_dp)/2.0_dp + ! Acm = A**(-cm) + ! m1 = 4.0_dp*C/Q0 + ! m2 = 1.0_dp/(H0*H0*H0*H0) + ! Ha = (m1*Particles % Coordinate(No,1) + m2)**(-0.25_dp) + ! !Velocity + ! Va = Q0/Ha + ! Exx = C*Ha*Ha*Ha + ! Particles % Velocity(No,1) = Va + ! Particles % H(No) = Ha + ! END IF + Particles % H(No) = H Particles % Mass(No) = Particles % pvolume(No) * Particles % H(No) * rhoi @@ -3044,6 +3117,17 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) CALL MPMParticlesToNodes( Particles, Model, 2) + IF (Test1D) THEN + print *,'TEST1d FIXING INITIAL MESH VALS' + Do i = 1,Model % Mesh % NumberOfNodes + IF (Model % Mesh % Nodes % x(i) <= dirichletmax) THEN + GHVal(GHPerm(i)) = GHiVal(GHiPerm(i)) + GVel1Val(GVel1Perm(i)) = GVel1iVal(GVel1iPerm(i)) + END IF + + END DO + END IF + IF ( ASSOCIATED( Basis ) ) DEALLOCATE( Basis ) IF ( ASSOCIATED( dBasisdx ) ) DEALLOCATE(dBasisdx) @@ -3052,7 +3136,7 @@ SUBROUTINE InitParticleVars(Particles, Model, Solver ) END SUBROUTINE InitParticleVars - !************************************************************************** + !************************************************************************** !> Distance to a line specified between two points +/- 1 km !! used for Larsen C initialization @@ -3070,7 +3154,7 @@ FUNCTION DistToLineBetweenTwoPoints(x0,y0,x1,y1,x2,y2) RESULT(dist) ymax = ymax+1000.0_dp xmin = xmin-1000.0_dp - ymin = ymin-1000.0_dp + ymin = ymin-1000.0_dp IF (xmax <= x0 .OR. xmin >= x0 .OR. ymax <= y0 .OR. ymin >= y0) THEN @@ -3103,7 +3187,7 @@ SUBROUTINE InitParticleDz(Particles, No,numoflayers,btzav,invvisc,Dav,Model,Dam, IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles - TYPE(Model_t) :: Model + TYPE(Model_t) :: Model INTEGER :: No,numoflayers,ii,kk,last,bestiter,numiters REAL(KIND=dp), POINTER :: Dam(:) REAL(KIND=dp) :: btzav,invvisc,Dav,rhoi,rhow @@ -3122,7 +3206,7 @@ SUBROUTINE InitParticleDz(Particles, No,numoflayers,btzav,invvisc,Dav,Model,Dam, IF (.NOT. Visited) THEN - WRITE(SolverName, '(A)') 'InitParticleDz' + WRITE(SolverName, '(A)') 'InitParticleDz' rhow = Particles % rhow rhoi = Particles % rhoi @@ -3344,7 +3428,7 @@ SUBROUTINE InitParticleDz(Particles, No,numoflayers,btzav,invvisc,Dav,Model,Dam, zrange = zhigh(ii)-zlow(ii) Dam(ii) = Dmax*((undamlow-zlow(ii))/zrange) ! IF (Dam(ii) < 0.0_dp) Dam(ii) = 0.0_dp - ! IF (Dam(ii) > Dmax) Dam(ii) = Dmax + ! IF (Dam(ii) > Dmax) Dam(ii) = Dmax IF (Dam(ii) > CriticalDamage) THEN IF (Dam(ii) > critormax) THEN Dam(ii) = Dmax @@ -3358,7 +3442,7 @@ SUBROUTINE InitParticleDz(Particles, No,numoflayers,btzav,invvisc,Dav,Model,Dam, zrange = zhigh(ii)-zlow(ii) Dam(ii) = Dmax*((zhigh(ii)-undamhigh)/zrange) ! IF (Dam(ii) < 0.0_dp) Dam(ii) = 0.0_dp - ! IF (Dam(ii) > Dmax) Dam(ii) = Dmax + ! IF (Dam(ii) > Dmax) Dam(ii) = Dmax IF (Dam(ii) > CriticalDamage) THEN IF (Dam(ii) > critormax) THEN Dam(ii) = Dmax @@ -3402,7 +3486,7 @@ SUBROUTINE InitParticleDz(Particles, No,numoflayers,btzav,invvisc,Dav,Model,Dam, END SUBROUTINE InitParticleDz - !************************************************************************** + !************************************************************************** !> Depth-average the 3-D damage field for a particle !! Accounts for the influence of vertically-varying viscosity @@ -3428,15 +3512,15 @@ SUBROUTINE VertIntDamFromVisc(Particles, No,layers,Model) newviscz(:) = D * Particles % Bz(No,:) newviscav = (SUM(newviscz)-half*(newviscz(1)+newviscz(layers)) ) * denom - Particles % Dav(No,ii) = newviscav/btzav + Particles % Dav(No,ii) = newviscav/btzav END DO END SUBROUTINE VertIntDamFromVisc !************************************************************************** - !> Subroutine allocates particles before launching them. - SUBROUTINE AllocateParticles(Particles, Model,NoParticles) + !> Subroutine allocates particles before launching them. + SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles @@ -3486,14 +3570,14 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) NoParticles = NoParticles + bufferparticles END IF - dim = Particles % dim + dim = Particles % dim dofs = dim PrevNoParticles = Particles % NumberOfParticles - ! If appending particles to existing particles, we essentially have to make a copy + ! If appending particles to existing particles, we essentially have to make a copy ! of the old allocation, reallocate the old allocation, and then fill the reallocated ! memory with the copied allocation for the existing particles. This effectively ! means we are at least doubling the memory use temporarily, which can cause a crash. @@ -3514,18 +3598,18 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) n1 = 1 n2 = PrevNoParticles - Bedrock => Particles % Bedrock + Bedrock => Particles % Bedrock Binit => Particles % Binit BZ => Particles % Bz - Coordinate => Particles % Coordinate + Coordinate => Particles % Coordinate Damage => Particles % Damage Dav => Particles % Dav dD => Particles % dD - EF => Particles % EF + EF => Particles % EF F => Particles % F FP => Particles % FP GMask => Particles % GMask - GradH => Particles % GradH + GradH => Particles % GradH GradVel => Particles % GradVel GradZs => Particles % GradZs GridVelocity => Particles % GridVelocity @@ -3545,7 +3629,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IF (Particles % usetracer) THEN Tracer => Particles % Tracer END IF - + Velocity => Particles % Velocity xpic => Particles % xpic @@ -3557,7 +3641,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) ElementIndex => Particles % ElementIndex - InterpElem => Particles % InterpElem + InterpElem => Particles % InterpElem Status => Particles % Status Static => Particles % Static @@ -3589,7 +3673,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) ALLOCATE( Particles % OrigLength(NoParticles,2) ) - IF (Particles % outputdbassis) THEN + IF (Particles % outputdbassis) THEN ALLOCATE( Particles % dbassis(NoParticles) ) END IF @@ -3603,14 +3687,14 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IF (Particles % usetracer) THEN ALLOCATE (Particles % Tracer(NoParticles)) END IF - + ALLOCATE( Particles % Velocity(NoParticles,dofs) ) ALLOCATE( Particles % xpic(NoParticles,6) ) ALLOCATE( Particles % ElementIndex(NoParticles) ) ALLOCATE( Particles % InterpElem(NoParticles) ) - ALLOCATE( Particles % Status(NoParticles) ) + ALLOCATE( Particles % Status(NoParticles) ) ALLOCATE( Particles % Static(NoParticles) ) ALLOCATE( Particles % DamStatus(NoParticles)) @@ -3627,13 +3711,13 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) DO No=1,PrevNoParticles IF ( Status(No) == PARTICLE_LOST ) CYCLE - IF ( Status(No) == PARTICLE_ALLOCATED ) CYCLE + IF ( Status(No) == PARTICLE_ALLOCATED ) CYCLE n = n+1 Perm(n) = No END DO WRITE(Message,'(A,I0)') 'Number of old active particles: ',n - CALL Info('AllocateParticles',Message,Level=4) + CALL Info('AllocateParticles',Message,Level=4) IF( n < PrevNoParticles ) THEN WRITE(Message,'(A,I0)') 'Number of deleted particles: ',PrevNoParticles-n @@ -3668,7 +3752,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) Particles % OrigLength(n1:n2,:) = OrigLength(Perm(n1:n2),:) - IF (Particles % outputdbassis) THEN + IF (Particles % outputdbassis) THEN Particles % dbassis(n1:n2) = dbassis(Perm(n1:n2)) END IF @@ -3682,12 +3766,12 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IF (Particles % usetracer) THEN Particles % Tracer(n1:n2) = Tracer(Perm(n1:n2)) END IF - + Particles % Velocity(n1:n2,:) = Velocity(Perm(n1:n2),:) Particles % xpic(n1:n2,:) = xpic(Perm(n1:n2),:) Particles % ElementIndex(n1:n2) = ElementIndex(Perm(n1:n2)) - Particles % InterpElem(n1:n2) = InterpElem(Perm(n1:n2)) + Particles % InterpElem(n1:n2) = InterpElem(Perm(n1:n2)) Particles % Status(n1:n2) = Status(Perm(n1:n2)) Particles % Static(n1:n2) = Static(Perm(n1:n2)) Particles % DamStatus(n1:n2) = DamStatus(Perm(n1:n2)) @@ -3701,17 +3785,17 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IF (ASSOCIATED(OrigNo)) DEALLOCATE(OrigNo) IF (ASSOCIATED(UseInterpElem)) DEALLOCATE(UseInterpElem) IF (ASSOCIATED(Static)) DEALLOCATE(Static) - IF (ASSOCIATED(DamStatus)) DEALLOCATE(DamStatus) + IF (ASSOCIATED(DamStatus)) DEALLOCATE(DamStatus) IF (ASSOCIATED(Status)) DEALLOCATE(Status) IF (ASSOCIATED(InterpElem )) DEALLOCATE(InterpElem ) - IF (ASSOCIATED(ElementIndex )) DEALLOCATE(ElementIndex ) + IF (ASSOCIATED(ElementIndex )) DEALLOCATE(ElementIndex ) IF (ASSOCIATED(xpic )) DEALLOCATE(xpic ) IF (ASSOCIATED(Velocity )) DEALLOCATE(Velocity ) IF (Particles % usetracer) THEN - IF (ASSOCIATED(Tracer)) DEALLOCATE(Tracer) + IF (ASSOCIATED(Tracer)) DEALLOCATE(Tracer) END IF - + IF (Particles % trackstrain) THEN IF (ASSOCIATED(Strain )) DEALLOCATE(Strain ) @@ -3719,7 +3803,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IF (ASSOCIATED(PVolume )) DEALLOCATE(PVolume ) - IF (Particles % outputdbassis) THEN + IF (Particles % outputdbassis) THEN IF (ASSOCIATED(dbassis ) ) DEALLOCATE(dbassis) END IF @@ -3733,7 +3817,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IF (ASSOCIATED(GridVelocity )) DEALLOCATE(GridVelocity ) IF (ASSOCIATED(GradZs )) DEALLOCATE(GradZs ) IF (ASSOCIATED(GradVel )) DEALLOCATE(GradVel ) - IF (ASSOCIATED(GradH )) DEALLOCATE(GradH ) + IF (ASSOCIATED(GradH )) DEALLOCATE(GradH ) IF (ASSOCIATED(GMask )) DEALLOCATE(GMask ) IF (ASSOCIATED(FP )) DEALLOCATE(FP ) IF (ASSOCIATED(F )) DEALLOCATE(F ) @@ -3744,7 +3828,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IF (ASSOCIATED(Coordinate )) DEALLOCATE(Coordinate ) IF (ASSOCIATED(Bz )) DEALLOCATE(Bz ) IF (ASSOCIATED(Binit )) DEALLOCATE(Binit ) - IF (ASSOCIATED(Bedrock )) DEALLOCATE(Bedrock ) + IF (ASSOCIATED(Bedrock )) DEALLOCATE(Bedrock ) END IF ! Initialize the newly allocated particles with default values @@ -3778,7 +3862,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) Particles % OrigLength(n1:n2,:) = 0.0_dp - IF (Particles % outputdbassis) THEN + IF (Particles % outputdbassis) THEN Particles % dbassis(n1:n2) = 0.0_dp END IF @@ -3795,7 +3879,7 @@ SUBROUTINE AllocateParticles(Particles, Model,NoParticles) IF (Particles % usetracer) THEN Particles % Tracer(n1:n2) = 0.0_dp END IF - + Particles % Velocity(n1:n2,:) = 0.0_dp Particles % xpic(n1:n2,:) = 0.0_dp @@ -3820,7 +3904,7 @@ END SUBROUTINE AllocateParticles !> Subroutine deletes lost particles that have exited the computational domain !! TODO: once the MPM code is parallelized, this routine should also be used for - !! particles that go to a neighboring partition, as in ParticleUtils.F90 + !! particles that go to a neighboring partition, as in ParticleUtils.F90 SUBROUTINE DeleteLostParticles(Particles) IMPLICIT NONE @@ -3837,7 +3921,7 @@ SUBROUTINE DeleteLostParticles(Particles) n = 0 n1 = 0 - highestnoparticleslost = .FALSE. + highestnoparticleslost = .FALSE. DO No=1,PrevNoParticles IF (Particles % Status(No) == PARTICLE_LOST .OR. & @@ -3865,7 +3949,7 @@ SUBROUTINE DeleteLostParticles(Particles) END IF ELSE CALL Info('DeleteLostParticles','First particle with changed permutation: '& - //TRIM(I2S(n1)),Level=1) + //TRIM(I2S(n1)),Level=1) END IF @@ -3885,22 +3969,22 @@ SUBROUTINE DeleteLostParticles(Particles) Particles % GradVel(n1:n2,:) = Particles % GradVel(Perm(n1:n2),:) Particles % GradZs(n1:n2,:) = Particles % GradZs(Perm(n1:n2),:) Particles % GridVelocity(n1:n2,:) = Particles % GridVelocity(Perm(n1:n2),:) - Particles % GVolume(n1:n2) = Particles % GVolume(Perm(n1:n2)) + Particles % GVolume(n1:n2) = Particles % GVolume(Perm(n1:n2)) Particles % H(n1:n2) = Particles % H(Perm(n1:n2)) Particles % InterpElem(n1:n2) = Particles % InterpElem(Perm(n1:n2)) Particles % Length(n1:n2,:) = Particles % Length(Perm(n1:n2),:) - Particles % Mass(n1:n2) = Particles % Mass(Perm(n1:n2)) + Particles % Mass(n1:n2) = Particles % Mass(Perm(n1:n2)) Particles % MB(n1:n2) = Particles % MB(Perm(n1:n2)) Particles % NextCoordinate(n1:n2,:) = Particles % NextCoordinate(Perm(n1:n2),:) Particles % OrigLength(n1:n2,:) = Particles % OrigLength(Perm(n1:n2),:) - IF (Particles % outputdbassis) THEN + IF (Particles % outputdbassis) THEN Particles % dbassis(n1:n2) = Particles % dbassis(Perm(n1:n2)) END IF Particles % PVolume(n1:n2) = Particles % PVolume(Perm(n1:n2)) - Particles % DamStatus(n1:n2) = Particles % DamStatus(Perm(n1:n2)) + Particles % DamStatus(n1:n2) = Particles % DamStatus(Perm(n1:n2)) Particles % Static(n1:n2) = Particles % Static(Perm(n1:n2)) Particles % Status(n1:n2) = Particles % Status(Perm(n1:n2)) @@ -3911,7 +3995,7 @@ SUBROUTINE DeleteLostParticles(Particles) IF (Particles % usetracer) THEN Particles % tracer(n1:n2) = Particles % Tracer(Perm(n1:n2)) END IF - + Particles % Velocity(n1:n2,:) = Particles % Velocity(Perm(n1:n2),:) Particles % xpic(n1:n2,:) = Particles % xpic(Perm(n1:n2),:) @@ -3937,7 +4021,7 @@ SUBROUTINE DeleteLostParticles(Particles) Particles % F(n2+1:PrevNoParticles,:) = 0.0_dp Particles % FP(n2+1:PrevNoParticles) = 0.0_dp Particles % GMask(n2+1:PrevNoParticles) = 0.0_dp - Particles % GradH(n2+1:PrevNoParticles,:) = 0.0_dp + Particles % GradH(n2+1:PrevNoParticles,:) = 0.0_dp Particles % GradVel(n2+1:PrevNoParticles,:) = 0.0_dp Particles % GradZs(n2+1:PrevNoParticles,:) = 0.0_dp Particles % GridVelocity(n2+1:PrevNoParticles,:) = 0.0_dp @@ -3950,13 +4034,13 @@ SUBROUTINE DeleteLostParticles(Particles) Particles % NextCoordinate(n2+1:PrevNoParticles,:) = 0.0_dp Particles % OrigLength(n2+1:PrevNoParticles,:) = 0.0_dp - IF (Particles % outputdbassis) THEN + IF (Particles % outputdbassis) THEN Particles % dbassis(n2+1:PrevNoParticles) = 0.0_dp END IF Particles % PVolume(n2+1:PrevNoParticles) = 0.0_dp - Particles % damstatus(n2+1:PrevNoParticles) = 0 + Particles % damstatus(n2+1:PrevNoParticles) = 0 Particles % Static(n2+1:PrevNoParticles) = .FALSE. Particles % Status(n2+1:PrevNoParticles) = PARTICLE_ALLOCATED @@ -3966,7 +4050,7 @@ SUBROUTINE DeleteLostParticles(Particles) IF (Particles % usetracer) THEN Particles % Tracer(n2+1:PrevNoParticles) = 0.0_dp - END IF + END IF Particles % Velocity(n2+1:PrevNoParticles,:) = 0.0_dp Particles % xpic(n2+1:PrevNoParticles,:) = 0.0_dp @@ -3988,13 +4072,13 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles - TYPE(Model_t) :: Model + TYPE(Model_t) :: Model TYPE(Mesh_t), POINTER :: Mesh - TYPE(Nodes_t) :: ElementNodes + TYPE(Nodes_t) :: ElementNodes TYPE(Variable_t), POINTER :: HVar,V1Var,V2Var,PassVar,Var, WeightVar,MassVar,& invvar,BCVar, IV1Var,IV2Var,HweightVar,BVar,PM,xp1var,xp2var,surfvar,& DxxVar,DyyVar,DzzVar,DxyVar,maskvar,mfvar,mfwvar,dirvar,dir2var,opvar - TYPE(Element_t), POINTER :: BulkElement + TYPE(Element_t), POINTER :: BulkElement INTEGER :: nn, nb, NoVar, ii, No, ni,t, whichtime CHARACTER(LEN=MAX_NAME_LEN) :: TargetVariableName INTEGER, POINTER :: NodeIndexes(:),HPerm(:),V1Perm(:),V2Perm(:),PassPerm(:),& @@ -4034,20 +4118,20 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) rhow = Particles % rhow sealevel = Particles % sealevel rhoi = Particles % rhoi - gridres = Particles % gridres + gridres = Particles % gridres g = ABS(Particles % gravity) cm = GetConstReal( Model % Constants, 'Viscosity Exponent', Found ) IF (.NOT. Found) CALL Fatal(SolverName,& - 'Need to define "Viscosity Exponent = Real $1/n" in constants') + 'Need to define "Viscosity Exponent = Real $1/n" in constants') Visited = .TRUE. END IF CALL INFO(Trim(SolverName), & - '-----Interpolating Particles to Field ----',Level=5) + '-----Interpolating Particles to Field ----',Level=5) WeightVar => VariableGet(Model % Mesh % Variables, 'TempVar' ) @@ -4103,7 +4187,7 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) V2Perm => V2Var % Perm IF (.NOT. Particles % uplag) THEN - V1Values = 0.0_dp + V1Values = 0.0_dp V2Values = 0.0_dp END IF @@ -4176,8 +4260,8 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) V2Values => V2Var % Values V2Perm => V2Var % Perm - V1Values = 0.0_dp - V2Values = 0.0_dp + V1Values = 0.0_dp + V2Values = 0.0_dp ELSEIF (whichtime == 5) THEN @@ -4223,7 +4307,7 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) ! NodeIndexes => BulkElement % NodeIndexes nn = BulkElement % TYPE % NumberofNodes - Area = ElementArea(Model % Mesh,BulkElement,nn) + Area = ElementArea(Model % Mesh,BulkElement,nn) DO t = 1,ABS(ElemParticles(ii) % NumberOfParticles) @@ -4239,16 +4323,16 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) IF (Particles % ShapeFunctions == 'gimpm') THEN stat = GIMPMElementInfo( t,Particles, Model,BulkElement, ElementNodes, No, & detJ, scale, .FALSE., Basis,dBasisdx) - ELSE + ELSE stat = sMPMElementInfo( BulkElement,Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) scale = 1.0_dp detJ = Particles % PVolume(No) END IF ! NOTE: using true for gimpmelementinfo takes particles with - ! status PARTICLE_LEAVING (i.e. overlapping a bound, or passive element) + ! status PARTICLE_LEAVING (i.e. overlapping a bound, or passive element) ! basis functions for that particle as if it was moved and scaled to fit ! entirely within the volume it overlaps in the element being called. ! Multiplying by "scale" is not applicable here. "Scale" is for use with @@ -4311,11 +4395,11 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) END IF - + IF (.NOT. Particles % uplag) THEN V1Values(V1Perm(NodeIndexes)) = V1Values(V1Perm(NodeIndexes)) + & - Basis(1:nn) * Particles % Velocity(No,1) * Particles % Mass(No) + Basis(1:nn) * Particles % Velocity(No,1) * Particles % Mass(No) V2Values(V2Perm(NodeIndexes)) = V2Values(V2Perm(NodeIndexes)) + & Basis(1:nn) * Particles % Velocity(No,2) * Particles % Mass(No) END IF @@ -4328,13 +4412,13 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) V1Values(V1Perm(NodeIndexes)) = V1Values(V1Perm(NodeIndexes)) + & Basis(1:nn) * Particles % Velocity(No,1) * & - Particles % Mass(No) + Particles % Mass(No) V2Values(V2Perm(NodeIndexes)) = V2Values(V2Perm(NodeIndexes)) + & Basis(1:nn) * Particles % Velocity(No,2) * & Particles % Mass(No) MassValues(MassPerm(NodeIndexes)) = MassValues(MassPerm(NodeIndexes)) +& - Basis(1:nn) * Particles % Mass(No) + Basis(1:nn) * Particles % Mass(No) IF (t==ABS(ElemParticles(ii) % NumberOfParticles)) THEN WeightValues(WeightPerm(NodeIndexes)) = WeightValues(WeightPerm(NodeIndexes)) + 1.0_dp @@ -4344,10 +4428,10 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) !you have stored particle vstar(r-1) on Particles % XPIC(No,1:2) V1Values(V1Perm(NodeIndexes)) = V1Values(V1Perm(NodeIndexes)) + & - Basis(1:nn) * Particles % xpic(No,1) * Particles % Mass(No) + Basis(1:nn) * Particles % xpic(No,1) * Particles % Mass(No) V2Values(V2Perm(NodeIndexes)) = V2Values(V2Perm(NodeIndexes)) + & - Basis(1:nn) * Particles % xpic(No,2) * Particles % Mass(No) + Basis(1:nn) * Particles % xpic(No,2) * Particles % Mass(No) ELSEIF (whichtime == 5) THEN @@ -4361,7 +4445,7 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) END IF HValues(HPerm(NodeIndexes)) = HValues(HPerm(NodeIndexes)) + & - Basis(1:nn) * zs *detJ / (Area) + Basis(1:nn) * zs *detJ / (Area) IF (t==ABS(ElemParticles(ii) % NumberOfParticles)) THEN WeightValues(WeightPerm(NodeIndexes)) = WeightValues(WeightPerm(NodeIndexes)) + 1.0_dp @@ -4382,19 +4466,19 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) Basis(1:nn) * detJ HValues(HPerm(NodeIndexes)) = HValues(HPerm(NodeIndexes)) + & - Basis(1:nn) * Particles % H(No) *detJ + Basis(1:nn) * Particles % H(No) *detJ ELSEIF (whichtime == 8) THEN V1Values(V1Perm(NodeIndexes)) = V1Values(V1Perm(NodeIndexes)) + & Basis(1:nn) * Particles % NextCoordinate(No,1) * & - Particles % Mass(No) + Particles % Mass(No) V2Values(V2Perm(NodeIndexes)) = V2Values(V2Perm(NodeIndexes)) + & Basis(1:nn) * Particles % NextCoordinate(No,2) * & Particles % Mass(No) MassValues(MassPerm(NodeIndexes)) = MassValues(MassPerm(NodeIndexes)) +& - Basis(1:nn) * Particles % Mass(No) + Basis(1:nn) * Particles % Mass(No) IF (t==ABS(ElemParticles(ii) % NumberOfParticles)) THEN WeightValues(WeightPerm(NodeIndexes)) = WeightValues(WeightPerm(NodeIndexes)) + 1.0_dp @@ -4526,7 +4610,7 @@ SUBROUTINE MPMParticlesToNodes( Particles, Model, whichtime) END DO ! CALL UpdateVelocityBoundsOnMesh( Model ) - CALL XPICBCVelocityUpdate( Model, V1Var, V1Perm, V1Values, V2Var, V2Perm, V2Values) + CALL XPICBCVelocityUpdate( Model, V1Var, V1Perm, V1Values, V2Var, V2Perm, V2Values) ELSEIF (whichtime == 5) THEN @@ -4614,12 +4698,12 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) ALLOCATE( ZsLocalField(nn), FLocalField(nn), & BLocalField(nn),MaskLocalField(nn),& HLocalField(nn),EFLocalField(nn), & - BedLocalField(nn), MBLocalField(nn)) + BedLocalField(nn), MBLocalField(nn)) g = ABS(Particles % gravity) - rhoi = Particles % rhoi + rhoi = Particles % rhoi rhow = Particles % rhow - dim = 2 + dim = 2 movegl = Particles % movegl ConstantMB = Particles % constmb @@ -4629,13 +4713,13 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) IF (ConstantMB) THEN mbparam = GetConstReal( Model % Constants, 'mbparam', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & - 'Need to define "mbparam = Real $mbparam" in constants') + 'Need to define "mbparam = Real $mbparam" in constants') END IF IF (ConstantEF) THEN efparam = GetConstReal( Model % Constants, 'efparam', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & - 'Need to define "efparam = Real $efparam" in constants') + 'Need to define "efparam = Real $efparam" in constants') END IF IF (ConstantFric) THEN @@ -4673,7 +4757,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) maskPerm => mask % Perm maskVal => mask % Values - MaskLocalField = 0.0_dp + MaskLocalField = 0.0_dp IF (.NOT. ConstantMB) THEN MB => VariableGet(Model % Mesh % Variables, 'MB' ) @@ -4699,7 +4783,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) IF (.NOT. ConstantFric) THEN F => VariableGet(Model % Mesh % Variables, 'FP' ) FPerm => F % Perm - FVal => F % Values + FVal => F % Values FLocalField = 0.0_dp ELSE Particles % FP(:) = fricparam @@ -4724,7 +4808,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) F => VariableGet(Model % Mesh % Variables, 'FP' ) FPerm => F % Perm - FVal => F % Values + FVal => F % Values MB => VariableGet(Model % Mesh % Variables, 'MB' ) MBPerm => MB % Perm @@ -4759,7 +4843,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) IF (ANY(Particles % Dav(No,:).NE.0.0_dp)) CYCLE END IF - Particles % Binit(No) = 0.0_dp + Particles % Binit(No) = 0.0_dp END DO ELSEIF (whichtime == 6) THEN @@ -4802,10 +4886,10 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) ZsPerm => Zs % Perm ZsVal => Zs % Values - ZsLocalField = 0.0_dp + ZsLocalField = 0.0_dp Particles % Gmask(:) = 0.0_dp - Particles % H(:) = 0.0_dp + Particles % H(:) = 0.0_dp Particles % GradZs(:,:) = 0.0_dp ELSEIF (whichtime == 9) THEN @@ -4814,7 +4898,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) HPerm => H % Perm HVal => H % Values - HLocalField = 0.0_dp + HLocalField = 0.0_dp END IF @@ -4823,7 +4907,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) DO ii = 1,nb - IF ( ElemTrack(ii) % Status >= FEM ) THEN + IF ( ElemTrack(ii) % Status >= FEM ) THEN BulkElement => Model % Mesh % Elements( ii ) NodeIndexes => BulkElement % NodeIndexes @@ -4854,7 +4938,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) EFLocalField(1:nn) = EFVal(EFPerm(BulkElement % NodeIndexes(1:nn))) END IF - ! MB + ! MB IF (.NOT. constantmb) THEN MBLocalField(1:nn) = MBVal(MBPerm(BulkElement % NodeIndexes(1:nn))) END IF @@ -4873,7 +4957,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) ZsLocalField(1:nn) = ZsVal(LocalPerm(1:nn)) ELSE IF (whichtime == 5) THEN - !BINIT + !BINIT BLocalField(1:nn) = BVal(BPerm(BulkElement % NodeIndexes(1:nn))) ELSE IF (whichtime == 6) THEN @@ -4900,7 +4984,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) ELSE stat = sMPMElementInfo( BulkElement, Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) scale = 1.0_dp END IF @@ -4927,7 +5011,7 @@ SUBROUTINE MPMMeshScalarToParticle( Particles, Model, whichtime) SUM(Basis(1:nn) * maskLocalField(1:nn)) * scale ELSE Particles % GMask(No) = Particles % GMask(No) + & - SUM(Basis(1:nn) * maskLocalField(1:nn)) * scale + SUM(Basis(1:nn) * maskLocalField(1:nn)) * scale END IF @@ -5030,8 +5114,8 @@ END SUBROUTINE MPMMeshScalarToParticle !************************************************************************** - !> For interpolating vector grid variables to particles - SUBROUTINE MPMMeshVectorToParticle( Particles, Model, whichtime, count) + !> For interpolating vector grid variables to particles + SUBROUTINE MPMMeshVectorToParticle( Particles, Model, whichtime, count) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles @@ -5055,7 +5139,7 @@ SUBROUTINE MPMMeshVectorToParticle( Particles, Model, whichtime, count) REAL(KIND=dp), POINTER :: VVal(:),PVVal(:),BzVal(:),gmaskval(:),PMVal(:) CHARACTER(LEN=MAX_NAME_LEN) :: SolverName INTEGER :: minstatus - REAL(KIND=dp) :: Exx,Eyy,Exy1,Exy2,Exy,Ezz,Ee + REAL(KIND=dp) :: Exx,Eyy,Exy1,Exy2,Exy,Ezz,Ee SAVE :: Mesh,nn,nb,LocalPerm,LocalField,dim,Visited,& PVLocalPerm,PVLocalField,BzLocalPerm,BzLocalField,templayers,& @@ -5074,7 +5158,7 @@ SUBROUTINE MPMMeshVectorToParticle( Particles, Model, whichtime, count) dim = 2 - WRITE(SolverName, '(A)') 'MPMMeshVectorToParticle' + WRITE(SolverName, '(A)') 'MPMMeshVectorToParticle' templayers = Particles % numberoftemperaturelayers particlelayers = Particles % numberofparticlelayers @@ -5167,7 +5251,7 @@ SUBROUTINE MPMMeshVectorToParticle( Particles, Model, whichtime, count) V => VariableGet(Model % Mesh % Variables, 'Vplus' ) VPerm => V % Perm - VVal => V % Values + VVal => V % Values ELSEIF (whichtime == 5) THEN @@ -5233,7 +5317,7 @@ SUBROUTINE MPMMeshVectorToParticle( Particles, Model, whichtime, count) !Use the previous velocity field to hold the velocity difference. !Then, ParticleVel(t+dt) = ParticleVel(t) + (NewVel - PrevVel) IF ( ((whichtime == 2) .AND. (count .NE. 0)) .OR. & - ((whichtime == 1 .AND. count<0))) THEN + ((whichtime == 1 .AND. count<0))) THEN PVLocalPerm(1:nn) = PVPerm(BulkElement % NodeIndexes) DO kk = 1,nn DO jj = 1,dim @@ -5279,7 +5363,7 @@ SUBROUTINE MPMMeshVectorToParticle( Particles, Model, whichtime, count) ELSE stat = sMPMElementInfo( BulkElement, Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) scale = 1.0_dp END IF @@ -5379,7 +5463,7 @@ SUBROUTINE MPMMeshVectorToParticle( Particles, Model, whichtime, count) END DO !InterpLayers holds the interpolation map and functions to - !interpolate between the temperature layers and particle layers. + !interpolate between the temperature layers and particle layers. !InterpLayers % Map(particlelayer,1) and InterpLayers % Map(particlelayer,2) give the !two temperature layers that a particle layers lies between. !InterpLayers % InterpFun(particlelayer,1) and InterpLayers % InterpFun(particlelayer,2) @@ -5573,7 +5657,7 @@ SUBROUTINE VertIntMeshTemp( Model) IMPLICIT NONE - TYPE(Model_t) :: Model + TYPE(Model_t) :: Model INTEGER :: templayers,ii,jj,kk REAL(KIND=dp) :: y2s,maxtemp REAL(KIND=dp) :: H,Arr,btzav,Temp,TT(2),TestArr(2) @@ -5586,7 +5670,7 @@ SUBROUTINE VertIntMeshTemp( Model) - WRITE(SolverName, '(A)') 'VertIntMeshTemp' + WRITE(SolverName, '(A)') 'VertIntMeshTemp' templayers = GetInteger( Model % Constants, 'number of temperature layers', GotIt ) IF (.NOT. GotIt) THEN @@ -5652,7 +5736,7 @@ SUBROUTINE VertIntMeshTemp( Model) Arr = log(Arr); TT(1) = ((-139.0E03_dp/Arr)/8.314_dp)-273.15_dp; - !Backcalculating for T<-10 + !Backcalculating for T<-10 Arr = (btzav)/(y2s**(-1.0_dp/3.0_dp)*1.0E-06_dp); Arr = Arr**(-3.0_dp); Arr = Arr/3.985E-13_dp; @@ -5695,9 +5779,9 @@ SUBROUTINE UpdateMeshZs( Particles,Model ) TYPE(Model_t) :: Model TYPE(Mesh_t), POINTER :: Mesh TYPE(Nodes_t) :: ElementNodes - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Variable_t), POINTER :: GM,Zs,bed,H - TYPE(Element_t), POINTER :: BulkElement + TYPE(Element_t), POINTER :: BulkElement INTEGER :: nn, nb, ii, ni CHARACTER(LEN=MAX_NAME_LEN) :: VariableName INTEGER, POINTER :: NodeIndexes(:),ZsPerm(:),bedPerm(:),HPerm(:),& @@ -5725,7 +5809,7 @@ SUBROUTINE UpdateMeshZs( Particles,Model ) ZsPerm => Zs % Perm ZsVal => Zs % Values - bed => VariableGet( Model % Mesh % Variables, 'Bed') + bed => VariableGet( Model % Mesh % Variables, 'Bed') bedPerm => bed % Perm bedVal => bed % Values @@ -5735,7 +5819,7 @@ SUBROUTINE UpdateMeshZs( Particles,Model ) !grounded mask (nomovegl : positive if floating) !groudned mask (movegl : neg if float) - GM => VariableGet( Mesh % Variables, 'mask') + GM => VariableGet( Mesh % Variables, 'mask') GMPerm => GM % Perm GMVal => GM % Values @@ -5781,13 +5865,13 @@ SUBROUTINE UpdateVelocityBoundsOnMesh( Model ) IMPLICIT NONE TYPE(Model_t) :: Model TYPE(Mesh_t), POINTER :: Mesh - TYPE(Variable_t), POINTER :: OrigSurf,Vel1,Vel2,InitVel1,InitVel2,BCTrack + TYPE(Variable_t), POINTER :: OrigSurf,Vel1,Vel2,InitVel1,InitVel2,BCTrack INTEGER :: nn, ii INTEGER, POINTER :: OrigSurfPerm(:),Vel1Perm(:),Vel2Perm(:), & InitVel1Perm(:),InitVel2Perm(:),BCTrackPerm(:) LOGICAL :: Visited = .FALSE. REAL(KIND=dp), POINTER :: OrigSurfVal(:),Vel1Val(:),Vel2Val(:),InitVel1Val(:),& - InitVel2Val(:),BCTrackVal(:) + InitVel2Val(:),BCTrackVal(:) SAVE :: Mesh,nn,OrigSurf,OrigSurfPerm,OrigSurfVal,Vel1,Vel1Perm,Vel1Val, & Vel2,Vel2Perm,Vel2Val,InitVel1,InitVel1Perm,InitVel1Val,InitVel2,InitVel2Perm, & @@ -5800,23 +5884,23 @@ SUBROUTINE UpdateVelocityBoundsOnMesh( Model ) OrigSurf => VariableGet(Model % Mesh % Variables, 'OrigSurf' ) OrigSurfPerm => OrigSurf % Perm - OrigSurfVal => OrigSurf % Values + OrigSurfVal => OrigSurf % Values Vel1 => VariableGet( Model % Mesh % Variables, 'SSAVelocity 1') Vel1Perm => Vel1 % Perm - Vel1Val => Vel1 % Values + Vel1Val => Vel1 % Values Vel2 => VariableGet(Model % Mesh % Variables, 'SSAVelocity 2' ) Vel2Perm => Vel2 % Perm - Vel2Val => Vel2 % Values + Vel2Val => Vel2 % Values InitVel1 => VariableGet(Model % Mesh % Variables, 'InvVel 1') InitVel1Perm => InitVel1 % Perm - InitVel1Val => InitVel1 % Values + InitVel1Val => InitVel1 % Values InitVel2 => VariableGet(Model % Mesh % Variables, 'InvVel 2') InitVel2Perm => InitVel2 % Perm - InitVel2Val => InitVel2 % Values + InitVel2Val => InitVel2 % Values BCTrack=> VariableGet(Model % Mesh % Variables, 'BCTrack') BCTrackPerm => BCTrack % Perm @@ -5844,14 +5928,14 @@ END SUBROUTINE UpdateVelocityBoundsOnMesh !************************************************************************** !> After updating particle positions and then mapping previous particle velocities to - !! the grid, update grid velocities to satisfy Dirichlet boundary conditions + !! the grid, update grid velocities to satisfy Dirichlet boundary conditions SUBROUTINE BCVelocityUpdate( Model, Vel1Var, Vel1Perm, Vel1Val, Vel2Var, Vel2Perm, Vel2Val ) IMPLICIT NONE TYPE(Model_t) :: Model TYPE(Element_t), POINTER :: CurrentElement INTEGER, POINTER :: NodeIndexes(:) - TYPE(Variable_t), POINTER :: Vel1Var,Vel2Var + TYPE(Variable_t), POINTER :: Vel1Var,Vel2Var INTEGER :: t,n,nd,i,j INTEGER, POINTER :: Vel1Perm(:),Vel2Perm(:) LOGICAL :: GotIt,MaskIceRises,Visited=.FALSE. @@ -5861,7 +5945,7 @@ SUBROUTINE BCVelocityUpdate( Model, Vel1Var, Vel1Perm, Vel1Val, Vel2Var, Vel2Per INTEGER, POINTER :: IRPerm(:) REAL(KIND=dp), POINTER :: IR(:) - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles REAL(KIND=dp) :: xmin,xmax,ymin,ymax,vel(2),rotmat(2,2),theta LOGICAL :: zeronormalvel @@ -5877,7 +5961,7 @@ SUBROUTINE BCVelocityUpdate( Model, Vel1Var, Vel1Perm, Vel1Val, Vel2Var, Vel2Per END IF IRPerm => IRSol % Perm - IR => IRSol % Values + IR => IRSol % Values Visited = .TRUE. END IF @@ -5963,7 +6047,7 @@ SUBROUTINE BCVelocityUpdate( Model, Vel1Var, Vel1Perm, Vel1Val, Vel2Var, Vel2Per vel = MATMUL(TRANSPOSE(rotmat),vel) Vel1Val(Vel1Perm(NodeIndexes(j))) = vel(2) - Vel2Val(Vel2Perm(NodeIndexes(j))) = vel(1) + Vel2Val(Vel2Perm(NodeIndexes(j))) = vel(1) END DO END IF END IF @@ -5981,7 +6065,7 @@ SUBROUTINE BCHUpdate( Model, HVar, HPerm, HVal ) TYPE(Model_t) :: Model TYPE(Element_t), POINTER :: CurrentElement INTEGER, POINTER :: NodeIndexes(:) - TYPE(Variable_t), POINTER :: HVar + TYPE(Variable_t), POINTER :: HVar INTEGER :: t,n,nd,i INTEGER, POINTER :: HPerm(:) LOGICAL :: GotIt @@ -6028,7 +6112,7 @@ SUBROUTINE XPICBCVelocityUpdate( Model, Vel1Var, Vel1Perm, Vel1Val, Vel2Var, Vel TYPE(Model_t) :: Model TYPE(Element_t), POINTER :: CurrentElement INTEGER, POINTER :: NodeIndexes(:) - TYPE(Variable_t), POINTER :: Vel1Var,Vel2Var + TYPE(Variable_t), POINTER :: Vel1Var,Vel2Var INTEGER :: t,n,nd,i,j INTEGER, POINTER :: Vel1Perm(:),Vel2Perm(:) LOGICAL :: GotIt @@ -6101,7 +6185,7 @@ SUBROUTINE XPICBCVelocityUpdate( Model, Vel1Var, Vel1Perm, Vel1Val, Vel2Var, Vel vel = MATMUL(TRANSPOSE(rotmat),vel) Vel1Val(Vel1Perm(NodeIndexes(j))) = vel(2) - Vel2Val(Vel2Perm(NodeIndexes(j))) = vel(1) + Vel2Val(Vel2Perm(NodeIndexes(j))) = vel(1) END DO END IF END IF @@ -6116,12 +6200,12 @@ END SUBROUTINE XPICBCVelocityUpdate !> Given the element & global coordinates returns the local coordinates. !! The idea of this routine is to transparently block the local coordinate !! search from the user by directly giving the basis function values related - !! to a global coordinate. Sloppy tolerances are used since we *should* + !! to a global coordinate. Sloppy tolerances are used since we *should* !! have already located the element. FUNCTION ParticleElementInfo( CurrentElement, GlobalCoord, & SqrtElementMetric, Basis, dBasisdx ) RESULT ( stat ) - IMPLICIT NONE + IMPLICIT NONE TYPE(Element_t), POINTER :: CurrentElement REAL(KIND=dp) :: GlobalCoord(:), SqrtElementMetric, LocalDistance REAL(KIND=dp) :: Basis(:) @@ -6142,7 +6226,7 @@ FUNCTION ParticleElementInfo( CurrentElement, GlobalCoord, & Stat = PointInElement( CurrentElement, ElementNodes, & GlobalCoord, LocalCoord, GlobalEps = -1.0_dp, LocalEps = 1.0e3_dp, & - LocalDistance = LocalDistance ) + LocalDistance = LocalDistance ) IF( .NOT. Stat ) THEN Misses(1) = Misses(1) + 1 @@ -6176,11 +6260,11 @@ END FUNCTION ParticleElementInfo !************************************************************************** !!> Particle splitting and reassignment of particle values for sMPM and GIMPM - SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) + SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) - IMPLICIT NONE + IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles - TYPE(Model_t) :: Model + TYPE(Model_t) :: Model REAL(KIND=dp) :: maxlength, maxDPlength,mlength,davsplitthres,sl,oldcoord(2) INTEGER :: No, count, NoOld, jj, ii,curr,numoflayers LOGICAL :: Visited=.FALSE.,GotIt,savepasf @@ -6189,7 +6273,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) SAVE :: Visited, maxlength, maxDPlength,davsplitthres - WRITE(SolverName, '(A)') 'ParticleSplitting' + WRITE(SolverName, '(A)') 'ParticleSplitting' IF (.NOT. Visited ) THEN maxlength = Particles % maxlength @@ -6216,7 +6300,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) END IF !we marked on xpic if a particle was within a - !mixed grounding/ungrounding element + !mixed grounding/ungrounding element IF (Particles % xpic(No,1) == 1.0_dp) THEN mlength = MIN(mlength,Particles % maxGLlength) END IF @@ -6271,9 +6355,9 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) !MaxNumberOfParticles. Otherwise, it will increase the allocation to jj+old. ! CALL AllocateParticles( Model, Particles, (jj+NoOld) ) - PRINT *, 'Allocating Particles to split' + PRINT *, 'Allocating Particles to split' CALL AllocateParticles( Particles, Model, (jj+NoOld) ) - PRINT *, 'Done Allocating' + PRINT *, 'Done Allocating' Particles % NumberOfParticles = jj+NoOld @@ -6288,7 +6372,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) END IF !we marked on xpic if a particle was within a - !mixed grounding/ungrounding element + !mixed grounding/ungrounding element IF (Particles % xpic(No,1) == 1.0_dp) THEN mlength = MIN(mlength,Particles % maxGLlength) END IF @@ -6343,7 +6427,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) IF (Particles % usetracer) THEN Particles % Tracer(curr) = Particles % Tracer(No) END IF - + Particles % Status(curr) = Particles % Status(No) Particles % Coordinate(curr,:) = Particles % Coordinate(No,:) Particles % ElementIndex(curr) = Particles % ElementIndex(No) @@ -6351,7 +6435,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % Bz(curr,:) = Particles % Bz(No,:) Particles % EF(curr) = Particles % EF(No) Particles % MB(curr) = Particles % MB(No) - Particles % Bedrock(curr) = Particles % Bedrock(No) + Particles % Bedrock(curr) = Particles % Bedrock(No) Particles % Binit(curr) = Particles % Binit(No) Particles % FP(curr) = Particles % FP(No) Particles % H(curr) = Particles % H(No) @@ -6371,7 +6455,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % gmask(curr) = Particles % gmask(No) Particles % pvolume(curr) = Particles % pvolume(No) Particles % mass(curr) = Particles % mass(No) - Particles % damstatus(curr) = Particles % damstatus(No) + Particles % damstatus(curr) = Particles % damstatus(No) Particles % Static(curr) = Particles % Static(No) Particles % GVolume(curr) = Particles % GVolume(No) @@ -6386,7 +6470,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) END DO - oldcoord = Particles % Coordinate(No,:) + oldcoord = Particles % Coordinate(No,:) !For No: !move x and y coord in positive direction for the splitting coord @@ -6404,7 +6488,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) !during particles in elem if on bound Particles % Length(No,:) = Particles % Length(No,:)/2.0_dp - IF (Particles % ShapeFunctions == 'gimpm') THEN + IF (Particles % ShapeFunctions == 'gimpm') THEN Particles % GVolume(No) = Particles % Length(No,1) * & Particles % Length(No,2) END IF @@ -6432,7 +6516,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % GradH(curr,1)*(Particles % Coordinate(curr,1)-oldcoord(1)) + & Particles % GradH(curr,2)*(Particles % Coordinate(curr,2)-oldcoord(2)) - IF (Particles % H(curr) < 1.0_dp) Particles % H(curr) = 1.0_dp + IF (Particles % H(curr) < 1.0_dp) Particles % H(curr) = 1.0_dp !(x,y)(count+2): xold-(Lx/4),yold+(Ly/4) curr = Count + 2 @@ -6445,7 +6529,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % H(curr) = Particles % H(curr) + & Particles % GradH(curr,1)*(Particles % Coordinate(curr,1)-oldcoord(1)) + & - Particles % GradH(curr,2)*(Particles % Coordinate(curr,2)-oldcoord(2)) + Particles % GradH(curr,2)*(Particles % Coordinate(curr,2)-oldcoord(2)) IF (Particles % H(curr) < 1.0_dp) Particles % H(curr) = 1.0_dp @@ -6453,7 +6537,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) curr = Count + jj - 1 Particles % Length(curr,:) = Particles % Length(No,:) - IF (Particles % ShapeFunctions == 'gimpm') THEN + IF (Particles % ShapeFunctions == 'gimpm') THEN Particles % GVolume(curr) = Particles % Length(curr,1)*Particles % Length(curr,2) END IF END DO @@ -6496,7 +6580,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) IF (Particles % usetracer) THEN Particles % tracer(Count) = Particles % Tracer(No) END IF - + Particles % Status(Count) = Particles % Status(No) Particles % Coordinate(Count,:) = Particles % Coordinate(No,:) Particles % ElementIndex(Count) = Particles % ElementIndex(No) @@ -6504,11 +6588,11 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % Bz(Count,:) = Particles % Bz(No,:) Particles % EF(Count) = Particles % EF(No) Particles % MB(Count) = Particles % MB(No) - Particles % Bedrock(Count) = Particles % Bedrock(No) + Particles % Bedrock(Count) = Particles % Bedrock(No) Particles % Binit(Count) = Particles % Binit(No) Particles % FP(Count) = Particles % FP(No) Particles % H(Count) = Particles % H(No) - Particles % F(Count,:) = Particles % F(No,:) + Particles % F(Count,:) = Particles % F(No,:) Particles % Dav(Count,:) = Particles % Dav(No,:) Particles % GradH(Count,:) = Particles % GradH(No,:) Particles % GradVel(Count,:) = Particles % GradVel(No,:) @@ -6523,7 +6607,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % gmask(Count) = Particles % gmask(No) Particles % pvolume(Count) = Particles % pvolume(No) Particles % mass(Count) = Particles % mass(No) - Particles % damstatus(Count) = Particles % damstatus(No) + Particles % damstatus(Count) = Particles % damstatus(No) Particles % Static(Count) = Particles % Static(No) Particles % GVolume(Count) = Particles % GVolume(No) @@ -6536,7 +6620,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % OrigNo(Count) = Particles % OrigNo(No) - oldcoord = Particles % Coordinate(No,:) + oldcoord = Particles % Coordinate(No,:) !For No: !move x or y coord in positive direction for the splitting coord @@ -6561,12 +6645,12 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % H(No) = Particles % H(No) + & Particles % GradH(No,ii)*(Particles % Coordinate(No,ii)-oldcoord(ii)) - IF (Particles % H(No) < 1.0_dp) Particles % H(No) = 1.0_dp + IF (Particles % H(No) < 1.0_dp) Particles % H(No) = 1.0_dp Particles % H(Count) = Particles % H(Count) + & Particles % GradH(Count,ii)*(Particles % Coordinate(Count,ii)-oldcoord(ii)) - IF (Particles % H(Count) < 1.0_dp) Particles % H(Count) = 1.0_dp + IF (Particles % H(Count) < 1.0_dp) Particles % H(Count) = 1.0_dp IF (Particles % ShapeFunctions == 'gimpm') THEN Particles % GVolume(No) = Particles % Length(No,1) * & @@ -6576,7 +6660,7 @@ SUBROUTINE ParticleSplitting(Particles, Model, numoflayers ) Particles % Length(Count,2) END IF - Count = Count + 1 + Count = Count + 1 END IF END IF END DO @@ -6593,10 +6677,10 @@ END SUBROUTINE ParticleSplitting !! Not as efficient as MPMMeshVectorToParticle SUBROUTINE GetVectorFieldInMesh(Var, CurrentElement, Basis, Velo, dBasisdx, GradVelo ) - IMPLICIT NONE + IMPLICIT NONE TYPE(Variable_t), POINTER :: Var TYPE(Element_t) :: CurrentElement - REAL(KIND=dp) :: Basis(:), Velo(:) + REAL(KIND=dp) :: Basis(:), Velo(:) REAL(KIND=dp), OPTIONAL :: dBasisdx(:,:), GradVelo(:,:) TYPE(Valuelist_t), POINTER :: Params @@ -6638,8 +6722,8 @@ SUBROUTINE GetVectorFieldInMesh(Var, CurrentElement, Basis, Velo, dBasisdx, Grad !----------------------------------------------------------------- ! compute the velocity also for case when the particle - ! has just crossed the boundary. For example, its floating on the - ! fluid boundary. This is a little bit fishy and could perhaps + ! has just crossed the boundary. For example, its floating on the + ! fluid boundary. This is a little bit fishy and could perhaps ! only be done conditionally.... ! Can't really determine the gradient here !----------------------------------------------------------------- @@ -6651,7 +6735,7 @@ SUBROUTINE GetVectorFieldInMesh(Var, CurrentElement, Basis, Velo, dBasisdx, Grad LocalVelo(i,k) = Var % Values( VeloFieldDofs*(j-1)+k) END DO END DO - ELSE + ELSE IF(.NOT. InterfaceNodes ) RETURN SumBasis = 0.0_dp @@ -6693,10 +6777,10 @@ END SUBROUTINE GetVectorFieldInMesh !! Not as efficient as MPMMeshScalarToParticle SUBROUTINE GetScalarFieldInMesh(Var, CurrentElement, Basis, Pot, dBasisdx, GradPot ) - IMPLICIT NONE + IMPLICIT NONE TYPE(Variable_t), POINTER :: Var TYPE(Element_t) :: CurrentElement - REAL(KIND=dp) :: Basis(:), Pot + REAL(KIND=dp) :: Basis(:), Pot REAL(KIND=dp), OPTIONAL :: dBasisdx(:,:), GradPot(:) TYPE(Mesh_t), POINTER :: Mesh @@ -6714,7 +6798,7 @@ SUBROUTINE GetScalarFieldInMesh(Var, CurrentElement, Basis, Pot, dBasisdx, GradP Visited = .TRUE. END IF - ALLOCATE( LocalPerm(n), LocalField(n) ) + ALLOCATE( LocalPerm(n), LocalField(n) ) LocalPerm = 0 LocalField = 0.0_dp @@ -6748,10 +6832,10 @@ END SUBROUTINE GetScalarFieldInMesh !************************************************************************** - !> Finds the particle in the mesh using octree based search. + !> Finds the particle in the mesh using octree based search. !! This could be preferred in the initial finding of the correct elements. !! The major downside of the method is that there is no controlled face - !! detection needed for wall interaction, for example. + !! detection needed for wall interaction, for example. SUBROUTINE LocateParticleInMeshOctree( ElementIndex, GlobalCoords, & LocalCoords ) @@ -6759,7 +6843,7 @@ SUBROUTINE LocateParticleInMeshOctree( ElementIndex, GlobalCoords, & USE Interpolation USE DefUtils - IMPLICIT NONE + IMPLICIT NONE INTEGER :: ElementIndex REAL(KIND=dp) :: GlobalCoords(3) REAL(KIND=dp), OPTIONAL :: LocalCoords(3) @@ -6839,7 +6923,7 @@ END SUBROUTINE LocateParticleInMeshOctree !************************************************************************** - SUBROUTINE EditParticleVolume(Particles, No,jj,N,S,E,W,xmax,xmin,ymax,ymin) + SUBROUTINE EditParticleVolume(Particles, No,jj,N,S,E,W,xmax,xmin,ymax,ymin) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles @@ -6871,22 +6955,22 @@ END SUBROUTINE EditParticleVolume !************************************************************************** - !> Saves particles in unstructured XML VTK format (VTU) to an external file. + !> Saves particles in unstructured XML VTK format (VTU) to an external file. SUBROUTINE ParticleOutputVtu( Particles,Model ) - USE DefUtils + USE DefUtils USE MeshUtils USE ElementDescription USE AscBinOutputUtils IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles TYPE(Model_t) :: Model TYPE(ValueList_t),POINTER :: Params INTEGER, SAVE :: nTime = 0 LOGICAL :: GotIt, Parallel, FixedMeshend,SinglePrec CHARACTER(MAX_NAME_LEN), SAVE :: FilePrefix - CHARACTER(MAX_NAME_LEN) :: VtuFile, PvtuFile + CHARACTER(MAX_NAME_LEN) :: VtuFile, PvtuFile TYPE(Mesh_t), POINTER :: Mesh TYPE(Variable_t), POINTER :: Var INTEGER :: i, j, k, Partitions, Part, ExtCount, FileindexOffSet, iTime, & @@ -6913,7 +6997,7 @@ SUBROUTINE ParticleOutputVtu( Particles,Model ) ALLOCATE( LocalVal( maxdofs) ) Params => ListGetSolverParams() - FloatingOnly = GetLogical( Params,'Floating Only',GotIt) + FloatingOnly = GetLogical( Params,'Floating Only',GotIt) IF( FloatingOnly ) THEN CALL Info('VtuOutputSolver','Saving Floating Particles Only!',Level=7) END IF @@ -6940,7 +7024,7 @@ SUBROUTINE ParticleOutputVtu( Particles,Model ) CALL Info('ParticleOutputVtu','Saving in VTK XML unstructured format to file: ' & //TRIM(FilePrefix)//'.vtu',Level=1) - Dir = ListGetString( Params,'Filename Directory') + Dir = ListGetString( Params,'Filename Directory') MinSaveStatus = PARTICLE_ACTIVE MaxSaveStatus = PARTICLE_LOST @@ -6959,28 +7043,28 @@ SUBROUTINE ParticleOutputVtu( Particles,Model ) SaveAll = GetLogical( Params,'Save All',GotIt) IF (.NOT. GotIt) SaveAll = .FALSE. - SinglePrec = GetLogical( Params,'Single Precision',GotIt) + SinglePrec = GetLogical( Params,'Single Precision',GotIt) IF( SinglePrec ) THEN CALL Info('VtuOutputSolver','Using single precision arithmetics in output!',Level=7) END IF - minx = GetCReal( Params,'Min X To Save Particle',GotIt) + minx = GetCReal( Params,'Min X To Save Particle',GotIt) IF( .NOT. GotIt ) THEN minx = -HUGE(1.0_dp) END IF - maxx = GetCReal( Params,'Max X To Save Particle',GotIt) + maxx = GetCReal( Params,'Max X To Save Particle',GotIt) IF( .NOT. GotIt ) THEN maxx = HUGE(1.0_dp) END IF IF( SinglePrec ) THEN PrecBits = 32 - PrecSize = KIND( SingleWrk ) + PrecSize = KIND( SingleWrk ) ELSE PrecBits = 64 - PrecSize = KIND( DoubleWrk ) + PrecSize = KIND( DoubleWrk ) END IF IntSize = KIND(i) @@ -7030,8 +7114,8 @@ SUBROUTINE ParticleOutputVtu( Particles,Model ) CONTAINS SUBROUTINE WriteVtuFile( VtuFile, Model ) - IMPLICIT NONE - TYPE(Model_t) :: Model + IMPLICIT NONE + TYPE(Model_t) :: Model CHARACTER(LEN=*), INTENT(IN) :: VtuFile INTEGER, PARAMETER :: VtuUnit = 58 TYPE(Variable_t), POINTER :: Var, Solution @@ -7058,7 +7142,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) REAL(KIND=dp) :: difference,tmf - TYPE(Nodes_t) :: Nodes + TYPE(Nodes_t) :: Nodes TYPE(Element_t), POINTER :: Element TYPE(Variable_t), POINTER :: ParticleVar @@ -7085,7 +7169,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) ThisOnly = .TRUE. - ParticleMode = .TRUE. !.NOT. ASSOCIATED( Particles % UVW ) + ParticleMode = .TRUE. !.NOT. ASSOCIATED( Particles % UVW ) ! Linefeed character !----------------------------------- @@ -7104,7 +7188,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) IF(.TRUE.) THEN OPEN( UNIT=VtuUnit, FILE=VtuFile, FORM = 'formatted', STATUS='unknown' ) WRITE( VtuUnit,'(A)') ' ' - CLOSE( VtuUnit ) + CLOSE( VtuUnit ) END IF ! This format works both for ascii and binary output @@ -7112,7 +7196,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) OPEN( UNIT=VtuUnit, FILE=VtuFile, FORM = 'unformatted', ACCESS = 'stream', STATUS='unknown' ) WRITE( OutStr,'(A)') ''//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) IF ( LittleEndian() ) THEN OutStr = ''//lf @@ -7202,7 +7286,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) CASE(15) FieldName = 'psre_two' CASE(16) - FieldName = 'psre_three' + FieldName = 'psre_three' CASE(17) FieldName = 'f' CASE(18) @@ -7278,13 +7362,13 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) IF( FieldName == 'velocity' ) THEN dofs = 2 ELSE IF( FieldName == 'gridvelocity' ) THEN - dofs = 2 + dofs = 2 ELSE IF( FieldName == 'gradvel') THEN dofs = 4 ELSE IF( FieldName == 'gradzs') THEN dofs = 2 ELSE IF (FieldName == 'gradh') THEN - dofs = 2 + dofs = 2 ELSE IF( FieldName == 'length') THEN dofs = 2 ELSE IF (FieldName == 'origlength') THEN @@ -7299,7 +7383,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) dofs = layers ELSE IF (FieldName == 'damageiii') THEN !returns DII(z) - dofs = layers + dofs = layers ELSE IF (FieldName == 'xdamage') THEN !returns D(z) if damdofs == 1, otherwise, returns Dxx(z) dofs = layers @@ -7311,12 +7395,12 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) dofs = layers ELSE IF (FieldName == 'xydamage') THEN !returns D(z) if damdofs == 1, otherwise, returns Dxx(z) - dofs = layers + dofs = layers ELSE IF (FieldName == 'dd') THEN !returns dD(z) if damdofs == 1, otherwise, returns dDxx(z) dofs = layers ELSE IF (FieldName == 'bz') THEN - dofs = layers + dofs = layers ELSE IF (FieldName == 'nextcoordinate') THEN dofs = 2 ELSE IF (FieldName == 'xpic') THEN @@ -7331,12 +7415,12 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) dofs = 2 ELSE IF (FieldName == 'pde_one') THEN dofs = 3 - ELSE IF (FieldName == 'pde_two') THEN + ELSE IF (FieldName == 'pde_two') THEN dofs = 3 ELSE IF (FieldName == 'pde_three' .OR. FieldName == 'eff_pds') THEN dofs = 3 ELSE IF (FieldName == 'pdse_two' .OR. FieldName == 'eff_pdse_two') THEN - dofs = 3 + dofs = 3 ELSE IF (FieldName == 'psre_one') THEN dofs = 3 ELSE IF (FieldName == 'psre_two') THEN @@ -7378,7 +7462,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) ELSE IF (FieldName == 'mass') THEN dofs = 1 ELSE IF( FieldName == 'elementindex') THEN - dofs = 1 + dofs = 1 ELSE IF( FieldName == 'binit') THEN dofs = 1 ELSE IF( FieldName == 'status') THEN @@ -7434,15 +7518,15 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) WRITE( OutStr,'(A,I0,A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) ELSE WRITE( OutStr,'(A,I0,A)') ' format="appended" offset="',Offset,'"/>'//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF END IF @@ -7480,19 +7564,19 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) IF( FieldName == 'velocity' ) THEN LocalVal(1:sdofs) = Particles % Velocity(i,1:sdofs) ELSE IF( FieldName == 'gridvelocity' ) THEN - LocalVal(1:sdofs) = Particles % GridVelocity(i,1:sdofs) + LocalVal(1:sdofs) = Particles % GridVelocity(i,1:sdofs) ELSE IF( FieldName == 'gradvel') THEN LocalVal(1:sdofs) = Particles % GradVel(i,1:sdofs) - ELSE IF( FieldName == 'gradh') THEN - LocalVal(1:sdofs) = Particles % GradH(i,1:sdofs) - ELSE IF( FieldName == 'gradzs') THEN + ELSE IF( FieldName == 'gradh') THEN + LocalVal(1:sdofs) = Particles % GradH(i,1:sdofs) + ELSE IF( FieldName == 'gradzs') THEN LocalVal(1:sdofs) = Particles % GradZs(i,1:sdofs) - ELSE IF( FieldName == 'length') THEN + ELSE IF( FieldName == 'length') THEN LocalVal(1:sdofs) = Particles % Length(i,1:sdofs) ELSE IF (FieldName == 'origlength') THEN LocalVal(1:sdofs) = Particles % OrigLength(i,1:sdofs) - ELSE IF( FieldName == 'dav') THEN + ELSE IF( FieldName == 'dav') THEN LocalVal(1:sdofs) = Particles % Dav(i,1:sdofs) DO lay = 1,sdofs @@ -7535,12 +7619,12 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) LocalVal(1:sdofs) = Particles % Damage(i,1:sdofs,3) ELSE IF (FieldName == 'xydamage') THEN - LocalVal(1:sdofs) = Particles % Damage(i,1:sdofs,4) + LocalVal(1:sdofs) = Particles % Damage(i,1:sdofs,4) ELSE IF (FieldName == 'dd') THEN LocalVal(1:sdofs) = Particles % dD(i,1:sdofs,1) ELSE IF (FieldName == 'bz') THEN - LocalVal(1:sdofs) = Particles % bz(i,1:sdofs) + LocalVal(1:sdofs) = Particles % bz(i,1:sdofs) ELSE IF (FieldName == 'nextcoordinate') THEN LocalVal(1:sdofs) = Particles % NextCoordinate(i,1:sdofs) ELSE IF (FieldName == 'xpic') THEN @@ -7581,7 +7665,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) pSR2(3,3) = -pSR2(1,1)-pSR2(2,2) EeExp = (1.0_dp-3.0_dp)/(2.0_dp * 3.0_dp) - EFexp = -1.0_dp/3.0_dp + EFexp = -1.0_dp/3.0_dp Ee = 0.5_dp*(pSR2(1,1)*pSR2(1,1) + pSR2(2,2)*pSR2(2,2) + & @@ -7610,7 +7694,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) Tau(2,2) = taurhsmultthird * (exxd1m1-2.0_dp*eyyd2m1+ezzd3m1-exyd4) Tau(3,3) = taurhsmultthird * (exxd1m1+eyyd2m1-2.0_dp*ezzd3m1+2.0_dp*exyd4) Tau(1,2) = -RHS * 0.5_dp * (psr2(1,2)*(D(1)+D(2)-2.0_dp) + D(4)*(psr2(1,1)+psr2(2,2))) - Tau(2,1) = Tau(1,2) + Tau(2,1) = Tau(1,2) CALL Eigen2DSym_TryGenFirst(Tau(1:2,1:2),EigValues,EigenVec) @@ -7634,7 +7718,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) pSR2(3,3) = -pSR2(1,1)-pSR2(2,2) EeExp = (1.0_dp-3.0_dp)/(2.0_dp * 3.0_dp) - EFexp = -1.0_dp/3.0_dp + EFexp = -1.0_dp/3.0_dp Ee = 0.5_dp*(pSR2(1,1)*pSR2(1,1) + pSR2(2,2)*pSR2(2,2) + & @@ -7682,7 +7766,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) pSR2(3,3) = -pSR2(1,1)-pSR2(2,2) EeExp = (1.0_dp-3.0_dp)/(2.0_dp * 3.0_dp) - EFexp = -1.0_dp/3.0_dp + EFexp = -1.0_dp/3.0_dp Ee = 0.5_dp*(pSR2(1,1)*pSR2(1,1) + pSR2(2,2)*pSR2(2,2) + & @@ -7719,14 +7803,14 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) denom = one/( D(4)*D(4) + D(1) + D(2) -D(1)*D(2) - one) t1d2m1 = Tau(1,1)*(D(2)-one)*denom t2d1m1 = Tau(2,2)*(D(1)-one)*denom - t3od3m1 = Tau(3,3)/(D(3)-one) + t3od3m1 = Tau(3,3)/(D(3)-one) d4t4 = Tau(1,2)*D(4)*denom Etau(1,1) = onethird*(two*t1d2m1 - t2d1m1 +t3od3m1 -d4t4) Etau(2,2) = onethird*(-t1d2m1 + two*t2d1m1 +t3od3m1 -d4t4) Etau(3,3) = onethird*(-t1d2m1 - t2d1m1 - two*t3od3m1 + two*d4t4) Etau(1,2) = half*denom*(tau(1,2)*(D(1)+D(2)-two) - D(4)*(Tau(1,1)+Tau(2,2))) - Etau(2,1) = Etau(1,2) + Etau(2,1) = Etau(1,2) SR(1) = ETau(1,1) @@ -7738,10 +7822,10 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) IF (FieldName == 'eff_pdse_two' ) THEN - CALL PrincipalEigenVec(SR,EV) + CALL PrincipalEigenVec(SR,EV) LocalVal(1) = EV(1,2) LocalVal(2) = EV(2,2) - LocalVal(3) = EV(3,2) + LocalVal(3) = EV(3,2) END IF @@ -7751,7 +7835,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) LocalVal(1) = PD(1) LocalVal(2) = PD(2) - LocalVal(3) = PD(3) + LocalVal(3) = PD(3) END IF @@ -7765,7 +7849,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) pSR2(3,3) = -pSR2(1,1)-pSR2(2,2) EeExp = (1.0_dp-3.0_dp)/(2.0_dp * 3.0_dp) - EFexp = -1.0_dp/3.0_dp + EFexp = -1.0_dp/3.0_dp Ee = 0.5_dp*(pSR2(1,1)*pSR2(1,1) + pSR2(2,2)*pSR2(2,2) + & @@ -7812,12 +7896,12 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) PD=0.0_dp - IF (Particles % gamma>0.0_dp ) THEN + IF (Particles % gamma>0.0_dp .or. Particles%nodzz ) THEN CALL PrincipalDamage(Particles%Dav(i,:),PD) LocalVal(1) = PD(1) LocalVal(2) = PD(2) - LocalVal(3) = PD(3) + LocalVal(3) = PD(3) IF (Particles % useriftdmax) THEN IF (Particles % DamStatus(i)==1) THEN @@ -7953,7 +8037,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) LocalVal(1) = EV(1,2) LocalVal(2) = EV(2,2) - LocalVal(3) = EV(3,2) + LocalVal(3) = EV(3,2) ELSE IF (FieldName == 'psre_three') THEN @@ -8005,7 +8089,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) !old LocalVal(1) = EV(1,2) LocalVal(2) = EV(2,2) - LocalVal(3) = EV(3,2) + LocalVal(3) = EV(3,2) ELSEIF (FieldName == 'f') THEN LocalVal(1:4) = Particles % F(i,1:4) @@ -8014,32 +8098,32 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) ELSE sdofs = 1 - IF (FieldName == 'particle time') THEN + IF (FieldName == 'particle time') THEN LocalVal(1) = Particles % time - ELSEIF (FieldName == 'particle dt') THEN + ELSEIF (FieldName == 'particle dt') THEN LocalVal(1) = Particles % dtime - ELSE IF( FieldName == 'fp' ) THEN + ELSE IF( FieldName == 'fp' ) THEN LocalVal(1) = MAX(Particles % FP(i),0.0_dp) ELSE IF( FieldName == 'h') THEN IF (Particles % H(i) .NE. Particles % H(i)) Particles % H(i) = -999.0_dp LocalVal(1) = Particles % H(i) - ELSE IF( FieldName == 'gvolume') THEN + ELSE IF( FieldName == 'gvolume') THEN LocalVal(1) = Particles % Gvolume(i) - ELSE IF( FieldName == 'pvolume') THEN + ELSE IF( FieldName == 'pvolume') THEN LocalVal(1) = Particles % pVolume(i) ELSE IF (FieldName == 'mass') THEN LocalVal(1) = Particles % mass(i) - ELSE IF( FieldName == 'elementindex') THEN - LocalVal(1) = Particles % ElementIndex(i) - ELSE IF( FieldName == 'binit') THEN + ELSE IF( FieldName == 'elementindex') THEN + LocalVal(1) = Particles % ElementIndex(i) + ELSE IF( FieldName == 'binit') THEN LocalVal(1) = Particles % binit(i) - ELSE IF( FieldName == 'status') THEN + ELSE IF( FieldName == 'status') THEN LocalVal(1) = Particles % Status(i) - ELSE IF( FieldName == 'interpelem') THEN + ELSE IF( FieldName == 'interpelem') THEN LocalVal(1) = Particles % InterpElem(i) - ELSE IF( FieldName == 'ef') THEN + ELSE IF( FieldName == 'ef') THEN LocalVal(1) = Particles % EF(i) - ELSE IF( FieldName == 'gmask') THEN + ELSE IF( FieldName == 'gmask') THEN LocalVal(1) = Particles % Gmask(i) ELSE IF( FieldName == 'viscosity') THEN LocalVal(1) = (1.0_dp - Particles % Dav(i,1)) * & @@ -8099,7 +8183,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) IF( AsciiOutput ) THEN WRITE( OutStr,'(A)') lf//' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF END DO @@ -8108,12 +8192,12 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) IF( WriteXML ) THEN WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF @@ -8121,17 +8205,17 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) !------------------------------------- IF( WriteXML ) THEN WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) WRITE( OutStr,'(A,I0,A,I0,A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) ELSE WRITE( OutStr,'(A,I0,A)') ' format="appended" offset="',Offset,'"/>'//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF END IF @@ -8140,7 +8224,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) Offset = Offset + IntSize + k END IF - IF( WriteData ) THEN + IF( WriteData ) THEN IF( BinaryOutput ) WRITE( VtuUnit ) k LocalVal = 0.0_dp @@ -8176,13 +8260,13 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) CALL AscBinRealWrite( 0.0_dp, .TRUE.) END IF - IF( AsciiOutput ) THEN + IF( AsciiOutput ) THEN WRITE( OutStr,'(A)') lf//' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF IF( WriteXML ) THEN WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF @@ -8190,17 +8274,17 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) !------------------------------------- IF( WriteXML ) THEN WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) ELSE WRITE( OutStr,'(A,I0,A)') ' format="appended" offset="',Offset,'"/>'//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF END IF @@ -8211,30 +8295,30 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) END IF IF( WriteData ) THEN - IF( BinaryOutput ) WRITE( VtuUnit ) k + IF( BinaryOutput ) WRITE( VtuUnit ) k DO i = 1, NumberOfNodes CALL AscBinIntegerWrite( i - 1) END DO - CALL AscBinIntegerWrite( 0, .TRUE. ) + CALL AscBinIntegerWrite( 0, .TRUE. ) END IF IF( AsciiOutput ) THEN WRITE( OutStr,'(A)') lf//' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF - ! Offsets for element indexes + ! Offsets for element indexes !------------------------------------------------------------------- IF( WriteXML ) THEN WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) ELSE WRITE( OutStr,'(A,I0,A)') ' format="appended" offset="',Offset,'"/>'//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF END IF @@ -8244,27 +8328,27 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) END IF IF( WriteData ) THEN - IF( BinaryOutput ) WRITE( VtuUnit ) k + IF( BinaryOutput ) WRITE( VtuUnit ) k DO i = 1, NumberOfNodes CALL AscBinIntegerWrite( i ) END DO - CALL AscBinIntegerWrite( 0, .TRUE.) + CALL AscBinIntegerWrite( 0, .TRUE.) END IF - IF( AsciiOutput ) THEN + IF( AsciiOutput ) THEN WRITE( OutStr,'(A)') lf//' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF IF( WriteXML ) THEN WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) ELSE WRITE( OutStr,'(A,I0,A)') ' format="appended" offset="',Offset,'"/>'//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF END IF @@ -8279,27 +8363,27 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) DO i = 1, NumberOfNodes CALL AscBinIntegerWrite( 1 ) END DO - CALL AscBinIntegerWrite( 0, .TRUE. ) + CALL AscBinIntegerWrite( 0, .TRUE. ) END IF IF( AsciiOutput ) THEN WRITE( OutStr,'(A)') lf//' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF IF( WriteXml ) THEN WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) WRITE( OutStr,'(A)') ' '//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF IF( BinaryOutput ) THEN IF( WriteXML ) THEN - WRITE( OutStr,'(A)') ''//lf - CALL AscBinStrWrite( OutStr ) + WRITE( OutStr,'(A)') ''//lf + CALL AscBinStrWrite( OutStr ) WRITE( VtuUnit ) '_' WriteXML = .FALSE. @@ -8307,16 +8391,16 @@ SUBROUTINE WriteVtuFile( VtuFile, Model ) GOTO 100 ELSE WRITE( OutStr,'(A)') lf//''//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) END IF END IF WRITE( OutStr,'(A)') ''//lf - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) WRITE( OutStr,'(A)') ' ' - CALL AscBinStrWrite( OutStr ) + CALL AscBinStrWrite( OutStr ) CLOSE( VtuUnit ) @@ -8339,7 +8423,7 @@ SUBROUTINE GetMaxdDPrincipalDamageVert(Particles,No,layers,pddmax) REAL(KIND=dp) :: D(2,2),T(3,3),pDold(3),pDnew(3) REAL(KIND=dp) :: Dnew(layers),newviscz(layers) REAL(KIND=dp) :: btzav,newviscav,oolmo - REAL(KIND=dp) :: EigVals(2),EigVec(2,2) + REAL(KIND=dp) :: EigVals(2),EigVec(2,2) REAL(KIND=dp) :: CriticalDamage,DMax,pddmax,DavNew(4),eigdmax REAL(KIND=dp) :: one = 1.0_dp, half=1.0_dp/2.0_dp INTEGER :: infor,No,ii,layers,damdofs @@ -8349,10 +8433,10 @@ SUBROUTINE GetMaxdDPrincipalDamageVert(Particles,No,layers,pddmax) DO ii = 1,4 - Dnew = Particles % Damage(No,:,ii) + Particles % dD(No,:,ii) - newviscz(:) = Particles % Bz(No,:) + Dnew = Particles % Damage(No,:,ii) + Particles % dD(No,:,ii) + newviscz(:) = Particles % Bz(No,:) btzav = (SUM(newviscz)-half*(newviscz(1)+newviscz(layers))) * oolmo - newviscz(:) = Dnew * Particles % Bz(No,:) + newviscz(:) = Dnew * Particles % Bz(No,:) newviscav = (SUM(newviscz)-half*(newviscz(1)+newviscz(layers))) * oolmo DavNew(ii) = newviscav/btzav END DO @@ -8360,7 +8444,7 @@ SUBROUTINE GetMaxdDPrincipalDamageVert(Particles,No,layers,pddmax) !old damage eigs D(1,1) = Particles % Dav(No,1) D(2,1) = Particles % Dav(No,4) - D(1,2) = Particles % Dav(No,4) + D(1,2) = Particles % Dav(No,4) D(2,2) = Particles % Dav(No,2) CALL Eigen2DSym_TryGenFirst(D,EigVals,EigVec) @@ -8371,7 +8455,7 @@ SUBROUTINE GetMaxdDPrincipalDamageVert(Particles,No,layers,pddmax) !new damage eigs D(1,1) = DavNew(1) D(2,1) = DavNew(4) - D(1,2) = DavNew(4) + D(1,2) = DavNew(4) D(2,2) = DavNew(2) CALL Eigen2DSym_TryGenFirst(D,EigVals,EigVec) @@ -8391,12 +8475,12 @@ SUBROUTINE PrincipalDamage(Din,Dout) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles REAL(KIND=dp) :: Din(4), D(2,2),Dout(3) - REAL(KIND=dp) :: EigVals(2),EigVec(2,2) + REAL(KIND=dp) :: EigVals(2),EigVec(2,2) INTEGER :: infor,no,ii D(1,1) = Din(1) D(1,2) = Din(4) - D(2,1) = Din(4) + D(2,1) = Din(4) D(2,2) = Din(2) CALL Eigen2DSym_TryGenFirst(D,EigVals,EigVec) @@ -8404,7 +8488,7 @@ SUBROUTINE PrincipalDamage(Din,Dout) !since output of eigvalues2d is in ascending order Dout(1) = EigVals(2) Dout(2) = EigVals(1) - Dout(3) = Din(3) + Dout(3) = Din(3) END SUBROUTINE PrincipalDamage @@ -8420,10 +8504,10 @@ SUBROUTINE PrincipalEigenVec(Din,EVout) D(1,1) = Din(1) D(2,1) = Din(4) - D(1,2) = Din(4) + D(1,2) = Din(4) D(2,2) = Din(2) - CALL Eigen2DSym_TryGenFirst(D,EigVals,EigVec) + CALL Eigen2DSym_TryGenFirst(D,EigVals,EigVec) IF (EigVals(1) == EigVals(2)) THEN @@ -8454,10 +8538,10 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) REAL(KIND=dp) :: D(2,2) REAL(KIND=dp) :: CriticalDamage,DMax,CriticalDav REAL(KIND=dp) :: DMaxI,DMaxII,DMaxIII,RiftDmax - REAL(KIND=dp) :: DavDMaxI,DavDMaxII,DavDMaxIII + REAL(KIND=dp) :: DavDMaxI,DavDMaxII,DavDMaxIII REAL(KIND=dp) :: TT,DD,lambda(3),en,sqrteig - REAL(KIND=dp) :: quart=0.25_dp,half=0.5_dp,thres=0.0001_dp,zero=0.0_dp - REAL(KIND=dp) :: EigValues(3),EigValues2d(2),WORK(68),EigenVec(2,2),EigenVec2(2,2) + REAL(KIND=dp) :: quart=0.25_dp,half=0.5_dp,thres=0.0001_dp,zero=0.0_dp + REAL(KIND=dp) :: EigValues(3),EigValues2d(2),WORK(68),EigenVec(2,2),EigenVec2(2,2) INTEGER :: infor,no,ii,jj,eigperm(3),maxloc1,midloc,minloc1,kk LOGICAL :: Visited = .FALSE.,rupt(3),useparticleeig TYPE(Model_t) :: Model @@ -8478,7 +8562,7 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) DavDmaxI = Particles % DavDmaxI DavDmaxII = Particles % DavDmaxII - DavDmaxIII = Particles % DavDmaxIII + DavDmaxIII = Particles % DavDmaxIII RiftDmax = Particles % RiftDmax @@ -8492,7 +8576,7 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) D(1,1) = Particles % Dav(No,1) D(2,1) = Particles % Dav(No,4) - D(1,2) = Particles % Dav(No,4) + D(1,2) = Particles % Dav(No,4) D(2,2) = Particles % Dav(No,2) TT = D(1,1)+D(2,2) @@ -8501,9 +8585,9 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) sqrteig = quart*TT*TT-DD IF (sqrteig<0.0_dp) sqrteig = 0.0_dp sqrteig = sqrt(sqrteig) - TT = half*TT + TT = half*TT lambda(1)=TT+sqrteig - lambda(2)=TT-sqrteig + lambda(2)=TT-sqrteig lambda(3) = Particles % Dav(No,3) IF (.NOT. (ANY(lambda < 0.0_dp) .OR. ANY(lambda > CriticalDav) )) RETURN @@ -8538,7 +8622,7 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) Particles % Dav(No,:) = 0.0_dp ! IF (Particles % useriftdmax) THEN - Particles % Dav(No,1:3) = RiftDmax + Particles % Dav(No,1:3) = RiftDmax ! ELSE ! Particles % Dav(No,1:2) = DmaxI ! Particles % Dav(No,3) = DmaxIII @@ -8563,7 +8647,7 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) !use the layer's eigenvectors to determine !which direction to rupt. - CALL Eigen2DSym_TryGenFirst(D,EigValues2d,EigenVec2) + CALL Eigen2DSym_TryGenFirst(D,EigValues2d,EigenVec2) IF (EigValues2d(1) == EigValues2d(2)) THEN @@ -8594,7 +8678,7 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) END IF - IF (rupt(1)) D(1,1) = DMaxII + IF (rupt(1)) D(1,1) = DMaxII IF (rupt(2)) D(2,2) = DMaxI !rotate back A'TA @@ -8623,8 +8707,8 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) END IF IF (rupt(3)) THEN - Particles % Damage(No,:,3) = DmaxIII - Particles % Dav(No,3) = DavDmaxIII + Particles % Damage(No,:,3) = DmaxIII + Particles % Dav(No,3) = DavDmaxIII END IF IF (ANY(rupt)) THEN @@ -8649,7 +8733,7 @@ SUBROUTINE FixPrincipalDamageVertInt(No,Model) D(1,1) = DavDMaxII D(2,2) = DavDMaxI - w = D(1,1)*EigenVec2(1,1) + w = D(1,1)*EigenVec2(1,1) x = D(2,2)*EigenVec2(1,2) y = D(1,1)*EigenVec2(2,1) z = D(2,2)*EigenVec2(2,2) @@ -8679,10 +8763,10 @@ SUBROUTINE CheckPrincipalDamage(No) D(1,1) = Particles % Dav(No,1) D(2,1) = Particles % Dav(No,4) - D(1,2) = Particles % Dav(No,4) - D(2,2) = Particles % Dav(No,2) + D(1,2) = Particles % Dav(No,4) + D(2,2) = Particles % Dav(No,2) - CALL Eigen2DSym_TryGenFirst(D,EigValues,DavEigenVec) + CALL Eigen2DSym_TryGenFirst(D,EigValues,DavEigenVec) PRINT *,'' PRINT *,'PARTICLE NO',No @@ -8696,10 +8780,10 @@ SUBROUTINE CheckPrincipalDamage(No) D(1,1) = Particles % damage(No,ii,1) D(2,1) = Particles % damage(No,ii,4) - D(1,2) = Particles % damage(No,ii,4) + D(1,2) = Particles % damage(No,ii,4) D(2,2) = Particles % damage(No,ii,2) - CALL Eigen2DSym_TryGenFirst(D,EigValues,EigenVec) + CALL Eigen2DSym_TryGenFirst(D,EigValues,EigenVec) PRINT *,'layer',ii @@ -8727,7 +8811,7 @@ SUBROUTINE FixPrincipalDavAndLayers(Particles, No, layers,Model) REAL(KIND=dp) :: D(2,2),Dav(2,2),Dav3,davvec(4) LOGICAL :: Visited = .FALSE.,rupt REAL(KIND=dp) :: lminval,lmidval,lmaxval,half=1.0_dp/2.0_dp,denom,one=1.0_dp,zero=0.0_dp - REAL(KIND=dp) :: EigValues(2),DavEigValues(2),WORK(68),EigenVec(2,2),DavEigenVec(2,2) + REAL(KIND=dp) :: EigValues(2),DavEigValues(2),WORK(68),EigenVec(2,2),DavEigenVec(2,2) INTEGER :: infor REAL(KIND=dp) :: w,x,y,z @@ -8748,7 +8832,7 @@ SUBROUTINE FixPrincipalDavAndLayers(Particles, No, layers,Model) ! Dav(1,1) = Particles % Dav(No,1) ! Dav(2,1) = Particles % Dav(No,4) - ! Dav(1,2) = Dav(2,1) + ! Dav(1,2) = Dav(2,1) ! Dav(2,2) = Particles % Dav(No,2) @@ -8761,14 +8845,14 @@ SUBROUTINE FixPrincipalDavAndLayers(Particles, No, layers,Model) Dav(1,1) = davvec(1) Dav(2,1) = davvec(4) - Dav(1,2) = Dav(2,1) + Dav(1,2) = Dav(2,1) Dav(2,2) = davvec(2) CALL Eigen2DSym_TryGenFirst(Dav,DavEigValues,DavEigenVec) - ! dont worry about rupturing Dav components at this point, as + ! dont worry about rupturing Dav components at this point, as ! fixprincipaldamagevertint is called at the end, which will take care of it. ! ------ 2. Get eigenvectors and eigenvalues for Damage on each layer ------ @@ -8782,7 +8866,7 @@ SUBROUTINE FixPrincipalDavAndLayers(Particles, No, layers,Model) D(1,1) = Particles % Damage(No,ii,1) D(2,1) = Particles % Damage(No,ii,4) - D(1,2) = D(2,1) + D(1,2) = D(2,1) D(2,2) = Particles % Damage(No,ii,2) !CALL Eigen2D(D,EigValues,EigenVec) @@ -8796,7 +8880,7 @@ SUBROUTINE FixPrincipalDavAndLayers(Particles, No, layers,Model) !same as above, but faster w = EigValues(1)*DavEigenVec(1,1) x = EigValues(2)*DavEigenVec(1,2) - y = EigValues(1)*DavEigenVec(2,1) + y = EigValues(1)*DavEigenVec(2,1) z = EigValues(2)*DavEigenVec(2,2) D(1,1) = DavEigenVec(1,1)*w + DavEigenVec(1,2)*x @@ -8856,15 +8940,15 @@ SUBROUTINE FixPrincipalDavAndLayers(Particles, No, layers,Model) ! Dav = MATMUL(DavEigenVec,Dav); Dav = MATMUL(Dav,TRANSPOSE(DavEigenVec)) ! same as above, but faster - w = Dav(1,1)*DavEigenVec(1,1) + w = Dav(1,1)*DavEigenVec(1,1) x = Dav(2,2)*DavEigenVec(1,2) - y = Dav(1,1)*DavEigenVec(2,1) - z = Dav(2,2)*DavEigenVec(2,2) + y = Dav(1,1)*DavEigenVec(2,1) + z = Dav(2,2)*DavEigenVec(2,2) Dav(1,1) = DavEigenVec(1,1)*w + DavEigenVec(1,2)*x Dav(2,2) = DavEigenVec(2,1)*y + DavEigenVec(2,2)*z Dav(1,2) = DavEigenVec(2,1)*w + DavEigenVec(2,2)*x - Dav(2,1) = Dav(1,2) + Dav(2,1) = Dav(1,2) Particles % Dav(No,1) = Dav(1,1) Particles % Dav(No,2) = Dav(2,2) @@ -8882,10 +8966,10 @@ END SUBROUTINE FixPrincipalDavAndLayers SUBROUTINE GetParticleLayerStressesforEllipse(Particles,No,numoflayers,pstressdir,pstress,& groundbasalwaterp,ellipsesthres) - IMPLICIT NONE + IMPLICIT NONE - TYPE(Particle_t), POINTER :: Particles - REAL(KIND=dp) :: pstressdir(numoflayers,2,2),pstress(numoflayers,2),z + TYPE(Particle_t), POINTER :: Particles + REAL(KIND=dp) :: pstressdir(numoflayers,2,2),pstress(numoflayers,2),z REAL(KIND=dp) :: n,Eeexp,EFExp,zsrhs,MinSRInvSquared,rhowtimesgravity,rhoitimesgravity,& oneovernumoflayersminus1,Identity(3,3),psr(3,3),rhs,zs,ID(3,3),& ESR(3,3),Tau(2,2),IDn1(3,3),ETau(2,2),peff,eigvalues(2),eigenvec(2,2) @@ -8893,7 +8977,7 @@ SUBROUTINE GetParticleLayerStressesforEllipse(Particles,No,numoflayers,pstressdi REAL(KIND=dp) :: one=1.0_dp,zero=0.0_dp,onethird=1.0_dp/3.0_dp,half=0.5_dp,& three=3.0_dp,onepfive=1.5_dp,two=2.0_dp,quart=0.25_dp, n3 = -3.0_dp REAL(KIND=dp) :: determ,dxx,dyy,dzz,dxy,ee,denom,ellipsesthres - REAL(KIND=dp) :: TT,DD + REAL(KIND=dp) :: TT,DD INTEGER :: numoflayers,ii,No,whichsurf,start,finish,step LOGICAL :: Visited = .FALSE., groundbasalwaterp REAL(KIND=dp) :: eyyd2m1,exxd1m1,ezzd3m1,exyd4,taurhsmultthird @@ -8901,13 +8985,13 @@ SUBROUTINE GetParticleLayerStressesforEllipse(Particles,No,numoflayers,pstressdi REAL(KIND=dp) :: k1,k2,maxtracesigma,Tau33,tracesigma,voutprod(3,3) REAL(KIND=dp) :: scalevec1(numoflayers) REAL(KIND=dp) :: kf,maxvec(3) - REAL(KIND=dp) :: TraceEtau, chi, ah, td1, Bh,pcont + REAL(KIND=dp) :: TraceEtau, chi, ah, td1, Bh,pcont SAVE :: n,Eeexp,EFExp,zsrhs,minsrinvsquared,rhowtimesgravity,rhoitimesgravity,& oneovernumoflayersminus1,zref,maxtracesigma,k1,k2,Visited ,ah,Bh,pcont IF (.NOT. Visited) THEN - ! various variable shortcuts for damage calculations + ! various variable shortcuts for damage calculations n = one/Particles % Viscosityexponent EeExp = (one-n)/(two * n) EFexp = -one/n @@ -8935,7 +9019,7 @@ SUBROUTINE GetParticleLayerStressesforEllipse(Particles,No,numoflayers,pstressdi ah = Particles % ah Bh = Particles % bh - pcont = one-ah-Bh + pcont = one-ah-Bh Visited = .TRUE. END IF @@ -8957,7 +9041,7 @@ SUBROUTINE GetParticleLayerStressesforEllipse(Particles,No,numoflayers,pstressdi RHS = (Ee**EeExp) * (Particles % EF(No)**EFexp) IF (Particles % Gmask(No) < zero) THEN zs = Particles % H(No)+Particles % Bedrock(No) - ELSE + ELSE zs = Particles % H(No)*zsRHS END IF @@ -9043,18 +9127,18 @@ SUBROUTINE GetParticleLayerStressesforEllipse(Particles,No,numoflayers,pstressdi ! denom = one/( Dxy*Dxy + Dxx + Dyy -Dxx*Dyy - one) ! t1d2m1 = Tau(1,1)*(Dyy-one)*denom ! t2d1m1 = Tau(2,2)*(Dxx-one)*denom - ! t3od3m1 = taurhsmultthird * (exxd1m1+eyyd2m1-two*ezzd3m1+two*exyd4)/(Dzz-one) + ! t3od3m1 = taurhsmultthird * (exxd1m1+eyyd2m1-two*ezzd3m1+two*exyd4)/(Dzz-one) ! d4t4 = Tau(1,2)*Dxy*denom - ! Etau(1,1) = onethird*(two*t1d2m1 - t2d1m1 +t3od3m1 -d4t4) - ! Etau(2,2) = onethird*(-t1d2m1 + two*t2d1m1 +t3od3m1 -d4t4) + ! Etau(1,1) = onethird*(two*t1d2m1 - t2d1m1 +t3od3m1 -d4t4) + ! Etau(2,2) = onethird*(-t1d2m1 + two*t2d1m1 +t3od3m1 -d4t4) ! !Etau(3,3) = onethird*(-t1d2m1 - t2d1m1 - two*t3od3m1 + two*d4t4) ! Etau(1,2) = half*denom*(tau(1,2)*(Dxx+Dyy-two) - Dxy*(Tau(1,1)+Tau(2,2))) ! Etau(2,1) = Etau(1,2) ! ETau(1,1) = ETau(1,1) - Peff ! ETau(2,2) = ETau(2,2) - Peff - ! CALL Eigen2DSym_TryGenFirst(ETau,EigValues,EigenVec) + ! CALL Eigen2DSym_TryGenFirst(ETau,EigValues,EigenVec) ! WHERE (EigValues < Particles % mindam) EigValues = Particles % mindam @@ -9148,7 +9232,7 @@ SUBROUTINE nonlocalsurroundelems(Particles,Mesh,lc) !y test coords tcoords(2) = scoordsy(kk) - ! IF (ABS(tcoords(1)-mcoords(1)) < Particles % gridres*1.1_dp) CYCLE + ! IF (ABS(tcoords(1)-mcoords(1)) < Particles % gridres*1.1_dp) CYCLE ElementIndNew = 0 CALL LocateParticleInMeshOctree( ElementIndNew, tcoords ) @@ -9185,7 +9269,7 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles - TYPE(Mesh_t), POINTER :: Mesh + TYPE(Mesh_t), POINTER :: Mesh INTEGER :: count,numoflayers,extracount,curcount REAL(KIND=dp) :: lc,gaussk,gridres,vertlc,ellipsesthres,fsquared LOGICAL :: groundbasalwaterp,justusegaussian @@ -9199,6 +9283,7 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & REAL(KIND=dp),ALLOCATABLE :: ruptstat(:,:) INTEGER, POINTER :: eligperm(:)=>NULL() INTEGER,TARGET :: eligref(numoflayers) + REAL(KIND=dp) :: ruptstat2(numoflayers),match2(numoflayers) REAL(KIND=dp) :: match(numoflayers),lmaxval, edgescale INTEGER :: ElementInd,basalref,surfref,eliglayers,smoothlayers INTEGER :: No, CompNo, ii, jj, kk, j, ind, ind2, p, q, m, mm @@ -9245,7 +9330,7 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & ! now set each element max layers to max of surrounding elements within nonlocal range ElemTrack(:) % ddlayfrombottom2 = ElemTrack(:) % ddlayfrombottom1 - ElemTrack(:) % ddlayfromtop2 = ElemTrack(:) % ddlayfromtop1 + ElemTrack(:) % ddlayfromtop2 = ElemTrack(:) % ddlayfromtop1 DO ind = 1,Mesh % NumberOfBulkElements IF (ElemParticles(ind) % NumberOfParticles < 1) CYCLE @@ -9297,7 +9382,7 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & CompCoord = Particles % Coordinate(CompNo,1:2) dist = (CompCoord(1)-Coord(1))*(CompCoord(1)-Coord(1)) + & - (CompCoord(2)-Coord(2))*(CompCoord(2)-Coord(2)) + (CompCoord(2)-Coord(2))*(CompCoord(2)-Coord(2)) !mark particle IF (dist < lcsquared) THEN tot = tot + one @@ -9317,7 +9402,7 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & ! ------------------------------------------------------------------- ! 2: allocate space to calculate nonlocal contributions - ! ------------------------------------------------------------------- + ! ------------------------------------------------------------------- IF (tot > zero) THEN ALLOCATE(nonlocdD(INT(tot),numoflayers,4)) @@ -9336,13 +9421,13 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & ! ------------------------------------------------------------------- ! 3: Particle loop: nonlocal contribution ! from No (current) to CompNo (surrounding) - ! ------------------------------------------------------------------- + ! ------------------------------------------------------------------- DO No = 1, Particles % NumberOfParticles - count = INT(Particles % xpic(No,1)) - IF (count == 0) CYCLE + count = INT(Particles % xpic(No,1)) + IF (count <= 0) CYCLE DO ii = 1,MIN(INT(Particles % xpic(No,5)),numoflayers) CALL MaxPFour(Particles % damage(No,ii,1:4),lmaxval) @@ -9371,12 +9456,29 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & ! IF (Particles % xpic(No,1) == zero) CYCLE ! IF (Particles % damstatus(No) == -1) CYCLE + !ADDED 2021--- + !For 'extracount' particles (xpic(No,1)==-1), ruptstat is determined here + !and saved on ruptstat2 + IF (curcount < 0 ) then + ruptstat2=zero + DO ii = 1,MIN(INT(Particles % xpic(No,5)),numoflayers) + CALL MaxPFour(Particles % damage(No,ii,1:4),lmaxval) + IF (lmaxval < Particles % criticaldamage) ruptstat2(ii) = 1.0_dp + END DO + + DO ii = numoflayers,MAX(INT(Particles % xpic(No,6)),1),-1 + CALL MaxPFour(Particles % damage(No,ii,1:4),lmaxval) + IF (lmaxval < Particles % criticaldamage) ruptstat2(ii) = 1.0_dp + END DO + ENDIF + !--- + IF (Particles % xpic(No,5) >= Particles % xpic(No,6)) THEN ! basal and surface crevasses overlap. Particles % xpic(No,5) = numoflayers Particles % xpic(No,6) = 0 - eligref = (/(j,j=1,numoflayers)/) + eligref = (/(j,j=1,numoflayers)/) eligperm => eligref eliglayers = numoflayers @@ -9458,7 +9560,7 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & IF (Particles % Status(CompNo) > 4) CYCLE IF (Particles % xpic(CompNo,2) == No) CYCLE !already taken care of - Particles % xpic(CompNo,2) = No + Particles % xpic(CompNo,2) = No IF (Particles % xpic(CompNo,1) <= zero) CYCLE ! IF (Particles % damstatus(No) .NE. Particles % damstatus(CompNo)) CYCLE ! IF (Particles % damstatus(CompNo) .EQ. -1) CYCLE @@ -9489,12 +9591,19 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & END IF END IF + match = 0.0_dp count = INT(Particles % xpic(CompNo,1)) - match = 0.0_dp - WHERE (ruptstat(curcount,:)== ruptstat(count,:)) match = 1.0_dp - + !CHANGED 2021--- + !WHERE (ruptstat(curcount,:)== ruptstat(count,:)) match = 1.0_dp + IF (curcount>0) then + WHERE (ruptstat(curcount,:)== ruptstat(count,:)) match = 1.0_dp + ELSE + match2 = ruptstat(count,:) + WHERE (match2(:)==ruptstat2(:)) match = 1.0_dp + ENDIF + !--- IF (.NOT. justusegaussian) THEN @@ -9507,13 +9616,13 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & rho(eligperm) = one !lcsquared ELSE diff(eligperm,1) = CompCoord(1)-Coord(1) - diff(eligperm,2) = CompCoord(2)-Coord(2) + diff(eligperm,2) = CompCoord(2)-Coord(2) - cosphi(eligperm) = SUM(diff(eligperm,:) * pstressdir(eligperm,1,1:2),DIM=2) + cosphi(eligperm) = SUM(diff(eligperm,:) * pstressdir(eligperm,1,1:2),DIM=2) sinphi(eligperm) = SUM(diff(eligperm,:) * pstressdir(eligperm,2,1:2),DIM=2) cosphi(eligperm) = cosphi(eligperm)*cosphi(eligperm)/phi - sinphi(eligperm) = sinphi(eligperm)*sinphi(eligperm)/phi + sinphi(eligperm) = sinphi(eligperm)*sinphi(eligperm)/phi !rho squared rho(eligperm) = one / & @@ -9545,19 +9654,19 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & END IF nonlocdD(count,eligperm,1) = nonlocdD(count,eligperm,1) + & - phivec(eligperm) * Particles % dD(No,eligperm,1) + phivec(eligperm) * Particles % dD(No,eligperm,1) nonlocdD(count,eligperm,2) = nonlocdD(count,eligperm,2) + & - phivec(eligperm) * Particles % dD(No,eligperm,2) + phivec(eligperm) * Particles % dD(No,eligperm,2) nonlocdD(count,eligperm,3) = nonlocdD(count,eligperm,3) + & - phivec(eligperm) * Particles % dD(No,eligperm,3) + phivec(eligperm) * Particles % dD(No,eligperm,3) nonlocdD(count,eligperm,4) = nonlocdD(count,eligperm,4) + & - phivec(eligperm) * Particles % dD(No,eligperm,4) + phivec(eligperm) * Particles % dD(No,eligperm,4) elldenom(count,eligperm,1) = elldenom(count,eligperm,1) + & - phivec(eligperm) + phivec(eligperm) END DO @@ -9566,18 +9675,18 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & ! ------------------------------------------------------------------- ! 4: Update Particles % dD based on nonlocal - ! ------------------------------------------------------------------- + ! ------------------------------------------------------------------- elldenom(:,:,2) = elldenom(:,:,1) elldenom(:,:,3) = elldenom(:,:,1) elldenom(:,:,4) = elldenom(:,:,1) - WHERE (elldenom .NE. zero) nonlocdD = nonlocdD / elldenom + WHERE (elldenom .NE. zero) nonlocdD = nonlocdD / elldenom DO No = 1, Particles % NumberOfParticles IF (Particles % xpic(No,1) <= zero) CYCLE - ! IF (Particles % damstatus(No) == -1) CYCLE + ! IF (Particles % damstatus(No) == -1) CYCLE count = INT(Particles % xpic(No,1)) Particles % dD(No,:,1:4) = nonlocdD(count,:,1:4) @@ -9591,11 +9700,11 @@ SUBROUTINE nonlocalintegraldDellipseRobust(Particles, numoflayers, & ! ------------------------------------------------------------------- ! 5: Vertical smoothing - ! ------------------------------------------------------------------- + ! ------------------------------------------------------------------- IF (vertlc > 0) THEN lcsquared = vertlc*vertlc - phiparam = -gaussksquared/lcsquared + phiparam = -gaussksquared/lcsquared DO No = 1, Particles % NumberOfParticles IF (Particles % xpic(No,1) <= zero) CYCLE y = (/(m,m=0,numoflayers-1,1)/) @@ -9691,7 +9800,7 @@ SUBROUTINE nonlocalintegraldD(Particles, numoflayers, countin, lc, gaussk, gridr CompCoord = GetParticleCoord( Particles, CompNo) dist = (CompCoord(1)-Coord(1))*(CompCoord(1)-Coord(1)) + & - (CompCoord(2)-Coord(2))*(CompCoord(2)-Coord(2)) + (CompCoord(2)-Coord(2))*(CompCoord(2)-Coord(2)) !mark particle IF (dist <= lcsquared) THEN tot = tot + 1.0_dp @@ -9747,7 +9856,7 @@ SUBROUTINE nonlocalintegraldD(Particles, numoflayers, countin, lc, gaussk, gridr !END IF ! ! - ! + ! !nonlocal between No and CompNo has already been taken care of. IF (Particles % xpic(CompNo,2) == No) CYCLE @@ -9795,7 +9904,7 @@ SUBROUTINE nonlocalintegraldD(Particles, numoflayers, countin, lc, gaussk, gridr ! lc = vertlc lcsquared = vertlc*vertlc phiparam = -gaussk/lcsquared - ! dblesmoothlayers = DBLE(smoothlayers) + ! dblesmoothlayers = DBLE(smoothlayers) DO No = 1, Particles % NumberOfParticles IF (Particles % xpic(No,1) == 0.0_dp) CYCLE y = (/(m,m=0,numoflayers-1,1)/) @@ -9824,19 +9933,19 @@ SUBROUTINE nonlocalintegraldD(Particles, numoflayers, countin, lc, gaussk, gridr DEALLOCATE(nonlocdD) END SUBROUTINE nonlocalintegraldD - !************************************************************************** + !************************************************************************** SUBROUTINE smoothrupth(Particles, Mesh, lc, smoothiters) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles - TYPE(Mesh_t), POINTER :: Mesh + TYPE(Mesh_t), POINTER :: Mesh INTEGER :: No,ii,kk,jj,ind2,CompNo,ElementInd,smoothiters REAL(KIND=dp) :: Coord(2),CompCoord(2),phi,lc,gaussk=2.0_dp,lcs,gks,pm LOGICAL :: edge,edge2 !,restarted=.FALSE. - REAL(KIND=dp) :: Coordreflecty,phi2 + REAL(KIND=dp) :: Coordreflecty,phi2 CALL nonlocalsurroundelems(Particles,Mesh,lc) @@ -9890,7 +9999,7 @@ SUBROUTINE smoothrupth(Particles, Mesh, lc, smoothiters) IF (CompNo==0) CYCLE !already taken care of - IF (Particles % xpic(CompNo,1) == No) CYCLE + IF (Particles % xpic(CompNo,1) == No) CYCLE Particles % xpic(CompNo,1) = No @@ -10006,7 +10115,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) REAL(KIND=dp), POINTER :: PMVal(:)=>NULL() LOGICAL :: VISITED = .FALSE., GotIt, & firsttime,nodamfront,stat - REAL(KIND=dp),ALLOCATABLE :: Basis(:),dBasisdx(:,:) + REAL(KIND=dp),ALLOCATABLE :: Basis(:),dBasisdx(:,:) INTEGER :: match,No2 REAL(KIND=dp) :: dist LOGICAL :: CalvingFront @@ -10022,7 +10131,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) IF (.NOT. VISITED) THEN - WRITE(SolverName, '(A)') 'GetElemParticles_GIMPM' + WRITE(SolverName, '(A)') 'GetElemParticles_GIMPM' ALLOCATE(Basis(4),dBasisdx(4,3)) ALLOCATE(ElementNodes % x(4),ElementNodes % y(4),ElementNodes % z(4)) @@ -10031,7 +10140,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) nodamfront = Particles % nodamfront CriticalDamage = Particles % CriticalDamage - CriticalDav = Particles % criticaldav + CriticalDav = Particles % criticaldav gridres = Particles % gridres frac = Particles % elementfraction @@ -10084,7 +10193,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) ! | 4 | 5 | 6 | !where the particle is in element 5 ! |-----------| ! | 7 | 8 | 9 | - ! ------------- + ! ------------- IF (ALLOCATED(ElemParticles)) DEALLOCATE(ElemParticles) @@ -10150,7 +10259,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) CASE (8) TestCoords(1) = xc TestCoords(2) = S - CASE (9) + CASE (9) TestCoords(1) = E TestCoords(2) = S END SELECT @@ -10176,7 +10285,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) WHERE (Particles % ElementIndex(:) == 0) Particles % Coordinate(:,1) = -HUGE(1.0_dp) - !Particles % Coordinate(:,1) = Particles % Coordinate(:,1) + 225.0_dp + !Particles % Coordinate(:,1) = Particles % Coordinate(:,1) + 225.0_dp END IF @@ -10230,7 +10339,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) ElementIndNew = 0 END IF - ! + ! ELSE @@ -10256,7 +10365,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) N = ymax - Coord(2) S = Coord(2) - ymin - E = xmax - Coord(1) + E = xmax - Coord(1) W = Coord(1) - xmin !we create test cases so that @@ -10266,7 +10375,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) !whichelem equals one of these spots: ! 11 - 12 - 13 - ! 21 - 22 - 23 + ! 21 - 22 - 23 ! 31 - 32 - 33 whichelem = 22 @@ -10302,10 +10411,10 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) ElementIndNew = ElemParticles(ElementInd) % SurroundingElems(9) CASE (99) ElementIndNew = ElementInd - CALL LocateParticleInMeshOctree( ElementIndNew, Coord ) + CALL LocateParticleInMeshOctree( ElementIndNew, Coord ) CASE DEFAULT ElementIndNew = ElementInd - CALL LocateParticleInMeshOctree( ElementIndNew, Coord ) + CALL LocateParticleInMeshOctree( ElementIndNew, Coord ) END SELECT IF (ElementIndNew > 0) THEN @@ -10375,7 +10484,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) IF(N > ymax) in(2)=1 IF(S < ymin) in(8)=1 IF(E > xmax) in(6)=1 - IF(W < xmin) in(4)=1 + IF(W < xmin) in(4)=1 IF (in(2) ==1 .AND. in(4)==1) in(1)=1 IF (in(2) ==1 .AND. in(6)==1) in(3)=1 @@ -10432,7 +10541,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) CASE (8) GlobalCoords(1) = Coord(1) GlobalCoords(2) = S - CASE (9) + CASE (9) GlobalCoords(1) = E GlobalCoords(2) = S END SELECT @@ -10485,7 +10594,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) Elems(8) = 0 END IF - IF (W>480000.0_dp) Elems = 0 + IF (W>480000.0_dp) Elems = 0 END IF END IF @@ -10585,7 +10694,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) !first some volume corrections if lost particles ended up in an element !this happens when locate particle in mesh octree is a little off and locates - !a leaving particle as being slightly within an element incorrectly. + !a leaving particle as being slightly within an element incorrectly. tot = 0 DO jj = 1,ElemParticles(ii) % NumberOfParticles @@ -10622,7 +10731,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) DO jj = 1,ElemParticles(ii) % NumberOfParticles No = Ptable(jj) IF (No > 0) THEN - kk = kk+1 + kk = kk+1 ElemParticles(ii) % p(kk) = No END IF END DO @@ -10637,7 +10746,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) !If they do overlap a FULL, then subtract their !volume from the NOTFULL element and set them to PARTICLE_LEAVING. !If the element isn't next to a full element, it is set to an IGNORE status. - !This shouldn't really happen if the front is smooth, but + !This shouldn't really happen if the front is smooth, but !for IGNORE, subtract the element from particle volumes, set them to PARTICLE_LEAVING, or !particle lost if they have no volume. @@ -10733,7 +10842,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) Element => Mesh % Elements(ii) IF (.NOT. ASSOCIATED(Element) ) CYCLE NodeIndexes => Element % NodeIndexes - nn = Element % TYPE % NumberOfNodes + nn = Element % TYPE % NumberOfNodes DO jj = 1,nn PMVal(PMPerm(NodeIndexes(jj))) = MAX(1.0_dp,PMVal(PMPerm(NodeIndexes(jj)))) @@ -10883,7 +10992,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) IF (ElemTrack(P1 % ElementIndex) % Status > IGNORE) THEN ElemTrack(P1 % ElementIndex) % Status = FEM NodeIndexes => P1 % NodeIndexes - PMVal(PMPerm(NodeIndexes)) = 2.0_dp + PMVal(PMPerm(NodeIndexes)) = 2.0_dp END IF END IF @@ -10891,7 +11000,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) IF (ElemTrack(P2 % ElementIndex) % Status > IGNORE) THEN ElemTrack(P2 % ElementIndex) % Status = FEM NodeIndexes => P2 % NodeIndexes - PMVal(PMPerm(NodeIndexes)) = 2.0_dp + PMVal(PMPerm(NodeIndexes)) = 2.0_dp END IF END IF END IF @@ -10921,7 +11030,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) nn = 0 ALLOCATE( Perm( Particles % NumberOfParticles)) - Perm = 0 + Perm = 0 DO No = 1,Particles % NumberOfParticles @@ -10953,7 +11062,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) IF (nn>0) THEN ALLOCATE(Old(nn)) - kk = 0 + kk = 0 DO jj = 1, ElemParticles(ii) % NumberOfParticles @@ -10991,7 +11100,7 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) Element => Mesh % Elements(ii) IF (.NOT. ASSOCIATED(Element) ) CYCLE NodeIndexes => Element % NodeIndexes - PMVal(PMPerm(NodeIndexes)) = 2.0_dp + PMVal(PMPerm(NodeIndexes)) = 2.0_dp END IF END IF END DO @@ -11012,10 +11121,10 @@ SUBROUTINE GetElemParticles_GIMPM( Particles, Model ) IF (kk < 1) CYCLE ALLOCATE(ElemParticles(ii) % Basis(kk,4)) - ALLOCATE(ElemParticles(ii) % dBasisdx(kk,4,3)) + ALLOCATE(ElemParticles(ii) % dBasisdx(kk,4,3)) Element => Model % Mesh % Elements(ii) - NodeIndexes => Element % NodeIndexes + NodeIndexes => Element % NodeIndexes CALL GetElementNodes(ElementNodes,Element) @@ -11058,7 +11167,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) INTEGER :: in(9), Elems(9),ElemVec(4),change,count,OldNoParticles INTEGER :: L,R,U,D,ii, nn, jj, kk,mm,pp,ne, No, Status,ElementInd,& ElementIndNew,istat,maxindex,tot,AddDam,whichelem,surroundelem,fulldamcount,nind,iter - INTEGER, POINTER :: NodeIndexes(:)=>NULL(),NextNodeIndexes(:)=>NULL(),PMPerm(:)=>NULL() + INTEGER, POINTER :: NodeIndexes(:)=>NULL(),NextNodeIndexes(:)=>NULL(),PMPerm(:)=>NULL() INTEGER, allocatable :: elemcount(:),fulldam(:),frontedit(:),Old(:),Perm(:) INTEGER, POINTER :: N1, N2 REAL(KIND=dp) :: LX,LY,N,S,E,W,xmin,xmax,ymin,ymax,yy,xx,AddVol,ElemVol,SumVol, & @@ -11080,14 +11189,14 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) IF (.NOT. VISITED) THEN - WRITE(SolverName, '(A)') 'GetElemParticles_sMPM' + WRITE(SolverName, '(A)') 'GetElemParticles_sMPM' Mesh => GetMesh() ne = Mesh % NumberOfBulkElements nodamfront = Particles % nodamfront CriticalDamage = Particles % CriticalDamage - CriticalDav = Particles % criticaldav - ! Dmax = Particles % dmax + CriticalDav = Particles % criticaldav + ! Dmax = Particles % dmax gridres = Particles % gridres frac = Particles % elementfraction @@ -11113,7 +11222,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) Particles % Length(:,2) Particles % pvolume(:) = Particles % GVolume(:) END IF - + CALL Info(Solvername,'allocating elemcount and ElemParticles',Level=4) @@ -11128,7 +11237,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) ! | 4 | 5 | 6 | !where the particle is in element 5 ! |-----------| ! | 7 | 8 | 9 | - ! ------------- + ! ------------- IF (ALLOCATED(ElemParticles)) DEALLOCATE(ElemParticles) @@ -11196,7 +11305,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) CASE (8) TestCoords(1) = xc TestCoords(2) = S - CASE (9) + CASE (9) TestCoords(1) = E TestCoords(2) = S END SELECT @@ -11281,7 +11390,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) ElementInd = 0 END IF - Particles % ElementIndex(No) = ElementInd + Particles % ElementIndex(No) = ElementInd IF (ElementInd < 1) THEN Particles % Status(No) = PARTICLE_LOST @@ -11289,7 +11398,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) END DO ! must delete lost particles before assigning the particles to their new elements - CALL DeleteLostParticles( Particles ) + CALL DeleteLostParticles( Particles ) ! determine how many particles in each element DO No = 1,Particles % NumberOfParticles @@ -11317,7 +11426,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) END DO ! assign particles to ElemParticle list, determine volume of particles in the element - elemcount = 0 + elemcount = 0 DO No = 1, Particles % NumberOfParticles ElementInd = GetParticleElement( Particles, No ) @@ -11327,7 +11436,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) ElemParticles(ElementInd) % p(elemcount(ElementInd)) = No END DO - !Set nodes of elements without particles to PMVal = -1 + !Set nodes of elements without particles to PMVal = -1 DO ii = 1,ne IF (ElemTrack(ii) % Status > EMPTY) CYCLE @@ -11395,7 +11504,7 @@ SUBROUTINE GetElemParticles_sMPM( Particles, Model ) NodeIndexes => Element % NodeIndexes Model % CurrentElement => Model % Elements(ii) - noofn = GetElementNOFNodes() + noofn = GetElementNOFNodes() IF (ABS(SUM(PMVal(PMPerm(NodeIndexes)))) .NE. DBLE(noofn)) THEN ElemTrack(ii) % Status = FEM @@ -11438,7 +11547,7 @@ SUBROUTINE XPIC(Particles,Model,m) TYPE(Variable_t), POINTER :: Vstar,Vk,H,VPlus,Vstar1,Vstar2,VelSol,PM TYPE(Model_t) :: Model TYPE(Nodes_t) :: ElementNodes - TYPE(Element_t), POINTER :: Element + TYPE(Element_t), POINTER :: Element REAL(KIND=dp) :: dt INTEGER, POINTER :: VstarPerm(:),VkPerm(:),HPerm(:),VPlusPerm(:),& Vstar1Perm(:),Vstar2Perm(:),VelSolPerm(:),PMPerm(:) @@ -11479,51 +11588,51 @@ SUBROUTINE XPIC(Particles,Model,m) ALLOCATE( VelSolLocalPerm(nn), adtLocalField(nn,dim) ) Vstar => VariableGet(Model % Mesh % Variables, 'Vstar' ) - IF (.NOT. ASSOCIATED(Vstar)) CALL Fatal('xpic','Vstar does not exist ') + IF (.NOT. ASSOCIATED(Vstar)) CALL Fatal('xpic','Vstar does not exist ') VstarPerm => Vstar % Perm VstarVal => Vstar % Values VstarVal = 0.0_dp Vplus => VariableGet(Model % Mesh % Variables, 'Vplus' ) - IF (.NOT. ASSOCIATED(Vplus)) CALL Fatal('xpic','Vplus does not exist ') + IF (.NOT. ASSOCIATED(Vplus)) CALL Fatal('xpic','Vplus does not exist ') VplusPerm => Vplus % Perm VplusVal => Vplus % Values VplusVal = 0.0_dp VelSol => VariableGet(Model % Mesh % Variables, 'SSAVelocity' ) - IF (.NOT. ASSOCIATED(VelSol)) CALL Fatal('xpic','SSAVelocity does not exist ') + IF (.NOT. ASSOCIATED(VelSol)) CALL Fatal('xpic','SSAVelocity does not exist ') VelSolPerm => VelSol % Perm VelSolVal => VelSol % Values Vk => VariableGet(Model % Mesh % Variables, 'PrevVel' ) - IF (.NOT. ASSOCIATED(Vk)) CALL Fatal('xpic','PrevVel does not exist ') + IF (.NOT. ASSOCIATED(Vk)) CALL Fatal('xpic','PrevVel does not exist ') VkPerm => Vk % Perm VkVal => Vk % Values H => VariableGet(Model % Mesh % Variables, 'H' ) - IF (.NOT. ASSOCIATED(H)) CALL Fatal('xpic','H does not exist ') + IF (.NOT. ASSOCIATED(H)) CALL Fatal('xpic','H does not exist ') HPerm => H % Perm HVal => H % Values Vstar1 => VariableGet(Model % Mesh % Variables, 'Vstar 1' ) - IF (.NOT. ASSOCIATED(Vstar1)) CALL Fatal('xpic','Vstar does not exist ') + IF (.NOT. ASSOCIATED(Vstar1)) CALL Fatal('xpic','Vstar does not exist ') Vstar1Perm => Vstar1 % Perm Vstar1Val => Vstar1 % Values Vstar2 => VariableGet(Model % Mesh % Variables, 'Vstar 2' ) - IF (.NOT. ASSOCIATED(Vstar2)) CALL Fatal('xpic','Vstar does not exist ') + IF (.NOT. ASSOCIATED(Vstar2)) CALL Fatal('xpic','Vstar does not exist ') Vstar2Perm => Vstar2 % Perm Vstar2Val => Vstar2 % Values PM => VariableGet( Model % Mesh % Variables, 'surface') PMValues => PM % Values - PMPerm => PM % Perm + PMPerm => PM % Perm Visited = .TRUE. END IF - CALL Info('xpic','Assigning new velocities and next coords to particles...',Level=1) + CALL Info('xpic','Assigning new velocities and next coords to particles...',Level=1) mm = DBLE(m) @@ -11531,18 +11640,18 @@ SUBROUTINE XPIC(Particles,Model,m) !INITIALIZATION !vplus starts (r = 1) by equaling prevvel... - VplusVal(2*(VplusPerm(:)-1)+1) = VkVal(2*(VkPerm(:)-1)+1) + VplusVal(2*(VplusPerm(:)-1)+1) = VkVal(2*(VkPerm(:)-1)+1) VplusVal(2*(VplusPerm(:)-1)+2) = VkVal(2*(VkPerm(:)-1)+2) VstarVal = 0.0_dp - Particles % xpic = 0.0_dp + Particles % xpic = 0.0_dp !LOOPS DO r = 2,m !multiply by the r and m function - rr = DBLE(r) + rr = DBLE(r) !vplus(r-1) from mesh to particles. 3 is a dumy CALL MPMMeshVectorToParticle( Particles, Model, 4, 3) @@ -11556,7 +11665,7 @@ SUBROUTINE XPIC(Particles,Model,m) rr = (mm-rr+1.0_dp)/rr VplusVal(2*(VplusPerm(:)-1)+1) = rr * VplusVal(2*(VplusPerm(:)-1)+1) - VplusVal(2*(VplusPerm(:)-1)+2) = rr * VplusVal(2*(VplusPerm(:)-1)+2) + VplusVal(2*(VplusPerm(:)-1)+2) = rr * VplusVal(2*(VplusPerm(:)-1)+2) VstarVal(2*(VstarPerm(:)-1)+1) = VstarVal(2*(VstarPerm(:)-1)+1) + bb * VplusVal(2*(VplusPerm(:)-1)+1) VstarVal(2*(VstarPerm(:)-1)+2) = VstarVal(2*(VstarPerm(:)-1)+2) + bb * VplusVal(2*(VplusPerm(:)-1)+2) @@ -11583,7 +11692,7 @@ SUBROUTINE XPIC(Particles,Model,m) DO jj = 1,m-1 DO ii = 1,nb - IF ( ElemTrack(ii) % Status < FEM ) CYCLE + IF ( ElemTrack(ii) % Status < FEM ) CYCLE Element => Model % Mesh % Elements(ii) NodeIndexes => Element % NodeIndexes @@ -11600,7 +11709,7 @@ SUBROUTINE XPIC(Particles,Model,m) DO ii = 1,nb !only use full elements - IF ( ElemTrack(ii) % Status < FEM ) CYCLE + IF ( ElemTrack(ii) % Status < FEM ) CYCLE Element => Model % Mesh % Elements(ii) NodeIndexes => Element % NodeIndexes @@ -11619,7 +11728,7 @@ SUBROUTINE XPIC(Particles,Model,m) ! VkLocalFied(kk,jj) = VkVal(2*(VkLocalPerm(kk)-1)+jj) adtLocalField(kk,jj) = VelSolVal(2*(VelSolLocalPerm(kk)-1)+jj) - & - VkVal(2*(VkLocalPerm(kk)-1)+jj) + VkVal(2*(VkLocalPerm(kk)-1)+jj) END DO END DO @@ -11631,17 +11740,17 @@ SUBROUTINE XPIC(Particles,Model,m) detJ, scale, .TRUE., Basis,dBasisdx) Basis = Basis*scale - ELSE + ELSE stat = sMPMElementInfo( Element,Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) scale = 1.0_dp END IF ! IF (ElemTrack(ii) % Status > FEM) THEN ! IF (ALL(PMValues(PMPerm(Element % NodeIndexes)) .NE. 2)) THEN - !S(a_ex^k) + !S(a_ex^k) DO kk = 1,2 Particles % xpic(No,kk) = Particles % xpic(No,kk) + & mm*SUM(Basis(1:nn) * VstarLocalField(1:nn,kk)) - & @@ -11659,13 +11768,13 @@ SUBROUTINE XPIC(Particles,Model,m) !S(v^k+) DO kk = 3,4 Particles % xpic(No,kk) = Particles % xpic(No,kk) + & - SUM(Basis(1:nn) * VsolLocalField(1:nn,kk-2)) + SUM(Basis(1:nn) * VsolLocalField(1:nn,kk-2)) END DO !S(v^(k+) - v^(k)) DO kk = 5,6 Particles % xpic(No,kk) = Particles % xpic(No,kk) + & - SUM(Basis(1:nn) * adtLocalField(1:nn,kk-4)) + SUM(Basis(1:nn) * adtLocalField(1:nn,kk-4)) END DO END DO END DO @@ -11685,7 +11794,7 @@ SUBROUTINE XPIC(Particles,Model,m) Particles % xpic = 0.0_dp - CALL Info('xpic','Done.',Level=1) + CALL Info('xpic','Done.',Level=1) END SUBROUTINE XPIC @@ -11703,7 +11812,7 @@ SUBROUTINE FixPrincipalDamage(Din,CriticalDamage) REAL(KIND=dp) ::w,x,y,z INTEGER :: ii REAL(KIND=dp) :: layerdmax,layerdmax2,sqrteig - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles LOGICAL :: Visited=.FALSE. SAVE :: Particles,Visited,layerdmax @@ -11711,14 +11820,16 @@ SUBROUTINE FixPrincipalDamage(Din,CriticalDamage) IF (.NOT. Visited) THEN Particles => GlobalParticles - layerdmax = Particles % DmaxI + layerdmax = Particles % DmaxI END IF !check eigenvalues IF (Particles % currentGamma == zero) THEN IF (Din(1) >= CriticalDamage) THEN Din(1:2) = Particles % DmaxI - Din(3) = Particles % DmaxIII + IF (.NOT. Particles % nodzz) THEN + Din(3) = Particles % DmaxIII + END IF END IF IF (Din(1) < zero) Din = zero @@ -11750,7 +11861,7 @@ SUBROUTINE FixPrincipalDamage(Din,CriticalDamage) D(1,1) = Din(1) D(2,1) = Din(4) - D(1,2) = Din(4) + D(1,2) = Din(4) D(2,2) = Din(2) IF (Din(4)==zero) THEN @@ -11758,10 +11869,10 @@ SUBROUTINE FixPrincipalDamage(Din,CriticalDamage) EigVals(2) = lambda(1) IF (Din(2)>Din(1)) THEN - EigVec(1,1) = one - EigVec(2,1) = zero - EigVec(1,2) = zero - EigVec(2,2) = one + EigVec(1,1) = one + EigVec(2,1) = zero + EigVec(1,2) = zero + EigVec(2,2) = one ELSE EigVec(1,1) = zero EigVec(2,1) = one @@ -11774,7 +11885,7 @@ SUBROUTINE FixPrincipalDamage(Din,CriticalDamage) CALL Eigen2D(D,EigVals,EigVec) ELSE EigVals(1) = lambda(2) - EigVals(2) = lambda(1) + EigVals(2) = lambda(1) !first eigenvector EigVec(1,2)=Din(4) @@ -11830,10 +11941,16 @@ SUBROUTINE FixPrincipalDamage(Din,CriticalDamage) ! IF (diff1 > zero) THEN diff2 = (1.0_dp - Particles % TempGamma) * diff1 EigVals(1) = EigVals(1)+diff2 - D3 = D3 + diff2 + IF (.NOT. Particles % noDzz) THEN + D3 = D3 + diff2 + ENDIF ! END IF EigVals(2) = layerdmax + + IF (Particles % forcedzz) D3 = Particles % DmaxIII END IF + + END IF @@ -11843,7 +11960,7 @@ SUBROUTINE FixPrincipalDamage(Din,CriticalDamage) IF (EigVals(1)< zero) EigVals(1) = zero IF (EigVals(2)< zero) EigVals(2) = zero - IF (D3 < zero) D3 = zero + IF (D3 < zero) D3 = zero ! D = zero; D(1,1) = EigVals(1); D(2,2) = EigVal(2) @@ -11859,7 +11976,7 @@ SUBROUTINE FixPrincipalDamage(Din,CriticalDamage) Din(1) = EigVec(1,1)*w + EigVec(1,2)*x Din(2) = EigVec(2,1)*y + EigVec(2,2)*z Din(3) = D3 - Din(4) = EigVec(2,1)*w + EigVec(2,2)*x + Din(4) = EigVec(2,1)*w + EigVec(2,2)*x END SUBROUTINE FixPrincipalDamage @@ -11877,7 +11994,7 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) REAL(KIND=dp) ::w,x,y,z,a,b,c INTEGER :: ii REAL(KIND=dp) :: Dmax,dmax2,dmax3,sqrteig - TYPE(Particle_t), POINTER :: Particles + TYPE(Particle_t), POINTER :: Particles LOGICAL :: Visited=.FALSE.,rupt SAVE :: Particles,Visited,Dmax,Dmax2,Dmax3 @@ -11896,7 +12013,9 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) IF (Particles % currentGamma == zero) THEN IF (Din(1) >= Dmax) THEN Din(1:2) = Particles % DmaxI - Din(3) = Particles % DmaxIII + IF (.NOT. Particles % nodzz) THEN + Din(3) = Particles % DmaxIII + END IF END IF IF (Din(1) < zero) Din = zero @@ -11917,7 +12036,7 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) lambda(1)=TT+sqrteig lambda(2)=TT-sqrteig - lambda(3) = Din(3) + lambda(3) = Din(3) Particles % bmd = MIN(lambda(1),Dmax) @@ -11942,17 +12061,17 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) D(1,1) = Din(1) D(2,1) = Din(4) - D(1,2) = Din(4) + D(1,2) = Din(4) D(2,2) = Din(2) IF (Din(4)==zero) THEN EigVals(1) = lambda(2) EigVals(2) = lambda(1) IF (Din(2)>Din(1)) THEN - EigVec(1,1) = one - EigVec(2,1) = zero - EigVec(1,2) = zero - EigVec(2,2) = one + EigVec(1,1) = one + EigVec(2,1) = zero + EigVec(1,2) = zero + EigVec(2,2) = one ELSE EigVec(1,1) = zero EigVec(2,1) = one @@ -11966,10 +12085,10 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) !precision/overflow/underflow issues under these conditions CALL Eigen2D(D,EigVals,EigVec) ELSE - ! CALL Eigen2D(D,EigValues2d,EigenVec) + ! CALL Eigen2D(D,EigValues2d,EigenVec) !general solution (returning with smallest eigvalues first) EigVals(1) = lambda(2) - EigVals(2) = lambda(1) + EigVals(2) = lambda(1) !first eigenvector EigVec(1,2)=Din(4) @@ -11991,7 +12110,7 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) IF (Din(3) > Dmax3) Din(3) = Dmax3 IF (EigVals(1) < zero) EigVals(1) = zero IF (EigVals(2) < zero) EigVals(2) = zero - IF (Din(3) < zero) Din(3) = zero + IF (Din(3) < zero) Din(3) = zero w = EigVals(1)*EigVec(1,1) x = EigVals(2)*EigVec(1,2) @@ -12000,7 +12119,7 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) Din(1) = EigVec(1,1)*w + EigVec(1,2)*x Din(2) = EigVec(2,1)*y + EigVec(2,2)*z - Din(4) = EigVec(2,1)*w + EigVec(2,2)*x + Din(4) = EigVec(2,1)*w + EigVec(2,2)*x ELSE @@ -12063,7 +12182,7 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) sqrteig = sqrt(sqrteig) TT = half*TT - lambda(1)=TT+sqrteig + lambda(1)=TT+sqrteig lambda(2)=TT-sqrteig lambda(3) = Din(3) @@ -12071,17 +12190,17 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) D(1,1) = Din(1) D(2,1) = Din(4) - D(1,2) = Din(4) + D(1,2) = Din(4) D(2,2) = Din(2) IF (Din(4)==zero) THEN EigVals(1) = lambda(2) EigVals(2) = lambda(1) IF (Din(2)>Din(1)) THEN - EigVec(1,1) = one - EigVec(2,1) = zero - EigVec(1,2) = zero - EigVec(2,2) = one + EigVec(1,1) = one + EigVec(2,1) = zero + EigVec(1,2) = zero + EigVec(2,2) = one ELSE EigVec(1,1) = zero EigVec(2,1) = one @@ -12095,10 +12214,10 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) !precision/overflow/underflow issues under these conditions CALL Eigen2D(D,EigVals,EigVec) ELSE - ! CALL Eigen2D(D,EigValues2d,EigenVec) + ! CALL Eigen2D(D,EigValues2d,EigenVec) !general solution (returning with smallest eigvalues first) EigVals(1) = lambda(2) - EigVals(2) = lambda(1) + EigVals(2) = lambda(1) !first eigenvector EigVec(1,2)=Din(4) @@ -12120,7 +12239,7 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) IF (Din(3) > Dmax3) Din(3) = Dmax3 IF (EigVals(1) < zero) EigVals(1) = zero IF (EigVals(2) < zero) EigVals(2) = zero - IF (Din(3) < zero) Din(3) = zero + IF (Din(3) < zero) Din(3) = zero w = EigVals(1)*EigVec(1,1) x = EigVals(2)*EigVec(1,2) @@ -12129,7 +12248,7 @@ SUBROUTINE FixPrincipalDamageInc(Din,dD,r) Din(1) = EigVec(1,1)*w + EigVec(1,2)*x Din(2) = EigVec(2,1)*y + EigVec(2,2)*z - Din(4) = EigVec(2,1)*w + EigVec(2,2)*x + Din(4) = EigVec(2,1)*w + EigVec(2,2)*x END IF @@ -12148,8 +12267,8 @@ SUBROUTINE bassisinc(Particles,D,RHS,f,dd) TYPE(Particle_t), POINTER :: Particles IF (Particles % Gamma > zero) THEN - f12rhs = D(4) * (Particles % dvdxmdudy) - !spin contribution + f12rhs = D(4) * (Particles % dvdxmdudy) + !spin contribution f(1) = -f12rhs f(2) = f12rhs f(3) = zero @@ -12177,12 +12296,12 @@ SUBROUTINE bassisinc(Particles,D,RHS,f,dd) ww = EigVals(1)*EigenVec(1,1) xx = EigVals(2)*EigenVec(1,2) - yy = EigVals(1)*EigenVec(2,1) + yy = EigVals(1)*EigenVec(2,1) zz = EigVals(2)*EigenVec(2,2) dD(1) = EigenVec(1,1)*ww + EigenVec(1,2)*xx dD(2) = EigenVec(2,1)*yy + EigenVec(2,2)*zz - dD(3) = EigVals(1) + dD(3) = EigVals(1) dD(4) = EigenVec(2,1)*ww + EigenVec(2,2)*xx dD = dD + f @@ -12201,7 +12320,7 @@ END SUBROUTINE bassisinc !! (here, SSA ice creep damage from Huth and others, 2020) !! integrates from t=a to t=b with the initial conditions in y !! Step length automatically adjusts so that absolute error estimate <= tol - SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) + SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) !edited from: !Chivers and Sleightholme @@ -12215,15 +12334,15 @@ SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) TYPE(Particle_t), POINTER :: Particles REAL(KIND=dp), INTENT (out), DIMENSION (4) :: dD - REAL(KIND=dp), INTENT (in) :: a, b, tol - REAL(KIND=dp), INTENT (in) :: Din(4) + REAL(KIND=dp), INTENT (in) :: a, b, tol + REAL(KIND=dp), INTENT (in) :: Din(4) INTEGER, INTENT (out) :: ifail REAL(KIND=dp), INTENT (out) :: ddscale REAL(KIND=dp), DIMENSION (4) :: s1, s2, s3, s4, s5,& r1,r2,r3,r4,r5,new_D_1, old_D_1,new_D_2, error,Dinit,D,inc,rinc REAL(KIND=dp), DIMENSION (2,2) :: D2, EigVec REAL(KIND=dp), DIMENSION (2) :: EigVal - REAL(KIND=dp) :: t, hh, hh2, hh3, hh6, hh8, w,x,y,z,factor + REAL(KIND=dp) :: t, hh, hh2, hh3, hh6, hh8, w,x,y,z,factor REAL(KIND=dp) :: max_error, smallest_step = 1.e-15_dp,rupttime INTEGER :: k,no_of_steps = 0,stoptimes = 1,ii LOGICAL :: Visited=.false.,torupt,rupted = .FALSE. @@ -12269,7 +12388,7 @@ SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) END IF t = a - hh = (b-a)*firststep + hh = (b-a)*firststep Dinit = Din D = Din @@ -12285,7 +12404,7 @@ SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) hh2 = hh*div2 hh3 = hh*div3 hh6 = hh*div6 - hh8 = hh*div8 + hh8 = hh*div8 !-------------S1--------------! ! calculate s1,s2,s3,s4,s5 @@ -12321,12 +12440,12 @@ SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) new_D_1 = D + inc CALL FixPrincipalDamageInc(new_D_1,inc,rinc) - !-------------S4--------------! + !-------------S4--------------! ! s4=f(t+h/2,D+h/8*(s2+3*s3)) CALL dDdtfast(new_D_1,s4,r4) inc = hh2*(s1-3.0_dp*s3+4.0_dp*s4) rinc = hh2*(r1-3.0_dp*r3+4.0_dp*r4) - new_D_1 = D + inc + new_D_1 = D + inc CALL FixPrincipalDamageInc(new_D_1,inc,rinc) !-------------S5--------------! @@ -12336,7 +12455,7 @@ SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) ! calculate values at t+h inc = hh2*(s1-3.0_dp*s3+4.0_dp*s4) rinc = hh2*(r1-3.0_dp*r3+4.0_dp*r4) - new_D_2 = D + inc + new_D_2 = D + inc IF (Particles % prupt) THEN CALL FixPrincipalDamageInc(new_D_2,inc,rinc) ELSE @@ -12344,10 +12463,10 @@ SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) Particles % prupt = .FALSE. END IF - old_D_1 = new_D_1 + old_D_1 = new_D_1 inc = hh6*(s1+4.0_dp*s4+s5) rinc = hh6*(r1+4.0_dp*r4+r5) - new_D_1 = D + inc + new_D_1 = D + inc CALL FixPrincipalDamageInc(new_D_1,inc,rinc) IF (ANY(new_D_1 .NE. new_D_1)) THEN @@ -12429,7 +12548,7 @@ SUBROUTINE runge_kutta_merson(Particles,Din,dD,a,b,tol,ifail,ddscale) dD = D - Dinit - ddscale = 1.0_dp + ddscale = 1.0_dp !added 10/2/19 IF (ALL(Dinit == 0.0_dp)) THEN @@ -12451,8 +12570,8 @@ END SUBROUTINE runge_kutta_merson !! Step length automatically adjusts so that absolute error estimate <= tol !! This version is edited for solving ice damage according to the zero-stress !! damage necking/mass balance modification (Bassis and Ma, 2015; Sun et al 2017; - !! Huth et al 2020) - SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,divu,mb,bmb) + !! Huth et al 2020) + SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,divu,mb,bmb) !edited from: !Chivers and Sleightholme @@ -12464,7 +12583,7 @@ SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,d TYPE(Particle_t), POINTER :: Particles REAL(KIND=dp), INTENT (out), DIMENSION (4) :: dD - REAL(KIND=dp), INTENT (in) :: a, b, tol,RHS,S0,bmb + REAL(KIND=dp), INTENT (in) :: a, b, tol,RHS,S0,bmb REAL(KIND=dp), INTENT (in) :: Din(4),divu,mb REAL(KIND=dp), INTENT (inout) :: Hin INTEGER, INTENT (out) :: ifail @@ -12518,7 +12637,7 @@ SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,d END IF t = a - hh = (b-a)*firststep + hh = (b-a)*firststep Dinit = Din D = Din H = Hin @@ -12529,7 +12648,7 @@ SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,d hh2 = hh*div2 hh3 = hh*div3 hh6 = hh*div6 - hh8 = hh*div8 + hh8 = hh*div8 !-------------S1--------------! ! calculate s1,s2,s3,s4,s5 @@ -12549,7 +12668,7 @@ SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,d !-------------S2--------------! ! s2 = f(t+h/3,D+h/3*s1) Sb = S0 * hnew/(1.0_dp-Particles % bmd) - RHS1 = RHS * (one-Sb) - bMB/hnew + RHS1 = RHS * (one-Sb) - bMB/hnew CALL bassisinc(Particles,new_D_1,RHS1,r2,s2) h2 = mb-hnew*divu inc = hh6*s1 + hh6*s2 @@ -12562,7 +12681,7 @@ SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,d !-------------S3--------------! ! s3=f(t+h/3,D+h/6*s1+h/6*s2) Sb = S0 * hnew/(1.0_dp-Particles % bmd) - RHS1 = RHS * (one-Sb) - bMB/hnew + RHS1 = RHS * (one-Sb) - bMB/hnew CALL bassisinc(Particles,new_D_1,RHS1,r3,s3) h3 = mb-hnew*divu inc = hh8*(s2+3.0_dp*s3) @@ -12572,29 +12691,29 @@ SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,d CALL FixPrincipalDamageInc(new_D_1,inc,rinc) hnew = MAX(H + hinc,one) - !-------------S4--------------! + !-------------S4--------------! ! s4=f(t+h/2,D+h/8*(s2+3*s3)) Sb = S0 * hnew/(1.0_dp-Particles % bmd) - RHS1 = RHS * (one-Sb) - bMB/hnew + RHS1 = RHS * (one-Sb) - bMB/hnew CALL bassisinc(Particles,new_D_1,RHS1,r4,s4) h4 = mb-hnew*divu inc = hh2*(s1-3.0_dp*s3+4.0_dp*s4) rinc = hh2*(r1-3.0_dp*r3+4.0_dp*r4) hinc = hh2*(h1-3.0_dp*h3+4.0_dp*h4) - new_D_1 = D + inc + new_D_1 = D + inc CALL FixPrincipalDamageInc(new_D_1,inc,rinc) hnew = MAX(H + hinc,one) !-------------S5--------------! ! s5=f(t+h,D+h/2*(s1-3*s3+4*s4)) Sb = S0 * hnew/(1.0_dp-Particles % bmd) - RHS1 = RHS * (one-Sb) - bMB/hnew + RHS1 = RHS * (one-Sb) - bMB/hnew CALL bassisinc(Particles,new_D_1,RHS1,r5,s5) h5 = mb-hnew*divu ! calculate values at t+h inc = hh2*(s1-3.0_dp*s3+4.0_dp*s4) rinc = hh2*(r1-3.0_dp*r3+4.0_dp*r4) - new_D_2 = D + inc + new_D_2 = D + inc IF (Particles % prupt) THEN CALL FixPrincipalDamageInc(new_D_2,inc,rinc) ELSE @@ -12605,7 +12724,7 @@ SUBROUTINE runge_kutta_merson_bassis(Particles,Din,dD,a,b,tol,RHS,S0,ifail,Hin,d inc = hh6*(s1+4.0_dp*s4+s5) rinc = hh6*(r1+4.0_dp*r4+r5) hinc = hh6*(h1+4.0_dp*h4+h5) - new_D_1 = D + inc + new_D_1 = D + inc CALL FixPrincipalDamageInc(new_D_1,inc,rinc) hnew = MAX(H + hinc,one) @@ -12679,18 +12798,18 @@ END SUBROUTINE runge_kutta_merson_bassis !! Particles % DmaxII>Particles % DmaxI (Particles % dmaxII_dom == .TRUE.) !! Simply evolve the damage using the spin tensor, as there should only !! be a directional change in damage. - !! CAUTION: may not work with recent changes? - SUBROUTINE runge_kutta_merson_fulldam_dmaxIIdom(Particles,Din,dD,a,b,tol,ifail) + !! CAUTION: may not work with recent changes? + SUBROUTINE runge_kutta_merson_fulldam_dmaxIIdom(Particles,Din,dD,a,b,tol,ifail) IMPLICIT NONE TYPE(Particle_t), POINTER :: Particles REAL(KIND=dp), INTENT (out), DIMENSION (4) :: dD - REAL(KIND=dp), INTENT (in) :: a, b, tol - REAL(KIND=dp), INTENT (in) :: Din(4) + REAL(KIND=dp), INTENT (in) :: a, b, tol + REAL(KIND=dp), INTENT (in) :: Din(4) INTEGER, INTENT (out) :: ifail REAL(KIND=dp), DIMENSION (4) :: s1, s2, s3, s4, s5, new_D_1, new_D_2, error,Dinit,D - REAL(KIND=dp) :: t, hh, hh2, hh3, hh6, hh8, factor + REAL(KIND=dp) :: t, hh, hh2, hh3, hh6, hh8, factor REAL(KIND=dp) :: max_error, smallest_step = 1.e-15_dp INTEGER :: k,no_of_steps = 0,stoptimes = 1 LOGICAL :: Visited=.false. @@ -12715,7 +12834,7 @@ SUBROUTINE runge_kutta_merson_fulldam_dmaxIIdom(Particles,Din,dD,a,b,tol,ifail) div6 = 1.0_dp/6.0_dp div8 = 1.0_dp/8.0_dp - factor = 1.e-2_dp + factor = 1.e-2_dp Visited = .TRUE. END IF @@ -12731,7 +12850,7 @@ SUBROUTINE runge_kutta_merson_fulldam_dmaxIIdom(Particles,Din,dD,a,b,tol,ifail) END IF t = a - hh = (b-a)*firststep + hh = (b-a)*firststep Dinit = Din D = Din @@ -12739,18 +12858,18 @@ SUBROUTINE runge_kutta_merson_fulldam_dmaxIIdom(Particles,Din,dD,a,b,tol,ifail) hh2 = hh*div2 hh3 = hh*div3 hh6 = hh*div6 - hh8 = hh*div8 + hh8 = hh*div8 !-------------S1--------------! ! calculate s1,s2,s3,s4,s5 ! s1=f(t,D) ! CALL dDdt(D,s1) - s1(1) = -D(4) - s1(2) = D(4) + s1(1) = -D(4) + s1(2) = D(4) s1(3) = 0.0_dp s1(4) = div2*(D(1)-D(2)) - s1 = s1*(Particles % dvdxmdudy) + s1 = s1*(Particles % dvdxmdudy) IF (ALL(s1 == 0.0_dp)) THEN dD = 0.0_dp @@ -12763,8 +12882,8 @@ SUBROUTINE runge_kutta_merson_fulldam_dmaxIIdom(Particles,Din,dD,a,b,tol,ifail) !-------------S2--------------! ! s2 = f(t+h/3,D+h/3*s1) !CALL dDdt(new_D_1,s2) - s2(1) = -new_D_1(4) - s2(2) = new_D_1(4) + s2(1) = -new_D_1(4) + s2(2) = new_D_1(4) s2(3) = 0.0_dp s2(4) = div2*(new_D_1(1)-new_D_1(2)) s2 = s2*(Particles % dvdxmdudy) @@ -12774,33 +12893,33 @@ SUBROUTINE runge_kutta_merson_fulldam_dmaxIIdom(Particles,Din,dD,a,b,tol,ifail) !-------------S3--------------! ! s3=f(t+h/3,D+h/6*s1+h/6*s2) !CALL dDdt(new_D_1,s3) - s3(1) = -new_D_1(4) - s3(2) = new_D_1(4) + s3(1) = -new_D_1(4) + s3(2) = new_D_1(4) s3(3) = 0.0_dp s3(4) = div2*(new_D_1(1)-new_D_1(2)) s3 = s3*(Particles % dvdxmdudy) new_D_1 = D + hh8*(s2+3.0_dp*s3) CALL FixPrincipalDamage(new_D_1,critdam) - !-------------S4--------------! + !-------------S4--------------! ! s4=f(t+h/2,D+h/8*(s2+3*s3)) !CALL dDdt(new_D_1,s4) - s4(1) = -new_D_1(4) - s4(2) = new_D_1(4) + s4(1) = -new_D_1(4) + s4(2) = new_D_1(4) s4(3) = 0.0_dp s4(4) = div2*(new_D_1(1)-new_D_1(2)) - s4 = s4*(Particles % dvdxmdudy) + s4 = s4*(Particles % dvdxmdudy) new_D_1 = D + hh2*(s1-3.0_dp*s3+4.0_dp*s4) CALL FixPrincipalDamage(new_D_1,critdam) !-------------S5--------------! ! s5=f(t+h,D+h/2*(s1-3*s3+4*s4)) !CALL dDdt(new_D_1,s5) - s5(1) = -new_D_1(4) - s5(2) = new_D_1(4) + s5(1) = -new_D_1(4) + s5(2) = new_D_1(4) s5(3) = 0.0_dp s5(4) = div2*(new_D_1(1)-new_D_1(2)) - s5 = s5*(Particles % dvdxmdudy) + s5 = s5*(Particles % dvdxmdudy) ! calculate values at t+h new_D_1 = D + hh6*(s1+4.0_dp*s4+s5) @@ -12876,7 +12995,7 @@ SUBROUTINE dDdtfast(D,f,r) REAL(KIND=dp) :: EigValues(2),EigenVec(2,2),WORK(68) REAL(KIND=dp) :: EigValues3(3),sigmaeigval3,Q(4) REAL(KIND=dp) :: Dxx,Dyy,Dzz,Dxy,Peff,td1,ps1,ps2,ps3,lmod,chi,determ - INTEGER :: infor,mm,nn,ii + INTEGER :: infor,mm,nn,ii LOGICAL :: Visited=.FALSE. TYPE(Particle_t), POINTER :: Particles @@ -12890,7 +13009,7 @@ SUBROUTINE dDdtfast(D,f,r) REAL(KIND=dp) :: e1, e2, e3, e1b,e2b,e3b REAL(KIND=dp) :: ez,tet,met,a12s - REAL(KIND=dp) :: TraceEtau2,vo1(3,3),vo2(3,3),vo3(3,3),voutprod1(3,3) + REAL(KIND=dp) :: TraceEtau2,vo1(3,3),vo2(3,3),vo3(3,3),voutprod1(3,3) SAVE :: ah,Bh,k1,k2,rf,sthres,Identity,Visited,pcont,psr,maxtracesigma,& Tau,Etau !,voutprod @@ -12908,7 +13027,7 @@ SUBROUTINE dDdtfast(D,f,r) ! Bf = Particles % bf Bh = Particles % bh k1 = Particles % k1 - k2 = Particles % k2 + k2 = Particles % k2 rf = Particles % rf sthres = Particles % sthres @@ -12935,8 +13054,8 @@ SUBROUTINE dDdtfast(D,f,r) IF (Particles % prupt .AND. Particles % noevolveruptlayers) THEN IF (Particles % CurrentGamma > zero) THEN - f12rhs = D(4) * (Particles % dvdxmdudy) - !spin contribution + f12rhs = D(4) * (Particles % dvdxmdudy) + !spin contribution f(1) = -f12rhs f(2) = f12rhs f(3) = zero @@ -12976,7 +13095,7 @@ SUBROUTINE dDdtfast(D,f,r) ! !deviatoric stress tensor: ! Tau = Particles % RHS * ESR - !FAST VERSION: + !FAST VERSION: exxd1m1 = psr(1,1)*(D(1)-one) eyyd2m1 = psr(2,2)*(D(2)-one) ezzd3m1 = psr(3,3)*(D(3)-one) @@ -12993,12 +13112,23 @@ SUBROUTINE dDdtfast(D,f,r) !------- effective pressure (Peff)------ Peff = Particles % pressure1 - (Tau(1,1)+Tau(2,2)) + IF (Particles % usetruecauchydamage) THEN + !Tau is now the true Cauchy stress, not deviatoric + Tau(1,1) = Tau(1,1) - Peff + Tau(2,2) = Tau(2,2) - Peff + Tau(3,3) = Tau(3,3) - Peff + + !The vertical z component of actual effective cauchy stress, used later for + !caulculating the new Peff + sigmaeigval3 = (Tau(3,3))/(1.0_dp - D(3)) + ENDIF + !---- deviatoric effective stress (ETau) -----! !IDn1 = (I-D)^-1, expanded here for speed: denom = one/( D(4)*D(4) + D(1) + D(2) -D(1)*D(2) - one) t1d2m1 = Tau(1,1)*(D(2)-one)*denom t2d1m1 = Tau(2,2)*(D(1)-one)*denom - t3od3m1 = Tau(3,3)/(D(3)-one) + t3od3m1 = Tau(3,3)/(D(3)-one) d4t4 = Tau(1,2)*D(4)*denom Etau(1,1) = onethird*(two*t1d2m1 - t2d1m1 +t3od3m1 -d4t4) @@ -13007,6 +13137,10 @@ SUBROUTINE dDdtfast(D,f,r) Etau(1,2) = half*denom*(tau(1,2)*(D(1)+D(2)-two) - D(4)*(Tau(1,1)+Tau(2,2))) Etau(2,1) = Etau(1,2) + IF (Particles % usetruecauchydamage) THEN + Peff = Etau(3,3)-sigmaeigval3 + ENDIF + !---- eigenvalues -----! TT = ETau(1,1)+ETau(2,2) @@ -13025,10 +13159,10 @@ SUBROUTINE dDdtfast(D,f,r) lambda(1)=EigValues(2) END IF - ! e3 = ETau(3,3) + ! e3 = ETau(3,3) !-----max effective principal stress------ - td1 = lambda(1)-Peff + td1 = lambda(1)-Peff !no change in damage IF (td1 < zero ) THEN !.AND. ALL(D==zero)) THEN @@ -13036,8 +13170,8 @@ SUBROUTINE dDdtfast(D,f,r) ! RETURN IF (Particles % CurrentGamma > zero) THEN - f12rhs = D(4) * (Particles % dvdxmdudy) - !spin contribution + f12rhs = D(4) * (Particles % dvdxmdudy) + !spin contribution f(1) = f(1) - f12rhs f(2) = f(2) + f12rhs f(4) = f(4) - half*(Particles % dvdxmdudy)*(D(2)-D(1)) @@ -13059,13 +13193,13 @@ SUBROUTINE dDdtfast(D,f,r) !------- tracesigma (for kf) ------ tracesigma = Tau(1,1)+Tau(2,2)+Tau(3,3)-three*Peff IF (tracesigmamaxtracesigma) tracesigma = maxtracesigma + IF (tracesigma>maxtracesigma) tracesigma = maxtracesigma !-----kf------ ! tracesigma = ETau(1,1)+ETau(2,2)+ETau(3,3)-three*Peff ! IF (tracesigmamaxtracesigma) tracesigma = maxtracesigma + ! IF (tracesigma>maxtracesigma) tracesigma = maxtracesigma !e.g. kf = 3.0_dp + 6.0_dp * tracesigma IF (tracesigma > Particles % stresshigh) Particles % stresshigh = tracesigma IF (tracesigma < Particles % stresslow) Particles % stresslow = tracesigma @@ -13081,7 +13215,7 @@ SUBROUTINE dDdtfast(D,f,r) EigValues3(2) = lambda(2) - Peff EigValues3(3) = sigmaeigval3 - ! 2d + ! 2d ! IF (ALL(EigValues3(1:2) > 0.0_dp)) THEN ! lmod = 1.0_dp - MINVAL(EigValues3(1:2))/MAXVAL(EigValues3(1:2)) ! gamma = gamma*lmod @@ -13120,7 +13254,7 @@ SUBROUTINE dDdtfast(D,f,r) CALL Eigen2DSym_TryGenFirst_VecOnly(ETau(1:2,1:2),lambda(1:2),EigValues,EigenVec) - maxvec(1:2) = EigenVec(1:2,2) + maxvec(1:2) = EigenVec(1:2,2) maxvec(3) = zero voutprod(:,1) = maxvec(1) * maxvec(:) @@ -13147,7 +13281,7 @@ SUBROUTINE dDdtfast(D,f,r) END IF END IF - maxvec(1:2) = EigenVec(1:2,2) + maxvec(1:2) = EigenVec(1:2,2) maxvec(3) = zero voutprod(:,1) = maxvec(1) * maxvec(:) @@ -13162,6 +13296,8 @@ SUBROUTINE dDdtfast(D,f,r) Rd(1,1) = Rd(1,1) + rdg Rd(2,2) = Rd(2,2) + rdg Rd(3,3) = Rd(3,3) + (one-gamma) + + IF (Particles % forcedzz) Rd(3,3) = 1.0_dp !Particles % CurrentGamma) !rdg !rd(3,3) will always be zero. And using currentgamma for z right now !to test the effect of only applying modified murikami to horizontal dirs @@ -13197,7 +13333,7 @@ SUBROUTINE dDdtfast(D,f,r) Q = D CALL removemaxd(Q) - denom = one/( Q(4)*Q(4) + Q(1) + Q(2) -Q(1)*Q(2) - one) + denom = one/( Q(4)*Q(4) + Q(1) + Q(2) -Q(1)*Q(2) - one) mur88 = (voutprod(1,1)*(Q(2)-one) + voutprod(2,2)*(Q(1)-one) & - two*Q(4)*voutprod(1,2) ) * denom @@ -13208,7 +13344,7 @@ SUBROUTINE dDdtfast(D,f,r) - two*D(4)*voutprod(1,2) ) * denom !note that "- voutprod(3,3)/(D(3)-one)" is not needed above - !because voutprod(3,3) is always zero in the current implementation + !because voutprod(3,3) is always zero in the current implementation END IF @@ -13223,9 +13359,9 @@ SUBROUTINE dDdtfast(D,f,r) f(1) = fd(1,1) !dDxx/dt f(2) = fd(2,2) !dDyy/dt f(3) = fd(3,3) !dDzz/dt - f(4) = fd(1,2) !dDxy/dt and dDyx/dt + f(4) = fd(1,2) !dDxy/dt and dDyx/dt - !2. spin contribution + !2. spin contribution f12rhs = D(4) * (Particles % dvdxmdudy) r(1) = -f12rhs r(2) = f12rhs @@ -13255,9 +13391,9 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) REAL(KIND=dp),ALLOCATABLE :: Basis(:),dBasisdx(:,:) LOGICAL :: gotit,Visited=.FALSE.,UpdateB,stat LOGICAL :: movegl, ConstantMB, ConstantEF, ConstantFP - TYPE(Variable_t), POINTER :: mask, MB, EF, F, B, Zs, V,Bed, HVar + TYPE(Variable_t), POINTER :: mask, MB, EF, F, B, Zs, V,Bed, HVar INTEGER, POINTER :: maskPerm(:),MBPerm(:),EFPerm(:),FPerm(:),& - BPerm(:),ZsPerm(:),VPerm(:),BedPerm(:),LocalPerm(:),HPerm(:) + BPerm(:),ZsPerm(:),VPerm(:),BedPerm(:),LocalPerm(:),HPerm(:) REAL(KIND=dp), POINTER :: maskVal(:),MBVal(:),EFVal(:),FVal(:),& BVal(:),ZsVal(:), VVal(:), BedVal(:),HVal(:) REAL(KIND=dp), POINTER :: ZsLocalField(:),FPLocalField(:),BLocalField(:),& @@ -13297,10 +13433,10 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) BLocalField(nn),MaskLocalField(nn),& EFLocalField(nn), VLocalField(nn,dim), & BedLocalField(nn), MBLocalField(nn),LocalPerm(nn),& - HLocalField(nn)) + HLocalField(nn)) - rhoi = Particles % rhoi + rhoi = Particles % rhoi rhow = Particles % rhow @@ -13311,18 +13447,18 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) HVar => VariableGet(Model % Mesh % Variables, 'H' ) HPerm => HVar % Perm - HVal => HVar % Values + HVal => HVar % Values IF (ConstantMB) THEN mbparam = GetConstReal( Model % Constants, 'mbparam', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & - 'Need to define "mbparam = Real $mbparam" in constants') + 'Need to define "mbparam = Real $mbparam" in constants') END IF IF (ConstantEF) THEN efparam = GetConstReal( Model % Constants, 'efparam', GotIt ) IF (.NOT. GotIt) CALL Fatal(SolverName, & - 'Need to define "efparam = Real $efparam" in constants') + 'Need to define "efparam = Real $efparam" in constants') END IF IF (ConstantFP) THEN @@ -13351,7 +13487,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) IF (.NOT. ConstantFP) THEN F => VariableGet(Model % Mesh % Variables, 'FP' ) FPerm => F % Perm - FVal => F % Values + FVal => F % Values END IF IF ((.NOT. Particles % constlintemp) .AND. & @@ -13370,7 +13506,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) Zs => VariableGet(Model % Mesh % Variables, 'Zs' ) ZsPerm => Zs % Perm - ZsVal => Zs % Values + ZsVal => Zs % Values V => VariableGet(Model % Mesh % Variables, 'SSAVelocity' ) VPerm => V % Perm @@ -13386,7 +13522,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) min_first_ef = MINVAL(Particles % EF(1:Particles % numberofparticles)) max_first_ef = MAXVAL(Particles % EF(1:Particles % numberofparticles)) - PRINT *,'min_first_binit',min_first_binit + PRINT *,'min_first_binit',min_first_binit PRINT *,'min_first_ef',min_first_ef PRINT *,'max_first_ef',max_first_ef @@ -13396,7 +13532,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) CALL Info(SolverName,& - 'Starting SSA Prep: Mesh to Particles',Level=1) + 'Starting SSA Prep: Mesh to Particles',Level=3) !-----------INITIALIZATION---------------! @@ -13424,7 +13560,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) END DO Particles % Gmask = 0.0_dp - Particles % GradH = 0.0_dp + Particles % GradH = 0.0_dp Particles % GradZs = 0.0_dp Particles % GradVel = 0.0_dp @@ -13538,10 +13674,10 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) IF (Particles % ShapeFunctions == 'gimpm') THEN stat = GIMPMElementInfo( t,Particles, Model,BulkElement, ElementNodes, No, & detJ, scale, .TRUE., Basis,dBasisdx) - ELSE + ELSE stat = sMPMElementInfo( Bulkelement, Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) scale = 1.0_dp END IF @@ -13555,7 +13691,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) SUM(dBasisdx(1:nn,jj) * ZsLocalField(1:nn)) * scale Particles % GradH(No,jj) = Particles % GradH(No,jj) + & - SUM(dBasisdx(1:nn,jj) * HLocalField(1:nn)) * scale + SUM(dBasisdx(1:nn,jj) * HLocalField(1:nn)) * scale END DO !dvx/dx @@ -13590,7 +13726,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) IF (Particles % xpic(No,1) .NE. 1.0_dp) THEN Particles % Gmask(No) = 1.0_dp ELSE - MaskLocalField = maskVal(MaskPerm(NodeIndexes)) + MaskLocalField = maskVal(MaskPerm(NodeIndexes)) Particles % Gmask(No) = Particles % Gmask(No) + & SUM(Basis(1:nn) * maskLocalField(1:nn)) * scale END IF @@ -13610,13 +13746,6 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) SUM(Basis(1:nn) * FPLocalField(1:nn)) * scale END IF - IF (Particles % SteadyAlbrecht) THEN - IF (Particles % Coordinate(No,1) + 0.5_dp*Particles % Length(No,1) < 0.0_dp) THEN - Particles % H(No) = Particles % H(No) + SUM(Basis(1:nn) * HVal(HPerm(NodeIndexes))) * scale - END IF - END IF - - END DO !particle loop @@ -13646,9 +13775,9 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) IF (Particles % ShapeFunctions == 'gimpm') THEN stat = GIMPMElementInfo( t,Particles, Model,BulkElement, ElementNodes, No, & detJ, scale, .TRUE., Basis,dBasisdx) - ELSE + ELSE stat = sMPMElementInfo( Bulkelement, Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) scale = 1.0_dp END IF @@ -13662,7 +13791,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) SUM(dBasisdx(1:nn,jj) * ZsLocalField(1:nn)) * scale Particles % GradH(No,jj) = Particles % GradH(No,jj) + & - SUM(dBasisdx(1:nn,jj) * HLocalField(1:nn)) * scale + SUM(dBasisdx(1:nn,jj) * HLocalField(1:nn)) * scale END DO !dvx/dx @@ -13699,7 +13828,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) IF (Particles % xpic(No,1) .NE. 1.0_dp) THEN Particles % Gmask(No) = -1.0_dp ELSE - MaskLocalField(1:nn) = maskVal(MaskPerm(NodeIndexes)) + MaskLocalField(1:nn) = maskVal(MaskPerm(NodeIndexes)) Particles % Gmask(No) = Particles % Gmask(No) + & SUM(Basis(1:nn) * maskLocalField(1:nn)) * scale END IF @@ -13745,7 +13874,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) IF (UpdateB) BLocalField = BVal(BPerm(NodeIndexes)) - MaskLocalField = maskVal(MaskPerm(NodeIndexes)) + MaskLocalField = maskVal(MaskPerm(NodeIndexes)) DO t = 1, ElemParticles(ii) % NumberOfParticles No = ElemParticles(ii) % p(t) @@ -13753,9 +13882,9 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) IF (Particles % ShapeFunctions == 'gimpm') THEN stat = GIMPMElementInfo( t,Particles, Model,BulkElement, ElementNodes, No, & detJ, scale, .TRUE., Basis,dBasisdx) - ELSE + ELSE stat = sMPMElementInfo( Bulkelement, Particles, Model, ElementNodes, No, & - Particles % gridres, Basis,dBasisdx) + Particles % gridres, Basis,dBasisdx) scale = 1.0_dp END IF @@ -13769,7 +13898,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) SUM(dBasisdx(1:nn,jj) * ZsLocalField(1:nn)) * scale Particles % GradH(No,jj) = Particles % GradH(No,jj) + & - SUM(dBasisdx(1:nn,jj) * HLocalField(1:nn)) * scale + SUM(dBasisdx(1:nn,jj) * HLocalField(1:nn)) * scale END DO !dvx/dx @@ -13848,11 +13977,11 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) END IF IF (Particles % UseInterpElem(No)) THEN - !IF (Particles % UseInterpElem(No) .OR. Particles % Status(No)==PARTICLE_LEAVING) THEN + !IF (Particles % UseInterpElem(No) .OR. Particles % Status(No)==PARTICLE_LEAVING) THEN Particles % EF(No) = Particles % XPIC(No,2) Particles % FP(No) = MAX(Particles % XPIC(No,3),0.0_dp) Particles % Binit(No) = Particles % xpic(No,5) - ELSE + ELSE IF (.NOT. UpdateB) CYCLE IF (Particles % GMask(No) >= 0.9_dp) CYCLE IF (ANY(Particles % Dav(No,:).NE.0.0_dp)) CYCLE @@ -13888,7 +14017,7 @@ SUBROUTINE SSAPrepMeshToParticles( Particles, Model) Particles % binit(1:Particles % NumberOfParticles) = Particles % XPIC(1:Particles % NumberofParticles,5) WHERE (Particles % binit(1:Particles % NumberOfParticles) .NE. & Particles % binit(1:Particles % NumberOfParticles)) & - Particles % binit(1:Particles % NumberOfParticles) = min_first_binit + Particles % binit(1:Particles % NumberOfParticles) = min_first_binit WHERE (Particles % binit(1:Particles % NumberOfParticles) < min_first_binit) & Particles % binit(1:Particles % NumberOfParticles) = min_first_binit END IF @@ -13961,7 +14090,7 @@ SUBROUTINE BorstadDamage(Particles, No,srthres,GradVel,dDBorstad,n,k) PRINT *,'damagenan no: ',no PRINT *,'EffSR: ',EFFSR PRINT *,'SRThres : ',SRThres - PRINT *,'K: ',K + PRINT *,'K: ',K PRINT *,' ' END IF @@ -13969,7 +14098,7 @@ SUBROUTINE BorstadDamage(Particles, No,srthres,GradVel,dDBorstad,n,k) IF (D GlobalParticles + Particles => GlobalParticles T=a(1,1)+a(2,2) D=a(1,1)*a(2,2)-a(1,2)*a(2,1) @@ -14068,7 +14197,7 @@ SUBROUTINE Eigen2Db(a,lambdaout,eout) END SUBROUTINE Eigen2Db - !************************************************************************** + !************************************************************************** ! Return eigenvalues (lambda) of 2x2 matrice a ! Return eigenvectors (columns of e) of 2x2 matrice a @@ -14087,7 +14216,7 @@ SUBROUTINE Eigen2D(a,lambdaout,eout) INTEGER :: infor EigenVec = a - CALL DSYEV('V', 'U', 2, EigenVec, 2, EigValues, Work, 68, infor) + CALL DSYEV('V', 'U', 2, EigenVec, 2, EigValues, Work, 68, infor) IF (infor.ne.0) CALL FATAL('Compute EigenValues', 'Failed to compute EigenValues') eout = EigenVec @@ -14115,7 +14244,7 @@ SUBROUTINE Eigen2DSym_TryGenFirstValOnly(a,EigValues) sqrteig = quart*T*T-D IF (sqrteig<0.0_dp) sqrteig = 0.0_dp sqrteig = sqrt(sqrteig) - T = half*T + T = half*T EigValues(1)=T-sqrteig EigValues(2)=T+sqrteig @@ -14143,7 +14272,7 @@ SUBROUTINE MaxPFour(a,lmaxval) sqrteig = quart*T*T-D IF (sqrteig<0.0_dp) sqrteig = 0.0_dp sqrteig = sqrt(sqrteig) - ! T = half*T + ! T = half*T ! EigValues(1)=T-sqrteig lmaxval=half*T+sqrteig @@ -14173,7 +14302,7 @@ SUBROUTINE Eigen2DSym_TryGenFirst(a,EigValues,EigenVec) IF (sqrteig<0.0_dp) sqrteig = 0.0_dp sqrteig = sqrt(sqrteig) - T = half*T + T = half*T EigValues(1)=T-sqrteig EigValues(2)=T+sqrteig @@ -14185,10 +14314,10 @@ SUBROUTINE Eigen2DSym_TryGenFirst(a,EigValues,EigenVec) IF (a(1,2)==zero) THEN IF (a(2,2)>a(1,1)) THEN - EigenVec(1,1) = one - EigenVec(2,1) = zero - EigenVec(1,2) = zero - EigenVec(2,2) = one + EigenVec(1,1) = one + EigenVec(2,1) = zero + EigenVec(1,2) = zero + EigenVec(2,2) = one ELSE EigenVec(1,1) = zero EigenVec(2,1) = one @@ -14239,7 +14368,7 @@ SUBROUTINE Eigen2DSym_TryGenFirst_VecOnly(a,lambda,EigValues,EigenVec) ! !eigenvalues: ! !2 is the biggest ! sqrteig = sqrt(quart*T*T-D) - ! T = half*T + ! T = half*T ! EigValues(1)=T-sqrteig ! EigValues(2)=T+sqrteig @@ -14249,10 +14378,10 @@ SUBROUTINE Eigen2DSym_TryGenFirst_VecOnly(a,lambda,EigValues,EigenVec) IF (a(1,2)==zero) THEN IF (a(2,2)>a(1,1)) THEN - EigenVec(1,1) = one - EigenVec(2,1) = zero - EigenVec(1,2) = zero - EigenVec(2,2) = one + EigenVec(1,1) = one + EigenVec(2,1) = zero + EigenVec(1,2) = zero + EigenVec(2,2) = one ELSE EigenVec(1,1) = zero EigenVec(2,1) = one @@ -14289,4 +14418,3 @@ END SUBROUTINE Eigen2DSym_TryGenFirst_VecOnly !************************************************************************** END MODULE MPMUtils - diff --git a/README.md b/README.md index 589b0d2..96dbe13 100644 --- a/README.md +++ b/README.md @@ -1,22 +1,22 @@ # GIMPM-SSA-Damage -The Generalized Interpolation Material Point Method (GIMPM) for the +The Generalized Interpolation Material Point Method (GIMPM) for the Shallow Shelf Approximation (SSA) of ice flow with Damage Developer: Alex Huth (ahuth@princeton.edu) This repository contains the GIMPM-SSA-Damage model detailed in: - Huth, A., Duddu, R., Smith, B.E. (2020a). A generalized interpolation material point method for shallow ice shelves. Part I: shallow shelf approximation and ice thickness evolution. + Huth, A., Duddu, R., Smith, B.E. (2021a). A generalized interpolation material point method for shallow ice shelves. Part I: shallow shelf approximation and ice thickness evolution. + + Huth, A., Duddu, R., & Smith, B. E. (2021b). A generalized interpolation material point method for shallow ice shelves. Part II: Anisotropic nonloacl damage mechanics and rift propagation. - Huth, A., Duddu, R., & Smith, B. E. (2020b). A generalized interpolation material point method for shallow ice shelves. Part II: Anisotropic creep damage mechanics and application to a marine ice sheet. - (manuscripts currently in review) In addition to the GIMPM, this code also includes the standard Material Point Method (sMPM) -Damage models included (see Huth et al., 2020b for details): - - SSA creep damage (Huth et al., 2020b) +Damage models included (see Huth et al., 2021b for details): + - SSA creep damage (Huth et al., 2021b) - SSA "zero-stress" damage (Sun et al., 2017) - The SSA "zero-stress" damage model + a modification to include necking/mass balance effects (Bassis & Ma, 2015) @@ -24,12 +24,11 @@ Damage models included (see Huth et al., 2020b for details): See README in `PROG`, which contains the main source code. ## Test cases -The examples from Huth et al., 2020a are found in `test1d`, `test2d`, and `mismip/steady` -The examples from Huth et al., 2020b are found in `mismip/damage` +The examples from Huth et al., 2021a are found in `test1d`, `test2d`, and `mismip/steady` +The examples from Huth et al., 2021b are found in `mismip/damage` Each directory contains a README with instructions for running the examples. ## Notes - An installation and knowledge of Elmer FEM and Elmer/Ice is required - https://github.com/ElmerCSC/elmerfem - - https://elmerfem.org/elmerice/wiki/ -- This model has not yet been parallelized \ No newline at end of file + - https://elmerfem.org/elmerice/wiki/ \ No newline at end of file diff --git a/mismip/damage/README b/mismip/damage/README index 5acc8e8..a82c0af 100644 --- a/mismip/damage/README +++ b/mismip/damage/README @@ -1,7 +1,7 @@ Sample .sifs for the creep damage, zero stress damage, and modified zero stress damage models. Each file contains some basic instructions on how to modify parameters to -reproduce the solutions in Huth et al., 2020 Part II. +reproduce the solutions in Huth et al., 2021 Part II. To run: ElmerSolver mismip_creep.sif ElmerSolver mismip_zs.sif diff --git a/mismip/damage/mismip_creep.sif b/mismip/damage/mismip_creep.sif index 8ef9230..e080f02 100644 --- a/mismip/damage/mismip_creep.sif +++ b/mismip/damage/mismip_creep.sif @@ -1,7 +1,7 @@ !Check Keywords "Warn" !echo on -!Which mesh? +!Which mesh? $Mesh = "half_MISMIP_500_orig" @@ -21,23 +21,23 @@ $alpha = 0.21 $beta = 0.63 !k -$kone = 4.0 -$ktwo = 0.0 +$kone = 4.0 +$ktwo = 0.0 !critical damage vals $dlayercrit = 0.6 -$davcrit = 0.8 +$davcrit = 0.8 !---------- $yearinsec = 31556926.0 $rhoi = 918.0/(1.0e6*yearinsec^2) -$rhow = 1028.0/(1.0e6*yearinsec^2) +$rhow = 1028.0/(1.0e6*yearinsec^2) $gravity = -9.81*yearinsec^2 $n = 3.0 $viscexp = 1.0/3.0 -$timestep = 12.0/365.0 -$firsttimestep = 2.0/365.0 +$timestep = 12.0/365.0 +$firsttimestep = 2.0/365.0 $A = 20.0 $B = A^(-1.0/n) @@ -62,17 +62,17 @@ Sea Level = Real 0.0 Maximum Time Step = Real $timestep First rkm dt = Real $firsttimestep -Critical Shear Rate = Real 1.0E-9 +Critical Shear Rate = Real 1.0E-9 Viscosity Exponent = Real $viscexp -Number of Particle Layers = Integer 41 +Number of Particle Layers = Integer 41 Number of Temperature Layers = Integer 41 Constant Linear Temperature = Logical False surftemp = Real -16.702728357631656 basetemp = Real -2.0 -Use Constant Temperature = Logical True +Use Constant Temperature = Logical True Constant Temperature = Real -8.930363929212376 Use Given Eta = Logical False @@ -105,7 +105,7 @@ Critical Dav = Real $davcrit !1. All 2D max damage components take the ! same value -rift dmax = Real 0.9 +rift dmax = Real 0.9 Use rift dmax = Logical True !2. Or set each component can be set separately @@ -113,47 +113,48 @@ Use rift dmax = Logical True ! or at least it allows the orientation of the rift ! to be tracked) Dav DMax I = Real 0.9 -Dav DMax II = Real 0.89 +Dav DMax II = Real 0.89 Dav DMax III = Real 0.89 +Use True Cauchy Damage = Logical False !------ !Max damage on vertical layers. !can be set component-wise -DMax I = Real 0.99 +DMax I = Real 0.99 DMax II = Real 0.98 DMax III = Real 0.98 !---Forces initially damaged particles to evolve isotropically--- -!Use Isotropic Damage for Initially Damaged Particles = Logical False +!Use Isotropic Damage for Initially Damaged Particles = Logical False !Iso Max Damage = Real 0.85 !Iso Critical Damage = Real 0.85 -!Iso Critical Dav = Real 0.85 +!Iso Critical Dav = Real 0.85 !-------- -ah = Real $alpha -Bf = Real 16.5043 -Bh = Real $beta -k1 = Real $kone -k2 = Real $ktwo +ah = Real $alpha +Bf = Real 16.5043 +Bh = Real $beta +k1 = Real $kone +k2 = Real $ktwo gamma = Real $GAMMA rf = Real 0.43 -sthres = Real $STHRES +sthres = Real $STHRES Dinit Tolerance = Real 1.0e-08 -Dinit Warning Tolerance= Real 5.0e-02 -Dinit Iters = Integer 5000 +Dinit Warning Tolerance= Real 5.0e-02 +Dinit Iters = Integer 5000 -No Init Dam = Logical True +No Init Dam = Logical True -Ignore Front Damage = Logical False +Ignore Front Damage = Logical False !Experimental damage symmetry fix following gancarski 2011 Use Modified Murakami = Logical False !will not allow any dzz accumulation on layers during dDdt -No Dzz = Logical False +No Dzz = Logical False !realigns all layer damage principal directions to those of dav !then recalculates dav. Experimental @@ -162,16 +163,16 @@ Fix Dav Principal Directions = Logical False Rupture All Damage Components for Rift = Logical True Switch to Isotropic Damage at Dav component rupture = Logical False -Restrict Damage = Logical False +Restrict Damage = Logical False !Restrict Damage X Min = Real 300000.0 !Restrict Damage X Max = Real 1000000.0 !Restrict Damage Y Min = Real -10000.0 !Restrict Damage Y Max = Real 50000.0 Use No Damage Region = Logical False -!No Damage Region X Min = Real -!No Damage Region X Max = Real -!No Damage Region Y Min = Real +!No Damage Region X Min = Real +!No Damage Region X Max = Real +!No Damage Region Y Min = Real !No Damage Region Y Max = Real Min Damage Threshold = Real 1.0e-10 @@ -183,7 +184,7 @@ Min Damage Threshold = Real 1.0e-10 !choose 'smpm' or 'gimpm' Shape Functions = String "gimpm" !initial particles per cell -Particle Element Fraction = Real 9.0 +Particle Element Fraction = Real 9.0 Grid Resolution = Real 500.0 Move GL = Logical True @@ -191,15 +192,15 @@ Use SEP = Logical True !for particle allocation/splitting Maximum Particle Length = Real 250.0 -Maximum Damaged Particle Length = Real 250.0 +Maximum Damaged Particle Length = Real 250.0 Maximum Grounding Line Particle Length = Real 250.0 Dav Split Threshold = Real 0.1 Number Of Buffer Particles = Integer 0 Use BC for PrevVel = Logical True -Update Particle Velocities for Friction = Logical True -Use Coulomb Friction = Logical True +Update Particle Velocities for Friction = Logical True +Use Coulomb Friction = Logical True Use Saved Basis = Logical True Always fill not full elements = Logical False @@ -218,20 +219,20 @@ End ! SIMULATION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Simulation - Coordinate System = Cartesian 2D + Coordinate System = Cartesian 2D Simulation Type = Transient Timestepping Method = String BDF BDF Order = Integer 2 Timestep Intervals = Integer 800000 - Output Intervals = Integer 0 + Output Intervals = Integer 0 !Timestep Sizes = Real $timestep - Timestep Size + Timestep Size Real Procedure "./../../PROG/MPM" "MPMTimestep" Steady State Max Iterations = Integer 1 - + ! Output File = "$Step$.result" ! Post File = "$Step$.vtu" @@ -246,8 +247,8 @@ Simulation Restart Variable 3 = String "SSAVelocity" Restart Before Initial Conditions = Logical True - Initialize Dirichlet Conditions = Logical True -End + Initialize Dirichlet Conditions = Logical True +End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BODY ! @@ -272,9 +273,9 @@ Initial Condition 1 partible b = Real $eta Surface = Real 1.0 - + icerises = real -1.0 - + FP = Real 0.01 PrevVel 1 = Equals SSAVelocity 1 @@ -290,7 +291,7 @@ End ! BODY FORCE ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Body Force 1 - Flow BodyForce 1 = Real 0.0 + Flow BodyForce 1 = Real 0.0 Flow BodyForce 2 = Real 0.0 Flow BodyForce 3 = Real $gravity @@ -307,20 +308,20 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MATERIAL ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Material 1 +Material 1 Viscosity Model = String "power law" SSA Mean Density = Real $rhoi SSA Mean Viscosity = Real $eta !"Particle B" - + Critical Shear Rate = Real 1.0e-9 Viscosity Exponent = Real 1.0/3.0 SSA Friction Law = String "coulomb" SSA Min Effective Pressure = Real 1.0e-6 - ! ! Needed for Linear, Weertman and Coulomb + ! ! Needed for Linear, Weertman and Coulomb SSA Friction Parameter = Real 1.0e-2 ! ! Needed for Weertman and Coulomb SSA Friction Exponent = Real $1.0/n @@ -343,7 +344,7 @@ exec solver = "before all" Equation = "Initial Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -352,19 +353,19 @@ Solver 3 exec solver = "before all" Equation = "MPM Init" Procedure = "./../../PROG/MPM" "MPM_Initialize" - + Initialization Condition Variable = String Surface Passive Mask Variable Name = String "Surface" InvVisc Variable Name = String "InvVisc" Velocity Variable Name = String "SSAVelocity" Additional Initial D Variable Name = String "Rift2" - Thickness Variable Name = String "H" + Thickness Variable Name = String "H" Friction Parameter Name = String "FP" Surface Height Variable Name = String "Zs" Damage Mask Variable Name = String "Mask" EF Variable Name = String "EF" - Bedrock Variable Name = String "bed" + Bedrock Variable Name = String "bed" End @@ -379,8 +380,8 @@ Solver 4 GL integration points number = Integer 9 Particle Reweighting = Logical False - - xpic m = Integer 5 + + xpic m = Integer 5 xpic interval = Integer 1 Use FEM MinMax = Logical False @@ -391,17 +392,17 @@ Solver 4 Linear System Iterative Method = BiCGStab Linear System Max Iterations = 10000 Linear System Preconditioning = "ILU2" - Linear System Convergence Tolerance = 1.0e-6 !5.0e-7 + Linear System Convergence Tolerance = 1.0e-6 !5.0e-7 Linear System Abort Not Converged = True Nonlinear System Max Iterations = 50 ! Nonlinear System Convergence Tolerance = 1.0e-6 !5.0e-7 ! - Nonlinear System Newton After Iterations = 100 - Nonlinear System Newton After Tolerance = 1.0e-3 - Nonlinear System Relaxation Factor = 0.95 - + Nonlinear System Newton After Iterations = 100 + Nonlinear System Newton After Tolerance = 1.0e-3 + Nonlinear System Relaxation Factor = 0.95 + Use Adaptive Relaxation = Logical True Adaptive Norm Mult Threshold = Real 1.5 - + Steady State Convergence Tolerance = Real 1.0e-3 Linear System Abort Not Converged = Logical False @@ -418,7 +419,7 @@ Solver 4 Exported Variable 8 = -dofs 1 "Effective Pressure" Exported Variable 9 = -dofs 4 "Mesh Damage" - Filename Prefix = String "$Step$_fail" + Filename Prefix = String "$Step$_fail" Filename Directory = String "./fail/" Ascii Output = Logical True @@ -432,7 +433,7 @@ Solver 5 Equation = "update particle position and constants, splitting" Procedure = "./../../PROG/MPM" "ParticleUpdates" - Update GIMPM with Corners = Logical True + Update GIMPM with Corners = Logical True End @@ -442,7 +443,7 @@ Solver 6 Procedure = "./../../PROG/MPM" "UpdateParticleHandMass" !set true if using zero-stress damage - no h update = Logical False !True + no h update = Logical False !True End Solver 7 @@ -452,15 +453,15 @@ Solver 7 RKM = Logical True - troubleshoot = Logical False + troubleshoot = Logical False Stress Threshold Modifier = Real 0.0 !5 - + Allow Grounded Damage = Logical True Allow Grounded Basal Water Pressure = Logical True Water Pressure for Basal Only = Logical True - no surface crevs without basal crevs = Logical False - + no surface crevs without basal crevs = Logical False + Skip IsoDam Particles = Logical False @@ -470,7 +471,7 @@ Solver 7 nonlocal variable = String "damage" - no evolve ruptured layers = Logical True + no evolve ruptured layers = Logical True ! nonlocal kernal can be an ellipse ! that changes shape based on stress (i.e. Giry 2011) @@ -479,21 +480,21 @@ Solver 7 ! But it is simpler, faster, and also effective to just ! use the regular Gaussian kernal with ! no stress threshold : - Just Use Gaussian for ellipse = Logical True + Just Use Gaussian for ellipse = Logical True - Maximum Allowed dDdt = Real 0.075 + Maximum Allowed dDdt = Real 0.075 Target dDdt = Real 0.05 Damage Convergence Tolerance = Real 1.0e-5 Ruptured Damage Convergence Tolerance = Real 1.0e-5 - Nonlocal dD rate threshold = Real 0.0 + Nonlocal dD rate threshold = Real 0.0 !set these to zero to skip nonlocal reg !note that nonlocal reg k is squared for the ellipse scheme !but not for the regular/SR integral scheme - Nonlocal Regularization k = Real 2.0 - Nonlocal Regularization lc = Real 1000.0 - Vertical Regularization lc = Real 0.0 + Nonlocal Regularization k = Real 2.0 + Nonlocal Regularization lc = Real 1000.0 + Vertical Regularization lc = Real 0.0 End Solver 8 @@ -507,7 +508,7 @@ Solver 9 Equation = "Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -528,16 +529,16 @@ Solver 11 Output Format = String "vtu" Output Interval = Integer 10 - Use Output Interval = Logical False + Use Output Interval = Logical False - Save Interval = Real 0.02 + Save Interval = Real 0.02 - Use Always Save Time = Logical False - Always Save Time = Real 0.258 + Use Always Save Time = Logical False + Always Save Time = Real 0.258 - Use MISMIP Final Damage Save = Logical True + Use MISMIP Final Damage Save = Logical True - StopTime = Real 5.0 + StopTime = Real 5.0 Min X To Save Particle = Real 350000.0 @@ -549,16 +550,16 @@ Solver 11 Vector Field 2 = String "length" Vector Field 3 = String "principal_strain_rates" Vector Field 4 = String "psre_two" - Vector Field 5 = String "dav" + Vector Field 5 = String "dav" Vector Field 6 = String "principal_damage" Vector Field 7 = String "pde_two" Vector Field 8 = String "pdse_two" Vector Field 9 = String "eff_pdse_two" Vector Field 10 = String "eff_pds" Vector Field 11 = String "principal_deviatoric_stresses" - Vector Field 12 = String "deviatoric_stresses" + Vector Field 12 = String "deviatoric_stresses" !Vector Field = String "damage" - !Vector Field = String "gradvel" + !Vector Field = String "gradvel" !Vector Field = String "xpic" !Vector Field = String "damage" !Vector Field = String "damage" @@ -568,7 +569,7 @@ Solver 11 !Vector Field = String "pde_one" !Vector Field = String "pde_three" !Vector Field = String "dd" - !Vector Field = String "gridvelocity" + !Vector Field = String "gridvelocity" !Vector Field = String "gradzs" !Vector Field = String "strain" !Vector Field = String "nextcoordinate" @@ -588,7 +589,7 @@ Solver 11 !Scalar Field = String "bedrock" !Scalar Field = String "gvolume" !Scalar Field = String "pvolume" - !Scalar Field = String "mass" + !Scalar Field = String "mass" !Scalar Field = String "binit" !Scalar Field = String "status" !Scalar Field = String "ef" @@ -617,11 +618,11 @@ Solver 1 Exported Variable 11 = -dofs 1 "dmask" Exported Variable 12 = -dofs 1 "zs" Exported Variable 13 = -dofs 2 "invvel" - Exported Variable 14 = -dofs 2 "ssavelocity" + Exported Variable 14 = -dofs 2 "ssavelocity" Exported Variable 15 = -dofs 2 "PrevVel" Exported Variable 16 = -dofs 1 "btrack" Exported Variable 17 = -dofs 1 "icerises" - + End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -637,19 +638,19 @@ End ! BOUNDARY CONDITIONS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Grounded +! Grounded Boundary Condition 1 Target Boundaries(1) = 4 SSAVelocity 1 = Real 0.0 SSAVelocity 2 = Real 0.0 - PrevVel 1 = Real 0.0 - PrevVel 2 = Real 0.0 + PrevVel 1 = Real 0.0 + PrevVel 2 = Real 0.0 !Vplus 1 = Real 0.0 End Boundary Condition 2 Target Boundaries(1) = 1 - + SSAVelocity 2 = Real 0.0 PrevVel 2 = Real 0.0 !Vplus 2 = Real 0.0 @@ -674,4 +675,3 @@ Boundary Condition 5 Passive Target = Logical True Calving Front = Logical True End - diff --git a/mismip/damage/mismip_zs.sif b/mismip/damage/mismip_zs.sif index bb15974..f5c6de7 100644 --- a/mismip/damage/mismip_zs.sif +++ b/mismip/damage/mismip_zs.sif @@ -20,18 +20,18 @@ $davcrit = 0.899 !(creep damage only) -$STHRES = 0.0 -$alpha = 1.0 +$STHRES = 0.0 +$alpha = 1.0 $beta = 0.0 $yearinsec = 31556926.0 $rhoi = 918.0/(1.0e6*yearinsec^2) -$rhow = 1028.0/(1.0e6*yearinsec^2) +$rhow = 1028.0/(1.0e6*yearinsec^2) $gravity = -9.81*yearinsec^2 $n = 3.0 $viscexp = 1.0/3.0 -$timestep = 14.0/365.0 -$firsttimestep = 2.0/365.0 +$timestep = 14.0/365.0 +$firsttimestep = 2.0/365.0 $A = 20.0 $B = A^(-1.0/n) @@ -58,7 +58,7 @@ Sea Level = Real 0.0 Maximum Time Step = Real $timestep First rkm dt = Real $firsttimestep -Critical Shear Rate = Real 1.0E-9 +Critical Shear Rate = Real 1.0E-9 Viscosity Exponent = Real $viscexp Number of Particle Layers = Integer 8 @@ -93,17 +93,17 @@ Output dbassis = Logical False Damage Model = String "zero stress" !Damage Model = String "creep" -Critical Damage = Real $davcrit +Critical Damage = Real $davcrit Critical Dav = Real $davcrit !creep dam only -DMax I = Real 0.99 -DMax II = Real 0.98 +DMax I = Real 0.99 +DMax II = Real 0.98 DMax III = Real 0.98 !---zero stress and creep dam -Dav DMax I = Real 0.9 -Dav DMax II = Real 0.89 +Dav DMax I = Real 0.9 +Dav DMax II = Real 0.89 Dav DMax III = Real 0.89 use rift dmax = Logical True @@ -111,35 +111,35 @@ rift dmax = Real 0.9 !----- !---Forces initially damaged particles to evolve isotropically--- -!Use Isotropic Damage for Initially Damaged Particles = Logical False +!Use Isotropic Damage for Initially Damaged Particles = Logical False !Iso Max Damage = Real 0.85 !Iso Critical Damage = Real 0.85 -!Iso Critical Dav = Real 0.85 +!Iso Critical Dav = Real 0.85 !-------- -ah = Real $alpha -Bf = Real 16.5043 -Bh = Real $beta +ah = Real $alpha +Bf = Real 16.5043 +Bh = Real $beta k1 = Real 4.0 k2 = Real 0.0 gamma = Real $GAMMA rf = Real 0.43 -sthres = Real $STHRES +sthres = Real $STHRES !creep dam only----- Dinit Tolerance = Real 1.0e-08 -Dinit Warning Tolerance= Real 5.0e-02 -Dinit Iters = Integer 5000 +Dinit Warning Tolerance= Real 5.0e-02 +Dinit Iters = Integer 5000 -No Init Dam = Logical True +No Init Dam = Logical True -Ignore Front Damage = Logical False +Ignore Front Damage = Logical False !Experimental damage symmetry fix following gancarski 2011 Use Modified Murakami = Logical False !will not allow any dzz accumulation on layers during dDdt -No Dzz = Logical False +No Dzz = Logical False !realigns all layer damage principal directions to those of dav !then recalculates dav. Experimental @@ -152,16 +152,16 @@ Min Damage Threshold = Real 1.0e-10 !------- -Restrict Damage = Logical False +Restrict Damage = Logical False !Restrict Damage X Min = Real 300000.0 !Restrict Damage X Max = Real 1000000.0 !Restrict Damage Y Min = Real -10000.0 !Restrict Damage Y Max = Real 50000.0 Use No Damage Region = Logical False -!No Damage Region X Min = Real -!No Damage Region X Max = Real -!No Damage Region Y Min = Real +!No Damage Region X Min = Real +!No Damage Region X Max = Real +!No Damage Region Y Min = Real !No Damage Region Y Max = Real !-------------------------! @@ -170,26 +170,26 @@ Use No Damage Region = Logical False Shape Functions = String "gimpm" !initial particles per cell -Particle Element Fraction = Real 9.0 +Particle Element Fraction = Real 9.0 Grid Resolution = Real 500.0 Move GL = Logical True Use SEP = Logical True !does this work anymore? -mixfrac4and9 = Logical False !True +mixfrac4and9 = Logical False !True !for particle allocation/splitting Maximum Particle Length = Real 250.0 -Maximum Damaged Particle Length = Real 250.0 +Maximum Damaged Particle Length = Real 250.0 Maximum Grounding Line Particle Length = Real 250.0 Dav Split Threshold = Real 0.1 Number Of Buffer Particles = Integer 0 Use BC for PrevVel = Logical True -Update Particle Velocities for Friction = Logical True -Use Coulomb Friction = Logical True +Update Particle Velocities for Friction = Logical True +Use Coulomb Friction = Logical True Use Saved Basis = Logical True Always fill not full elements = Logical False @@ -208,20 +208,20 @@ End ! SIMULATION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Simulation - Coordinate System = Cartesian 2D + Coordinate System = Cartesian 2D Simulation Type = Transient Timestepping Method = String BDF BDF Order = Integer 2 Timestep Intervals = Integer 800000 - Output Intervals = Integer 0 + Output Intervals = Integer 0 !Timestep Sizes = Real $timestep - Timestep Size + Timestep Size Real Procedure "./../../PROG/MPM" "MPMTimestep" Steady State Max Iterations = Integer 1 - + ! Output File = "$Step$.result" ! Post File = "$Step$.vtu" @@ -237,8 +237,8 @@ Simulation Restart Before Initial Conditions = Logical True - Initialize Dirichlet Conditions = Logical True -End + Initialize Dirichlet Conditions = Logical True +End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BODY ! @@ -263,9 +263,9 @@ Initial Condition 1 partible b = Real $eta Surface = Real 1.0 - + icerises = real -1.0 - + FP = Real 0.01 PrevVel 1 = Equals SSAVelocity 1 @@ -280,7 +280,7 @@ End ! BODY FORCE ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Body Force 1 - Flow BodyForce 1 = Real 0.0 + Flow BodyForce 1 = Real 0.0 Flow BodyForce 2 = Real 0.0 Flow BodyForce 3 = Real $gravity @@ -297,20 +297,20 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MATERIAL ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Material 1 +Material 1 Viscosity Model = String "power law" SSA Mean Density = Real $rhoi SSA Mean Viscosity = Real $eta !"Particle B" - + Critical Shear Rate = Real 1.0e-9 Viscosity Exponent = Real 1.0/3.0 SSA Friction Law = String "coulomb" SSA Min Effective Pressure = Real 1.0e-6 - ! ! Needed for Linear, Weertman and Coulomb + ! ! Needed for Linear, Weertman and Coulomb SSA Friction Parameter = Real 1.0e-2 ! ! Needed for Weertman and Coulomb SSA Friction Exponent = Real $1.0/n @@ -333,7 +333,7 @@ exec solver = "before all" Equation = "Initial Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -342,19 +342,19 @@ Solver 3 exec solver = "before all" Equation = "MPM Init" Procedure = "./../../PROG/MPM" "MPM_Initialize" - + Initialization Condition Variable = String Surface Passive Mask Variable Name = String "Surface" InvVisc Variable Name = String "InvVisc" Velocity Variable Name = String "SSAVelocity" Additional Initial D Variable Name = String "Rift2" - Thickness Variable Name = String "H" + Thickness Variable Name = String "H" Friction Parameter Name = String "FP" Surface Height Variable Name = String "Zs" Damage Mask Variable Name = String "Mask" EF Variable Name = String "EF" - Bedrock Variable Name = String "bed" + Bedrock Variable Name = String "bed" End Solver 4 @@ -368,20 +368,20 @@ Solver 4 GL integration points number = Integer 9 Particle Reweighting = Logical False - - xpic m = Integer 5 + + xpic m = Integer 5 xpic interval = Integer 1 !----- ZERO STRESS OPTIONS: ----- - + Use Zero Stress Damage = Logical True - + !let SSA solver finish without zero stress first, !then activate combined zero stress SSA solver !usually little impact, but can help with stability Converge before zs = Logical True !False - + !surface crevasses (1),basal crevasses(-1), or both (0, default)? !zero stress surface = Integer 0 @@ -392,7 +392,7 @@ Solver 4 !-------------------------------- - Use FEM MinMax = Logical False + Use FEM MinMax = Logical False FEM Min x = Real -1.0 FEM Max x = Real 300000.0 @@ -400,19 +400,19 @@ Solver 4 Linear System Solver = Iterative Linear System Iterative Method = BiCGStab - Linear System Max Iterations = 100 + Linear System Max Iterations = 100 Linear System Preconditioning = "ILU2" - Linear System Convergence Tolerance = 1.0e-6 + Linear System Convergence Tolerance = 1.0e-6 Linear System Abort Not Converged = True Nonlinear System Max Iterations = 100 !200 - Nonlinear System Convergence Tolerance = 1.0e-6 - Nonlinear System Newton After Iterations = 100 - Nonlinear System Newton After Tolerance = 5.0e-4 - Nonlinear System Relaxation Factor = 0.925 - - Use Adaptive Relaxation = Logical False + Nonlinear System Convergence Tolerance = 1.0e-6 + Nonlinear System Newton After Iterations = 100 + Nonlinear System Newton After Tolerance = 5.0e-4 + Nonlinear System Relaxation Factor = 0.925 + + Use Adaptive Relaxation = Logical False Adaptive Norm Mult Threshold = Real 1.5 - + Steady State Convergence Tolerance = Real 1.0e-3 Linear System Abort Not Converged = Logical False @@ -429,7 +429,7 @@ Solver 4 Exported Variable 8 = -dofs 1 "Effective Pressure" Exported Variable 9 = -dofs 4 "Mesh Damage" - Filename Prefix = String "$Step$_fail" + Filename Prefix = String "$Step$_fail" Filename Directory = String "./fail/" Ascii Output = Logical True @@ -443,7 +443,7 @@ Solver 5 Equation = "update particle position and constants, splitting" Procedure = "./../../PROG/MPM" "ParticleUpdates" - Update GIMPM with Corners = Logical True + Update GIMPM with Corners = Logical True End Solver 6 @@ -452,7 +452,7 @@ Solver 6 Procedure = "./../../PROG/MPM" "UpdateDamageModifiedZeroStress" CFL const = Real 0.9 - cflonly = Logical False + cflonly = Logical False Use melt for floating = Logical False crevasse melt rate = real 0.0 @@ -460,7 +460,7 @@ Solver 6 !true if do NOT want the modified model zero stress only = Logical True - Link with zero stress = Logical True + Link with zero stress = Logical True Allow Grounded Damage = Logical True !skip particles with damage that was assigned @@ -472,7 +472,7 @@ Solver 6 !runge-kutta-merson RKM = Logical True - Maximum Allowed dDdt = Real 0.05 + Maximum Allowed dDdt = Real 0.05 Target dDdt = Real 0.05 Damage Convergence Tolerance = Real 1.0e-5 End @@ -482,7 +482,7 @@ Solver 7 Procedure = "./../../PROG/MPM" "UpdateParticleHandMass" !set true if using zero-stress damage - no h update = Logical True + no h update = Logical True End Solver 8 @@ -495,7 +495,7 @@ Solver 9 Equation = "Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -516,16 +516,16 @@ Solver 11 Output Format = String "vtu" Output Interval = Integer 10 - Use Output Interval = Logical False + Use Output Interval = Logical False - Save Interval = Real 2.0 + Save Interval = Real 2.0 - Use Always Save Time = Logical False - Always Save Time = Real 0.258 + Use Always Save Time = Logical False + Always Save Time = Real 0.258 - Use MISMIP Final Damage Save = Logical True + Use MISMIP Final Damage Save = Logical True - StopTime = Real 32.0 + StopTime = Real 32.0 Min X To Save Particle = Real 350000.0 @@ -537,16 +537,16 @@ Solver 11 Vector Field 2 = String "length" Vector Field 3 = String "principal_strain_rates" Vector Field 4 = String "psre_two" - Vector Field 5 = String "dav" + Vector Field 5 = String "dav" Vector Field 6 = String "principal_damage" Vector Field 7 = String "pde_two" Vector Field 8 = String "pdse_two" Vector Field 9 = String "eff_pdse_two" Vector Field 10 = String "eff_pds" Vector Field 11 = String "principal_deviatoric_stresses" - Vector Field 12 = String "deviatoric_stresses" + Vector Field 12 = String "deviatoric_stresses" !Vector Field = String "damage" - !Vector Field = String "gradvel" + !Vector Field = String "gradvel" !Vector Field = String "xpic" !Vector Field = String "damage" !Vector Field = String "damage" @@ -556,7 +556,7 @@ Solver 11 !Vector Field = String "pde_one" !Vector Field = String "pde_three" !Vector Field = String "dd" - !Vector Field = String "gridvelocity" + !Vector Field = String "gridvelocity" !Vector Field = String "gradzs" !Vector Field = String "strain" !Vector Field = String "nextcoordinate" @@ -575,7 +575,7 @@ Solver 11 !Scalar Field = String "bedrock" !Scalar Field = String "gvolume" !Scalar Field = String "pvolume" - !Scalar Field = String "mass" + !Scalar Field = String "mass" !Scalar Field = String "binit" !Scalar Field = String "status" !Scalar Field = String "ef" @@ -605,7 +605,7 @@ Solver 1 Exported Variable 11 = -dofs 1 "dmask" Exported Variable 12 = -dofs 1 "zs" Exported Variable 13 = -dofs 2 "invvel" - Exported Variable 14 = -dofs 2 "ssavelocity" + Exported Variable 14 = -dofs 2 "ssavelocity" Exported Variable 15 = -dofs 2 "PrevVel" Exported Variable 16 = -dofs 1 "btrack" Exported Variable 17 = -dofs 1 "icerises" @@ -616,7 +616,7 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Equation 1 - Active Solvers(11) = 1 2 3 4 5 6 7 8 9 10 11 + Active Solvers(11) = 1 2 3 4 5 6 7 8 9 10 11 End @@ -624,7 +624,7 @@ End ! BOUNDARY CONDITIONS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Grounded +! Grounded Boundary Condition 1 Target Boundaries(1) = 4 SSAVelocity 1 = Real 0.0 @@ -636,7 +636,7 @@ End Boundary Condition 2 Target Boundaries(2) = 1 3 - + SSAVelocity 2 = Real 0.0 PrevVel 2 = Real 0.0 !VPlus 2 = Real 0.0 @@ -653,4 +653,3 @@ Boundary Condition 5 Passive Target = Logical True Calving Front = Logical True End - diff --git a/mismip/damage/mismip_zs_mod.sif b/mismip/damage/mismip_zs_mod.sif index 1f876d7..94a90b5 100644 --- a/mismip/damage/mismip_zs_mod.sif +++ b/mismip/damage/mismip_zs_mod.sif @@ -24,18 +24,18 @@ $davcrit = 0.899 !(creep damage only) -$STHRES = 0.0 -$alpha = 1.0 +$STHRES = 0.0 +$alpha = 1.0 $beta = 0.0 $yearinsec = 31556926.0 $rhoi = 918.0/(1.0e6*yearinsec^2) -$rhow = 1028.0/(1.0e6*yearinsec^2) +$rhow = 1028.0/(1.0e6*yearinsec^2) $gravity = -9.81*yearinsec^2 $n = 3.0 $viscexp = 1.0/3.0 -$timestep = 14.0/365.0 -$firsttimestep = 2.0/365.0 +$timestep = 14.0/365.0 +$firsttimestep = 2.0/365.0 $A = 20.0 $B = A^(-1.0/n) @@ -62,7 +62,7 @@ Sea Level = Real 0.0 Maximum Time Step = Real $timestep First rkm dt = Real $firsttimestep -Critical Shear Rate = Real 1.0E-9 +Critical Shear Rate = Real 1.0E-9 Viscosity Exponent = Real $viscexp Number of Particle Layers = Integer 8 @@ -98,17 +98,17 @@ Output dbassis = Logical True Damage Model = String "zero stress" !Damage Model = String "creep" -Critical Damage = Real $davcrit +Critical Damage = Real $davcrit Critical Dav = Real $davcrit -!creep dam only -DMax I = Real 0.99 -DMax II = Real 0.98 +!creep dam only +DMax I = Real 0.99 +DMax II = Real 0.98 DMax III = Real 0.98 !---zero stress and creep dam Dav DMax I = Real 0.9 -Dav DMax II = Real 0.89 +Dav DMax II = Real 0.89 Dav DMax III = Real 0.89 use rift dmax = Logical True @@ -116,35 +116,35 @@ rift dmax = Real 0.9 !----- !---Forces initially damaged particles to evolve isotropically--- -!Use Isotropic Damage for Initially Damaged Particles = Logical False +!Use Isotropic Damage for Initially Damaged Particles = Logical False !Iso Max Damage = Real 0.85 !Iso Critical Damage = Real 0.85 -!Iso Critical Dav = Real 0.85 +!Iso Critical Dav = Real 0.85 !-------- !creep dam only----- -ah = Real $alpha -Bf = Real 16.5043 -Bh = Real $beta +ah = Real $alpha +Bf = Real 16.5043 +Bh = Real $beta k1 = Real 4.0 k2 = Real 0.0 gamma = Real $GAMMA rf = Real 0.43 -sthres = Real $STHRES +sthres = Real $STHRES Dinit Tolerance = Real 1.0e-08 -Dinit Warning Tolerance= Real 5.0e-02 -Dinit Iters = Integer 5000 +Dinit Warning Tolerance= Real 5.0e-02 +Dinit Iters = Integer 5000 -No Init Dam = Logical True +No Init Dam = Logical True -Ignore Front Damage = Logical False +Ignore Front Damage = Logical False !Experimental creep damage symmetry fix following gancarski 2011 Use Modified Murakami = Logical False !will not allow any creep dzz accumulation on layers during dDdt -No Dzz = Logical False +No Dzz = Logical False !realigns all layer creep damage principal directions to those of dav !then recalculates dav. Experimental @@ -157,16 +157,16 @@ Min Damage Threshold = Real 1.0e-10 !----- -Restrict Damage = Logical False +Restrict Damage = Logical False !Restrict Damage X Min = Real 300000.0 !Restrict Damage X Max = Real 1000000.0 !Restrict Damage Y Min = Real -10000.0 !Restrict Damage Y Max = Real 50000.0 Use No Damage Region = Logical False -!No Damage Region X Min = Real -!No Damage Region X Max = Real -!No Damage Region Y Min = Real +!No Damage Region X Min = Real +!No Damage Region X Max = Real +!No Damage Region Y Min = Real !No Damage Region Y Max = Real !-------------------------! @@ -175,26 +175,26 @@ Use No Damage Region = Logical False Shape Functions = String "gimpm" !initial particles per cell -Particle Element Fraction = Real 9.0 +Particle Element Fraction = Real 9.0 Grid Resolution = Real 500.0 Move GL = Logical True Use SEP = Logical True !does this work anymore? -mixfrac4and9 = Logical False !True +mixfrac4and9 = Logical False !True !for particle allocation/splitting Maximum Particle Length = Real 250.0 -Maximum Damaged Particle Length = Real 250.0 +Maximum Damaged Particle Length = Real 250.0 Maximum Grounding Line Particle Length = Real 250.0 Dav Split Threshold = Real 0.1 Number Of Buffer Particles = Integer 0 Use BC for PrevVel = Logical True -Update Particle Velocities for Friction = Logical True -Use Coulomb Friction = Logical True +Update Particle Velocities for Friction = Logical True +Use Coulomb Friction = Logical True Use Saved Basis = Logical True Always fill not full elements = Logical False @@ -213,20 +213,20 @@ End ! SIMULATION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Simulation - Coordinate System = Cartesian 2D + Coordinate System = Cartesian 2D Simulation Type = Transient Timestepping Method = String BDF BDF Order = Integer 2 Timestep Intervals = Integer 800000 - Output Intervals = Integer 0 + Output Intervals = Integer 0 !Timestep Sizes = Real $timestep - Timestep Size + Timestep Size Real Procedure "./../../PROG/MPM" "MPMTimestep" Steady State Max Iterations = Integer 1 - + ! Output File = "$Step$.result" ! Post File = "$Step$.vtu" @@ -242,8 +242,8 @@ Simulation Restart Variable 3 = String "SSAVelocity" Restart Before Initial Conditions = Logical True - Initialize Dirichlet Conditions = Logical True -End + Initialize Dirichlet Conditions = Logical True +End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BODY ! @@ -268,9 +268,9 @@ Initial Condition 1 partible b = Real $eta Surface = Real 1.0 - + icerises = real -1.0 - + FP = Real 0.01 PrevVel 1 = Equals SSAVelocity 1 @@ -285,7 +285,7 @@ End ! BODY FORCE ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Body Force 1 - Flow BodyForce 1 = Real 0.0 + Flow BodyForce 1 = Real 0.0 Flow BodyForce 2 = Real 0.0 Flow BodyForce 3 = Real $gravity @@ -302,20 +302,20 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MATERIAL ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Material 1 +Material 1 Viscosity Model = String "power law" SSA Mean Density = Real $rhoi SSA Mean Viscosity = Real $eta !"Particle B" - + Critical Shear Rate = Real 1.0e-9 Viscosity Exponent = Real 1.0/3.0 SSA Friction Law = String "coulomb" SSA Min Effective Pressure = Real 1.0e-6 - ! ! Needed for Linear, Weertman and Coulomb + ! ! Needed for Linear, Weertman and Coulomb SSA Friction Parameter = Real 1.0e-2 ! ! Needed for Weertman and Coulomb SSA Friction Exponent = Real $1.0/n @@ -338,7 +338,7 @@ exec solver = "before all" Equation = "Initial Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -347,19 +347,19 @@ Solver 3 exec solver = "before all" Equation = "MPM Init" Procedure = "./../../PROG/MPM" "MPM_Initialize" - + Initialization Condition Variable = String Surface Passive Mask Variable Name = String "Surface" InvVisc Variable Name = String "InvVisc" Velocity Variable Name = String "SSAVelocity" Additional Initial D Variable Name = String "Rift2" - Thickness Variable Name = String "H" + Thickness Variable Name = String "H" Friction Parameter Name = String "FP" Surface Height Variable Name = String "Zs" Damage Mask Variable Name = String "Mask" EF Variable Name = String "EF" - Bedrock Variable Name = String "bed" + Bedrock Variable Name = String "bed" End Solver 4 @@ -373,20 +373,20 @@ Solver 4 GL integration points number = Integer 9 Particle Reweighting = Logical False - - xpic m = Integer 5 + + xpic m = Integer 5 xpic interval = Integer 1 !----- ZERO STRESS OPTIONS: ----- - + Use Zero Stress Damage = Logical True - + !let SSA solver finish without zero stress first, !then activate combined zero stress SSA solver !usually little impact, but can help with stability Converge before zs = Logical True !False - + !surface crevasses (1),basal crevasses(-1), or both (0, default)? !zero stress surface = Integer 0 @@ -397,7 +397,7 @@ Solver 4 !-------------------------------- - Use FEM MinMax = Logical False + Use FEM MinMax = Logical False FEM Min x = Real -1.0 FEM Max x = Real 300000.0 @@ -405,19 +405,19 @@ Solver 4 Linear System Solver = Iterative Linear System Iterative Method = BiCGStab - Linear System Max Iterations = 100 + Linear System Max Iterations = 100 Linear System Preconditioning = "ILU2" - Linear System Convergence Tolerance = 1.0e-6 + Linear System Convergence Tolerance = 1.0e-6 Linear System Abort Not Converged = True Nonlinear System Max Iterations = 100 !200 - Nonlinear System Convergence Tolerance = 1.0e-6 - Nonlinear System Newton After Iterations = 100 - Nonlinear System Newton After Tolerance = 5.0e-4 - Nonlinear System Relaxation Factor = 0.925 - - Use Adaptive Relaxation = Logical False + Nonlinear System Convergence Tolerance = 1.0e-6 + Nonlinear System Newton After Iterations = 100 + Nonlinear System Newton After Tolerance = 5.0e-4 + Nonlinear System Relaxation Factor = 0.925 + + Use Adaptive Relaxation = Logical False Adaptive Norm Mult Threshold = Real 1.5 - + Steady State Convergence Tolerance = Real 1.0e-3 Linear System Abort Not Converged = Logical False @@ -434,7 +434,7 @@ Solver 4 Exported Variable 8 = -dofs 1 "Effective Pressure" Exported Variable 9 = -dofs 4 "Mesh Damage" - Filename Prefix = String "$Step$_fail" + Filename Prefix = String "$Step$_fail" Filename Directory = String "./fail/" Ascii Output = Logical True @@ -448,7 +448,7 @@ Solver 5 Equation = "update particle position and constants, splitting" Procedure = "./../../PROG/MPM" "ParticleUpdates" - Update GIMPM with Corners = Logical True + Update GIMPM with Corners = Logical True End Solver 6 @@ -457,7 +457,7 @@ Solver 6 Procedure = "./../../PROG/MPM" "UpdateDamageModifiedZeroStress" CFL const = Real 0.9 - cflonly = Logical False + cflonly = Logical False !melt rate Use melt for floating = Logical False @@ -466,7 +466,7 @@ Solver 6 !true if do NOT want the modified model zero stress only = Logical False - Link with zero stress = Logical True + Link with zero stress = Logical True Allow Grounded Damage = Logical True !skip particles with damage that was assigned @@ -478,7 +478,7 @@ Solver 6 !runge-kutta-merson RKM = Logical True - Maximum Allowed dDdt = Real 0.05 + Maximum Allowed dDdt = Real 0.05 Target dDdt = Real 0.05 Damage Convergence Tolerance = Real 1.0e-5 End @@ -488,7 +488,7 @@ Solver 7 Procedure = "./../../PROG/MPM" "UpdateParticleHandMass" !set true if using zero-stress damage - no h update = Logical True + no h update = Logical True End Solver 8 @@ -501,7 +501,7 @@ Solver 9 Equation = "Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -522,16 +522,16 @@ Solver 11 Output Format = String "vtu" Output Interval = Integer 10 - Use Output Interval = Logical False + Use Output Interval = Logical False - Save Interval = Real 2.0 + Save Interval = Real 2.0 - Use Always Save Time = Logical False - Always Save Time = Real 0.258 + Use Always Save Time = Logical False + Always Save Time = Real 0.258 - Use MISMIP Final Damage Save = Logical True + Use MISMIP Final Damage Save = Logical True - StopTime = Real 32.0 + StopTime = Real 32.0 Min X To Save Particle = Real 350000.0 @@ -543,16 +543,16 @@ Solver 11 Vector Field 2 = String "length" Vector Field 3 = String "principal_strain_rates" Vector Field 4 = String "psre_two" - Vector Field 5 = String "dav" + Vector Field 5 = String "dav" Vector Field 6 = String "principal_damage" Vector Field 7 = String "pde_two" Vector Field 8 = String "pdse_two" Vector Field 9 = String "eff_pdse_two" Vector Field 10 = String "eff_pds" Vector Field 11 = String "principal_deviatoric_stresses" - Vector Field 12 = String "deviatoric_stresses" + Vector Field 12 = String "deviatoric_stresses" !Vector Field = String "damage" - !Vector Field = String "gradvel" + !Vector Field = String "gradvel" !Vector Field = String "xpic" !Vector Field = String "damage" !Vector Field = String "damage" @@ -562,7 +562,7 @@ Solver 11 !Vector Field = String "pde_one" !Vector Field = String "pde_three" !Vector Field = String "dd" - !Vector Field = String "gridvelocity" + !Vector Field = String "gridvelocity" !Vector Field = String "gradzs" !Vector Field = String "strain" !Vector Field = String "nextcoordinate" @@ -583,7 +583,7 @@ Solver 11 !Scalar Field = String "bedrock" !Scalar Field = String "gvolume" !Scalar Field = String "pvolume" - !Scalar Field = String "mass" + !Scalar Field = String "mass" !Scalar Field = String "binit" !Scalar Field = String "status" !Scalar Field = String "ef" @@ -613,7 +613,7 @@ Solver 1 Exported Variable 11 = -dofs 1 "dmask" Exported Variable 12 = -dofs 1 "zs" Exported Variable 13 = -dofs 2 "invvel" - Exported Variable 14 = -dofs 2 "ssavelocity" + Exported Variable 14 = -dofs 2 "ssavelocity" Exported Variable 15 = -dofs 2 "PrevVel" Exported Variable 16 = -dofs 1 "btrack" Exported Variable 17 = -dofs 1 "icerises" @@ -624,7 +624,7 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Equation 1 - Active Solvers(11) = 1 2 3 4 5 6 7 8 9 10 11 + Active Solvers(11) = 1 2 3 4 5 6 7 8 9 10 11 End @@ -632,7 +632,7 @@ End ! BOUNDARY CONDITIONS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Grounded +! Grounded Boundary Condition 1 Target Boundaries(1) = 4 SSAVelocity 1 = Real 0.0 @@ -644,7 +644,7 @@ End Boundary Condition 2 Target Boundaries(2) = 1 3 - + SSAVelocity 2 = Real 0.0 PrevVel 2 = Real 0.0 !VPlus 2 = Real 0.0 @@ -661,4 +661,3 @@ Boundary Condition 5 Passive Target = Logical True Calving Front = Logical True End - diff --git a/mismip/half_MISMIP_500_orig.grd b/mismip/half_MISMIP_500_orig.grd index a288ed8..b1b25c7 100644 --- a/mismip/half_MISMIP_500_orig.grd +++ b/mismip/half_MISMIP_500_orig.grd @@ -1,26 +1,25 @@ ***** ElmerGrid input file for structured grid generation ***** Version = 210903 Coordinate System = Cartesian 2D -Subcell Divisions in 2D = 1 1 -Subcell Limits 1 = 0.0 640000.0 +Subcell Divisions in 2D = 1 1 +Subcell Limits 1 = 0.0 640000.0 Subcell Limits 2 = 0.0 40000.0 Material Structure in 2D 1 End Materials Interval = 1 1 Boundary Definitions -! type out int - 1 -1 1 1 - 2 -2 1 1 - 3 -3 1 1 - 4 -4 1 1 +! type out int + 1 -1 1 1 + 2 -2 1 1 + 3 -3 1 1 + 4 -4 1 1 End Numbering = Horizontal -Coordinate Ratios = 1 +Coordinate Ratios = 1 Decimals = 12 -Element Innernodes = False +Element Innernodes = False Element Degree = 1 Triangles = False Element Divisions 1 = 1280 Element Divisions 2 = 80 - diff --git a/mismip/steady/README b/mismip/steady/README index eb682ca..ecf5df1 100644 --- a/mismip/steady/README +++ b/mismip/steady/README @@ -1,5 +1,5 @@ In this test, a passive scalar is assigned to the MISMIP+ configuration (see subroutine AdvectRiftsTest), and is advected for 100 years -using GIMPM, as in Huth et al., 2020 Part I. +using GIMPM, as in Huth et al., 2021 Part I. To run: ElmerSolver mismip_steady.sif diff --git a/mismip/steady/mismip_makerestart.sif b/mismip/steady/mismip_makerestart.sif index 6f5a4c4..f84b727 100644 --- a/mismip/steady/mismip_makerestart.sif +++ b/mismip/steady/mismip_makerestart.sif @@ -17,20 +17,20 @@ End ! SIMULATION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Simulation - Coordinate System = Cartesian 2D + Coordinate System = Cartesian 2D Simulation Type = Steady !Transient Timestepping Method = String BDF BDF Order = Integer 2 - + !will stop at ~100 years automatically - Timestep Intervals = Integer 1 !800000 + Timestep Intervals = Integer 1 !800000 Output Intervals = Integer 1 Timestep Sizes = Real 1.0 Steady State Max Iterations = Integer 1 - + Output File = "$Step$.result" ! Post File = "$Step$.vtu" @@ -45,8 +45,8 @@ Simulation Restart Variable 3 = String "SSAVelocity" Restart Before Initial Conditions = Logical True - Initialize Dirichlet Conditions = Logical True -End + Initialize Dirichlet Conditions = Logical True +End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BODY ! @@ -84,7 +84,7 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MATERIAL ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Material 1 +Material 1 Viscosity Model = String "power law" @@ -127,7 +127,7 @@ End ! BOUNDARY CONDITIONS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Grounded +! Grounded Boundary Condition 1 Target Boundaries(1) = 4 SSAVelocity 1 = Real 0.0 @@ -136,7 +136,7 @@ End Boundary Condition 2 Target Boundaries(2) = 1 3 - + SSAVelocity 2 = Real 0.0 End @@ -144,5 +144,3 @@ End Boundary Condition 3 Target Boundaries(1) = 2 End - - diff --git a/mismip/steady/mismip_steady.sif b/mismip/steady/mismip_steady.sif index 0413026..0d5fbb9 100644 --- a/mismip/steady/mismip_steady.sif +++ b/mismip/steady/mismip_steady.sif @@ -6,15 +6,15 @@ $Step = "mismip_steady" !shortcuts for damage !not used here -$GAMMA = 0.0 -$STHRES = 0.0 -$alpha = 1.0 -$beta = 0.0 +$GAMMA = 0.0 +$STHRES = 0.0 +$alpha = 1.0 +$beta = 0.0 $davcrit = 0.8 $yearinsec = 31556926.0 $rhoi = 918.0/(1.0e6*yearinsec^2) -$rhow = 1028.0/(1.0e6*yearinsec^2) +$rhow = 1028.0/(1.0e6*yearinsec^2) $gravity = -9.81*yearinsec^2 $n = 3.0 $viscexp = 1.0/3.0 @@ -43,11 +43,11 @@ Sea Level = Real 0.0 Maximum Time Step = Real $timestep First rkm dt = Real $firsttimestep -Critical Shear Rate = Real 1.0E-9 +Critical Shear Rate = Real 1.0E-9 Viscosity Exponent = Real $viscexp Number of Particle Layers = Integer 8 -Number of Temperature Layers = Integer 8 +Number of Temperature Layers = Integer 8 Constant Linear Temperature = Logical False surftemp = Real -16.702728357631656 @@ -79,21 +79,21 @@ Use Damage = Logical False Damage Model = String "creep" Output dbassis = Logical False -Critical Damage = Real $davcrit -Critical Dav = Real $davcrit -DMax I = Real 0.9 -DMax II = Real 0.9 -DMax III = Real 0.9 +Critical Damage = Real $davcrit +Critical Dav = Real $davcrit +DMax I = Real 0.9 +DMax II = Real 0.9 +DMax III = Real 0.9 Dav DMax I = Real 0.9 -Dav DMax II = Real 0.9 +Dav DMax II = Real 0.9 Dav DMax III = Real 0.9 !creep damage params -ah = Real $alpha -Bf = Real 16.5043 -Bh = Real $beta -k1 = Real 4.0 -k2 = Real 0.0 +ah = Real $alpha +Bf = Real 16.5043 +Bh = Real $beta +k1 = Real 4.0 +k2 = Real 0.0 rf = Real 0.43 sthres = Real $STHRES @@ -102,7 +102,7 @@ sthres = Real $STHRES !1 = fully anisotropic !zero stress damage can use gamma = 0 or 1 !creep damage can use gamma = 0, 1, or any value inbetween -gamma = Real $GAMMA +gamma = Real $GAMMA use rift dmax = Logical True rift dmax = Real 0.9 @@ -110,21 +110,21 @@ First aniso dt = Real 0.0 !For initializing damage (from inversion) !---Forces initially damaged particles to evolve isotropically--- -!Use Isotropic Damage for Initially Damaged Particles = Logical True +!Use Isotropic Damage for Initially Damaged Particles = Logical True !Iso Max Damage = Real 0.85 !Iso Critical Damage = Real 0.85 -!Iso Critical Dav = Real 0.85 +!Iso Critical Dav = Real 0.85 Dinit Tolerance = Real 1.0e-08 -Dinit Warning Tolerance= Real 5.0e-02 +Dinit Warning Tolerance= Real 5.0e-02 Dinit Iters = Integer 5000 -No Init Dam = Logical True +No Init Dam = Logical True !Experimental damage symmetry fix following gancarski 2011 -Use Modified Murakami = Logical False +Use Modified Murakami = Logical False !will not allow any dzz accumulation on layers during dDdt -No Dzz = Logical False +No Dzz = Logical False !realigns all layer damage principal directions to those of dav !then recalculates dav. Experimental @@ -133,16 +133,16 @@ Fix Dav Principal Directions = Logical False Rupture All Damage Components for Rift = Logical True Switch to Isotropic Damage at Dav component rupture = Logical False -Restrict Damage = Logical False +Restrict Damage = Logical False !Restrict Damage X Min = Real 300000.0 !Restrict Damage X Max = Real 1000000.0 !Restrict Damage Y Min = Real -10000.0 !Restrict Damage Y Max = Real 50000.0 Use No Damage Region = Logical False -!No Damage Region X Min = Real -!No Damage Region X Max = Real -!No Damage Region Y Min = Real +!No Damage Region X Min = Real +!No Damage Region X Max = Real +!No Damage Region Y Min = Real !No Damage Region Y Max = Real Min Damage Threshold = Real 1.0e-10 @@ -154,7 +154,7 @@ Min Damage Threshold = Real 1.0e-10 !choose 'smpm' or 'gimpm' Shape Functions = String "gimpm" !this is particle per cell -Particle Element Fraction = Real 9.0 +Particle Element Fraction = Real 9.0 Grid Resolution = Real 500.0 Move GL = Logical True @@ -162,19 +162,19 @@ Use SEP = Logical True !for particle allocation/splitting Maximum Particle Length = Real 250.0 -Maximum Damaged Particle Length = Real 250.0 -Maximum Grounding Line Particle Length = Real 250.0 +Maximum Damaged Particle Length = Real 250.0 +Maximum Grounding Line Particle Length = Real 250.0 Dav Split Threshold = Real 0.1 Number Of Buffer Particles = Integer 0 Use BC for PrevVel = Logical True -Update Particle Velocities for Friction = Logical True -Use Coulomb Friction = Logical True +Update Particle Velocities for Friction = Logical True +Use Coulomb Friction = Logical True Use Saved Basis = Logical True -Always fill not full elements = Logical False -FEM fill element under percent = Real 0.0 +Always fill not full elements = Logical False +FEM fill element under percent = Real 0.0 Use FEM if grounded = Logical False @@ -185,7 +185,7 @@ cfl constant = Real 0.9 !-------------------------! First Timestep Zero = Logical True -Use Steady Timestep = Logical True +Use Steady Timestep = Logical True Steady Timestep = Real $timestep Use Tracer = Logical True @@ -195,23 +195,23 @@ End ! SIMULATION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Simulation - Coordinate System = Cartesian 2D + Coordinate System = Cartesian 2D Simulation Type = Transient Timestepping Method = String BDF BDF Order = Integer 2 - + !will stop at ~100 years automatically - Timestep Intervals = Integer 800000 - Output Intervals = Integer 0 + Timestep Intervals = Integer 800000 + Output Intervals = Integer 0 !Timestep Sizes = Real $timestep - Timestep Size + Timestep Size Real Procedure "./../../PROG/MPM" "SSATimestep" !Real Procedure "./../../PROG/MPM" "MPMTimestep" Steady State Max Iterations = Integer 1 - + ! Output File = "$Step$.result" ! Post File = "$Step$.vtu" @@ -226,8 +226,8 @@ Simulation Restart Variable 3 = String "SSAVelocity" Restart Before Initial Conditions = Logical True - Initialize Dirichlet Conditions = Logical True -End + Initialize Dirichlet Conditions = Logical True +End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BODY ! @@ -250,11 +250,11 @@ Initial Condition 1 Btz = Real $eta invvisc = Real $eta partible b = Real $eta - + Surface = Real 1.0 icerises = real -1.0 - + FP = Real 0.01 PrevVel 1 = Equals SSAVelocity 1 @@ -270,7 +270,7 @@ End ! BODY FORCE ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Body Force 1 - Flow BodyForce 1 = Real 0.0 + Flow BodyForce 1 = Real 0.0 Flow BodyForce 2 = Real 0.0 Flow BodyForce 3 = Real $gravity @@ -287,20 +287,20 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MATERIAL ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Material 1 +Material 1 Viscosity Model = String "power law" SSA Mean Density = Real $rhoi SSA Mean Viscosity = Real $eta !"Particle B" - + Critical Shear Rate = Real 1.0e-9 Viscosity Exponent = Real 1.0/3.0 SSA Friction Law = String "coulomb" SSA Min Effective Pressure = Real 1.0e-6 - ! ! Needed for Linear, Weertman and Coulomb + ! ! Needed for Linear, Weertman and Coulomb SSA Friction Parameter = Real 1.0e-2 ! ! Needed for Weertman and Coulomb SSA Friction Exponent = Real $1.0/n @@ -322,7 +322,7 @@ exec solver = "before all" Equation = "Initial Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -331,19 +331,19 @@ Solver 3 exec solver = "before all" Equation = "MPM Init" Procedure = "./../../PROG/MPM" "MPM_Initialize" - + Initialization Condition Variable = String Surface Passive Mask Variable Name = String "Surface" InvVisc Variable Name = String "InvVisc" Velocity Variable Name = String "SSAVelocity" Additional Initial D Variable Name = String "Rift2" - Thickness Variable Name = String "H" + Thickness Variable Name = String "H" Friction Parameter Name = String "FP" Surface Height Variable Name = String "Zs" Damage Mask Variable Name = String "Mask" EF Variable Name = String "EF" - Bedrock Variable Name = String "bed" + Bedrock Variable Name = String "bed" End Solver 4 @@ -365,11 +365,11 @@ Solver 5 Calculate Loads = Logical True Apply Limiter = True - + GL integration points number = Integer 9 Particle Reweighting = Logical False - - xpic m = Integer 5 + + xpic m = Integer 5 xpic interval = Integer 1 Use FEM MinMax = Logical False @@ -378,8 +378,8 @@ Solver 5 ! Use Zero Stress Damage First Timestep Only = Logical True ! Assign Zero Stress Damage To Layers = Logical False !True - Use Zero Stress Damage = Logical False - Converge before zs = Logical False + Use Zero Stress Damage = Logical False + Converge before zs = Logical False Linear System Solver = Iterative Linear System Iterative Method = BiCGStab @@ -387,15 +387,15 @@ Solver 5 Linear System Preconditioning = "ILU2" Linear System Convergence Tolerance = 1.0e-6 Linear System Abort Not Converged = True - Nonlinear System Max Iterations = 100 + Nonlinear System Max Iterations = 100 Nonlinear System Convergence Tolerance = 1.0e-6 - Nonlinear System Newton After Iterations = 100 + Nonlinear System Newton After Iterations = 100 Nonlinear System Newton After Tolerance = 5.0e-4 Nonlinear System Relaxation Factor = 0.8 - + Use Adaptive Relaxation = Logical True Adaptive Norm Mult Threshold = Real 1.25 - + Steady State Convergence Tolerance = Real 1.0e-3 Linear System Abort Not Converged = Logical False Max Norm = Real 250000.0 @@ -410,7 +410,7 @@ Solver 5 Exported Variable 8 = -dofs 1 "Effective Pressure" Exported Variable 9 = -dofs 4 "Mesh Damage" - Filename Prefix = String "$Step$_fail" + Filename Prefix = String "$Step$_fail" Filename Directory = String "./fail/" Ascii Output = Logical True @@ -424,7 +424,7 @@ Solver 6 Equation = "update particle position and constants, splitting" Procedure = "./../../PROG/MPM" "ParticleUpdates" - Update GIMPM with Corners = Logical True + Update GIMPM with Corners = Logical True End Solver 7 @@ -432,7 +432,7 @@ Solver 7 Equation = "update particle H and Mass" Procedure = "./../../PROG/MPM" "UpdateParticleHandMass" - no h update = Logical False + no h update = Logical False End Solver 8 @@ -446,7 +446,7 @@ Solver 9 Equation = "Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -465,27 +465,27 @@ Solver 11 Ascii Output = Logical True Output Format = String "vtu" - + Output Interval = Integer 1 - Use Output Interval = Logical False + Use Output Interval = Logical False Save Interval = Real 5.0 !0.2 - !5.0 + !5.0 - Use Always Save Time = Logical False - Always Save Time = Real 0.258 + Use Always Save Time = Logical False + Always Save Time = Real 0.258 - Use MISMIP Final Damage Save = Logical True + Use MISMIP Final Damage Save = Logical True - StopTime = Real 102.0 + StopTime = Real 102.0 Min X To Save Particle = Real 350000.0 Filename Prefix = String $Step Filename Directory = String "./results/" - + Vector Field 1 = String "velocity" Vector Field 2 = String "length" @@ -493,13 +493,13 @@ Solver 11 Vector Field 4 = String "psre_two" Vector Field 5 = String "principal_deviatoric_stresses" Vector Field 6 = String "deviatoric_stresses" - !Vector Field = String "dav" + !Vector Field = String "dav" !Vector Field = String "principal_damage" - !Vector Field = String "pde_two" + !Vector Field = String "pde_two" !Vector Field = String "damage" - !Vector Field = String "gradvel" + !Vector Field = String "gradvel" !Vector Field = String "pdse_two" - !Vector Field = String "outell" + !Vector Field = String "outell" !Vector Field = String "xpic" !Vector Field = String "damage" !Vector Field = String "damageii" @@ -509,7 +509,7 @@ Solver 11 !Vector Field = String "pde_one" !Vector Field = String "pde_three" !Vector Field = String "dd" - !Vector Field = String "gridvelocity" + !Vector Field = String "gridvelocity" !Vector Field = String "gradzs" !Vector Field = String "strain" !Vector Field = String "nextcoordinate" @@ -529,7 +529,7 @@ Solver 11 !Scalar Field = String "bedrock" !Scalar Field = String "gvolume" !Scalar Field = String "pvolume" - !Scalar Field = String "mass" + !Scalar Field = String "mass" !Scalar Field = String "status" !Scalar Field = String "ef" !Scalar Field = String "ElementIndex" @@ -558,7 +558,7 @@ Solver 1 Exported Variable 11 = -dofs 1 "dmask" Exported Variable 12 = -dofs 1 "zs" Exported Variable 13 = -dofs 2 "invvel" - Exported Variable 14 = -dofs 2 "ssavelocity" + Exported Variable 14 = -dofs 2 "ssavelocity" Exported Variable 15 = -dofs 2 "PrevVel" Exported Variable 16 = -dofs 1 "btrack" Exported Variable 17 = -dofs 1 "icerises" @@ -569,7 +569,7 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Equation 1 - Active Solvers(11) = 1 2 3 4 5 6 7 8 9 10 11 + Active Solvers(11) = 1 2 3 4 5 6 7 8 9 10 11 End @@ -577,7 +577,7 @@ End ! BOUNDARY CONDITIONS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Grounded +! Grounded Boundary Condition 1 Target Boundaries(1) = 4 SSAVelocity 1 = Real 0.0 @@ -590,7 +590,7 @@ End Boundary Condition 2 Target Boundaries(2) = 1 3 - + SSAVelocity 2 = Real 0.0 PrevVel 2 = Real 0.0 ! Vplus 2 = Real 0.0 @@ -607,4 +607,3 @@ Boundary Condition 5 Passive Target = Logical True Calving Front = Logical True End - diff --git a/test1d/README b/test1d/README index 4fced23..7389384 100644 --- a/test1d/README +++ b/test1d/README @@ -1,4 +1,4 @@ -1-D sMPM and GIMPM tests from Huth et al., 2020 Part I. +1-D sMPM and GIMPM tests from Huth et al., 2021 Part I. ./frontprop1d contains the front propagation test ./steady1d contains the steady 1-D test diff --git a/test1d/Test1D_5km.grd b/test1d/Test1D_0.625km.grd similarity index 91% rename from test1d/Test1D_5km.grd rename to test1d/Test1D_0.625km.grd index d816168..d229a2e 100644 --- a/test1d/Test1D_5km.grd +++ b/test1d/Test1D_0.625km.grd @@ -3,7 +3,7 @@ Version = 210903 Coordinate System = Cartesian 2D Subcell Divisions in 2D = 1 1 Subcell Limits 1 = -200000 250000 -Subcell Limits 2 = 0.0 5000.0 +Subcell Limits 2 = 0.0 625.0 Material Structure in 2D 1 End @@ -21,5 +21,5 @@ Decimals = 12 Element Innernodes = False Element Degree = 1 Triangles = False -Element Divisions 1 = 90 +Element Divisions 1 = 720 Element Divisions 2 = 1 diff --git a/test1d/Test1D_1.25km.grd b/test1d/Test1D_1.25km.grd new file mode 100644 index 0000000..4399728 --- /dev/null +++ b/test1d/Test1D_1.25km.grd @@ -0,0 +1,25 @@ +***** ElmerGrid input file for structured grid generation ***** +Version = 210903 +Coordinate System = Cartesian 2D +Subcell Divisions in 2D = 1 1 +Subcell Limits 1 = -200000 250000 +Subcell Limits 2 = 0.0 1250.0 +Material Structure in 2D + 1 +End +Materials Interval = 1 1 +Boundary Definitions +! type out int + 1 -1 1 1 + 2 -2 1 1 + 3 -3 1 1 + 4 -4 1 1 +End +Numbering = Horizontal +Coordinate Ratios = 1 +Decimals = 12 +Element Innernodes = False +Element Degree = 1 +Triangles = False +Element Divisions 1 = 360 +Element Divisions 2 = 1 diff --git a/test1d/Test1D_5km/mesh.boundary b/test1d/Test1D_5km/mesh.boundary deleted file mode 100644 index 2c72965..0000000 --- a/test1d/Test1D_5km/mesh.boundary +++ /dev/null @@ -1,182 +0,0 @@ -1 1 1 0 202 2 1 -2 1 2 0 202 3 2 -3 1 3 0 202 4 3 -4 1 4 0 202 5 4 -5 1 5 0 202 6 5 -6 1 6 0 202 7 6 -7 1 7 0 202 8 7 -8 1 8 0 202 9 8 -9 1 9 0 202 10 9 -10 1 10 0 202 11 10 -11 1 11 0 202 12 11 -12 1 12 0 202 13 12 -13 1 13 0 202 14 13 -14 1 14 0 202 15 14 -15 1 15 0 202 16 15 -16 1 16 0 202 17 16 -17 1 17 0 202 18 17 -18 1 18 0 202 19 18 -19 1 19 0 202 20 19 -20 1 20 0 202 21 20 -21 1 21 0 202 22 21 -22 1 22 0 202 23 22 -23 1 23 0 202 24 23 -24 1 24 0 202 25 24 -25 1 25 0 202 26 25 -26 1 26 0 202 27 26 -27 1 27 0 202 28 27 -28 1 28 0 202 29 28 -29 1 29 0 202 30 29 -30 1 30 0 202 31 30 -31 1 31 0 202 32 31 -32 1 32 0 202 33 32 -33 1 33 0 202 34 33 -34 1 34 0 202 35 34 -35 1 35 0 202 36 35 -36 1 36 0 202 37 36 -37 1 37 0 202 38 37 -38 1 38 0 202 39 38 -39 1 39 0 202 40 39 -40 1 40 0 202 41 40 -41 1 41 0 202 42 41 -42 1 42 0 202 43 42 -43 1 43 0 202 44 43 -44 1 44 0 202 45 44 -45 1 45 0 202 46 45 -46 1 46 0 202 47 46 -47 1 47 0 202 48 47 -48 1 48 0 202 49 48 -49 1 49 0 202 50 49 -50 1 50 0 202 51 50 -51 1 51 0 202 52 51 -52 1 52 0 202 53 52 -53 1 53 0 202 54 53 -54 1 54 0 202 55 54 -55 1 55 0 202 56 55 -56 1 56 0 202 57 56 -57 1 57 0 202 58 57 -58 1 58 0 202 59 58 -59 1 59 0 202 60 59 -60 1 60 0 202 61 60 -61 1 61 0 202 62 61 -62 1 62 0 202 63 62 -63 1 63 0 202 64 63 -64 1 64 0 202 65 64 -65 1 65 0 202 66 65 -66 1 66 0 202 67 66 -67 1 67 0 202 68 67 -68 1 68 0 202 69 68 -69 1 69 0 202 70 69 -70 1 70 0 202 71 70 -71 1 71 0 202 72 71 -72 1 72 0 202 73 72 -73 1 73 0 202 74 73 -74 1 74 0 202 75 74 -75 1 75 0 202 76 75 -76 1 76 0 202 77 76 -77 1 77 0 202 78 77 -78 1 78 0 202 79 78 -79 1 79 0 202 80 79 -80 1 80 0 202 81 80 -81 1 81 0 202 82 81 -82 1 82 0 202 83 82 -83 1 83 0 202 84 83 -84 1 84 0 202 85 84 -85 1 85 0 202 86 85 -86 1 86 0 202 87 86 -87 1 87 0 202 88 87 -88 1 88 0 202 89 88 -89 1 89 0 202 90 89 -90 1 90 0 202 91 90 -91 2 90 0 202 182 91 -92 3 1 0 202 92 93 -93 3 2 0 202 93 94 -94 3 3 0 202 94 95 -95 3 4 0 202 95 96 -96 3 5 0 202 96 97 -97 3 6 0 202 97 98 -98 3 7 0 202 98 99 -99 3 8 0 202 99 100 -100 3 9 0 202 100 101 -101 3 10 0 202 101 102 -102 3 11 0 202 102 103 -103 3 12 0 202 103 104 -104 3 13 0 202 104 105 -105 3 14 0 202 105 106 -106 3 15 0 202 106 107 -107 3 16 0 202 107 108 -108 3 17 0 202 108 109 -109 3 18 0 202 109 110 -110 3 19 0 202 110 111 -111 3 20 0 202 111 112 -112 3 21 0 202 112 113 -113 3 22 0 202 113 114 -114 3 23 0 202 114 115 -115 3 24 0 202 115 116 -116 3 25 0 202 116 117 -117 3 26 0 202 117 118 -118 3 27 0 202 118 119 -119 3 28 0 202 119 120 -120 3 29 0 202 120 121 -121 3 30 0 202 121 122 -122 3 31 0 202 122 123 -123 3 32 0 202 123 124 -124 3 33 0 202 124 125 -125 3 34 0 202 125 126 -126 3 35 0 202 126 127 -127 3 36 0 202 127 128 -128 3 37 0 202 128 129 -129 3 38 0 202 129 130 -130 3 39 0 202 130 131 -131 3 40 0 202 131 132 -132 3 41 0 202 132 133 -133 3 42 0 202 133 134 -134 3 43 0 202 134 135 -135 3 44 0 202 135 136 -136 3 45 0 202 136 137 -137 3 46 0 202 137 138 -138 3 47 0 202 138 139 -139 3 48 0 202 139 140 -140 3 49 0 202 140 141 -141 3 50 0 202 141 142 -142 3 51 0 202 142 143 -143 3 52 0 202 143 144 -144 3 53 0 202 144 145 -145 3 54 0 202 145 146 -146 3 55 0 202 146 147 -147 3 56 0 202 147 148 -148 3 57 0 202 148 149 -149 3 58 0 202 149 150 -150 3 59 0 202 150 151 -151 3 60 0 202 151 152 -152 3 61 0 202 152 153 -153 3 62 0 202 153 154 -154 3 63 0 202 154 155 -155 3 64 0 202 155 156 -156 3 65 0 202 156 157 -157 3 66 0 202 157 158 -158 3 67 0 202 158 159 -159 3 68 0 202 159 160 -160 3 69 0 202 160 161 -161 3 70 0 202 161 162 -162 3 71 0 202 162 163 -163 3 72 0 202 163 164 -164 3 73 0 202 164 165 -165 3 74 0 202 165 166 -166 3 75 0 202 166 167 -167 3 76 0 202 167 168 -168 3 77 0 202 168 169 -169 3 78 0 202 169 170 -170 3 79 0 202 170 171 -171 3 80 0 202 171 172 -172 3 81 0 202 172 173 -173 3 82 0 202 173 174 -174 3 83 0 202 174 175 -175 3 84 0 202 175 176 -176 3 85 0 202 176 177 -177 3 86 0 202 177 178 -178 3 87 0 202 178 179 -179 3 88 0 202 179 180 -180 3 89 0 202 180 181 -181 3 90 0 202 181 182 -182 4 1 0 202 1 92 diff --git a/test1d/Test1D_5km/mesh.elements b/test1d/Test1D_5km/mesh.elements deleted file mode 100644 index d4d90d9..0000000 --- a/test1d/Test1D_5km/mesh.elements +++ /dev/null @@ -1,90 +0,0 @@ -1 1 404 1 2 93 92 -2 1 404 2 3 94 93 -3 1 404 3 4 95 94 -4 1 404 4 5 96 95 -5 1 404 5 6 97 96 -6 1 404 6 7 98 97 -7 1 404 7 8 99 98 -8 1 404 8 9 100 99 -9 1 404 9 10 101 100 -10 1 404 10 11 102 101 -11 1 404 11 12 103 102 -12 1 404 12 13 104 103 -13 1 404 13 14 105 104 -14 1 404 14 15 106 105 -15 1 404 15 16 107 106 -16 1 404 16 17 108 107 -17 1 404 17 18 109 108 -18 1 404 18 19 110 109 -19 1 404 19 20 111 110 -20 1 404 20 21 112 111 -21 1 404 21 22 113 112 -22 1 404 22 23 114 113 -23 1 404 23 24 115 114 -24 1 404 24 25 116 115 -25 1 404 25 26 117 116 -26 1 404 26 27 118 117 -27 1 404 27 28 119 118 -28 1 404 28 29 120 119 -29 1 404 29 30 121 120 -30 1 404 30 31 122 121 -31 1 404 31 32 123 122 -32 1 404 32 33 124 123 -33 1 404 33 34 125 124 -34 1 404 34 35 126 125 -35 1 404 35 36 127 126 -36 1 404 36 37 128 127 -37 1 404 37 38 129 128 -38 1 404 38 39 130 129 -39 1 404 39 40 131 130 -40 1 404 40 41 132 131 -41 1 404 41 42 133 132 -42 1 404 42 43 134 133 -43 1 404 43 44 135 134 -44 1 404 44 45 136 135 -45 1 404 45 46 137 136 -46 1 404 46 47 138 137 -47 1 404 47 48 139 138 -48 1 404 48 49 140 139 -49 1 404 49 50 141 140 -50 1 404 50 51 142 141 -51 1 404 51 52 143 142 -52 1 404 52 53 144 143 -53 1 404 53 54 145 144 -54 1 404 54 55 146 145 -55 1 404 55 56 147 146 -56 1 404 56 57 148 147 -57 1 404 57 58 149 148 -58 1 404 58 59 150 149 -59 1 404 59 60 151 150 -60 1 404 60 61 152 151 -61 1 404 61 62 153 152 -62 1 404 62 63 154 153 -63 1 404 63 64 155 154 -64 1 404 64 65 156 155 -65 1 404 65 66 157 156 -66 1 404 66 67 158 157 -67 1 404 67 68 159 158 -68 1 404 68 69 160 159 -69 1 404 69 70 161 160 -70 1 404 70 71 162 161 -71 1 404 71 72 163 162 -72 1 404 72 73 164 163 -73 1 404 73 74 165 164 -74 1 404 74 75 166 165 -75 1 404 75 76 167 166 -76 1 404 76 77 168 167 -77 1 404 77 78 169 168 -78 1 404 78 79 170 169 -79 1 404 79 80 171 170 -80 1 404 80 81 172 171 -81 1 404 81 82 173 172 -82 1 404 82 83 174 173 -83 1 404 83 84 175 174 -84 1 404 84 85 176 175 -85 1 404 85 86 177 176 -86 1 404 86 87 178 177 -87 1 404 87 88 179 178 -88 1 404 88 89 180 179 -89 1 404 89 90 181 180 -90 1 404 90 91 182 181 diff --git a/test1d/Test1D_5km/mesh.header b/test1d/Test1D_5km/mesh.header deleted file mode 100644 index a54a695..0000000 --- a/test1d/Test1D_5km/mesh.header +++ /dev/null @@ -1,4 +0,0 @@ -182 90 182 -2 -202 182 -404 90 diff --git a/test1d/Test1D_5km/mesh.nodes b/test1d/Test1D_5km/mesh.nodes deleted file mode 100644 index ecb3668..0000000 --- a/test1d/Test1D_5km/mesh.nodes +++ /dev/null @@ -1,182 +0,0 @@ -1 -1 -200000 0 0 -2 -1 -195000 0 0 -3 -1 -190000 0 0 -4 -1 -185000 0 0 -5 -1 -180000 0 0 -6 -1 -175000 0 0 -7 -1 -170000 0 0 -8 -1 -165000 0 0 -9 -1 -160000 0 0 -10 -1 -155000 0 0 -11 -1 -150000 0 0 -12 -1 -145000 0 0 -13 -1 -140000 0 0 -14 -1 -135000 0 0 -15 -1 -130000 0 0 -16 -1 -125000 0 0 -17 -1 -120000 0 0 -18 -1 -115000 0 0 -19 -1 -110000 0 0 -20 -1 -105000 0 0 -21 -1 -100000 0 0 -22 -1 -95000 0 0 -23 -1 -90000 0 0 -24 -1 -85000 0 0 -25 -1 -80000 0 0 -26 -1 -75000 0 0 -27 -1 -70000 0 0 -28 -1 -65000 0 0 -29 -1 -60000 0 0 -30 -1 -55000 0 0 -31 -1 -50000 0 0 -32 -1 -45000 0 0 -33 -1 -40000 0 0 -34 -1 -35000 0 0 -35 -1 -30000 0 0 -36 -1 -25000 0 0 -37 -1 -20000 0 0 -38 -1 -15000 0 0 -39 -1 -10000 0 0 -40 -1 -5000 0 0 -41 -1 0 0 0 -42 -1 5000 0 0 -43 -1 10000 0 0 -44 -1 15000 0 0 -45 -1 20000 0 0 -46 -1 25000 0 0 -47 -1 30000 0 0 -48 -1 35000 0 0 -49 -1 40000 0 0 -50 -1 45000 0 0 -51 -1 50000 0 0 -52 -1 55000 0 0 -53 -1 60000 0 0 -54 -1 65000 0 0 -55 -1 70000 0 0 -56 -1 75000 0 0 -57 -1 80000 0 0 -58 -1 85000 0 0 -59 -1 90000 0 0 -60 -1 95000 0 0 -61 -1 100000 0 0 -62 -1 105000 0 0 -63 -1 110000 0 0 -64 -1 115000 0 0 -65 -1 120000 0 0 -66 -1 125000 0 0 -67 -1 130000 0 0 -68 -1 135000 0 0 -69 -1 140000 0 0 -70 -1 145000 0 0 -71 -1 150000 0 0 -72 -1 155000 0 0 -73 -1 160000 0 0 -74 -1 165000 0 0 -75 -1 170000 0 0 -76 -1 175000 0 0 -77 -1 180000 0 0 -78 -1 185000 0 0 -79 -1 190000 0 0 -80 -1 195000 0 0 -81 -1 200000 0 0 -82 -1 205000 0 0 -83 -1 210000 0 0 -84 -1 215000 0 0 -85 -1 220000 0 0 -86 -1 225000 0 0 -87 -1 230000 0 0 -88 -1 235000 0 0 -89 -1 240000 0 0 -90 -1 245000 0 0 -91 -1 250000 0 0 -92 -1 -200000 5000 0 -93 -1 -195000 5000 0 -94 -1 -190000 5000 0 -95 -1 -185000 5000 0 -96 -1 -180000 5000 0 -97 -1 -175000 5000 0 -98 -1 -170000 5000 0 -99 -1 -165000 5000 0 -100 -1 -160000 5000 0 -101 -1 -155000 5000 0 -102 -1 -150000 5000 0 -103 -1 -145000 5000 0 -104 -1 -140000 5000 0 -105 -1 -135000 5000 0 -106 -1 -130000 5000 0 -107 -1 -125000 5000 0 -108 -1 -120000 5000 0 -109 -1 -115000 5000 0 -110 -1 -110000 5000 0 -111 -1 -105000 5000 0 -112 -1 -100000 5000 0 -113 -1 -95000 5000 0 -114 -1 -90000 5000 0 -115 -1 -85000 5000 0 -116 -1 -80000 5000 0 -117 -1 -75000 5000 0 -118 -1 -70000 5000 0 -119 -1 -65000 5000 0 -120 -1 -60000 5000 0 -121 -1 -55000 5000 0 -122 -1 -50000 5000 0 -123 -1 -45000 5000 0 -124 -1 -40000 5000 0 -125 -1 -35000 5000 0 -126 -1 -30000 5000 0 -127 -1 -25000 5000 0 -128 -1 -20000 5000 0 -129 -1 -15000 5000 0 -130 -1 -10000 5000 0 -131 -1 -5000 5000 0 -132 -1 0 5000 0 -133 -1 5000 5000 0 -134 -1 10000 5000 0 -135 -1 15000 5000 0 -136 -1 20000 5000 0 -137 -1 25000 5000 0 -138 -1 30000 5000 0 -139 -1 35000 5000 0 -140 -1 40000 5000 0 -141 -1 45000 5000 0 -142 -1 50000 5000 0 -143 -1 55000 5000 0 -144 -1 60000 5000 0 -145 -1 65000 5000 0 -146 -1 70000 5000 0 -147 -1 75000 5000 0 -148 -1 80000 5000 0 -149 -1 85000 5000 0 -150 -1 90000 5000 0 -151 -1 95000 5000 0 -152 -1 100000 5000 0 -153 -1 105000 5000 0 -154 -1 110000 5000 0 -155 -1 115000 5000 0 -156 -1 120000 5000 0 -157 -1 125000 5000 0 -158 -1 130000 5000 0 -159 -1 135000 5000 0 -160 -1 140000 5000 0 -161 -1 145000 5000 0 -162 -1 150000 5000 0 -163 -1 155000 5000 0 -164 -1 160000 5000 0 -165 -1 165000 5000 0 -166 -1 170000 5000 0 -167 -1 175000 5000 0 -168 -1 180000 5000 0 -169 -1 185000 5000 0 -170 -1 190000 5000 0 -171 -1 195000 5000 0 -172 -1 200000 5000 0 -173 -1 205000 5000 0 -174 -1 210000 5000 0 -175 -1 215000 5000 0 -176 -1 220000 5000 0 -177 -1 225000 5000 0 -178 -1 230000 5000 0 -179 -1 235000 5000 0 -180 -1 240000 5000 0 -181 -1 245000 5000 0 -182 -1 250000 5000 0 diff --git a/test1d/USF_1dtest.F90 b/test1d/USF_1dtest.F90 index 9d223e3..4e21ce7 100644 --- a/test1d/USF_1dtest.F90 +++ b/test1d/USF_1dtest.F90 @@ -11,7 +11,7 @@ FUNCTION initsurf(Model,nodenumber,VarIn) RESULT(VarOut) ELSE VarOut = -1.0_dp END IF - + End FUNCTION initsurf FUNCTION initH(Model,nodenumber,VarIn) RESULT(VarOut) @@ -21,17 +21,26 @@ FUNCTION initH(Model,nodenumber,VarIn) RESULT(VarOut) TYPE(Model_t) :: Model INTEGER :: nodenumber REAL(kind=dp) :: VarIn(1),VarOut,H0,V0,C,Q0,termA,TermB,x,gridres,H,dH - LOGICAL :: found + LOGICAL :: found gridres = GetConstReal( Model % Constants,'Grid Resolution',Found ) IF (.NOT. Found) CALL Fatal('USF_1dtest:', & 'initH: Need to define "gridres = Real $" in constants') - H0 = 600.0_dp - v0 = 300.0_dp + H0 = GetConstReal( Model % Constants,'H0',Found ) + IF (.NOT. Found) CALL Fatal('USF_1dtest:', & + 'initH: Need to define "H0 = Real $" in constants') + + v0 = GetConstReal( Model % Constants,'v0',Found ) + IF (.NOT. Found) CALL Fatal('USF_1dtest:', & + 'initH: Need to define "H0 = Real $" in constants') + + + !H0 = 600.0_dp + !v0 = 300.0_dp C = (((910.0_dp*9.81_dp/(4.0_dp*1.9E8_dp))*& - (1.0_dp-910.0_dp/1028.0_dp))**3.0_dp)*31556926.0_dp + (1.0_dp-910.0_dp/1028.0_dp))**3.0_dp)*31556926.0_dp Q0 = H0*v0 termA = 4.0_dp*C/Q0 diff --git a/test1d/frontprop1d/RUN.sh b/test1d/frontprop1d/RUN.sh index 14ae386..8b9cb3f 100755 --- a/test1d/frontprop1d/RUN.sh +++ b/test1d/frontprop1d/RUN.sh @@ -1,33 +1,35 @@ #!/bin/bash -wm='Test1D_5km' -#'Test1D_10km' +wm=(Test1D_5km Test1D_2.5km Test1D_1.25km Test1D_0.625km) #grid resolution -r='5000' -#'10000' +res=(5000 2500 1250 625) #shape function -whichsf='gimpm' # smpm' +whichsf='gimpm smpm' #initial particles per grid cell -ppe='9' # 4 16' +ppe='4 9 16' -for i in $whichsf -do - for j in $ppe + +for ((i = 0; i < ${#wm[@]}; ++i)); do + m=(${wm[$i]}) + r=(${res[$i]}) + for i in $whichsf do - echo $i - echo $j - echo $wm - echo $r - - sed "s//$i/; s//$j/; s//$wm/; s//$r/g" \ - frontprop1d.sif > fp_5k.sif - - ElmerSolver fp_5k.sif - #rm fp_5k.sif + for j in $ppe + do + echo $i + echo $j + echo $m + echo $r + + sed "s//$i/; s//$j/; s//$m/; s//$r/g" \ + frontprop1d.sif > fp.sif + + ElmerSolver fp.sif + #rm fp_5k.sif + done done done - diff --git a/test1d/frontprop1d/frontprop1d.sif b/test1d/frontprop1d/frontprop1d.sif index ff5f337..194d9d9 100644 --- a/test1d/frontprop1d/frontprop1d.sif +++ b/test1d/frontprop1d/frontprop1d.sif @@ -2,11 +2,11 @@ !echo on $Mesh = "" -$Step = "test1d_frontprop_" +$Step = "test1d_frontprop_" $yearinsec = 31556926.0 $rhoi = 910.0/(1.0e6*yearinsec^2) -$rhow = 1028.0/(1.0e6*yearinsec^2) +$rhow = 1028.0/(1.0e6*yearinsec^2) $gravity = -9.81*yearinsec^2 $n = 3.0 @@ -21,7 +21,7 @@ $viscexp = 1.0/3.0 $timestep = 1.0/12.0 !the mass balance -$M = 0.0 +$M = 0.0 $gridres=.0 $pfrac = .0 @@ -32,9 +32,13 @@ Header End Constants + +H0 = Real 600.0 +v0 = Real 300.0 !-------------------------! ! ICE PARAMETERS ! !-------------------------! +Analytic Test = Logical True Ice Density = Real $rhoi Water Density = Real $rhow @@ -42,17 +46,17 @@ Gravity = Real $gravity Sea Level = Real 0.0 Maximum Time Step = Real $timestep -Critical Shear Rate = Real 1.0E-9 +Critical Shear Rate = Real 1.0E-9 Viscosity Exponent = Real $viscexp -Number of Particle Layers = Integer 8 -Number of Temperature Layers = Integer 8 +Number of Particle Layers = Integer 8 +Number of Temperature Layers = Integer 8 -Constant Linear Temperature = Logical False +Constant Linear Temperature = Logical False surftemp = Real 0.0 basetemp = Real 0.0 -Use Constant Temperature = Logical False +Use Constant Temperature = Logical False Constant Temperature = Real 0.0 !viscosity parameter @@ -64,7 +68,7 @@ fricparam = Real 0.0 !mass balance Constant MB Parameter = Logical True -mbparam = Real $M +mbparam = Real $M !enhancement factor Constant EF Parameter = Logical True @@ -79,34 +83,34 @@ Use damage = Logical False !Damage Model = String "zero stress" Damage Model = String "creep" Critical Damage = Real 0.85 -Critical Dav = Real 0.5 -DMax I = Real 0.99 -DMax II = Real 0.99 +Critical Dav = Real 0.5 +DMax I = Real 0.99 +DMax II = Real 0.99 DMax III = Real 0.99 Dav DMax I = Real 0.9 Dav DMax II = Real 0.9 Dav DMax III = Real 0.9 -ah = Real 0.21 -Bf = Real 16.5043 -Bh = Real 0.63 -k1 = Real 4.0 -k2 = Real 0.0 -gamma = Real 0.0 +ah = Real 0.21 +Bf = Real 16.5043 +Bh = Real 0.63 +k1 = Real 4.0 +k2 = Real 0.0 +gamma = Real 0.0 rf = Real 0.43 sthres = Real 0.2 rift dmax = Real 0.9 use rift dmax = Logical True Dinit Tolerance = Real 1.0e-08 -Dinit Warning Tolerance= Real 5.0e-02 -Dinit Iters = Integer 5000 -No Init Dam = Logical True +Dinit Warning Tolerance= Real 5.0e-02 +Dinit Iters = Integer 5000 +No Init Dam = Logical True First aniso dt = Real 0.0 First zero stress dt = Real $timestep -Use time based rift healing = Logical False +Use time based rift healing = Logical False Use Isotropic Damage for Initially Damaged Particles = Logical False Use Modified Murakami = Logical False -No Dzz = Logical False -Fix Dav Principal Directions = Logical False +No Dzz = Logical False +Fix Dav Principal Directions = Logical False Rupture All Damage Components for Rift = Logical True Restrict Damage = Logical False Use No Damage Region = Logical False @@ -123,7 +127,7 @@ Particle Element Fraction = Real .0 Grid Resolution = Real $gridres Move GL = Logical True -Use SEP = Logical True +Use SEP = Logical True !for particle allocation/splitting Maximum Particle Length = Real $splitlength @@ -134,11 +138,11 @@ Number Of Buffer Particles = Integer 0 Use BC for PrevVel = Logical True Use Thickness BC = Logical True -Update Particle Velocities for Friction = Logical False -Use Coulomb Friction = Logical False +Update Particle Velocities for Friction = Logical False +Use Coulomb Friction = Logical False Use Saved Basis = Logical True -Always fill not full elements = Logical False +Always fill not full elements = Logical False cfl constant = Real 0.5 @@ -156,25 +160,25 @@ End ! SIMULATION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Simulation - Coordinate System = Cartesian 2D + Coordinate System = Cartesian 2D Simulation Type = Transient Timestepping Method = String BDF BDF Order = Integer 2 - Timestep Intervals = Integer 4201 !350 years if monthly timestep + Timestep Intervals = Integer 3601 !4201 !350 years if monthly timestep Output Intervals = Integer 0 !Timestep Sizes = Real $timestep - Timestep Size + Timestep Size Real Procedure "./../../PROG/MPM" "SSATimestep" Steady State Max Iterations = Integer 1 - + !Output File = "$Step$.result" !Post File = "$Step$.vtu" max output level = 1 -End +End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BODY ! @@ -210,7 +214,7 @@ Initial Condition 1 InitVel 1 = Variable "Coordinate 1" Real Procedure "./../USF_1dtest" "initVel" - InitVel 2 = Real 0.0 + InitVel 2 = Real 0.0 PrevVel 1 = Equals SSAVelocity 1 PrevVel 2 = Equals SSAVelocity 2 @@ -232,11 +236,11 @@ End ! BODY FORCE ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Body Force 1 - Flow BodyForce 1 = Real 0.0 + Flow BodyForce 1 = Real 0.0 Flow BodyForce 2 = Real 0.0 Flow BodyForce 3 = Real $gravity - Passive Element Min Nodes = Integer 1 + Passive Element Min Nodes = Integer 1 SSAVelocity Passive = Variable Surface Real Procedure "./../../PROG/USF_MPM" "getpassive" @@ -245,7 +249,7 @@ Body Force 1 SSAVelocity 2 = Real 0.0 - SSAVelocity 1 = Equals InitVel 1 + SSAVelocity 1 = Equals InitVel 1 SSAVelocity 1 Condition = Variable "Coordinate 1" Real MATC "-tx + .1" End @@ -254,14 +258,14 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MATERIAL ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Material 1 +Material 1 Critical Shear Rate = Real 1.0E-10 !* yearinsec Viscosity Model = String "power law" Viscosity Exponent = $1.0/n SSA Mean Viscosity = Equals "particle b" SSA Mean Density = Real $rhoi - + SSA Friction Law = String "linear" SSA Friction Parameter = Real 0.0 Min H = Real 1.0 @@ -277,7 +281,7 @@ Solver 2 Equation = "Initial Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -286,18 +290,21 @@ Solver 3 exec solver = "before all" Equation = "MPM Init" Procedure = "./../../PROG/MPM" "MPM_Initialize" - + Initialization Condition Variable = String Surface Passive Mask Variable Name = String "Surface" InvVisc Variable Name = String "InvVisc" Velocity Variable Name = String "SSAVelocity" Additional Initial D Variable Name = String "Rift2" - Thickness Variable Name = String "H" + Thickness Variable Name = String "H" Friction Parameter Name = String "FP" Surface Height Variable Name = String "Zs" Damage Mask Variable Name = String "Mask" EF Variable Name = String "EF" - Bedrock Variable Name = String "bed" + Bedrock Variable Name = String "bed" + + Test1d = Logical True + dirichlet max x = Real 300000.0 End Solver 4 @@ -311,7 +318,7 @@ Solver 4 !defaults to true for smpm and false for gimpm ! Particle Reweighting = Logical True - xpic m = Integer 5 + xpic m = Integer 5 xpic interval = Integer 1 Linear System Solver = Direct !Iterative @@ -325,11 +332,11 @@ Solver 4 Nonlinear System Convergence Tolerance = 1.0e-8 Nonlinear System Newton After Iterations = 300 Nonlinear System Newton After Tolerance = 1.0e-4 - Nonlinear System Relaxation Factor = 0.9 + Nonlinear System Relaxation Factor = 0.8 !!0.9 Steady State Convergence Tolerance = Real 1.0e-8 Use Adaptive Relaxation = Logical True - Adaptive Norm Mult Threshold = Real 1.25 + Adaptive Norm Mult Threshold = Real 1.25 Max Norm = Real 100000.0 @@ -344,29 +351,27 @@ Solver 4 Exported Variable 9 = -dofs 1 "icerises" Exported Variable 10 = -dofs 1 "btrack" - Filename Prefix = String "frontprop1d__ppe__FAIL" + Filename Prefix = String "frontprop1d__ppe__FAIL" Filename Directory = String "./results/" Ascii Output = Logical True Output Format = String "vtu" - Save All = Logical True + Save All = Logical True End Solver 5 - Equation = "update particle position and constants and mb" - Procedure = "./../../PROG/MPM" "ParticleUpdates" - Update GIMPM with Corners = Logical False -End - -Solver 6 +Exec Solver = never Equation = "save error" Procedure = "./../../PROG/MPM" "SteadyStressError_1DTest" + minx = Real .1 + maxx = Real 250000.0 + Filename Prefix = String "frontprop1d__ppe__stresserror" Filename Directory = String "./results" End -Solver 7 +Solver 6 Equation = "save front x" Procedure = "./../../PROG/MPM" "SaveMaxFrontX_1DTest" @@ -376,14 +381,21 @@ Solver 7 Filename Directory = String "./results" End +Solver 7 + Equation = "update particle position and constants and mb" + Procedure = "./../../PROG/MPM" "ParticleUpdates" + Update GIMPM with Corners = Logical False +End + Solver 8 +Exec solver = never Procedure = "./../../PROG/MPM" "SaveParticleData" Equation = "save stuff" Ascii Output = Logical True Output Format = String "vtu" - Output Interval = Integer 100 + Output Interval = Integer 100 Use Output Interval = Logical False Save Interval = Real 25.0 @@ -395,7 +407,7 @@ Solver 8 Vector Field 1 = String "velocity" Vector Field 2 = String "length" Vector Field 3 = String "gradvel" - Vector Field 4 = String "gridvelocity" + Vector Field 4 = String "gridvelocity" Vector Field 5 = String "gradzs" Vector Field 6 = String "gradH" Vector Field 7 = String "strain" @@ -407,7 +419,7 @@ Solver 8 Scalar Field 4 = String "origno" Scalar Field 5 = String "gvolume" Scalar Field 6 = String "pvolume" - Scalar Field 7 = String "mass" + Scalar Field 7 = String "mass" End Solver 9 @@ -415,6 +427,8 @@ Solver 9 Procedure = "./../../PROG/MPM" "UpdateParticleHandMass" no h update = Logical False + Fix H = Logical True + dirichlet max x = Real .1 End Solver 10 @@ -429,7 +443,7 @@ Solver 11 Equation = "Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -448,7 +462,7 @@ Solver 1 Exported Variable 1 = -dofs 1 "surface" Exported Variable 2 = -dofs 1 "H" - Exported Variable 3 = -dofs 1 "bed" + Exported Variable 3 = -dofs 1 "bed" Exported Variable 4 = -dofs 1 "MB" Exported Variable 5 = -dofs 1 "fp" Exported Variable 6 = -dofs 1 "invvisc" @@ -458,12 +472,12 @@ Solver 1 Exported Variable 10 = -dofs 1 "zs" Exported Variable 11 = -dofs 1 "mass" Exported Variable 12 = -dofs 2 "invvel" - Exported Variable 13 = -dofs 2 "ssavelocity" + Exported Variable 13 = -dofs 2 "ssavelocity" Exported Variable 14 = -dofs 1 "TempVar" Exported Variable 15 = -dofs 2 "PrevVel" Exported Variable 16 = -dofs 1 "btz" Exported Variable 17 = -dofs 2 "initvel" - Exported Variable 18 = -dofs 1 "Hinit" + Exported Variable 18 = -dofs 1 "Hinit" End @@ -480,7 +494,7 @@ End ! BOUNDARY CONDITIONS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Grounded +! Grounded Boundary Condition 1 Target Boundaries(1) = 4 SSAVelocity 1 = Equals InitVel 1 @@ -515,4 +529,3 @@ Boundary Condition 5 Passive Target = Logical True Calving Front = Logical True End - diff --git a/test1d/steady1d/RUN.sh b/test1d/steady1d/RUN.sh index 18c5a12..04ce4b8 100755 --- a/test1d/steady1d/RUN.sh +++ b/test1d/steady1d/RUN.sh @@ -1,39 +1,46 @@ #!/bin/bash -wm='Test1D_5km' -#'Test1D_10km' +wm=(Test1D_10km Test1D_5km Test1D_2.5km Test1D_1.25km Test1D_0.625km) #grid resolution -r='5000' -#'10000' +res=(10000 5000 2500 1250 625) #shape function -whichsf='gimpm' #smpm' +whichsf='gimpm smpm' #initial particles per grid cell -ppe='9' #9 16' +ppe='4 9 16' #use particle reweighting? -reweight='false' # true' +reweight='false true' -for i in $whichsf -do - for j in $ppe +#for m in $wm +for ((i = 0; i < ${#wm[@]}; ++i)); do + m=(${wm[$i]}) + r=(${res[$i]}) + for s in $whichsf do - for k in $reweight + for k in $reweight do + if [ $s == 'gimpm' ] && [ $k == 'true' ] + then + echo "Skipping reweight==true for gimpm" + continue + fi + for j in $ppe + do - echo $wm + echo $m echo $r - echo $i - echo $j + echo $s echo $k - - sed "s//$i/; s//$j/; s//$wm/; s//$r/; s//$k/g" \ - steady1d.sif > steady_5k.sif - - ElmerSolver steady_5k.sif - #rm steady_5k.sif + echo $j + + sed "s//$s/; s//$j/; s//$m/; s//$r/; s//$k/g" \ + steady1d.sif > steady_1d.sif + + ElmerSolver steady_1d.sif + done done done done diff --git a/test1d/steady1d/steady1d.sif b/test1d/steady1d/steady1d.sif index 673770c..89e5929 100644 --- a/test1d/steady1d/steady1d.sif +++ b/test1d/steady1d/steady1d.sif @@ -6,7 +6,7 @@ $Step = "test1d_steady_" $yearinsec = 31556926.0 $rhoi = 910.0/(1.0e6*yearinsec^2) -$rhow = 1028.0/(1.0e6*yearinsec^2) +$rhow = 1028.0/(1.0e6*yearinsec^2) $gravity = -9.81*yearinsec^2 $n = 3.0 @@ -18,11 +18,11 @@ $eta = A^(-1.0/n) $mesheta = (2*A)^(-1.0/n) $viscexp = 1.0/3.0 -$timestep = 1.0/12.0 +$timestep = 5.0/365.0 !the mass balance -$M = 0.0 -$gridres=.0 +$M = 0.0 +$gridres= $pfrac = .0 $splitlength = (gridres/sqrt(pfrac))*1.5 @@ -33,9 +33,14 @@ Header End Constants + +H0 = Real 600.0 +v0 = Real 300.0 + !-------------------------! ! ICE PARAMETERS ! !-------------------------! +Analytic Test = Logical True Ice Density = Real $rhoi Water Density = Real $rhow @@ -43,17 +48,17 @@ Gravity = Real $gravity Sea Level = Real 0.0 Maximum Time Step = Real $timestep -Critical Shear Rate = Real 1.0E-9 +Critical Shear Rate = Real 1.0E-9 Viscosity Exponent = Real $viscexp -Number of Particle Layers = Integer 8 -Number of Temperature Layers = Integer 8 +Number of Particle Layers = Integer 8 +Number of Temperature Layers = Integer 8 -Constant Linear Temperature = Logical False +Constant Linear Temperature = Logical False surftemp = Real 0.0 basetemp = Real 0.0 -Use Constant Temperature = Logical False +Use Constant Temperature = Logical False Constant Temperature = Real 0.0 !viscosity parameter @@ -65,7 +70,7 @@ fricparam = Real 0.0 !mass balance Constant MB Parameter = Logical True -mbparam = Real $M +mbparam = Real $M !enhancement factor Constant EF Parameter = Logical True @@ -80,50 +85,49 @@ Use damage = Logical False !Damage Model = String "zero stress" Damage Model = String "creep" Critical Damage = Real 0.85 -Critical Dav = Real 0.5 -DMax I = Real 0.99 -DMax II = Real 0.99 +Critical Dav = Real 0.5 +DMax I = Real 0.99 +DMax II = Real 0.99 DMax III = Real 0.99 Dav DMax I = Real 0.9 Dav DMax II = Real 0.9 Dav DMax III = Real 0.9 -ah = Real 0.21 -Bf = Real 16.5043 -Bh = Real 0.63 -k1 = Real 4.0 -k2 = Real 0.0 -gamma = Real 0.0 +ah = Real 0.21 +Bf = Real 16.5043 +Bh = Real 0.63 +k1 = Real 4.0 +k2 = Real 0.0 +gamma = Real 0.0 rf = Real 0.43 sthres = Real 0.2 rift dmax = Real 0.9 use rift dmax = Logical True Dinit Tolerance = Real 1.0e-08 -Dinit Warning Tolerance= Real 5.0e-02 -Dinit Iters = Integer 5000 -No Init Dam = Logical True +Dinit Warning Tolerance= Real 5.0e-02 +Dinit Iters = Integer 5000 +No Init Dam = Logical True First aniso dt = Real 0.0 First zero stress dt = Real $timestep -Use time based rift healing = Logical False +Use time based rift healing = Logical False Use Isotropic Damage for Initially Damaged Particles = Logical False Use Modified Murakami = Logical False -No Dzz = Logical False -Fix Dav Principal Directions = Logical False +No Dzz = Logical False +Fix Dav Principal Directions = Logical False Rupture All Damage Components for Rift = Logical True Restrict Damage = Logical False Use No Damage Region = Logical False -in Damage Threshold = Real 1.0e-10 +Damage Threshold = Real 1.0e-10 !-------------------------! ! sMPM/GIMPM ! !-------------------------! Shape Functions = String "" -!"mpm" !"gimp" Particle Element Fraction = Real .0 Grid Resolution = Real $gridres Move GL = Logical True -Use SEP = Logical True +Use SEP = Logical True !for particle allocation/splitting Maximum Particle Length = Real $splitlength @@ -134,11 +138,11 @@ Number Of Buffer Particles = Integer 0 Use BC for PrevVel = Logical True Use Thickness BC = Logical True -Update Particle Velocities for Friction = Logical False -Use Coulomb Friction = Logical False +Update Particle Velocities for Friction = Logical False +Use Coulomb Friction = Logical False Use Saved Basis = Logical True -Always fill not full elements = Logical True +Always fill not full elements = Logical True !-------------------------! @@ -155,25 +159,23 @@ End ! SIMULATION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Simulation - Coordinate System = Cartesian 2D + Coordinate System = Cartesian 2D Simulation Type = Transient Timestepping Method = String BDF BDF Order = Integer 2 - Timestep Intervals = Integer 4201 !350 years if timestep is 10 days - Output Intervals = Integer 0 + Timestep Intervals = Integer 10951 !150 years + Output Intervals = Integer 0 - !Timestep Sizes = Real $timestep - - Timestep Size + Timestep Size Real Procedure "./../../PROG/MPM" "SSATimestep" Steady State Max Iterations = Integer 1 - - Output File = "$Step$.result" - Post File = "$Step$.vtu" + + !Output File = "$Step$.result" + !Post File = "$Step$.vtu" max output level = 1 -End +End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BODY ! @@ -208,7 +210,7 @@ Initial Condition 1 InitVel 1 = Variable "Coordinate 1" Real Procedure "./../USF_1dtest" "initVel" - InitVel 2 = Real 0.0 + InitVel 2 = Real 0.0 PrevVel 1 = Equals SSAVelocity 1 PrevVel 2 = Equals SSAVelocity 2 @@ -232,36 +234,38 @@ End ! BODY FORCE ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Body Force 1 - Flow BodyForce 1 = Real 0.0 + Flow BodyForce 1 = Real 0.0 Flow BodyForce 2 = Real 0.0 Flow BodyForce 3 = Real $gravity - Passive Element Min Nodes = Integer 1 + ! Passive Element Min Nodes = Integer 1 - SSAVelocity Passive = Variable Surface - Real Procedure "./../../PROG/USF_MPM" "getpassive" + ! SSAVelocity Passive = Variable Surface + ! Real Procedure "./../../PROG/USF_MPM" "getpassive" H Lower Limit = Real 1.0 SSAVelocity 2 = Real 0.0 - SSAVelocity 1 = Equals InitVel 1 + SSAVelocity 1 = Equals InitVel 1 SSAVelocity 1 Condition = Variable "Coordinate 1" - Real MATC "-tx + .1" + Real MATC "-tx + 5000.1" + ! Real MATC "-tx + .1" End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MATERIAL ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Material 1 +Material 1 Critical Shear Rate = Real 1.0E-10 Viscosity Model = String "power law" Viscosity Exponent = $1.0/n - SSA Mean Viscosity = Equals "particle b" + SSA Mean Viscosity = Real $eta + !Equals "particle b" SSA Mean Density = Real $rhoi - + SSA Friction Law = String "linear" SSA Friction Parameter = Real 0.0 Min H = Real 1.0 @@ -278,7 +282,7 @@ Solver 2 Equation = "Initial Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -287,18 +291,21 @@ Solver 3 exec solver = "before all" Equation = "MPM Init" Procedure = "./../../PROG/MPM" "MPM_Initialize" - + Initialization Condition Variable = String Surface Passive Mask Variable Name = String "Surface" InvVisc Variable Name = String "InvVisc" Velocity Variable Name = String "SSAVelocity" Additional Initial D Variable Name = String "Rift2" - Thickness Variable Name = String "H" + Thickness Variable Name = String "H" Friction Parameter Name = String "FP" Surface Height Variable Name = String "Zs" Damage Mask Variable Name = String "Mask" EF Variable Name = String "EF" - Bedrock Variable Name = String "bed" + Bedrock Variable Name = String "bed" + + Test1d = Logical True + dirichlet max x = Real 300000.0 End Solver 4 @@ -311,7 +318,7 @@ Solver 4 Particle Reweighting = Logical "" xpic m = Integer 5 - xpic interval = Integer 1 + xpic interval = Integer 1 Linear System Solver = Direct !Iterative Linear System Direct Method = umfpack @@ -324,11 +331,11 @@ Solver 4 Nonlinear System Convergence Tolerance = 1.0e-8 Nonlinear System Newton After Iterations = 300 Nonlinear System Newton After Tolerance = 1.0e-4 - Nonlinear System Relaxation Factor = 0.9 + Nonlinear System Relaxation Factor = 0.8 !9 Steady State Convergence Tolerance = Real 1.0e-8 Use Adaptive Relaxation = Logical True - Adaptive Norm Mult Threshold = Real 1.25 + Adaptive Norm Mult Threshold = Real 1.25 Max Norm = Real 100000.0 @@ -342,52 +349,50 @@ Solver 4 Exported Variable 8 = -dofs 1 "Particle B" Exported Variable 9 = -dofs 1 "icerises" - Filename Prefix = String "steady1d__ppe__FAIL" + Filename Prefix = String "steady1d__ppe__FAIL" Filename Directory = String "./results/" Ascii Output = Logical True Output Format = String "vtu" - Save All = Logical True + Save All = Logical True End - Solver 5 - Equation = "update particle position and constants and mb" - Procedure = "./../../PROG/MPM" "ParticleUpdates" - Update GIMPM with Corners = Logical False -End - -Solver 6 +!exec solver=never Equation = "save front x" Procedure = "./../../PROG/MPM" "SaveParticleLoc_1Dtest" Save hvelgradveltime = Logical True Target Initial Location = Real 0.0 - Filename Prefix = String "steady1d__ppe__ploc_" + Filename Prefix = String "steady1d__ppe_rw__ploc_" Filename Directory = String "./results" End -Solver 7 +Solver 6 +!exec solver=never Equation = "save error" Procedure = "./../../PROG/MPM" "SteadyStressError_1DTest" + minx = Real 5000.0 !.1 + maxx = Real 250000.0 Filename Prefix = String "steady1d__ppe_rw__error_" Filename Directory = String "./results" End -Solver 8 +Solver 7 +exec solver=never Procedure = "./../../PROG/MPM" "SaveParticleData" Equation = "save stuff" Ascii Output = Logical True Output Format = String "vtu" - Output Interval = Integer 25 + Output Interval = Integer 1 !25 - Use Output Interval = Logical False + Use Output Interval = Logical True !False Save Interval = Real 25.0 @@ -399,7 +404,7 @@ Solver 8 Vector Field 1 = String "velocity" Vector Field 2 = String "length" Vector Field 3 = String "gradvel" - Vector Field 4 = String "gridvelocity" + Vector Field 4 = String "gridvelocity" Vector Field 5 = String "gradzs" Vector Field 6 = String "gradH" Vector Field 7 = String "strain" @@ -411,15 +416,21 @@ Solver 8 Scalar Field 4 = String "origno" Scalar Field 5 = String "gvolume" Scalar Field 6 = String "pvolume" - Scalar Field 7 = String "mass" + Scalar Field 7 = String "mass" End +Solver 8 + Equation = "update particle position and constants and mb" + Procedure = "./../../PROG/MPM" "ParticleUpdates" + Update GIMPM with Corners = Logical False +End Solver 9 Equation = "update particle H and Mass" Procedure = "./../../PROG/MPM" "UpdateParticleHandMass" no h update = Logical False + Fix H = Logical True End @@ -428,14 +439,14 @@ Solver 10 Procedure = "./../../PROG/MPM" "ParticlesToMesh" Test1d = Logical True - dirichlet max x = Real .1 + dirichlet max x = Real 5000.1 End Solver 11 Equation = "Floatation" Procedure = File "./../../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -453,7 +464,7 @@ Solver 1 Exported Variable 1 = -dofs 1 "surface" Exported Variable 2 = -dofs 1 "H" - Exported Variable 3 = -dofs 1 "bed" + Exported Variable 3 = -dofs 1 "bed" Exported Variable 4 = -dofs 1 "MB" Exported Variable 5 = -dofs 1 "fp" Exported Variable 6 = -dofs 1 "invvisc" @@ -463,12 +474,12 @@ Solver 1 Exported Variable 10 = -dofs 1 "zs" Exported Variable 11 = -dofs 1 "mass" Exported Variable 12 = -dofs 2 "invvel" - Exported Variable 13 = -dofs 2 "ssavelocity" + Exported Variable 13 = -dofs 2 "ssavelocity" Exported Variable 14 = -dofs 1 "TempVar" Exported Variable 15 = -dofs 2 "PrevVel" Exported Variable 16 = -dofs 1 "btz" Exported Variable 17 = -dofs 2 "initvel" - Exported Variable 18 = -dofs 1 "Hinit" + Exported Variable 18 = -dofs 1 "Hinit" End @@ -485,7 +496,7 @@ End ! BOUNDARY CONDITIONS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Grounded +! Grounded Boundary Condition 1 Target Boundaries(1) = 4 SSAVelocity 1 = Equals InitVel 1 @@ -515,9 +526,8 @@ Boundary Condition 4 Calving Front = Logical True End -Boundary Condition 5 - Target Boundaries(1) = 5 - Passive Target = Logical True - Calving Front = Logical True -End - +!Boundary Condition 5 +! Target Boundaries(1) = 5 +! Passive Target = Logical True + !Calving Front = Logical True +!End diff --git a/test2d/README b/test2d/README index b2f8844..9b2d67e 100644 --- a/test2d/README +++ b/test2d/README @@ -1,4 +1,4 @@ -#2-D front propagation test from Huth et al., 2020 Part I +#2-D front propagation test from Huth et al., 2021 Part I #to make mesh: ElmerGrid 14 2 hoop_smpm_10deg_rotated.msh -autoclean diff --git a/test2d/USF_hoop.F90 b/test2d/USF_hoop.F90 index d5868ab..7b8bf35 100644 --- a/test2d/USF_hoop.F90 +++ b/test2d/USF_hoop.F90 @@ -6,8 +6,8 @@ FUNCTION hoopsurf(Model,nodenumber,VarIn) RESULT(VarOut) INTEGER :: nodenumber REAL(kind=dp) :: VarIn(2),VarOut,x,y,r,buffer,yc LOGICAL:: Visited,GotIt - - r = 70000.0_dp + + r = 70000.0_dp x = ABS(VarIn(1)) y = ABS(VarIn(2)) @@ -20,7 +20,7 @@ FUNCTION hoopsurf(Model,nodenumber,VarIn) RESULT(VarOut) VarOut = 1.0_dp ELSE VarOut = -1.0_dp - END IF + END IF END IF End FUNCTION hoopsurf @@ -61,14 +61,14 @@ FUNCTION upstream_yvel_adj(Model,nodenumber,VarIn) RESULT(VarOut) x = VarIn(1) y = VarIn(2) mag = VarIn(3) - + IF (y<0.0_dp) THEN y = -y mag = -mag END IF - + IF (x == 0.0_dp) THEN - VarOut = mag + VarOut = mag ELSE theta = y/x VarOut = mag * theta/sqrt(1.0_dp+theta*theta) @@ -96,5 +96,5 @@ FUNCTION constantvarssmpm(Model,nodenumber,VarIn) RESULT(VarOut) ELSE VarOut = -1.0_dp END IF - + End FUNCTION constantvarssmpm diff --git a/test2d/hooptest_smpm.sif b/test2d/hooptest_smpm.sif index 940d09e..bd336cd 100644 --- a/test2d/hooptest_smpm.sif +++ b/test2d/hooptest_smpm.sif @@ -1,13 +1,13 @@ !Check Keywords "Warn" !echo on -!Which mesh? +!Which mesh? $Mesh = "hoop_smpm_10deg_rotated" $Step = "hoop_smpm" $yearinsec = 31556926.0 $rhoi = 918.0/(1.0e6*yearinsec^2) -$rhow = 1028.0/(1.0e6*yearinsec^2) +$rhow = 1028.0/(1.0e6*yearinsec^2) $gravity = -9.81*yearinsec^2 $n = 3.0 $viscexp = 1.0/3.0 @@ -18,7 +18,7 @@ $A = Ao * yearinsec * (1.0e18) $B = (A)^(-1.0/n) $eta = (2.0*A)^(-1.0/n) -$Dmax = 0.9 +$Dmax = 0.9 $theta = 10.0 @@ -44,27 +44,27 @@ Gravity = Real $gravity Sea Level = Real 0.0 Maximum Time Step = Real 1.0 -Critical Shear Rate = Real 1.0E-9 +Critical Shear Rate = Real 1.0E-9 Viscosity Exponent = Real $viscexp -Number of Particle Layers = Integer 8 -Number of Temperature Layers = Integer 8 +Number of Particle Layers = Integer 8 +Number of Temperature Layers = Integer 8 -Constant Linear Temperature = Logical False +Constant Linear Temperature = Logical False surftemp = Real -16.702728357631656 basetemp = Real -2.0 -Use Constant Temperature = Logical False +Use Constant Temperature = Logical False Constant Temperature = Real 0.0 -Use Given Eta = Logical True +Use Given Eta = Logical True Given Eta = Real $B Constant Friction Parameter = Logical True -fricparam = Real 0.0 +fricparam = Real 0.0 Constant MB Parameter = Logical True -mbparam = Real $M +mbparam = Real $M Constant EF Parameter = Logical True efparam = Real 1.0 @@ -78,34 +78,34 @@ Use damage = Logical False !Damage Model = String "zero stress" Damage Model = String "creep" Critical Damage = Real 0.85 -Critical Dav = Real 0.5 -DMax I = Real 0.99 -DMax II = Real 0.99 +Critical Dav = Real 0.5 +DMax I = Real 0.99 +DMax II = Real 0.99 DMax III = Real 0.99 Dav DMax I = Real 0.9 Dav DMax II = Real 0.9 Dav DMax III = Real 0.9 -ah = Real 0.21 -Bf = Real 16.5043 -Bh = Real 0.63 -k1 = Real 4.0 -k2 = Real 0.0 -gamma = Real 0.0 +ah = Real 0.21 +Bf = Real 16.5043 +Bh = Real 0.63 +k1 = Real 4.0 +k2 = Real 0.0 +gamma = Real 0.0 rf = Real 0.43 sthres = Real 0.2 rift dmax = Real 0.9 use rift dmax = Logical True Dinit Tolerance = Real 1.0e-08 -Dinit Warning Tolerance= Real 5.0e-02 -Dinit Iters = Integer 5000 -No Init Dam = Logical True +Dinit Warning Tolerance= Real 5.0e-02 +Dinit Iters = Integer 5000 +No Init Dam = Logical True First aniso dt = Real 0.0 First zero stress dt = Real $timestep -Use time based rift healing = Logical False +Use time based rift healing = Logical False Use Isotropic Damage for Initially Damaged Particles = Logical False Use Modified Murakami = Logical False -No Dzz = Logical False -Fix Dav Principal Directions = Logical False +No Dzz = Logical False +Fix Dav Principal Directions = Logical False Rupture All Damage Components for Rift = Logical True Restrict Damage = Logical False Use No Damage Region = Logical False @@ -115,25 +115,25 @@ in Damage Threshold = Real 1.0e-10 ! MPM/GIMP ! !-------------------------! -Shape Functions = String "smpm" +Shape Functions = String "smpm" Particle Element Fraction = Real 9.0 -Grid Resolution = Real 500.0 +Grid Resolution = Real 500.0 -Move GL = Logical True -Use SEP = Logical True +Move GL = Logical True +Use SEP = Logical True !for particle allocation/splitting -Maximum Particle Length = Real 250.0 -Maximum Damaged Particle Length = Real 250.0 +Maximum Particle Length = Real 250.0 +Maximum Damaged Particle Length = Real 250.0 Maximum Grounding Line Particle Length = Real 250.0 Dav Split Threshold = Real 0.1 -Number Of Buffer Particles = Integer 0 +Number Of Buffer Particles = Integer 0 Use BC for PrevVel = Logical True -Update Particle Velocities for Friction = Logical False -Use Coulomb Friction = Logical False -Use Saved Basis = Logical False +Update Particle Velocities for Friction = Logical False +Use Coulomb Friction = Logical False +Use Saved Basis = Logical False Always fill not full elements = Logical False FEM fill element under percent = Real 0.0 @@ -144,7 +144,7 @@ cfl constant = Real 0.5 !-------------------------! First Timestep Zero = Logical True -Use Steady Timestep = Logical True +Use Steady Timestep = Logical True Steady Timestep = Real $timestep ! MUST BE TRUE FOR THIS TEST!!! @@ -156,29 +156,29 @@ End ! SIMULATION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Simulation - Coordinate System = Cartesian 2D + Coordinate System = Cartesian 2D Simulation Type = Transient Timestepping Method = String BDF BDF Order = Integer 2 !dummy value, as it will stop at 90 years anyway - Timestep Intervals = Integer 99999 - Output Intervals = Integer 0 + Timestep Intervals = Integer 99999 + Output Intervals = Integer 0 - Timestep Size + Timestep Size Real Procedure "./../PROG/MPM" "SSATimestep" Steady State Max Iterations = Integer 1 - + Post File = "m_$Step$.vtu" - max output level = 3 + max output level = 3 Restart Before Initial Conditions = Logical True Initialize Dirichlet Conditions = Logical True Set Dirichlet BCs by BC Numbering = True -End +End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BODY ! @@ -198,7 +198,7 @@ End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Initial Condition 1 - Hinit = Real 400.0 + Hinit = Real 400.0 H = Equals Hinit Surface = Variable "coordinate 1","coordinate 2" @@ -214,16 +214,16 @@ Initial Condition 1 InitVel 2 = Variable "coordinate 1","coordinate 2","InitVelMag" Real Procedure "./USF_hoop" "upstream_yvel_adj" - PrevVel 1 = Real 0.0 - PrevVel 2 = Real 0.0 + PrevVel 1 = Real 0.0 + PrevVel 2 = Real 0.0 - SSAVelocity 1 = Real 0.0 - SSAVelocity 2 = Real 0.0 + SSAVelocity 1 = Real 0.0 + SSAVelocity 2 = Real 0.0 icerises = real -1.0 dmask = real -1.0 - InvVisc= Real $B + InvVisc= Real $B Rift = Real 0.0 Rift2 = Real 0.0 FP = Real 0.0 @@ -232,7 +232,7 @@ Initial Condition 1 Bed = Real $bed MB = Real $M - Particle B = Real $B + Particle B = Real $B TempVar = Real 0.0 Vstar = Real 0.0 Vplus = Real 0.0 @@ -245,7 +245,7 @@ End ! BODY FORCE ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Body Force 1 - Flow BodyForce 1 = Real 0.0 + Flow BodyForce 1 = Real 0.0 Flow BodyForce 2 = Real 0.0 Flow BodyForce 3 = Real $gravity @@ -267,29 +267,29 @@ Body Force 1 inflow 1 = Equals SSAVelocity 1 inflow 2 = Equals SSAVelocity 2 - + End !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MATERIAL ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Material 1 +Material 1 Viscosity Model = String "power law" SSA Mean Density = Real $rhoi SSA Mean Viscosity = Real $eta - Critical Shear Rate = Real 1.0E-10 + Critical Shear Rate = Real 1.0E-10 Viscosity Exponent = $1.0/n Density = Real $rhoi Min H = Real 1.0 - SSA Friction Law = String "linear" + SSA Friction Law = String "linear" ! SSA Min Effective Pressure = Real 1.0e-6 - !! Needed for Linear, Weertman and Coulomb - SSA Friction Parameter = Real 0.0 + !! Needed for Linear, Weertman and Coulomb + SSA Friction Parameter = Real 0.0 !! Needed for Weertman and Coulomb !SSA Friction Exponent = Real $1.0/n !SSA Friction Linear Velocity = Real 0.0001 @@ -308,7 +308,7 @@ exec solver = "before all" Equation = "Initial Floatation" Procedure = File "./../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -317,18 +317,18 @@ Solver 3 exec solver = "before all" Equation = "MPM Init" Procedure = "./../PROG/MPM" "MPM_Initialize" - + Initialization Condition Variable = String Surface Passive Mask Variable Name = String "Surface" InvVisc Variable Name = String "InvVisc" Velocity Variable Name = String "SSAVelocity" Additional Initial D Variable Name = String "Rift2" - Thickness Variable Name = String "H" + Thickness Variable Name = String "H" Friction Parameter Name = String "FP" Surface Height Variable Name = String "Zs" Damage Mask Variable Name = String "Mask" EF Variable Name = String "EF" - Bedrock Variable Name = String "bed" + Bedrock Variable Name = String "bed" End Solver 4 @@ -340,26 +340,26 @@ Solver 4 GL integration points number = Integer 4 Particle Reweighting = Logical True - - xpic m = Integer 5 + + xpic m = Integer 5 xpic interval = Integer 1 Linear System Solver = Iterative Linear System Iterative Method = BiCGStab Linear System Max Iterations = 10000 Linear System Preconditioning = "ILU2" - Linear System Convergence Tolerance = 1.0e-7 + Linear System Convergence Tolerance = 1.0e-7 Nonlinear System Max Iterations = 200 - Nonlinear System Convergence Tolerance = 1.0e-7 - Nonlinear System Newton After Iterations = 1500 - Nonlinear System Newton After Tolerance = 1.0e-4 - Nonlinear System Relaxation Factor = 0.95 + Nonlinear System Convergence Tolerance = 1.0e-7 + Nonlinear System Newton After Iterations = 1500 + Nonlinear System Newton After Tolerance = 1.0e-4 + Nonlinear System Relaxation Factor = 0.95 Steady State Convergence Tolerance = Real 1.0e-3 Linear System Abort Not Converged = Logical False Use Adaptive Relaxation = Logical True - Adaptive Norm Mult Threshold = Real 1.5 + Adaptive Norm Mult Threshold = Real 1.5 Max Norm = Real 1.0e16 @@ -371,9 +371,9 @@ Solver 4 Exported Variable 6 = -dofs 1 "Particle B" Exported Variable 7 = -dofs 1 "weight" Exported Variable 8 = -dofs 1 "icerises" - - Filename Prefix = String "$Step$_fail_tongue" + + Filename Prefix = String "$Step$_fail_tongue" Filename Directory = String "./fail/" Ascii Output = Logical True @@ -420,7 +420,7 @@ Solver 10 Equation = "Floatation" Procedure = File "./../PROG/MPM_Floatation" "Floatation" Variable = "Mask" - Bottom Surface Name = String "Zb" + Bottom Surface Name = String "Zb" Top Surface Name = String "Zs" Thickness Variable Name = String "H" End @@ -439,15 +439,15 @@ Solver 12 Ascii Output = Logical True Output Format = String "vtu" - - Output Interval = Integer 1 + + Output Interval = Integer 1 Use Output Interval = Logical False - Use Always Save Time = Logical False + Use Always Save Time = Logical False Always Save Time = Real 0.0 Save Interval = Real 1.0 - StopTime = Real 90.0 + StopTime = Real 90.0 Filename Prefix = String $Step @@ -456,14 +456,14 @@ Solver 12 Vector Field 1 = String "velocity" Vector Field 2 = String "length" Vector Field 3 = String "gradvel" - Vector Field 4 = String "gridvelocity" - Vector Field 5 = String "gradzs" + Vector Field 4 = String "gridvelocity" + Vector Field 5 = String "gradzs" Vector Field 6 = String "principal_strain_rates" Vector Field 7 = String "principal_deviatoric_stresses" Vector Field 8 = String "pdse_two" - !Vector Field = String "strain" + !Vector Field = String "strain" !Vector Field = String "dav" - !Vector Field = String "damage" + !Vector Field = String "damage" !Vector Field = String "dav" !Vector Field = String "principal_damage" !Vector Field = String "pde_two" @@ -487,13 +487,13 @@ Solver 12 Scalar Field 7 = String "ElementIndex" Scalar Field 8 = String "fp" Scalar Field 9 = String "gvolume" - Scalar Field 10 = String "pvolume" + Scalar Field 10 = String "pvolume" !Scalar Field = String "damstatus" !Scalar Field = String "mb" !Scalar Field = String "healtime" !Scalar Field = String "viscosity" !Scalar Field = String "bedrock" - !Scalar Field = String "mass" + !Scalar Field = String "mass" !Scalar Field = String "ef" !Scalar Field = String "binit" !Scalar Field = String "particle dt" @@ -518,7 +518,7 @@ Solver 1 Exported Variable 11 = -dofs 1 "dmask" Exported Variable 12 = -dofs 1 "zs" Exported Variable 13 = -dofs 2 "invvel" - Exported Variable 14 = -dofs 2 "ssavelocity" + Exported Variable 14 = -dofs 2 "ssavelocity" Exported Variable 15 = -dofs 2 "PrevVel" Exported Variable 16 = -dofs 1 "bed" Exported Variable 17 = -dofs 2 "InitVel" @@ -543,10 +543,10 @@ End Boundary Condition 1 Target Boundaries(1) = 1 - PrevVel 1 = Real 0.0 + PrevVel 1 = Real 0.0 PrevVel 2 = Real 0.0 - VPlus 1 = Real 0.0 - VPlus 2 = Real 0.0 + VPlus 1 = Real 0.0 + VPlus 2 = Real 0.0 SSAVelocity 1 = Real 0.0 SSAVelocity 2 = Real 0.0