40
41
42
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65#include "implicit_f.inc"
66
67
68
69#include "com01_c.inc"
70#include "com04_c.inc"
71#include "com08_c.inc"
72#include "param_c.inc"
73#include "tabsiz_c.inc"
74
75
76
77! spmd CASE : sx >= 3*numnod(sx = 3*(numnod_l+nrcvvois_l))
78
79
80
81
82 INTEGER NALE(NUMNOD), NODFT, NODLT,
83 . NBRCVOIS(*),NBSDVOIS(*),
84 . LNRCVOIS(*),LNSDVOIS(*),ISKEW(*),ICODT(*)
85 my_real x(3,sx/3),v(3,sv/3), w(3,sw/3), wa(3,*), skew(lskew,*)
86 TYPE(t_connectivity), INTENT(IN) :: ALE_NN_CONNECT
87
88
89
90 INTEGER I, LENCOM, K, ITER,NITER,NUM
91 my_real vec(3),lambda,iform, weight(6),som,som2,min_dist,max_dist
92 my_real,
DIMENSION(:),
ALLOCATABLE :: dist
93 INTEGER :: IAD, IAD1, IAD2, NODE_ID
94
95
96
98 niter=nint(
ale%GRID%VGX)
99 iform=nint(
ale%GRID%GAMMA)
100
101 wa(1:3,nodft:nodlt)=x(1:3,nodft:nodlt)
103
104 DO iter=1,niter
105
106 IF(nspmd > 1)THEN
107
108 lencom = nbrcvois(nspmd+1)+nbsdvois(nspmd+1)
109 CALL spmd_xvois(wa ,nbrcvois,nbsdvois,lnrcvois,lnsdvois,lencom)
110
111 END IF
112
113 IF(iform == 1)THEN
114
115 DO i = nodft, nodlt
116 IF(iabs(nale(i)) == 1) THEN
117 iad1 = ale_nn_connect%IAD_CONNECT(i)
118 iad2 = ale_nn_connect%IAD_CONNECT(i + 1) - 1
119 num = 0
120 vec(1:3) = zero
121 DO iad = iad1, iad2
122 num = num + 1
123 node_id = ale_nn_connect%CONNECTED(iad)
124 vec(1) = vec(1) + wa(1, node_id)
125 vec(2) = vec(2) + wa(2, node_id)
126 vec(3) = vec(3) + wa(3, node_id)
127 ENDDO
128
129 vec(1) = vec(1) / num - wa(1,i)
130 vec(2) = vec(2) / num - wa(2,i)
131 vec(3) = vec(3) / num - wa(3,i)
132
133
135 w(1,i) = wa(1,i) + lambda * vec(1)
136 w(2,i) = wa(2,i) + lambda * vec(2)
137 w(3,i) = wa(3,i) + lambda * vec(3)
138
139 ELSE
140 w(1,i) = wa(1,i)
141 w(2,i) = wa(2,i)
142 w(3,i) = wa(3,i)
143 ENDIF
144 ENDDO
145 ELSEIF(iform == 2)THEN
146
147 DO i = nodft, nodlt
148 IF(iabs(nale(i)) == 1) THEN
149 iad1 = ale_nn_connect%IAD_CONNECT(i)
150 iad2 = ale_nn_connect%IAD_CONNECT(i + 1) - 1
151 num = 0
152 vec(1:3) = zero
153 ALLOCATE(dist(iad2 - iad1 + 1))
154 DO iad = iad1, iad2
155 num = num + 1
156 node_id = ale_nn_connect%CONNECTED(iad)
157 vec(1) = wa(1,node_id) - wa(1,i)
158 vec(2) = wa(2,node_id) - wa(2,i)
159 vec(3) = wa(3,node_id) - wa(3,i)
160 dist(iad) = sqrt(vec(1)*vec(1)+vec(2)*vec(2)+vec(3)*vec(3))
161
162 ENDDO
163 som = sum(dist(1:num))
164
165 min_dist = minval(dist(1:num))
166 max_dist = maxval(dist(1:num))
167 som2 = zero
168 DO k=1,num
169 som2 = som2 + one / dist(k)
170 ENDDO
171
172 DO k=1,num
173 weight(k)=dist(k)/som
174 ENDDO
175 vec(1:3)=zero
176 DO iad = iad1, iad2
177 node_id = ale_nn_connect%CONNECTED(iad)
178 vec(1) = vec(1) + weight(k) * (wa(1,node_id) - wa(1,i))
179 vec(2) = vec(2) + weight(k) * (wa(2,node_id) - wa(2,i))
180 vec(3) = vec(3) + weight(k) * (wa(3,node_id) - wa(3,i))
181 ENDDO
182
183
185 w(1,i) = wa(1,i) + lambda * vec(1)
186 w(2,i) = wa(2,i) + lambda * vec(2)
187 w(3,i) = wa(3,i) + lambda * vec(3)
188
189 ELSE
190 w(1,i)=wa(1,i)
191 w(2,i)=wa(2,i)
192 w(3,i)=wa(3,i)
193 ENDIF
194 DEALLOCATE(dist)
195 ENDDO
196 ENDIF
197
199 wa(1:3,nodft:nodlt)=w(1:3,nodft:nodlt)
200
201 ENDDO
202
203
204 DO i = nodft, nodlt
205 IF(iabs(nale(i)) == 1 .AND. dt2 > zero) THEN
206 w(1,i)=(wa(1,i)-x(1,i))/dt2
207 w(2,i)=(wa(2,i)-x(2,i))/dt2
208 w(3,i)=(wa(3,i)-x(3,i))/dt2
209 ELSEIF(nale(i) == 0)THEN
210 w(1,i)=v(1,i)
211 w(2,i)=v(2,i)
212 w(3,i)=v(3,i)
213 ELSE
214 w(1,i)=zero
215 w(2,i)=zero
216 w(3,i)=zero
217 ENDIF
218 ENDDO
219
220 RETURN
subroutine alewdx_grid_bcs(skew, iskew, icodt, vec, nale, node_id)
subroutine spmd_xvois(x, nbrcvois, nbsdvois, lnrcvois, lnsdvois, lencom)
1.15.0