OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2vit3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i2vit3n ../engine/source/interfaces/interf/i2vit3.F
25!||--- called by ------------------------------------------------------
26!|| intti2v ../engine/source/interfaces/interf/intti2v.F
27!||====================================================================
28 SUBROUTINE i2vit3n(
29 1 NSN , NMN , A , IRECT, CRST,
30 2 MSR , NSV , IRTL, V , MS ,
31 3 WEIGHT, MMASS )
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C D u m m y A r g u m e n t s
38C-----------------------------------------------
39 INTEGER NSN, NMN,
40 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*)
41C REAL
42 my_real
43 . a(*), crst(2,*), v(*),ms(*), mmass(*)
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER NIR, I, J, I3, J3, I2, J2, I1, J1, II, L, JJ
52C REAL
53 my_real
54 . h(4), ss, tt, amx, amy, amz, vmx, vmy, vmz,sp,sm,tp,tm
55C-----------------------------------------------
56 nir=2
57 IF(n2d==0)nir=4
58C
59 DO ii=1,nsn
60 i=nsv(ii)
61 IF(i>0)THEN
62 l=irtl(ii)
63C
64 ss=crst(1,ii)
65 tt=crst(2,ii)
66 sp=one + ss
67 sm=one - ss
68 tp=fourth*(one + tt)
69 tm=fourth*(one - tt)
70 h(1)=tm*sm
71 h(2)=tm*sp
72 h(3)=tp*sp
73 h(4)=tp*sm
74 i3=3*i
75 i2=i3-1
76 i1=i2-1
77 amx=zero
78 amy=zero
79 amz=zero
80 vmx=zero
81 vmy=zero
82 vmz=zero
83C
84 DO jj=1,nir
85 j=irect(jj,l)
86 j3=3*j
87 j2=j3-1
88 j1=j2-1
89 amx=amx+a(j1)*h(jj)
90 amy=amy+a(j2)*h(jj)
91 amz=amz+a(j3)*h(jj)
92 vmx=vmx+v(j1)*h(jj)
93 vmy=vmy+v(j2)*h(jj)
94 vmz=vmz+v(j3)*h(jj)
95 ENDDO
96 a(i1)=amx
97 a(i2)=amy
98 a(i3)=amz
99 v(i1)=vmx
100 v(i2)=vmy
101 v(i3)=vmz
102 ENDIF
103C
104 ENDDO
105C-----------
106 RETURN
107 END
108C | INTTI12V /interf/intti12.F
109!||====================================================================
110!|| i2vit3 ../engine/source/interfaces/interf/i2vit3.F
111!||--- called by ------------------------------------------------------
112!|| intti2v ../engine/source/interfaces/interf/intti2v.F
113!||====================================================================
114 SUBROUTINE i2vit3(
115 1 NSN , NMN , A , IRECT, CRST,
116 2 MSR , NSV , IRTL, V , MS ,
117 3 WEIGHT, MMASS )
118C-----------------------------------------------
119C I m p l i c i t T y p e s
120C-----------------------------------------------
121#include "implicit_f.inc"
122C-----------------------------------------------
123C D u m m y A r g u m e n t s
124C-----------------------------------------------
125 INTEGER NSN, NMN,
126 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*)
127C REAL
128 my_real
129 . A(*), CRST(2,*), V(*),MS(*), MMASS(*)
130C-----------------------------------------------
131C C o m m o n B l o c k s
132C-----------------------------------------------
133#include "com01_c.inc"
134C-----------------------------------------------
135C L o c a l V a r i a b l e s
136C-----------------------------------------------
137 INTEGER NIR, I, J, I3, J3, I2, J2, I1, J1, II, L, JJ
138C REAL
139 my_real
140 . H(4), SS, TT, AMX, AMY, AMZ, VMX, VMY, VMZ,SP,SM,TP,TM
141C-----------------------------------------------
142 NIR=2
143 IF(n2d==0)nir=4
144C
145 DO 70 ii=1,nsn
146 i=nsv(ii)
147 IF(i>0)THEN
148 l=irtl(ii)
149C
150 ss=crst(1,ii)
151 tt=crst(2,ii)
152 sp=one + ss
153 sm=one - ss
154 tp=fourth*(one + tt)
155 tm=fourth*(one - tt)
156 h(1)=tm*sm
157 h(2)=tm*sp
158 h(3)=tp*sp
159 h(4)=tp*sm
160 i3=3*i
161 i2=i3-1
162 i1=i2-1
163 amx=zero
164 amy=zero
165 amz=zero
166 vmx=zero
167 vmy=zero
168 vmz=zero
169C XMSI=MS(I)*WEIGHT(I)
170C
171 DO jj=1,nir
172C J3=3*MSR(IRECT(JJ,L))
173 j=irect(jj,l)
174 j3=3*j
175 j2=j3-1
176 j1=j2-1
177 amx=amx+a(j1)*h(jj)
178 amy=amy+a(j2)*h(jj)
179 amz=amz+a(j3)*h(jj)
180 vmx=vmx+v(j1)*h(jj)
181 vmy=vmy+v(j2)*h(jj)
182 vmz=vmz+v(j3)*h(jj)
183CFP (RESET MASSE MAIN)
184C MS(J)=MS(J)-XMSI*H(JJ)
185 ENDDO
186 a(i1)=amx
187 a(i2)=amy
188 a(i3)=amz
189 v(i1)=vmx
190 v(i2)=vmy
191 v(i3)=vmz
192 ENDIF
193C
194 70 CONTINUE
195C
196C initial mass restitution on main nodes
197 DO ii=1,nmn
198 j=msr(ii)
199 ms(j)=mmass(ii)
200 ENDDO
201C
202 RETURN
203 END
204!||====================================================================
205!|| i2rot3 ../engine/source/interfaces/interf/i2vit3.F
206!||--- called by ------------------------------------------------------
207!|| intti2v ../engine/source/interfaces/interf/intti2v.F
208!||====================================================================
209 SUBROUTINE i2rot3(NSN,NMN,AR ,IRECT,CRST,MSR ,
210 2 NSV,IRTL,VR ,IN ,A ,V ,X )
211C-----------------------------------------------
212C I m p l i c i t T y p e s
213C-----------------------------------------------
214#include "implicit_f.inc"
215C-----------------------------------------------
216C C o m m o n B l o c k s
217C-----------------------------------------------
218#include "com01_c.inc"
219C-----------------------------------------------
220C D u m m y A r g u m e n t s
221C-----------------------------------------------
222 INTEGER NSN, NMN,
223 . IRECT(4,*), MSR(*), NSV(*), IRTL(*)
224C REAL
225 my_real
226 . AR(3,*), CRST(2,*), VR(3,*),
227 . IN(*), A(3,*), V(3,*), X(3,*)
228C-----------------------------------------------
229C L o c a l V a r i a b l e s
230C-----------------------------------------------
231 INTEGER I, J, II, L, JJ,
232 . nir
233 my_real
234 . h(4), ss, tt, amx, amy, amz, vmx, vmy, vmz,
235 .
236 . xc0,yc0,zc0,sp,sm,tp,tm,
237 . vmxx,vmyy,vmzz
238C-----------------------------------------------
239C
240 nir=2
241 IF(n2d==0)nir=4
242C
243 DO 70 ii=1,nsn
244 i=nsv(ii)
245 IF(i>0)THEN
246 l=irtl(ii)
247C
248 ss=crst(1,ii)
249 tt=crst(2,ii)
250 sp=one + ss
251 sm=one - ss
252 tp=fourth*(one + tt)
253 tm=fourth*(one - tt)
254 h(1)=tm*sm
255 h(2)=tm*sp
256 h(3)=tp*sp
257 h(4)=tp*sm
258C
259 xc0 = x(1,i)
260 yc0 = x(2,i)
261 zc0 = x(3,i)
262C
263 amx=zero
264 amy=zero
265 amz=zero
266 vmx=zero
267 vmy=zero
268 vmz=zero
269C
270 DO jj=1,nir
271C J=MSR(IRECT(JJ,L))
272 j=irect(jj,l)
273 amx=amx+ar(1,j)*h(jj)
274 amy=amy+ar(2,j)*h(jj)
275 amz=amz+ar(3,j)*h(jj)
276 vmx=vmx+vr(1,j)*h(jj)
277 vmy=vmy+vr(2,j)*h(jj)
278 vmz=vmz+vr(3,j)*h(jj)
279 xc0=xc0 - x(1,j) * h(jj)
280 yc0=yc0 - x(2,j) * h(jj)
281 zc0=zc0 - x(3,j) * h(jj)
282 ENDDO
283C
284 ar(1,i)=amx
285 ar(2,i)=amy
286 ar(3,i)=amz
287 vr(1,i)=vmx
288 vr(2,i)=vmy
289 vr(3,i)=vmz
290C
291 vmxx = vmy*zc0 - vmz*yc0
292 vmyy = vmz*xc0 - vmx*zc0
293 vmzz = vmx*yc0 - vmy*xc0
294C
295 a(1,i)= a(1,i) + amy*zc0 -amz*yc0 +half*(vmy*vmzz-vmz*vmyy)
296 a(2,i)= a(2,i) + amz*xc0 -amx*zc0 +half*(vmz*vmxx-vmx*vmzz)
297 a(3,i)= a(3,i) + amx*yc0 -amy*xc0 +half*(vmx*vmyy-vmy*vmxx)
298 v(1,i)= v(1,i) + vmxx
299 v(2,i)= v(2,i) + vmyy
300 v(3,i)= v(3,i) + vmzz
301C
302 ENDIF
303C
304 70 CONTINUE
305 RETURN
306 END
307C=======================================================================
308!||====================================================================
309!|| i2virot3 ../engine/source/interfaces/interf/i2vit3.F
310!||--- called by ------------------------------------------------------
311!|| i2vit28 ../engine/source/interfaces/interf/i2vit28.F
312!|| intti2v ../engine/source/interfaces/interf/intti2v.F
313!||====================================================================
314 SUBROUTINE i2virot3(NSN,NMN,A ,IRECT,DPARA,MSR ,
315 2 NSV,IRTL,V ,MS ,AR ,VR ,
316 3 X ,WEIGHT )
317C-----------------------------------------------
318C I m p l i c i t T y p e s
319C-----------------------------------------------
320#include "implicit_f.inc"
321C-----------------------------------------------
322C D u m m y A r g u m e n t s
323C-----------------------------------------------
324 INTEGER NSN, NMN,
325 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*)
326C REAL
327 my_real
328 . A(3,*), DPARA(7,*), V(3,*),
329 . MS(*),VR(3,*),AR(3,*),X(3,*)
330C-----------------------------------------------
331C C o m m o n B l o c k s
332C-----------------------------------------------
333#include "com01_c.inc"
334C-----------------------------------------------
335C L o c a l V a r i a b l e s
336C-----------------------------------------------
337 INTEGER NIR, I, J1, J2, J3, J4, II, L
338C REAL
339 my_real
340 . AMX, AMY, AMZ, VMX, VMY, VMZ,
341 . MRX,MRY,MRZ,MGX,MGY,MGZ,DET,ARX,ARY,ARZ,
342 . X0,X1,X2,X3,X4,XS,Y0,Y1,Y2,Y3,Y4,YS,Z0,Z1,Z2,Z3,Z4,ZS,
343 . ZZXYZ222,
344 . VRX,VRY,VRZ,B1,B2,B3,C1,C2,C3
345C-----------------------------------------------
346 nir=2
347 IF(n2d==0)nir=4
348CFP (RESET MASSE MAIN)
349C DO II=1,NSN
350C I=NSV(II)
351C L=IRTL(II)
352C SS=CRST(1,II)
353C TT=CRST(2,II)
354C SP=1.0+SS
355C SM=1.0-SS
356C TP=.25*(1.0+TT)
357C TM=.25*(1.0-TT)
358C H(1)=TM*SM
359C H(2)=TM*SP
360C H(3)=TP*SP
361C H(4)=TP*SM
362C I1=3*I-2
363C XMSI=MS(I)*WEIGHT(I)
364C DO JJ=1,NIR
365C J=IRECT(JJ,L)
366C MS(J)=MS(J)-XMSI*H(JJ)
367C ENDDO
368C ENDDO
369C------------------------------------
370C velocities of secondary nodes
371C------------------------------------
372 DO ii=1,nsn
373 i=nsv(ii)
374 IF(i>0)THEN
375 l=irtl(ii)
376C J1=MSR(IRECT(1,L))
377C J2=MSR(IRECT(2,L))
378C J3=MSR(IRECT(3,L))
379C J4=MSR(IRECT(4,L))
380 j1=irect(1,l)
381 j2=irect(2,l)
382 j3=irect(3,l)
383 j4=irect(4,l)
384C----------------------------------------
385C VELOCITY MOYENNE DU SEGMENT MAIN
386C----------------------------------------
387 vmx=fourth*(v(1,j1)+v(1,j2)+v(1,j3)+v(1,j4))
388 vmy=fourth*(v(2,j1)+v(2,j2)+v(2,j3)+v(2,j4))
389 vmz=fourth*(v(3,j1)+v(3,j2)+v(3,j3)+v(3,j4))
390 amx=fourth*(a(1,j1)+a(1,j2)+a(1,j3)+a(1,j4))
391 amy=fourth*(a(2,j1)+a(2,j2)+a(2,j3)+a(2,j4))
392 amz=fourth*(a(3,j1)+a(3,j2)+a(3,j3)+a(3,j4))
393C----------------------------------------------------
394C average rotation velocity of the main segment
395C----------------------------------------------------
396 x1=x(1,j1)
397 y1=x(2,j1)
398 z1=x(3,j1)
399 x2=x(1,j2)
400 y2=x(2,j2)
401 z2=x(3,j2)
402 x3=x(1,j3)
403 y3=x(2,j3)
404 z3=x(3,j3)
405 x4=x(1,j4)
406 y4=x(2,j4)
407 z4=x(3,j4)
408 x0=fourth*(x1+x2+x3+x4)
409 y0=fourth*(y1+y2+y3+y4)
410 z0=fourth*(z1+z2+z3+z4)
411 x1=x1-x0
412 y1=y1-y0
413 z1=z1-z0
414 x2=x2-x0
415 y2=y2-y0
416 z2=z2-z0
417 x3=x3-x0
418 y3=y3-y0
419 z3=z3-z0
420 x4=x4-x0
421 y4=y4-y0
422 z4=z4-z0
423 xs=x(1,i)-x0
424 ys=x(2,i)-y0
425 zs=x(3,i)-z0
426C
427C X12=X1*X1
428C X22=X2*X2
429C X32=X3*X3
430C X42=X4*X4
431C Y12=Y1*Y1
432C Y22=Y2*Y2
433C Y32=Y3*Y3
434C Y42=Y4*Y4
435C Z12=Z1*Z1
436C Z22=Z2*Z2
437C Z32=Z3*Z3
438C Z42=Z4*Z4
439C XX=X12 + X22 + X32 + X42
440C YY=Y12 + Y22 + Y32 + Y42
441C ZZ=Z12 + Z22 + Z32 + Z42
442C XY=X1*Y1 + X2*Y2 + X3*Y3 + X4*Y4
443C YZ=Y1*Z1 + Y2*Z2 + Y3*Z3 + Y4*Z4
444C ZX=Z1*X1 + Z2*X2 + Z3*X3 + Z4*X4
445C ZZZ=XX+YY
446C XXX=YY+ZZ
447C YYY=ZZ+XX
448C XY2=XY*XY
449C YZ2=YZ*YZ
450C ZX2=ZX*ZX
451C DET= XXX*YYY*ZZZ - XXX*YZ2 - YYY*ZX2 - ZZZ*XY2 - 2.*XY*YZ*ZX
452C DET=1./DET
453C B1=ZZZ*YYY-YZ2
454C B2=XXX*ZZZ-ZX2
455C B3=YYY*XXX-XY2
456C C3=ZZZ*XY+YZ*ZX
457C C1=XXX*YZ+ZX*XY
458C C2=YYY*ZX+XY*YZ
459C
460C
461 det= dpara(1,ii)
462 b1=dpara(2,ii)
463 b2=dpara(3,ii)
464 b3=dpara(4,ii)
465 c1=dpara(5,ii)
466 c2=dpara(6,ii)
467 c3=dpara(7,ii)
468C
469 mgx = y1*v(3,j1) + y2*v(3,j2) + y3*v(3,j3) + y4*v(3,j4)
470 . - z1*v(2,j1) - z2*v(2,j2) - z3*v(2,j3) - z4*v(2,j4)
471 mgy = z1*v(1,j1) + z2*v(1,j2) + z3*v(1,j3) + z4*v(1,j4)
472 . - x1*v(3,j1) - x2*v(3,j2) - x3*v(3,j3) - x4*v(3,j4)
473 mgz = x1*v(2,j1) + x2*v(2,j2) + x3*v(2,j3) + x4*v(2,j4)
474 . - y1*v(1,j1) - y2*v(1,j2) - y3*v(1,j3) - y4*v(1,j4)
475C
476 mrx = y1*a(3,j1) + y2*a(3,j2) + y3*a(3,j3) + y4*a(3,j4)
477 . - z1*a(2,j1) - z2*a(2,j2) - z3*a(2,j3) - z4*a(2,j4)
478 mry = z1*a(1,j1) + z2*a(1,j2) + z3*a(1,j3) + z4*a(1,j4)
479 . - x1*a(3,j1) - x2*a(3,j2) - x3*a(3,j3) - x4*a(3,j4)
480 mrz = x1*a(2,j1) + x2*a(2,j2) + x3*a(2,j3) + x4*a(2,j4)
481 . - y1*a(1,j1) - y2*a(1,j2) - y3*a(1,j3) - y4*a(1,j4)
482C
483
484 vrx=det*(mgx*b1+mgy*c3+mgz*c2)
485 vry=det*(mgy*b2+mgz*c1+mgx*c3)
486 vrz=det*(mgz*b3+mgx*c2+mgy*c1)
487 arx=det*(mrx*b1+mry*c3+mrz*c2)
488 ary=det*(mry*b2+mrz*c1+mrx*c3)
489 arz=det*(mrz*b3+mrx*c2+mry*c1)
490C
491C----------------------------------------------------
492C rotation velocity of the secondary node
493C----------------------------------------------------
494 IF (iroddl == 1) THEN
495 vr(1,i)=vrx
496 vr(2,i)=vry
497 vr(3,i)=vrz
498 ar(1,i)=arx
499 ar(2,i)=ary
500 ar(3,i)=arz
501 ENDIF
502C----------------------------------------------------
503C velocity of the secondary node
504C----------------------------------------------------
505 v(1,i)=vmx + vry*zs - vrz*ys
506 v(2,i)=vmy + vrz*xs - vrx*zs
507 v(3,i)=vmz + vrx*ys - vry*xs
508 a(1,i)=amx + ary*zs - arz*ys
509 a(2,i)=amy + arz*xs - arx*zs
510 a(3,i)=amz + arx*ys - ary*xs
511 ENDIF
512 ENDDO
513C
514 RETURN
515 END
516!||====================================================================
517!|| i2rot3_27 ../engine/source/interfaces/interf/i2vit3.F
518!||--- called by ------------------------------------------------------
519!|| i2vit27 ../engine/source/interfaces/interf/i2vit27.F
520!||====================================================================
521 SUBROUTINE i2rot3_27(NSN,NMN,AR ,IRECT,CRST,MSR ,
522 2 NSV,IRTL,VR ,IN ,A ,V ,X,
523 3 SINER,DPARA,MSEGTYP2)
524C-----------------------------------------------
525C I m p l i c i t T y p e s
526C-----------------------------------------------
527#include "implicit_f.inc"
528C-----------------------------------------------
529C D u m m y A r g u m e n t s
530C-----------------------------------------------
531 INTEGER NSN, NMN,
532 . irect(4,*), msr(*), nsv(*), irtl(*),msegtyp2(*)
533C REAL
534 my_real
535 . ar(3,*), crst(2,*), vr(3,*),
536 . in(*), a(3,*), v(3,*), x(3,*), siner(*),dpara(7,*)
537C-----------------------------------------------
538C C o m m o n B l o c k s
539C-----------------------------------------------
540#include "com01_c.inc"
541C-----------------------------------------------
542C L o c a l V a r i a b l e s
543C-----------------------------------------------
544 INTEGER I, J, J3, J2, J1, II, L, JJ,
545 . j4
546 my_real
547 . h(4), ss, tt, amx, amy, amz, vmx, vmy, vmz,
548 . x0,x1,x2,x3,x4,y0,y1,y2,y3,y4,z0,z1,z2,z3,z4,
549 . xc0,yc0,zc0,sp,sm,tp,tm,
550 . mgx,mgy,mgz,mrx,mry,mrz,vmxx,vmyy,vmzz,
551 . det,c1,c2,c3,b1,b2,b3
552C
553C-----------------------------------------------
554C
555C
556 DO 70 ii=1,nsn
557 i=nsv(ii)
558C
559 IF(i>0)THEN
560 l=irtl(ii)
561C
562 ss=crst(1,ii)
563 tt=crst(2,ii)
564
565 IF (irect(3,l) == irect(4,l)) THEN
566C-- Shape functions of triangles
567 h(1) = ss
568 h(2) = tt
569 h(3) = one-ss-tt
570 h(4) = zero
571 ELSE
572C-- Shape functions of quadrangles
573 sp = one + ss
574 sm = one - ss
575 tp = fourth*(one + tt)
576 tm = fourth*(one - tt)
577C
578 h(1)=tm*sm
579 h(2)=tm*sp
580 h(3)=tp*sp
581 h(4)=tp*sm
582 ENDIF
583C
584 xc0 = x(1,i)
585 yc0 = x(2,i)
586 zc0 = x(3,i)
587C
588 DO jj=1,4
589 j=irect(jj,l)
590 xc0=xc0 - x(1,j) * h(jj)
591 yc0=yc0 - x(2,j) * h(jj)
592 zc0=zc0 - x(3,j) * h(jj)
593 ENDDO
594C
595 j1=irect(1,l)
596 j2=irect(2,l)
597 j3=irect(3,l)
598 j4=irect(4,l)
599C
600 IF (msegtyp2(l)==0) THEN
601C
602C--------------------------------------------C
603C--- solid / solid connection ---------------C
604C--------------------------------------------C
605C
606 x1=x(1,j1)
607 y1=x(2,j1)
608 z1=x(3,j1)
609 x2=x(1,j2)
610 y2=x(2,j2)
611 z2=x(3,j2)
612 x3=x(1,j3)
613 y3=x(2,j3)
614 z3=x(3,j3)
615 x4=x(1,j4)
616 y4=x(2,j4)
617 z4=x(3,j4)
618C
619 IF (j3 == j4) THEN
620 x0=third*(x1+x2+x3)
621 y0=third*(y1+y2+y3)
622 z0=third*(z1+z2+z3)
623 ELSE
624 x0=fourth*(x1+x2+x3+x4)
625 y0=fourth*(y1+y2+y3+y4)
626 z0=fourth*(z1+z2+z3+z4)
627 ENDIF
628C
629 x1=x1-x0
630 y1=y1-y0
631 z1=z1-z0
632 x2=x2-x0
633 y2=y2-y0
634 z2=z2-z0
635 x3=x3-x0
636 y3=y3-y0
637 z3=z3-z0
638 x4=x4-x0
639 y4=y4-y0
640 z4=z4-z0
641C
642 IF (j3 == j4) THEN
643 x4 = zero
644 y4 = zero
645 z4 = zero
646 ENDIF
647C
648 det=dpara(1,ii)
649 b1=dpara(2,ii)
650 b2=dpara(3,ii)
651 b3=dpara(4,ii)
652 c1=dpara(5,ii)
653 c2=dpara(6,ii)
654 c3=dpara(7,ii)
655C
656 mgx = y1*v(3,j1) + y2*v(3,j2) + y3*v(3,j3) + y4*v(3,j4)
657 . - z1*v(2,j1) - z2*v(2,j2) - z3*v(2,j3) - z4*v(2,j4)
658 mgy = z1*v(1,j1) + z2*v(1,j2) + z3*v(1,j3) + z4*v(1,j4)
659 . - x1*v(3,j1) - x2*v(3,j2) - x3*v(3,j3) - x4*v(3,j4)
660 mgz = x1*v(2,j1) + x2*v(2,j2) + x3*v(2,j3) + x4*v(2,j4)
661 . - y1*v(1,j1) - y2*v(1,j2) - y3*v(1,j3) - y4*v(1,j4)
662C
663 mrx = y1*a(3,j1) + y2*a(3,j2) + y3*a(3,j3) + y4*a(3,j4)
664 . - z1*a(2,j1) - z2*a(2,j2) - z3*a(2,j3) - z4*a(2,j4)
665 mry = z1*a(1,j1) + z2*a(1,j2) + z3*a(1,j3) + z4*a(1,j4)
666 . - x1*a(3,j1) - x2*a(3,j2) - x3*a(3,j3) - x4*a(3,j4)
667 mrz = x1*a(2,j1) + x2*a(2,j2) + x3*a(2,j3) + x4*a(2,j4)
668 . - y1*a(1,j1) - y2*a(1,j2) - y3*a(1,j3) - y4*a(1,j4)
669C
670 vmx=det*(mgx*b1+mgy*c3+mgz*c2)
671 vmy=det*(mgy*b2+mgz*c1+mgx*c3)
672 vmz=det*(mgz*b3+mgx*c2+mgy*c1)
673 amx=det*(mrx*b1+mry*c3+mrz*c2)
674 amy=det*(mry*b2+mrz*c1+mrx*c3)
675 amz=det*(mrz*b3+mrx*c2+mry*c1)
676C
677 ELSE
678C--------------------------------------------------C
679C--- shell / shell - shell / solide --------------C
680C--------------------------------------------------C
681C
682 amx=zero
683 amy=zero
684 amz=zero
685 vmx=zero
686 vmy=zero
687 vmz=zero
688C
689 DO jj=1,4
690 j=irect(jj,l)
691 amx=amx+ar(1,j)*h(jj)
692 amy=amy+ar(2,j)*h(jj)
693 amz=amz+ar(3,j)*h(jj)
694 vmx=vmx+vr(1,j)*h(jj)
695 vmy=vmy+vr(2,j)*h(jj)
696 vmz=vmz+vr(3,j)*h(jj)
697 ENDDO
698C
699 ENDIF
700C
701 IF (iroddl==1) THEN
702 ar(1,i)=amx
703 ar(2,i)=amy
704 ar(3,i)=amz
705 vr(1,i)=vmx
706 vr(2,i)=vmy
707 vr(3,i)=vmz
708 ENDIF
709C
710 vmxx = vmy*zc0 - vmz*yc0
711 vmyy = vmz*xc0 - vmx*zc0
712 vmzz = vmx*yc0 - vmy*xc0
713C
714 a(1,i)= a(1,i) + amy*zc0 -amz*yc0 +half*(vmy*vmzz-vmz*vmyy)
715 a(2,i)= a(2,i) + amz*xc0 -amx*zc0 +half*(vmz*vmxx-vmx*vmzz)
716 a(3,i)= a(3,i) + amx*yc0 -amy*xc0 +half*(vmx*vmyy-vmy*vmxx)
717 v(1,i)= v(1,i) + vmxx
718 v(2,i)= v(2,i) + vmyy
719 v(3,i)= v(3,i) + vmzz
720C
721 ENDIF
722C
723 70 CONTINUE
724 RETURN
725 END
726!||====================================================================
727!|| i2vit3_27 ../engine/source/interfaces/interf/i2vit3.F
728!||--- called by ------------------------------------------------------
729!|| i2vit27 ../engine/source/interfaces/interf/i2vit27.F
730!||====================================================================
731 SUBROUTINE i2vit3_27(
732 1 NSN , NMN , A , IRECT, CRST,
733 2 MSR , NSV , IRTL, V , MS ,
734 3 WEIGHT, MMASS )
735C-----------------------------------------------
736C I m p l i c i t T y p e s
737C-----------------------------------------------
738#include "implicit_f.inc"
739C-----------------------------------------------
740C D u m m y A r g u m e n t s
741C-----------------------------------------------
742 INTEGER NSN, NMN,
743 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*)
744C REAL
745 my_real
746 . a(*), crst(2,*), v(*),ms(*), mmass(*)
747C-----------------------------------------------
748C C o m m o n B l o c k s
749C-----------------------------------------------
750#include "com01_c.inc"
751C-----------------------------------------------
752C L o c a l V a r i a b l e s
753C-----------------------------------------------
754 INTEGER NIR, I, J, I3, J3, I2, J2, I1, J1, II, L, JJ
755C REAL
756 my_real
757 . h(4), ss, tt, amx, amy, amz, vmx, vmy, vmz,sp,sm,tp,tm
758C-----------------------------------------------
759 nir=2
760 IF(n2d==0)nir=4
761C
762 DO ii=1,nsn
763 i=nsv(ii)
764 IF(i>0)THEN
765 l=irtl(ii)
766C
767 ss=crst(1,ii)
768 tt=crst(2,ii)
769
770 IF (irect(3,l) == irect(4,l)) THEN
771C-- Shape functions of triangles
772 h(1) = ss
773 h(2) = tt
774 h(3) = one-ss-tt
775 h(4) = zero
776 ELSE
777C-- Shape functions of quadrangles
778 sp = one + ss
779 sm = one - ss
780 tp = fourth*(one + tt)
781 tm = fourth*(one - tt)
782C
783 h(1)=tm*sm
784 h(2)=tm*sp
785 h(3)=tp*sp
786 h(4)=tp*sm
787 ENDIF
788C
789 i3=3*i
790 i2=i3-1
791 i1=i2-1
792 amx=zero
793 amy=zero
794 amz=zero
795 vmx=zero
796 vmy=zero
797 vmz=zero
798C
799 DO jj=1,nir
800 j=irect(jj,l)
801 j3=3*j
802 j2=j3-1
803 j1=j2-1
804 amx=amx+a(j1)*h(jj)
805 amy=amy+a(j2)*h(jj)
806 amz=amz+a(j3)*h(jj)
807 vmx=vmx+v(j1)*h(jj)
808 vmy=vmy+v(j2)*h(jj)
809 vmz=vmz+v(j3)*h(jj)
810 ENDDO
811 a(i1)=amx
812 a(i2)=amy
813 a(i3)=amz
814 v(i1)=vmx
815 v(i2)=vmy
816 v(i3)=vmz
817 ENDIF
818C
819 ENDDO
820C-----------
821 RETURN
822 END
my_real
#define my_real
Definition cppsort.cpp:32
i2vit3
subroutine i2vit3(nsn, nmn, a, irect, crst, msr, nsv, irtl, v, ms, weight, mmass)
Definition i2vit3.F:118
i2vit3_27
subroutine i2vit3_27(nsn, nmn, a, irect, crst, msr, nsv, irtl, v, ms, weight, mmass)
Definition i2vit3.F:735
i2rot3_27
subroutine i2rot3_27(nsn, nmn, ar, irect, crst, msr, nsv, irtl, vr, in, a, v, x, siner, dpara, msegtyp2)
Definition i2vit3.F:524
i2virot3
subroutine i2virot3(nsn, nmn, a, irect, dpara, msr, nsv, irtl, v, ms, ar, vr, x, weight)
Definition i2vit3.F:317
i2vit3n
subroutine i2vit3n(nsn, nmn, a, irect, crst, msr, nsv, irtl, v, ms, weight, mmass)
Definition i2vit3.F:32
i2rot3
subroutine i2rot3(nsn, nmn, ar, irect, crst, msr, nsv, irtl, vr, in, a, v, x)
Definition i2vit3.F:211