Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
 Path: blob/devel/elmerice/Tests/Calving3D_lset_parMMG/PROG/bedrockfunction_3D.F90
3206 views
1
FUNCTION initbedrock(Model, nodenumber, inputarray) RESULT(elevation)

2
  USE ElementDescription

3
  USE DefUtils

4


5
  IMPLICIT NONE

6
  TYPE(Model_t) :: Model

7
  INTEGER :: nodenumber

8
  REAL (KIND=dp) :: inputarray(*),x,y,elevation,elevation_x,&

9
       elevation_y,z0, slope, centrality, trunk_hwidth, &

10
       obs_length,obs_height,elevation_obstacle, bump_height, &

11
       bump_radius, bump_1_dist, bump_1_elev, bump_2_dist, bump_2_elev

12


13
  x = inputarray(1)

14
  y = inputarray(2)

15


16
  !Y varies from 5000.0 at input to 0 at calving front

17
  !X varies from 0 at right margin to 5000.0 at left

18


19
  !longitudinal component of bed function

20
  slope = 1.0_dp/40.0

21
  z0 = -550.0_dp

22
  elevation_y = z0 + slope*y

23


24
  trunk_hwidth = (3000.0 + 2000.0 * (y/5000.0)) * 0.5

25


26
  centrality = ABS(x - 2500.0) / trunk_hwidth !1 at margins, 0 at centerline

27
  elevation_x = centrality**2.0 * 200.0 !vary depth from -550.0 at centerline to -350.0 at edge

28


29
  obs_length = 1000.0_dp

30
  obs_height = 100.0_dp

31
  elevation_obstacle = obs_height * EXP(-(y/obs_length)**2.0)

32


33
  bump_height = 100.0_dp

34
  bump_radius = 500.0_dp

35


36
  bump_1_dist = ((x - 1800.0)**2.0 + (y - 0.0)**2.0)**0.5

37
  bump_1_elev = bump_height * EXP(-(bump_1_dist / bump_radius)**2.0)

38


39
  bump_2_dist = ((x - 3000.0)**2.0 + (y - 0.0)**2.0)**0.5

40
  bump_2_elev = bump_height * EXP(-(bump_2_dist / bump_radius)**2.0)

41
  

42
  elevation = elevation_y + elevation_x + elevation_obstacle + bump_1_elev + bump_2_elev

43


44
END FUNCTION initbedrock

45


46
FUNCTION initsurface(Model, nodenumber, inputarray) RESULT(elevation)

47
  USE ElementDescription

48
  USE DefUtils

49


50
  IMPLICIT NONE

51


52
  TYPE(Model_t) :: Model

53
  INTEGER :: nodenumber

54
  REAL (KIND=dp) :: inputarray(*),x,y, elevation, elevation_y, slope, z0

55


56
  x = inputarray(1)

57
  y = inputarray(2)

58


59
  !Y varies from 5000.0 at input to 0 at calving front

60
  !X varies from 0 at right margin to 5000.0 at left

61


62
  !longitudinal component of bed function

63
  slope = 1.0_dp/40.0

64
  z0 = 50.0_dp

65
  elevation_y = z0 + slope*y

66
  elevation = elevation_y

67
END FUNCTION initsurface

68


69