39
40
41
42
43
44
45
46
47
48
49
50
53 use element_mod , only : nixs
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "mvsiz_p.inc"
62
63
64
65#include "vect01_c.inc"
66#include "com01_c.inc"
67#include "com06_c.inc"
68#include "com08_c.inc"
69#include "param_c.inc"
70#include "comlock.inc"
71
72
73
74
75
76
77
78
79
80
81
82 INTEGER :: IXS(NIXS,*),NV46,IPM(NPROPMI,*),NALE(*),NEL
84 my_real :: n1x(*), n2x(*), n3x(*), n4x(*), n5x(*), n6x(*),
85 . n1y(*), n2y(*), n3y(*), n4y(*), n5y(*), n6y
86 . n1z(*), n2z(*), n3z(*), n4z
87 TYPE(t_ale_connectivity), INTENT(IN) ::
88 DOUBLE PRECISION,INTENT(INOUT)
89
90
91
92 INTEGER :: I, II, IV, J, MT, IALEFVM_FLG, ICF(4,6),IX(4)
93 INTEGER :: NC1(MVSIZ),NC2(),NC3(MVSIZ),NC4(MVSIZ),NC5(MVSIZ),NC6(MVSIZ),NC7(MVSIZ),NC8(MVSIZ)
94 my_real :: x1(mvsiz), x2(mvsiz), x3(mvsiz) , x4(mvsiz), x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz),
95 . y1(mvsiz), y2(mvsiz), y3(mvsiz) , y4(mvsiz), y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
96 . z1(mvsiz), z2(mvsiz), z3(mvsiz) , z4(mvsiz), z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz),
97 . swn(6) , wface(3,6,mvsiz), wfext_add, wfextt
98
99 DATA icf/1,4,3,2,3,4,8,7,5,6,7,8,1,2,6,5,2,3,7,6,1,5,8,4/
100 INTEGER :: IAD2
101
102
103
105 mt = ixs(1,nft+lft)
106 ialefvm_flg = ipm(251,mt)
107 IF(ialefvm_flg <= 1)RETURN
108
109 IF(jale == 0)RETURN
110
111
112
113
114
115
116
117 IF(jale==1)THEN
118 DO i=lft,llt
119 ii = i + nft
120
121 nc1(i)=ixs(2,ii)
122 nc2(i)=ixs(3,ii)
123 nc3(i)=ixs(4,ii)
124 nc4(i)=ixs(5,ii)
125 nc5(i)=ixs(6,ii)
126 nc6(i)=ixs(7,ii)
127 nc7(i)=ixs(8,ii)
128 nc8(i)=ixs(9,ii)
129
130
131 x1(i)=x(1,nc1(i))
132 y1(i)=x(2,nc1(i))
133 z1(i)=x(3,nc1(i))
134
135 x2(i)=x(1,nc2(i))
136 y2(i)=x(2,nc2(i))
137 z2(i)=x(3,nc2(i))
138
139 x3(i)=x(1,nc3(i))
140 y3(i)=x(2,nc3(i))
141 z3(i)=x(3,nc3(i))
142
143 x4(i)=x(1,nc4(i))
144 y4(i)=x(2,nc4(i))
145 z4(i)=x(3,nc4(i))
146
147 x5(i)=x(1,nc5(i))
148 y5(i)=x(2,nc5(i))
149 z5(i)=x(3,nc5(i))
150
151 x6(i)=x(1,nc6(i))
152 y6(i)=x(2,nc6(i))
153 z6(i)=x(3,nc6(i))
154
155 x7(i)=x(1,nc7(i))
156 y7(i)=x(2,nc7(i))
157 z7(i)=x(3,nc7(i))
158
159 x8(i)=x(1,nc8(i))
160 y8(i)=x(2,nc8(i))
161 z8(i)=x(3,nc8(i))
162 ENDDO
163 DO i=lft,llt
164
165 n1x(i)=(y3(i)-y1(i))*(z2(i)-z4(i)) - (z3(i)-z1(i))*(y2(i)-y4(i))
166 n1y(i)=(z3(i)-z1(i))*(x2(i)-x4(i)) - (x3(i)-x1(i))*(z2(i)-z4(i))
167 n1z(i)=(x3(i)-x1(i))*(y2(i)-y4(i)) - (y3(i)-y1(i))*(x2(i)-x4(i))
168
169 n2x(i)=(y7(i)-y4(i))*(z3(i)-z8(i)) - (z7(i)-z4(i))*(y3(i)-y8(i))
170 n2y(i)=(z7(i)-z4(i))*(x3(i)-x8(i)) - (x7(i)-x4(i))*(z3(i)-z8(i))
171 n2z(i)=(x7(i)-x4(i))*(y3(i)-y8(i)) - (y7(i)-y4(i))*(x3(i)-x8(i))
172
173 n3x(i)=(y6(i)-y8(i))*(z7(i)-z5(i)) - (z6(i)-z8(i))*(y7(i)-y5(i))
174 n3y(i)=(z6(i)-z8(i))*(x7(i)-x5(i)) - (x6(i)-x8(i))*(z7(i)-z5(i))
175 n3z(i)
176
177 n4x(i)=(y2(i)-y5(i))*(z6(i)-z1(i)) - (z2(i)-z5(i))*(y6(i)-y1(i))
178 n4y(i)=(z2(i)-z5(i))*(x6(i)-x1(i)) - (x2(i)-x5(i))*(z6(i)-z1(i))
179 n4z(i)=(x2(i)-x5(i))*(y6(i)-y1(i)) - (y2(i
180
181 n5x(i)=(y7(i)-y2(i))*(z6(i)-z3(i)) - (z7
182 n5y(i)=(z7(i)-z2(i))*(x6(i)-x3(i)) - (x7(i)-x2
183 n5z(i)=(x7(i)-x2(i
184
185 n6x(i)=(y8(i)-y1(i))*(z4(i)-z5(i)) - (z8(i)-z1(i))*(y4(i)-y5
186 n6y(i)=(z8(i)-z1(i))*(x4(i)-x5(i)) - (x8(i)-x1(i))*(z4(i)-z5(i))
187 n6z(i)=(x8(i)-x1(i))*(y4(i)-y5(i)) - (y8(i)-y1(i))*(x4(i)-x5
188 ENDDO
189
190 DO i=lft,llt
191 wface(1,1,i) = fourth*(w(1,nc1(i))+w(1,nc2(i))+w(1,nc3(i))+w(1,nc4(i)))
192 wface(2,1,i) = fourth*(w(2,nc1(i))+w(2,nc2(i))+w(2,nc3(i))+w(2,nc4(i)))
193 wface(3,1,i) = fourth*(w(3,nc1(i))+w(3,nc2(i))+w(3,nc3(i))+w(3,nc4(i)))
194
195 wface(1,2,i) = fourth*(w(1,nc3(i))+w(1,nc4(i))+w(1,nc7(i))+w(1,nc8(i)))
196 wface(2,2,i) = fourth*(w(2,nc3(i))+w(2,nc4(i))+w(2,nc7(i))+w(2,nc8(i)))
197 wface(3,2,i) = fourth*(w(3,nc3(i))+w(3,nc4(i))+w(3,nc7(i))+w(3,nc8(i)))
198
199 wface(1,3,i) = fourth*(w(1,nc5(i))+w(1,nc6(i))+w(1,nc7(i))+w(1,nc8(i)))
200 wface(2,3,i) = fourth*(w(2,nc5(i))+w(2,nc6(i))+w(2,nc7(i))+w(
201 wface(3,3,i) = fourth*(w(3,nc5(i))+w(3,nc6(i))+w(3,nc7(i))+w(3,nc8(i)))
202
203 wface(1,4,i) = fourth*(w(1,nc1(i))+w(1,nc2(i))+w(1,nc5(i))+w(1,nc6(i)))
204 wface(2,4,i) = fourth*(w(2,nc1(i))+w(2,nc2(i))+w(2,nc5(i))+w(2,nc6(i)))
205 wface(3,4,i) = fourth*(w(3,nc1(i))+w(3,nc2(i))+w(3,nc5(i))+w(3,nc6(i)))
206
207 wface(1,5,i) = fourth*(w(1,nc2(i))+w(1,nc3(i))+w(1,nc6(i))+w(1,nc7(i)))
208 wface(2,5,i) = fourth*(w(2,nc2(i))+w(2,nc3(i))+w(2,nc6(i))+w(2,nc7(i)))
209 wface(3,5,i) = fourth*(w(3,nc2(i))+w(3,nc3(i))+w(3,nc6(i))+w(3,nc7(i)))
210
211 wface(1,6,i) = fourth*(w(1,nc1(i))+w
212 wface(2,6,i) = fourth*(w(2,nc1(i))+w(2,nc4(i))+w(2,nc5(i))+w(2,nc8(i)))
213 wface(3,6,i) = fourth*(w(3,nc1(i))+w(3,nc4(i))+w(3,nc5(i))+w(3,nc8(i)))
214 ENDDO
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245 ENDIF
246
247
248
249
251 wfextt = zero
252 DO i=lft,llt
253 ii = i + nft
254 iad2 = ale_connect%ee_connect%iad_connect(ii)
255
256 swn(1) = wface(1,1,i)*n1x(i) + wface(2,1,i)*n1y(i) + wface(3,1,i)*n1z(i)
257 swn(2) = wface(1,2,i)*n2x(i) + wface(2,2,i)*n2y(i) + wface(3,2,i)*n2z(i)
258 swn(3) = wface(1,3,i)*n3x(i) + wface(2,3,i)*n3y(i) + wface(3,3,i)*n3z(i)
259 swn(4) = wface(1,4,i)*n4x(i) + wface(2,4,i)*n4y(i) + wface(3,4,i)*n4z(i)
260 swn(5) = wface(1,5,i)*n5x(i) + wface(2,5,i)*n5y(i) + wface(3,5,i)*n5z(i)
261 swn(6) = wface(1,6,i)*n6x(i) + wface(2,6,i)*n6y(i) + wface(3,6,i)*n6z(i)
262 wfext_add = zero
263 Do j=1,nv46
264 iv = ale_connect%ee_connect%connected(iad2 + j - 1)
265
266 ix(1) = ixs(icf(1,j)+1,ii)
267 ix(2) = ixs(icf(2,j)+1,ii)
268 ix(3) = ixs(icf(3,j)+1,ii)
269 ix(4) = ixs(icf(4,j)+1,ii)
270 IF(sum(iabs(nale(ix(1:4))))==4)cycle
271
272 wfext_add = wfext_add - dt1*third*(sig(i,1)+sig(i,2)+sig(i,3))*swn
273 ENDDO
275 wfextt = wfextt + wfext_add
276 ENDDO
277
278#include "lockon.inc"
279 wfext = wfext + wfextt
280#include "lockoff.inc"
281
282
283
285 IF(wfextt /= zero)THEN
286
287 print *, " |----alefvm_tfext.F------|"
288 print *, " | THREAD INFORMATION |"
289 print *, " |------------------------|"
290 print *, " NCYCLE =", ncycle
291 do i=lft,llt
292 ii = nft + i
294 write(*,fmt='(A,I10,A,F30.16,A,F30.16,A,6F30.16)') " brique=", ixs(11,ii)," Wfext="
295 .
alefvm_buffer%WFEXT_CELL(ii),
"P(I)=", p(i),
"SWn(1:6)=",swn(1:6)
296 enddo
297 ENDIF
298
299 endif
300
301
302 RETURN
type(alefvm_buffer_), target alefvm_buffer
type(alefvm_param_), target alefvm_param