32
33
34
35#include "implicit_f.inc"
36
37
38
39 INTEGER N0,N1,N2,N3,NC, LLL(*),JLL(*),SLL(*),IADLL(*)
41 . x(3,*),xll(*),sk(9),l1(3),l2(3),l3(3),
alpha
42
43
44
45 INTEGER I,II,J,JJ,IK,IC,IAD,INOD(4)
47 . ux(3),uy(3),uz(3),vx(3),vy(3),vz(3),wx(3),wy(3),wz(3),
48 . rx(3),ry(3),rz(3),
49 . x0,y0,z0,x1,y1,z1,x2,y2,z2,x3,y3,z3,xs,ys,zs,
50 . x12,x22,x32,x42,y12,y22,y32,y42,z12,z22,z32,z42,
51 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
52 . lx,ly,lz,
norm,unt,deut,b1,b2,b3,c1,c2,c3,det
53
54
55
56
57
58
59
60
61
62
63
64
65 unt = third
66 deut= two_third
67
68 ux(1) = sk(1)*l1(1)+sk(4)*l1(2)+sk(7)*l1(3)
69 uy(1) = sk(2)*l1(1)+sk(5)*l1(2)+sk(8)*l1(3)
70 uz(1) = sk(3)*l1(1)+sk(6)*l1(2)+sk(9)*l1(3)
71 norm = one/sqrt(ux(1)*ux(1)+uy(1)*uy(1)+uz(1)*uz(1))
75 IF (abs(ux(1))>zep99) THEN
76 wx(1) =-uz(1)
77 wy(1) = zero
78 wz(1) = ux(1)
79 ELSE
80 wx(1) = zero
81 wy(1) =-uz(1)
82 wz(1) = uy(1)
83 ENDIF
84 norm = one/sqrt(wx(1)*wx(1)+wy(1)*wy(1)+wz(1)*wz(1))
88 vx(1) = wy(1)*uz(1)-wz(1)*uy(1)
89 vy(1) = wz(1)*ux(1)-wx(1)*uz(1)
90 vz(1) = wx(1)*uy(1)-wy(1)*ux(1)
91
92 ux(2) = sk(1)*l2(1)+sk(4)*l2(2)+sk(7)*l2(3)
93 uy(2) = sk(2)*l2(1)+sk(5)*l2(2)+sk(8)*l2(3)
94 uz(2) = sk(3)*l2(1)+sk(6)*l2(2)+sk(9)*l2(3)
95 norm = one/sqrt(ux(2)*ux(2)+uy(2)*uy(2)+uz(2)*uz(2))
99 IF (abs(ux(2))>zep99) THEN
100 wx(2) =-uz(2)
101 wy(2) = zero
102 wz(2) = ux(2)
103 ELSE
104 wx(2) = zero
105 wy(2) =-uz(2)
106 wz(2) = uy(2)
107 ENDIF
108 norm = one/sqrt(wx(1)*wx(1)+wy(1)*wy(1)+wz(1)*wz(1))
112 vx(2) = wy(2)*uz(2)-wz(2)*uy(2)
113 vy(2) = wz(2)*ux(2)-wx(2)*uz(2)
114 vz(2) = wx(2)*uy(2)-wy(2)*ux(2)
115
116 ux(3) = sk(1)*l3(1)+sk(4)*l3(2)+sk(7)*l3(3)
117 uy(3) = sk(2)*l3(1)+sk(5)*l3(2)+sk(8)*l3(3)
118 uz(3) = sk(3)*l3(1)+sk(6)*l3(2)+sk(9)*l3(3)
119 norm = one/sqrt(ux(3)*ux(3)+uy(3)*uy(3)+uz(3)*uz(3))
123 IF (abs(ux(3))>zep99) THEN
124 wx(3) =-uz(3)
125 wy(3) = zero
126 wz(3) = ux(3)
127 ELSE
128 wx(3) = zero
129 wy(3) =-uz(3)
130 wz(3) = uy(3)
131 ENDIF
132 norm = one/sqrt(wx(1)*wx(1)+wy(1)*wy(1)+wz(1)*wz(1))
136 vx(3) = wy(3)*uz(3)-wz(3)*uy(3)
137 vy(3) = wz(3)*ux(3)-wx(3)*uz(3)
138 vz(3) = wx(3)*uy(3)-wy(3)*ux(3)
139
140 x1=x(1,n1)
141 y1=x(2,n1)
142 z1=x(3,n1)
143 x2=x(1,n2)
144 y2=x(2,n2)
145 z2=x(3,n2)
146 x3=x(1,n3)
147 y3=x(2,n3)
148 z3=x(3,n3)
149 x0=(x1+x2+x3)*third
150 y0=(y1+y2+y3)*third
151 z0=(z1+z2+z3)*third
152
153 inod(1) = n1
154 inod(2) = n2
155 inod(3) = n3
156 inod(4) = n0
157
158 x1=x1-x0
159 y1=y1-y0
160 z1=z1-z0
161 x2=x2-x0
162 y2=y2-y0
163 z2=z2-z0
164 x3=x3-x0
165 y3=y3-y0
166 z3=z3-z0
167 xs=x(1,n0)-x0
168 ys=x(2,n0)-y0
169 zs=x(3,n0)-z0
170 rx(1) = x1
171 rx(2) = x2
172 rx(3) = x3
173 ry(1) = y1
174 ry(2) = y2
175 ry(3) = y3
176 rz(1) = z1
177 rz(2) = z2
178 rz(3) = z3
179
180 x12=x1*x1
181 x22=x2*x2
182 x32=x3*x3
183 y12=y1*y1
184 y22=y2*y2
185 y32=y3*y3
186 z12=z1*z1
187 z22=z2*z2
188 z32=z3*z3
189 xx=x12 + x22 + x32
190 yy=y12 + y22 + y32
191 zz=z12 + z22 + z32
192 xy=x1*y1 + x2*y2 + x3*y3
193 yz=y1*z1 + y2*z2 + y3*z3
194 zx=z1*x1 + z2*x2 + z3*x3
195 zzz=xx+yy
196 xxx=yy+zz
197 yyy=zz+xx
198 xy2=xy*xy
199 yz2=yz*yz
200 zx2=zx*zx
201 det=xxx*yyy*zzz - xxx*yz2 - yyy*zx2 - zzz*xy2 - 2.*xy*yz*zx
202 det=one/det
203 b1=zzz*yyy-yz2
204 b2=xxx*zzz-zx2
205 b3=yyy*xxx-xy2
206 c3=zzz*xy+yz*zx
207 c1=xxx*yz+zx*xy
208 c2=yyy*zx+xy*yz
209
210
211 nc = nc + 1
212 iadll(nc+1) = iadll(nc) + 10
213 iad = iadll(nc) -1
214 DO jj=1,3
215 ik = iad+jj
216 lll(ik) = inod(jj)
217 jll(ik) = 1
218 sll(ik) = 0
219 xll(ik) = fourth
220 . + det*zs*(b2*rz(jj) - c1*ry(jj))
221 . - det*ys*(c1*rz(jj) - b3*ry(jj))
222 ENDDO
223 iad = iad + 3
224 DO jj=1,3
225 ik = iad+jj
226 lll(ik) = inod(jj)
227 jll(ik) = 2
228 sll(ik) = 0
229 xll(ik) = det*zs*(c1*rx(jj) - c3*rz(jj))
230 . - det*ys*(b3*rx(jj) - c2*rz(jj))
231 ENDDO
232 iad = iad + 3
233 DO jj=1,3
234 ik = iad+jj
235 lll(ik) = inod(jj)
236 jll(ik) = 3
237 sll(ik) = 0
238 xll(ik) = det*zs*(c3*ry(jj) - b2*rx(jj))
239 . - det*ys*(c2*ry(jj) - c1*rx(jj))
240 ENDDO
241 ik = iad + 4
242 lll(ik) = inod(4)
243 jll(ik) = 1
244 sll(ik) = 0
245 xll(ik) = -1.0
246
247 nc = nc + 1
248 iadll(nc+1) = iadll(nc) + 10
249 iad = iadll(nc) -1
250 DO jj=1,3
251 ik = iad+jj
252 lll(ik) = inod(jj)
253 jll(ik) = 1
254 sll(ik) = 0
255 xll(ik) = det*xs*(c1*rz(jj) - b3*ry(jj))
256 . - det*zs*(c3*rz(jj) - c2*ry(jj))
257 ENDDO
258 iad = iad + 3
259 DO jj=1,3
260 ik = iad+jj
261 lll(ik) = inod(jj)
262 jll(ik) = 2
263 sll(ik) = 0
264 xll(ik) = fourth
265 . + det*xs*(b3*rx(jj) - c2*rz(jj))
266 . - det*zs*(c2*rx(jj) - b1*rz(jj))
267 ENDDO
268 iad = iad + 3
269 DO jj=1,3
270 ik = iad+jj
271 lll(ik) = inod(jj)
272 jll(ik) = 3
273 sll(ik) = 0
274 xll(ik) = det*xs*(c2*ry(jj) - c1*rx(jj))
275 . - det*zs*(b1*ry(jj) - c3*rx(jj))
276 ENDDO
277 ik = iad + 4
278 lll(ik) = inod(4)
279 jll(ik) = 2
280 sll(ik) = 0
281 xll(ik) = -one
282
283 nc = nc + 1
284 iadll(nc+1) = iadll(nc) + 10
285 iad = iadll(nc) -1
286 DO jj=1,3
287 ik = iad+jj
288 lll(ik) = inod(jj)
289 jll(ik) = 1
290 sll(ik) = 0
291 xll(ik) = det*ys*(c3*rz(jj) - c2*ry(jj))
292 . - det*xs*(b2*rz(jj) - c1*ry(jj))
293 ENDDO
294 iad = iad + 3
295 DO jj=1,3
296 ik = iad+jj
297 lll(ik) = inod(jj)
298 jll(ik) = 2
299 sll(ik) = 0
300 xll(ik) = det*ys*(c2*rx(jj) - b1*rz(jj))
301 . - det*xs*(c1*rx(jj) - c3*rz(jj))
302 ENDDO
303 iad = iad + 3
304 DO jj=1,3
305 ik = iad+jj
306 lll(ik) = inod(jj)
307 jll(ik) = 3
308 sll(ik) = 0
309 xll(ik) = fourth
310 . + det*ys*(b1*ry(jj) - c3*rx(jj))
311 . - det*xs*(c3*ry(jj) - b2*rx(jj))
312 ENDDO
313 ik = iad + 4
314 lll(ik) = inod(4)
315 jll(ik) = 3
316 sll(ik) = 0
3172 xll(ik) = -one
318
319
320
321 nc = nc + 1
322 iadll(nc+1) = iadll(nc) + 10
323 iad = iadll(nc) -1
324 DO jj=1,3
325 ik = iad+jj
326 lll(ik) = inod(jj)
327 jll(ik) = 1
328 sll(ik) = 0
329 xll(ik) = det*(c3*rz(jj) - c2*ry(jj))
330 ENDDO
331 iad = iad + 3
332 DO jj=1,3
333 ik = iad+jj
334 lll(ik) = inod(jj)
335 jll(ik) = 2
336 sll(ik) = 0
337 xll(ik) = det*(c2*rx(jj) - b1*rz(jj))
338 ENDDO
339 iad = iad + 3
340 DO jj=1,3
341 ik = iad+jj
342 lll(ik) = inod(jj)
343 jll(ik) = 3
344 sll(ik) = 0
345 xll(ik) = det*(b1*ry(jj) - c3*rx(jj))
346 ENDDO
347 ik = iad + 4
348 lll(ik) = inod(4)
349 jll(ik) = 4
350 sll(ik) = 0
351 xll(ik) = -1.0
352
353 nc = nc + 1
354 iadll(nc+1) = iadll(nc) + 10
355 iad = iadll(nc) -1
356 DO jj=1,3
357 ik = iad+jj
358 lll(ik) = inod(jj)
359 jll(ik) = 1
360 sll(ik) = 0
361 xll(ik) = det*(b2*rz(jj) - c1*ry(jj))
362 ENDDO
363 iad = iad + 3
364 DO jj=1,3
365 ik = iad+jj
366 lll(ik) = inod(jj)
367 jll(ik) = 2
368 sll(ik) = 0
369 xll(ik) = det*(c1*rx(jj) - c3*rz(jj))
370 ENDDO
371 iad = iad + 3
372 DO jj=1,3
373 ik = iad+jj
374 lll(ik) = inod(jj)
375 jll(ik) = 3
376 sll(ik) = 0
377 xll(ik) = det*(c3*ry(jj) - b2*rx(jj))
378 ENDDO
379 ik = iad + 4
380 lll(ik) = inod(4)
381 jll(ik) = 5
382 sll(ik) = 0
383 xll(ik) = -1.0
384
385 nc = nc + 1
386 iadll(nc+1) = iadll(nc) + 10
387 iad = iadll(nc) -1
388 DO jj=1,3
389 ik = iad+jj
390 lll(ik) = inod(jj)
391 jll(ik) = 1
392 sll(ik) = 0
393 xll(ik) = det*(c1*rz(jj) - b3*ry(jj))
394 ENDDO
395 iad = iad + 3
396 DO jj=1,3
397 ik = iad+jj
398 lll(ik) = inod(jj)
399 jll(ik) = 2
400 sll(ik) = 0
401 xll(ik) = det*(b3*rx(jj) - c2*rz(jj))
402 ENDDO
403 iad = iad + 3
404 DO jj=1,3
405 ik = iad+jj
406 lll(ik) = inod(jj)
407 jll(ik) = 3
408 sll(ik) = 0
409 xll(ik) = det*(c2*ry(jj) - c1*rx(jj))
410 ENDDO
411 ik = iad + 4
412 lll(ik) = inod(4)
413 jll(ik) = 6
414 sll(ik) = 0
415 xll(ik) = -one
416
417
418
419
420 inod(4) = n0
421
422 nc = nc + 1
423 iadll(nc+1) = iadll(nc) + 12
424 ik = iadll(nc)
425 lll(ik) = n1
426 jll(ik) = 4
427 sll(ik) = 0
428 xll(ik) =
alpha*ux(1)
429 ik = ik+1
430 lll(ik) = n1
431 jll(ik) = 5
432 sll(ik) = 0
433 xll(ik) =
alpha*uy(1)
434 ik = ik+1
435 lll(ik) = n1
436 jll(ik) = 6
437 sll(ik) = 0
438 xll(ik) =
alpha*uz(1)
439 DO i=2,3
440 ik = ik+1
441 lll(ik) = inod(i)
442 jll(ik) = 4
443 sll(ik) = 0
444 xll(ik) = ux(i)
445 ik = ik+1
446 lll(ik) = inod(i)
447 jll(ik) = 5
448 sll(ik) = 0
449 xll(ik) = uy(i)
450 ik = ik+1
451 lll(ik) = inod(i)
452 jll(ik) = 6
453 sll(ik) = 0
454 xll(ik) = uz(i)
455 ENDDO
456 ik = ik+1
457 lll(ik) = n0
458 jll(ik) = 4
459 sll(ik) = 0
460 xll(ik) =-
alpha*ux(1)-ux(2)-ux(3)
461 ik = ik+1
462 lll(ik) = n0
463 jll(ik) = 5
464 sll(ik) = 0
465 xll(ik) =-
alpha*uy(1)-uy(2)-uy(3)
466 ik = ik+1
467 lll(ik) = n0
468 jll(ik) = 6
469 sll(ik) = 0
470 xll(ik) =-
alpha*uz(1)-uz(2)-uz(3)
471
472
473 DO i=1,3
474 nc = nc + 1
475 iadll(nc+1) = iadll(nc) + 6
476 ik = iadll(nc)
477 lll(ik) = inod(i)
478 jll(ik) = 4
479 sll(ik) = 0
480 xll(ik) = vx(i)
481 ik = ik+1
482 lll(ik) = inod(i)
483 jll(ik) = 5
484 sll(ik) = 0
485 xll(ik) = vy(i)
486 ik = ik+1
487 lll(ik) = inod(i)
488 jll(ik) = 6
489 sll(ik) = 0
490 xll(ik) = vz(i)
491 ik = ik+1
492 lll(ik) = n0
493 jll(ik) = 4
494 sll(ik) = 0
495 xll(ik) =-vx(i)
496 ik = ik+1
497 lll(ik) = n0
498 jll(ik) = 5
499 sll(ik) = 0
500 xll(ik) =-vy(i)
501 ik = ik+1
502 lll(ik) = n0
503 jll(ik) = 6
504 sll(ik) = 0
505 xll(ik) =-vz(i)
506 ENDDO
507
508
509 DO i=1,3
510 nc = nc + 1
511 iadll(nc+1) = iadll(nc) + 6
512 ik = iadll(nc)
513 lll(ik) = inod(i)
514 jll(ik) = 4
515 sll(ik) = 0
516 xll(ik) = wx(i)
517 ik = ik+1
518 lll(ik) = inod(i)
519 jll(ik) = 5
520 sll(ik) = 0
521 xll(ik) = wy(i)
522 ik = ik+1
523 lll(ik) = inod(i)
524 jll(ik) = 6
525 sll(ik) = 0
526 xll(ik) = wz(i)
527 ik = ik+1
528 lll(ik) = n0
529 jll(ik) = 4
530 sll(ik) = 0
531 xll(ik) =-wx(i)
532 ik = ik+1
533 lll(ik) = n0
534 jll(ik) = 5
535 sll(ik) = 0
536 xll(ik) =-wy(i)
537 ik = ik+1
538 lll(ik) = n0
539 jll(ik) = 6
540 sll(ik) = 0
541 xll(ik) =-wz(i)
542 ENDDO
543
544 RETURN
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB