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