Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
 Path: blob/devel/elmerice/Tests/Calving2D/PROG/bedrockfunction_flat.f90
3206 views
1


2
RECURSIVE SUBROUTINE getBedrock( Model,Solver,Timestep,TransientSimulation )

3
  USE DefUtils

4
 

5
  IMPLICIT NONE

6
  INTERFACE

7
     FUNCTION initbedrock(Model, nodenumber, x) RESULT(elevation)

8
       USE DefUtils

9
       TYPE(Model_t) :: Model

10
       INTEGER :: nodenumber

11
       REAL (KIND=dp) :: x, elevation

12
     END FUNCTION initbedrock

13
  END INTERFACE

14


15
  !------------------------------------------------------------------------------

16
  !    External variables

17
  !------------------------------------------------------------------------------

18
  TYPE(Model_t)  :: Model

19
  TYPE(Solver_t), TARGET :: Solver

20
  LOGICAL :: TransientSimulation

21
  REAL(KIND=dp) :: Timestep

22
  !------------------------------------------------------------------------------

23
  !    Local variables

24
  !------------------------------------------------------------------------------

25
  TYPE(ValueList_t), Pointer :: BC

26
  TYPE(Variable_t), POINTER :: Var

27
  TYPE(Element_t),POINTER :: Element

28
  INTEGER, POINTER :: VarPerm(:)

29
  INTEGER :: VarDOFs, i, k

30
  REAL(KIND=dp) :: x

31
  REAL(KIND=dp), POINTER :: VarValues(:)

32
  LOGICAL :: GotIt

33


34
  CALL INFO("getBedrock","Computing bedrock distribution", Level=1)

35


36
  Var => Solver % Variable

37
  IF (ASSOCIATED(Var)) THEN

38
     VarPerm => Var % Perm

39
     VarDOFs =  Var % DOFs

40
     VarValues => Var % Values

41
  ELSE

42
     CALL FATAL('getBedrock','No Variable associated')

43
  END IF

44
  k=0

45
  DO i = 1,Model % NumberOfNodes

46
     IF (VarPerm(i) > 0) THEN

47
        x = Solver % Mesh % Nodes % x(i)

48
        VarValues(VarPerm(i)) = initbedrock(Model,i,x)

49
        PRINT *, "bed:", x, VarValues(VarPerm(i))

50
     END IF

51
  END DO

52
END SUBROUTINE getBedrock

53


54
FUNCTION initbedrock(Model, nodenumber, x) RESULT(elevation)

55
  USE ElementDescription

56
  USE DefUtils

57


58
  IMPLICIT NONE

59
  TYPE(Model_t) :: Model

60
  INTEGER :: nodenumber

61
  REAL (KIND=dp) :: x, elevation,z0, slope

62
    slope = 1.0_dp/40.0

63
    z0 = -550.0_dp

64
    elevation = z0 - slope*x

65
END FUNCTION initbedrock

66


67
FUNCTION initsurface(Model, nodenumber, x) RESULT(elevation)

68
  USE ElementDescription

69
  USE DefUtils

70


71
  IMPLICIT NONE

72
  INTERFACE

73
     FUNCTION initbedrock(Model, nodenumber, x) RESULT(elevation)

74
       USE DefUtils

75
       TYPE(Model_t) :: Model

76
       INTEGER :: nodenumber

77
       REAL (KIND=dp) :: x, elevation

78
     END FUNCTION initbedrock

79
  END INTERFACE

80


81
  TYPE(Model_t) :: Model

82
  INTEGER :: nodenumber

83
  REAL (KIND=dp) :: x, elevation

84
  

85
  elevation = initbedrock(Model, nodenumber, x) + 680.0_dp

86
END FUNCTION initsurface

87


88