Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ||===\\ |
! || \\ |
! || || //==\\ || || //==|| ||/==\\ |
! || || || || || || || || || || |
! || // || || || || || || || |
! ||===// \\==// \\==\\ \\==\\ || |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! DEFINE_BC_MODEL1 May 2008 |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
subroutine define_bc_model1 (nnode,kfix,kfixt,x,y,z,u,v,w,temp,vo)
!------------------------------------------------------------------------------|
!(((((((((((((((( Purpose of the routine ))))))))))))))))))))))))))))))))))))))
!------------------------------------------------------------------------------|
! this routine assigns the boundary condition for the Stokes sphere experiment
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine arguments ))))))))))))))))))))
!------------------------------------------------------------------------------|
use definitions
implicit none
integer nnode
integer kfix(nnode*3)
integer kfixt(nnode)
double precision x(nnode),y(nnode),z(nnode)
double precision u(nnode),v(nnode),w(nnode)
double precision temp(nnode)
type (void) vo
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
!------------------------------------------------------------------------------|
integer i
double precision eps
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
eps=1.d-10
do i=1,nnode
if (x(i).lt.eps) then
kfix((i-1)*3+1)=1 ; u(i)=0.d0
endif
if (x(i).gt.1.d0-eps) then
kfix((i-1)*3+1)=1 ; u(i)=0.d0
endif
if (y(i).lt.eps) then
kfix((i-1)*3+1)=1 ; u(i)=0.d0
kfix((i-1)*3+2)=1 ; v(i)=-1.d0
! kfix((i-1)*3+3)=1 ; w(i)=0.d0
endif
if (y(i).gt.1.d0-eps) then
kfix((i-1)*3+1)=1 ; u(i)=0.d0
kfix((i-1)*3+2)=1 ; v(i)=1.d0
! kfix((i-1)*3+3)=1 ; w(i)=0.d0
endif
if (z(i).lt.eps) then
! kfix((i-1)*3+1)=1 ; u(i)=0.d0
kfix((i-1)*3+3)=1 ; w(i)=0.d0
!if (x(i)<0.41d0) then
! if (y(i).lt.0.45d0) then
! kfix((i-1)*3+2)=1 ; v(i)=-1.d0
! else
! kfix((i-1)*3+2)=1 ; v(i)=1.d0
! end if
!elseif (x(i)>0.59d0) then
! if (y(i).lt.0.55d0) then
! kfix((i-1)*3+2)=1 ; v(i)=-1.d0
! else
! kfix((i-1)*3+2)=1 ; v(i)=1.d0
! end if
!end if
kfixt(i)=1
temp(i)=1.d0
endif
if (z(i).gt.1.d0-eps) then
! kfix((i-1)*3+1)=1 ; u(i)=0.d0
kfixt(i)=1
temp(i)=0.d0
endif
if (.not.vo%influid(i)) then
kfixt(i)=1
temp(i)=0.d0
endif
end do
return
end subroutine
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------