OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rby_imp0.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!|| rby_imp0 ../engine/source/constraints/general/rbody/rby_imp0.F
25!||--- called by ------------------------------------------------------
26!|| upd_glob_k ../engine/source/implicit/upd_glob_k.F
27!||--- calls -----------------------------------------------------
28!|| rby_imp1 ../engine/source/constraints/general/rbody/rby_imp0.F
29!|| rby_impm ../engine/source/constraints/general/rbody/rby_imp0.F
30!||====================================================================
31 SUBROUTINE rby_imp0(X ,RBY ,LPBY ,NPBY ,SKEW ,
32 1 NRBYAC,IRBYAC,NSC ,ISIJ ,NMC ,
33 2 IMIJ ,NSS ,ISS ,ISKEW ,ITAB ,
34 3 WEIGHT,MS ,IN ,
35 4 NDDL ,IADK ,JDIK ,DIAG_K ,
36 5 LT_K ,NDOF ,IDDL ,IKC ,B )
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "param_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ISKEW(*),ITAB(*),
50 . NRBYAC,IRBYAC(*),NDDL,IADK(*),JDIK(*),NDOF(*),
51 . IDDL(*),IKC(*),NSC(*),ISIJ(*),NSS(*) ,ISS(*),
52 . NMC,IMIJ(*)
53 my_real
54 . x(3,*), rby(nrby,*), skew(lskew,*),
55 . in(*),ms(*),diag_k(*),lt_k(*),b(*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, N,K,NK,NN,J,K1
60C-----------------------------------------------
61 K=1
62 nk=1
63 nn=1
64 DO i=1,nrbyac
65 n=irbyac(i)
66 k1=irbyac(i+nrbykin)+1
67 CALL rby_imp1(x, rby(1,n),lpby(k1),npby(1,n),
68 1 nsc(i),isij(nk),nss(k),iss(nn),
69 2 skew,iskew,itab,weight,ms,in,
70 3 nddl ,iadk ,jdik ,diag_k ,
71 4 lt_k ,ndof ,iddl ,ikc ,b )
72 DO j=1,npby(2,n)
73 nn = nn + nss(k+j-1)
74 ENDDO
75 k = k + npby(2,n)
76 nk = nk + 2*nsc(i)
77 ENDDO
78C
79 IF (nmc>0)
80 . CALL rby_impm(x ,nmc ,imij ,isij(nk),skew ,
81 1 iskew,itab ,weight,ms ,in ,
82 2 iadk ,jdik ,lt_k ,ndof ,iddl )
83C
84 RETURN
85 END
86!||====================================================================
87!|| rby_impi ../engine/source/constraints/general/rbody/rby_imp0.F
88!||--- called by ------------------------------------------------------
89!|| upd_int_k ../engine/source/implicit/upd_glob_k.F
90!||--- calls -----------------------------------------------------
91!|| rby_imp1 ../engine/source/constraints/general/rbody/rby_imp0.F
92!||====================================================================
93 SUBROUTINE rby_impi(X ,RBY ,LPBY ,NPBY ,SKEW ,
94 1 NRBYAC,IRBYAC,NSS ,ISS ,ISKEW ,
95 2 ITAB ,WEIGHT,MS ,IN ,
96 3 NDDL ,IADK ,JDIK ,DIAG_K ,
97 4 LT_K ,NDOF ,IDDL ,IKC ,B )
98C-----------------------------------------------
99C I m p l i c i t T y p e s
100C-----------------------------------------------
101#include "implicit_f.inc"
102C-----------------------------------------------
103C C o m m o n B l o c k s
104C-----------------------------------------------
105#include "com04_c.inc"
106#include "param_c.inc"
107C-----------------------------------------------
108C D u m m y A r g u m e n t s
109C-----------------------------------------------
110 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ISKEW(*),ITAB(*),
111 . NRBYAC,IRBYAC(*),NDDL,IADK(*),JDIK(*),NDOF(*),
112 . IDDL(*),IKC(*),NSS(*) ,ISS(*)
113 my_real
114 . X(3,*), RBY(NRBY,*), SKEW(LSKEW,*),
115 . IN(*),MS(*),DIAG_K(*),LT_K(*),B(*)
116C-----------------------------------------------
117C L o c a l V a r i a b l e s
118C-----------------------------------------------
119 INTEGER I, N,K,NN,J,NSC,ISIJ,K1
120C-----------------------------------------------
121 NSC=0
122 k=1
123 nn=1
124 DO i=1,nrbyac
125 n=irbyac(i)
126 k1=irbyac(i+nrbykin)+1
127 CALL rby_imp1(x, rby(1,n),lpby(k1),npby(1,n),
128 1 nsc ,isij ,nss(k),iss(nn),
129 2 skew,iskew,itab,weight,ms,in,
130 3 nddl ,iadk ,jdik ,diag_k ,
131 4 lt_k ,ndof ,iddl ,ikc ,b )
132 DO j=1,npby(2,n)
133 nn = nn + nss(k+j-1)
134 ENDDO
135 k = k + npby(2,n)
136 ENDDO
137C
138 RETURN
139 END
140!||====================================================================
141!|| rby_imp1 ../engine/source/constraints/general/rbody/rby_imp0.F
142!||--- called by ------------------------------------------------------
143!|| rby_imp0 ../engine/source/constraints/general/rbody/rby_imp0.f
144!|| rby_impi ../engine/source/constraints/general/rbody/rby_imp0.F
145!||--- calls -----------------------------------------------------
146!|| get_kii ../engine/source/implicit/imp_glob_k.F
147!|| get_kij ../engine/source/implicit/imp_glob_k.F
148!|| print_wkij ../engine/source/implicit/imp_glob_k.F
149!|| put_kii ../engine/source/implicit/imp_glob_k.F
150!|| put_kij ../engine/source/implicit/imp_glob_k.F
151!|| updkb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
152!|| updkb_rb1 ../engine/source/constraints/general/rbody/rby_imp0.F
153!|| updkb_rb2 ../engine/source/constraints/general/rbody/rby_imp0.F
154!||====================================================================
155 SUBROUTINE rby_imp1(X ,RBY,NOD ,NBY,
156 1 NSC, ISI ,NS ,NODS,
157 2 SKEW,ISKEW,ITAB,WEIGHT,MS ,IN ,
158 3 NDDL ,IADK ,JDIK ,DIAG_K ,
159 4 LT_K ,NDOF ,IDDL ,IKC ,B )
160C-----------------------------------------------
161C I m p l i c i t T y p e s
162C-----------------------------------------------
163#include "implicit_f.inc"
164C-----------------------------------------------
165C C o m m o n B l o c k s
166C-----------------------------------------------
167#include "param_c.inc"
168C-----------------------------------------------
169C D u m m y A r g u m e n t s
170C-----------------------------------------------
171 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*),
172 . NSC,ISI(2,NSC) ,NS(*),NODS(*)
173 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
174 my_real
175 . X(3,*), RBY(*), SKEW(LSKEW,*),
176 . IN(*),MS(*),DIAG_K(*),LT_K(*),B(*)
177C-----------------------------------------------
178C L o c a l V a r i a b l e s
179C-----------------------------------------------
180C ds010 21/2/00 +1
181 INTEGER M, NSN, IJD, ISK, I, N, J,NI,NJ,J1,
182 . K,L,ID,JD,ND,IMD,NIDOF,IR
183C REAL
184 my_real
185 . xs,ys,zs,xs1,ys1,zs1, kdd(6,6),bd(6)
186C-----------------------------------------------
187 m =nby(1)
188C -------main utilise place de premier secnd node (just like change node number)
189 IF (m<0) RETURN
190 nsn =nby(2)
191 imd = iddl(m)+1
192 nd = 6
193C--------boucle secnd nodes--
194 j1=0
195 DO i=1,nsn
196C--------block diagonal Kmm--
197 n = nod(i)
198 IF (ndof(n)>0) THEN
199 xs=x(1,n)-x(1,m)
200 ys=x(2,n)-x(2,m)
201 zs=x(3,n)-x(3,m)
202 DO k=1,ndof(n)
203 id = iddl(n)+k
204 ikc(id)=7
205 bd(k)=b(id)
206 ENDDO
207 DO k=ndof(n)+1,nd
208 bd(k)=zero
209 ENDDO
210 CALL get_kii(n ,iddl ,iadk,diag_k,lt_k ,kdd,ndof(n))
211 CALL updkb_rb(ndof(n),xs,ys,zs,kdd,bd)
212C-------Update K,B---
213 CALL put_kii(m ,iddl ,iadk,diag_k,lt_k ,kdd,nd)
214 DO k=1,nd
215 id = imd+k-1
216 b(id) = b(id) + bd(k)
217 ENDDO
218C--------no diag--Kjm=sum(KjsCsm)--
219 DO j = 1,ns(i)
220 ni=nods(j1+j)
221 nidof=ndof(ni)
222 CALL get_kij(ni,n,iddl,iadk,jdik,lt_k,kdd,nidof,ndof(n),ir)
223 IF (ir==1) CALL print_wkij(itab(ni) ,itab(n) ,1 )
224 CALL updkb_rb1(nidof,ndof(n),xs,ys,zs,kdd)
225C------- Update ---
226 CALL put_kij(ni,m,iddl,iadk,jdik,lt_k,kdd,nidof,nd,ir)
227 IF (ir==1) CALL print_wkij(itab(ni) ,itab(m) ,1 )
228 ENDDO
229 j1=j1+ns(i)
230 ENDIF
231 ENDDO
232C-------fin -boucle secnd nodes--
233C--------due au coupled block KIJ--
234 DO i=1,nsc
235 ni =isi(1,i)
236 nj =isi(2,i)
237 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,ndof(ni),ndof(nj),ir)
238 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,1 )
239 xs=x(1,ni)-x(1,m)
240 ys=x(2,ni)-x(2,m)
241 zs=x(3,ni)-x(3,m)
242 xs1=x(1,nj)-x(1,m)
243 ys1=x(2,nj)-x(2,m)
244 zs1=x(3,nj)-x(3,m)
245 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,1)
246C--------update --
247 CALL put_kii(m ,iddl ,iadk,diag_k,lt_k ,kdd,nd)
248c write(*,*)'2 lt_k(2)=',lt_k(2),kdd(1,3),i
249 ENDDO
250C
251 RETURN
252 END
253!||====================================================================
254!|| rby_impm ../engine/source/constraints/general/rbody/rby_imp0.F
255!||--- called by ------------------------------------------------------
256!|| rby_imp0 ../engine/source/constraints/general/rbody/rby_imp0.F
257!||--- calls -----------------------------------------------------
258!|| get_kij ../engine/source/implicit/imp_glob_k.F
259!|| print_wkij ../engine/source/implicit/imp_glob_k.F
260!|| put_kij ../engine/source/implicit/imp_glob_k.F
261!|| updkb_rb2 ../engine/source/constraints/general/rbody/rby_imp0.F
262!||====================================================================
263 SUBROUTINE rby_impm(X ,NMC ,IMI ,ISI ,SKEW ,
264 1 ISKEW,ITAB ,WEIGHT,MS ,IN ,
265 2 IADK ,JDIK ,LT_K ,NDOF ,IDDL )
266C-----------------------------------------------
267C I m p l i c i t T y p e s
268C-----------------------------------------------
269#include "implicit_f.inc"
270C-----------------------------------------------
271C C o m m o n B l o c k s
272C-----------------------------------------------
273#include "param_c.inc"
274C-----------------------------------------------
275C D u m m y A r g u m e n t s
276C-----------------------------------------------
277 INTEGER ISKEW(*),ITAB(*), WEIGHT(*),
278 . nmc,imi(2,nmc) ,isi(2,nmc)
279 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*)
280C REAL
281 my_real
282 . SKEW(LSKEW,*),X(3,*), IN(*),MS(*),LT_K(*)
283C-----------------------------------------------
284C L o c a l V a r i a b l e s
285C-----------------------------------------------
286C ds010 21/2/00 +1
287 INTEGER M, I, NI,NJ,ND,NM,IR
288C REAL
289 my_real
290 . XS,YS,ZS,XS1,YS1,ZS1, KDD(6,6)
291C-----------------------------------------------
292 nd=6
293 DO i=1,nmc
294 ni =isi(1,i)
295 nj =isi(2,i)
296 m =imi(1,i)
297 nm =imi(2,i)
298 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,ndof(ni),ndof(nj),ir)
299 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,1 )
300 xs=x(1,ni)-x(1,m)
301 ys=x(2,ni)-x(2,m)
302 zs=x(3,ni)-x(3,m)
303 xs1=x(1,nj)-x(1,nm)
304 ys1=x(2,nj)-x(2,nm)
305 zs1=x(3,nj)-x(3,nm)
306 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,0)
307C--------update --
308 CALL put_kij(m ,nm ,iddl ,iadk,jdik,lt_k,kdd,nd,nd,ir)
309 IF (ir==1) CALL print_wkij(itab(m) ,itab(nm) ,1 )
310 ENDDO
311C
312 RETURN
313 END
314!||====================================================================
315!|| updkb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
316!||--- called by ------------------------------------------------------
317!|| i2_frk0 ../engine/source/interfaces/interf/i2_imp1.F
318!|| i2updk0 ../engine/source/interfaces/interf/i2_imp1.f
319!|| rbe2_imp1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
320!|| rby_frk ../engine/source/constraints/general/rbody/rby_imp0.F
321!|| rby_imp1 ../engine/source/constraints/general/rbody/rby_imp0.F
322!||====================================================================
323 SUBROUTINE updkb_rb(NDL,XS,YS,ZS,KDD,BD)
324C-----------------------------------------------
325C I m p l i c i t T y p e s
326C-----------------------------------------------
327#include "implicit_f.inc"
328C-----------------------------------------------
329C D u m m y A r g u m e n t s
330C-----------------------------------------------
331 INTEGER NDL
332C REAL
333 my_real
334 . XS,YS,ZS, BD(6),KDD(6,6)
335C-----------------------------------------------
336C L o c a l V a r i a b l e s
337C-----------------------------------------------
338 INTEGER I, J, MI,MJ
339C REAL
340 my_real
341 . B(3),K(6,6),KR(3,3),RKR(3,3),RMF(3,3)
342C------------------------------------
343C-------------produit {K'}=[CDI]^t[K][CDI] B'=[CDI]^tB
344c-----with [CDI]=-[[I] [R]]-----
345c---- [[0] [I]]-----
346 kdd(2,1)=kdd(1,2)
347 kdd(3,1)=kdd(1,3)
348 kdd(3,2)=kdd(2,3)
349 DO i=1,3
350 kr(i,1)=-kdd(i,2)*zs+kdd(i,3)*ys
351 kr(i,2)= kdd(i,1)*zs-kdd(i,3)*xs
352 kr(i,3)=-kdd(i,1)*ys+kdd(i,2)*xs
353 ENDDO
354 DO i=1,3
355 rkr(1,i)=-kr(2,i)*zs+kr(3,i)*ys
356 rkr(2,i)= kr(1,i)*zs-kr(3,i)*xs
357 rkr(3,i)=-kr(1,i)*ys+kr(2,i)*xs
358 ENDDO
359C
360 DO i=1,3
361 DO j=1,3
362 mj=j+3
363 k(i,mj)=kr(i,j)
364 ENDDO
365 ENDDO
366 DO i=1,3
367 mi=i+3
368 DO j=1,3
369 mj=j+3
370 k(mi,mj)=rkr(i,j)
371 ENDDO
372 ENDDO
373C
374 IF (ndl==6) THEN
375 DO i=1,3
376 DO j=4,6
377 k(i,j)=k(i,j)+kdd(i,j)
378 ENDDO
379 ENDDO
380 DO i=1,3
381 j=i+3
382 rmf(1,i)=-kdd(2,j)*zs+kdd(3,j)*ys
383 rmf(2,i)= kdd(1,j)*zs-kdd(3,j)*xs
384 rmf(3,i)=-kdd(1,j)*ys+kdd(2,j)*xs
385 ENDDO
386 DO i=1,3
387 mi=i+3
388 DO j=i,3
389 mj=j+3
390 k(mi,mj)=k(mi,mj)+rmf(i,j)+rmf(j,i)+kdd(mi,mj)
391 ENDDO
392 ENDDO
393 b(1)=-bd(2)*zs+bd(3)*ys
394 b(2)= bd(1)*zs-bd(3)*xs
395 b(3)=-bd(1)*ys+bd(2)*xs
396 DO i=1,3
397 mi=i+3
398 bd(mi)= bd(mi)+b(i)
399 ENDDO
400 ENDIF
401C
402 DO i=1,3
403 DO j=4,6
404 kdd(i,j)=k(i,j)
405 ENDDO
406 ENDDO
407 DO i=4,6
408 DO j=i,6
409 kdd(i,j)=k(i,j)
410 ENDDO
411 ENDDO
412C
413 RETURN
414 END
415!||====================================================================
416!|| updkb_rb1 ../engine/source/constraints/general/rbody/rby_imp0.F
417!||--- called by ------------------------------------------------------
418!|| i2_frk0 ../engine/source/interfaces/interf/i2_imp1.F
419!|| i2updk0 ../engine/source/interfaces/interf/i2_imp1.f
420!|| rbe2_imp1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
421!|| rby_frk ../engine/source/constraints/general/rbody/rby_imp0.F
422!|| rby_imp1 ../engine/source/constraints/general/rbody/rby_imp0.F
423!||====================================================================
424 SUBROUTINE updkb_rb1(NI,NJ,XS,YS,ZS,KDD)
425C-----------------------------------------------
426C I m p l i c i t T y p e s
427C-----------------------------------------------
428#include "implicit_f.inc"
429C-----------------------------------------------
430C D u m m y A r g u m e n t s
431C-----------------------------------------------
432 INTEGER NI,NJ
433C REAL
434 my_real
435 . XS,YS,ZS, KDD(6,6)
436C-----------------------------------------------
437C L o c a l V a r i a b l e s
438C-----------------------------------------------
439 INTEGER I, J
440C REAL
441 my_real
442 . K(6,6)
443C------------------------------------
444C-------------produit {K'}=-[K][CDI]
445c-----with [CDI]=-[[I] [R]]-----
446c---- [[0] [I]]-----
447C
448 DO i=1,6
449 DO j=1,6
450 k(i,j)=zero
451 ENDDO
452 ENDDO
453 DO i=1,ni
454 DO j=1,nj
455 k(i,j)=kdd(i,j)
456 ENDDO
457 ENDDO
458 DO i=1,3
459 k(i,4)=k(i,4)-kdd(i,2)*zs+kdd(i,3)*ys
460 k(i,5)=k(i,5)+kdd(i,1)*zs-kdd(i,3)*xs
461 k(i,6)=k(i,6)-kdd(i,1)*ys+kdd(i,2)*xs
462 ENDDO
463C
464 IF (ni==6) THEN
465 DO i=4,6
466 k(i,4)=k(i,4)-kdd(i,2)*zs+kdd(i,3)*ys
467 k(i,5)=k(i,5)+kdd(i,1)*zs-kdd(i,3)*xs
468 k(i,6)=k(i,6)-kdd(i,1)*ys+kdd(i,2)*xs
469 ENDDO
470 ENDIF
471C
472 DO i=1,6
473 DO j=1,6
474 kdd(i,j)=k(i,j)
475 ENDDO
476 ENDDO
477C
478 RETURN
479 END
480!||====================================================================
481!|| updkb_rb2 ../engine/source/constraints/general/rbody/rby_imp0.F
482!||--- called by ------------------------------------------------------
483!|| i2updk0 ../engine/source/interfaces/interf/i2_imp1.F
484!|| i2updkm0 ../engine/source/interfaces/interf/i2_imp1.F
485!|| rby_imp1 ../engine/source/constraints/general/rbody/rby_imp0.F
486!|| rby_impm ../engine/source/constraints/general/rbody/rby_imp0.F
487!||====================================================================
488 SUBROUTINE updkb_rb2(NI,NJ,XS,YS,ZS,XS1,YS1,ZS1,KDD,ISYM)
489C-----------------------------------------------
490C I m p l i c i t T y p e s
491C-----------------------------------------------
492#include "implicit_f.inc"
493C-----------------------------------------------
494C D u m m y A r g u m e n t s
495C-----------------------------------------------
496 INTEGER NI,NJ,ISYM
497C REAL
498 my_real
499 . XS,YS,ZS,XS1,YS1,ZS1, KDD(6,6)
500C-----------------------------------------------
501C L o c a l V a r i a b l e s
502C-----------------------------------------------
503 INTEGER I, J, MI,MJ
504C REAL
505 my_real
506 . K(6,6),KR(3,3),RKR(3,3),RMF(3,3),RK(3,3)
507C------------------------------------
508C-------------produit {K'}=[CDI]^t[K][CDJ] +()^t
509c-----with [CDI]=-[[I] [R]]-----
510c---- [[0] [I]]-----
511C
512 DO i=1,3
513 kr(i,1)=-kdd(i,2)*zs1+kdd(i,3)*ys1
514 kr(i,2)= kdd(i,1)*zs1-kdd(i,3)*xs1
515 kr(i,3)=-kdd(i,1)*ys1+kdd(i,2)*xs1
516 ENDDO
517 DO i=1,3
518 rkr(1,i)=-kr(2,i)*zs+kr(3,i)*ys
519 rkr(2,i)= kr(1,i)*zs-kr(3,i)*xs
520 rkr(3,i)=-kr(1,i)*ys+kr(2,i)*xs
521 rk(1,i)=-kdd(2,i)*zs+kdd(3,i)*ys
522 rk(2,i)= kdd(1,i)*zs-kdd(3,i)*xs
523 rk(3,i)=-kdd(1,i)*ys+kdd(2,i)*xs
524 ENDDO
525C
526 DO i=1,3
527 mi=i+3
528 DO j=1,3
529 mj=j+3
530 k(i,j)=kdd(i,j)
531 k(i,mj)=kr(i,j)
532 k(mi,j)=rk(i,j)
533 k(mi,mj)=rkr(i,j)
534 ENDDO
535 ENDDO
536C
537 IF (ni==6) THEN
538 DO i=4,6
539 DO j=1,3
540 k(i,j)=k(i,j)+kdd(i,j)
541 ENDDO
542 ENDDO
543C---------FM Rj------------
544 DO i=1,3
545 j=i+3
546 rmf(i,1)=-kdd(j,2)*zs1+kdd(j,3)*ys1
547 rmf(i,2)= kdd(j,1)*zs1-kdd(j,3)*xs1
548 rmf(i,3)=-kdd(j,1)*ys1+kdd(j,2)*xs1
549 ENDDO
550 DO i=1,3
551 mi=i+3
552 DO j=1,3
553 mj=j+3
554 k(mi,mj)=k(mi,mj)+rmf(i,j)
555 ENDDO
556 ENDDO
557 ENDIF
558 IF (nj==6) THEN
559 DO i=1,3
560 DO j=4,6
561 k(i,j)=k(i,j)+kdd(i,j)
562 ENDDO
563 ENDDO
564C---------Ri^tMF------------
565 DO i=1,3
566 j=i+3
567 rmf(1,i)=-kdd(2,j)*zs+kdd(3,j)*ys
568 rmf(2,i)= kdd(1,j)*zs-kdd(3,j)*xs
569 rmf(3,i)=-kdd(1,j)*ys+kdd(2,j)*xs
570 ENDDO
571 DO i=1,3
572 mi=i+3
573 DO j=1,3
574 mj=j+3
575 k(mi,mj)=k(mi,mj)+rmf(i,j)
576 ENDDO
577 ENDDO
578 ENDIF
579 IF (ni==6.AND.nj==6) THEN
580 DO i=1,3
581 mi=i+3
582 DO j=1,3
583 mj=j+3
584 k(mi,mj)=k(mi,mj)+kdd(mi,mj)
585 ENDDO
586 ENDDO
587 ENDIF
588C
589 IF (isym==1) THEN
590 DO i=1,6
591 DO j=1,6
592 kdd(i,j)=k(i,j)+k(j,i)
593 ENDDO
594 ENDDO
595 ELSE
596 DO i=1,6
597 DO j=1,6
598 kdd(i,j)=k(i,j)
599 ENDDO
600 ENDDO
601 ENDIF
602C
603 RETURN
604 END
605!||====================================================================
606!|| rby_impf ../engine/source/constraints/general/rbody/rby_imp0.F
607!||--- called by ------------------------------------------------------
608!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
609!|| upd_fr ../engine/source/mpi/implicit/imp_fri.F
610!||====================================================================
611 SUBROUTINE rby_impf(X ,M ,N ,NDOF ,A ,AR )
612C-----------------------------------------------
613C I m p l i c i t T y p e s
614C-----------------------------------------------
615#include "implicit_f.inc"
616C-----------------------------------------------
617C D u m m y A r g u m e n t s
618C-----------------------------------------------
619 INTEGER N, M,NDOF(*)
620C REAL
621 my_real
622 . X(3,*), A(3,*),AR(3,*)
623C-----------------------------------------------
624C L o c a l V a r i a b l e s
625C-----------------------------------------------
626C REAL
627 my_real
628 . xs,ys,zs
629C-----------------------------------------------
630 IF (m<0) RETURN
631 a(1,m)=a(1,m)+a(1,n)
632 a(2,m)=a(2,m)+a(2,n)
633 a(3,m)=a(3,m)+a(3,n)
634 IF (ndof(m)==6) THEN
635 xs=x(1,n)-x(1,m)
636 ys=x(2,n)-x(2,m)
637 zs=x(3,n)-x(3,m)
638 ar(1,m)=ar(1,m)-a(2,n)*zs+a(3,n)*ys
639 ar(2,m)=ar(2,m)+a(1,n)*zs-a(3,n)*xs
640 ar(3,m)=ar(3,m)-a(1,n)*ys+a(2,n)*xs
641 ENDIF
642C
643 RETURN
644 END
645!||====================================================================
646!|| updfr_rb ../engine/source/constraints/general/rbody/rby_imp0.F
647!||--- called by ------------------------------------------------------
648!|| diag_int ../engine/source/mpi/implicit/imp_fri.F
649!|| i2_frup0 ../engine/source/interfaces/interf/i2_imp1.F
650!||====================================================================
651 SUBROUTINE updfr_rb(XS,YS,ZS,KII,K)
652C-----------------------------------------------
653C I m p l i c i t T y p e s
654C-----------------------------------------------
655#include "implicit_f.inc"
656C-----------------------------------------------
657C D u m m y A r g u m e n t s
658C-----------------------------------------------
659 INTEGER NDL
660C REAL
661 my_real
662 . XS,YS,ZS, K(6),KII(6)
663C-----------------------------------------------
664C L o c a l V a r i a b l e s
665C-----------------------------------------------
666 INTEGER I
667C REAL
668 my_real
669 . KDD(3,3),KR(3,3)
670C------------------------------------
671C-------------produit {K'}=[CDI]^t[K][CDI]
672c-----with [CDI]=-[[I] [R]]-----
673 DO I=1,3
674 kdd(i,i)=kii(i)
675 k(i)=k(i)+kii(i)
676 ENDDO
677 kdd(1,2)=kii(4)
678 kdd(1,3)=kii(5)
679 kdd(2,3)=kii(6)
680 kdd(2,1)=kdd(1,2)
681 kdd(3,1)=kdd(1,3)
682 kdd(3,2)=kdd(2,3)
683 DO i=1,3
684 kr(i,1)=-kdd(i,2)*zs+kdd(i,3)*ys
685 kr(i,2)= kdd(i,1)*zs-kdd(i,3)*xs
686 kr(i,3)=-kdd(i,1)*ys+kdd(i,2)*xs
687 ENDDO
688C
689 k(4)=k(4)-kr(2,1)*zs+kr(3,1)*ys
690 k(5)=k(5)+kr(1,2)*zs-kr(3,2)*xs
691 k(6)=k(6)-kr(1,3)*ys+kr(2,3)*xs
692C
693 RETURN
694 END
695!||====================================================================
696!|| rby_impr1 ../engine/source/constraints/general/rbody/rby_imp0.F
697!||--- called by ------------------------------------------------------
698!|| imp_dykv ../engine/source/implicit/imp_dyna.F
699!|| imp_dykv0 ../engine/source/implicit/imp_dyna.F
700!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
701!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
702!||--- calls -----------------------------------------------------
703!|| updb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
704!||====================================================================
705 SUBROUTINE rby_impr1(X ,RBY,NOD ,NBY,NDOF ,
706 1 IDDL ,B )
707C-----------------------------------------------
708C I m p l i c i t T y p e s
709C-----------------------------------------------
710#include "implicit_f.inc"
711C-----------------------------------------------
712C C o m m o n B l o c k s
713C-----------------------------------------------
714C-----------------------------------------------
715C D u m m y A r g u m e n t s
716C-----------------------------------------------
717 INTEGER NOD(*), NBY(*),NDOF(*),IDDL(*)
718C REAL
719 my_real
720 . X(3,*), RBY(*), B(*)
721C-----------------------------------------------
722C L o c a l V a r i a b l e s
723C-----------------------------------------------
724C ds010 21/2/00 +1
725 INTEGER M, NSN, IJD, ISK, I, N, J,NI,NJ,J1,
726 . K,L,ID,JD,ND,IMD,NIDOF
727C REAL
728 my_real
729 . XS,YS,ZS,BD(6)
730C-----------------------------------------------
731 M =nby(1)
732C -------main utilise place de premier secnd node (just like change node number)
733 IF ((m<0).OR.ndof(m)==0) RETURN
734 nsn =nby(2)
735 nd = 6
736C--------boucle secnd nodes--
737 j1=0
738 DO i=1,nsn
739C--------block diagonal Kmm--
740 n = nod(i)
741 IF (ndof(n)>0) THEN
742 xs=x(1,n)-x(1,m)
743 ys=x(2,n)-x(2,m)
744 zs=x(3,n)-x(3,m)
745 DO k=1,ndof(n)
746 id = iddl(n)+k
747 bd(k)=b(id)
748 ENDDO
749 DO k=ndof(n)+1,nd
750 bd(k)=zero
751 ENDDO
752 CALL updb_rb(ndof(n),xs,ys,zs,bd)
753C-------Update B---
754 DO k=1,nd
755 id = iddl(m)+k
756 b(id) = b(id) + bd(k)
757 ENDDO
758 ENDIF
759 ENDDO
760C
761 RETURN
762 END
763!||====================================================================
764!|| updb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
765!||--- called by ------------------------------------------------------
766!|| i2updb0 ../engine/source/interfaces/interf/i2_imp1.F
767!|| i2updb02 ../engine/source/interfaces/interf/i2_imp1.F
768!|| rbe2_impb0 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
769!|| rby_impr1 ../engine/source/constraints/general/rbody/rby_imp0.F
770!|| rby_impr2 ../engine/source/constraints/general/rbody/rby_imp0.f
771!||====================================================================
772 SUBROUTINE updb_rb(NDL,XS,YS,ZS,BD)
773C-----------------------------------------------
774C I m p l i c i t T y p e s
775C-----------------------------------------------
776#include "implicit_f.inc"
777C-----------------------------------------------
778C D u m m y A r g u m e n t s
779C-----------------------------------------------
780 INTEGER NDL
781C REAL
782 my_real
783 . XS,YS,ZS, BD(6)
784C-----------------------------------------------
785C L o c a l V a r i a b l e s
786C-----------------------------------------------
787 INTEGER I, J, MI,MJ
788C REAL
789 my_real
790 . b(3)
791C------------------------------------
792C-------------produit B'=[CDI]^tB
793c-----with [CDI]=-[[I] [R]]-----
794c---- [[0] [I]]-----
795C
796 IF (ndl==6) THEN
797 b(1)=-bd(2)*zs+bd(3)*ys
798 b(2)= bd(1)*zs-bd(3)*xs
799 b(3)=-bd(1)*ys+bd(2)*xs
800 DO i=1,3
801 mi=i+3
802 bd(mi)= bd(mi)+b(i)
803 ENDDO
804 ENDIF
805C
806 RETURN
807 END
808!||====================================================================
809!|| rby_impr2 ../engine/source/constraints/general/rbody/rby_imp0.F
810!||--- called by ------------------------------------------------------
811!|| imp_dykv ../engine/source/implicit/imp_dyna.F
812!|| imp_dykv0 ../engine/source/implicit/imp_dyna.F
813!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
814!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
815!||--- calls -----------------------------------------------------
816!|| updb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
817!||====================================================================
818 SUBROUTINE rby_impr2(X ,RBY,NOD ,NBY,NDOF ,
819 1 IDDL ,B ,AC ,ACR )
820C-----------------------------------------------
821C I m p l i c i t T y p e s
822C-----------------------------------------------
823#include "implicit_f.inc"
824C-----------------------------------------------
825C C o m m o n B l o c k s
826C-----------------------------------------------
827C-----------------------------------------------
828C D u m m y A r g u m e n t s
829C-----------------------------------------------
830 INTEGER NOD(*), NBY(*),NDOF(*),IDDL(*)
831C REAL
832 my_real
833 . X(3,*), RBY(*), B(*)
834C-----------------------------------------------
835C L o c a l V a r i a b l e s
836C-----------------------------------------------
837C ds010 21/2/00 +1
838 INTEGER M, NSN, IJD, ISK, I, N, J,NI,NJ,J1,
839 . K,L,ID,JD,ND,IMD,NIDOF
840C REAL
841 my_real
842 . XS,YS,ZS,BD(6),AC(3,*) ,ACR(3,*)
843C-----------------------------------------------
844 M =nby(1)
845C -------main utilise place de premier secnd node (just like change node number)
846 IF (m<0) RETURN
847 nsn =nby(2)
848 nd = 6
849C--------boucle secnd nodes--
850 j1=0
851 DO i=1,nsn
852C--------block diagonal Kmm--
853 n = nod(i)
854 IF (ndof(n)==0) THEN
855 xs=x(1,n)-x(1,m)
856 ys=x(2,n)-x(2,m)
857 zs=x(3,n)-x(3,m)
858 DO k=1,3
859 bd(k)=ac(k,n)
860 bd(k+3)=acr(k,n)
861 ENDDO
862 CALL updb_rb(nd,xs,ys,zs,bd)
863C-------Update B---
864 IF (ndof(m)==0) THEN
865 DO k=1,3
866 ac(k,m)=ac(k,m)+bd(k)
867 acr(k,m)=acr(k,m)+bd(k+3)
868 ENDDO
869 ELSE
870 DO k=1,nd
871 id = iddl(m)+k
872 b(id) = b(id) + bd(k)
873 ENDDO
874 ENDIF
875 ENDIF
876 ENDDO
877C
878 RETURN
879 END
880!||====================================================================
881!|| rby_frk ../engine/source/constraints/general/rbody/rby_imp0.F
882!||--- called by ------------------------------------------------------
883!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
884!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.F
885!||--- calls -----------------------------------------------------
886!|| put_kmii ../engine/source/implicit/imp_glob_k.F
887!|| updkb_rb ../engine/source/constraints/general/rbody/rby_imp0.f
888!|| updkb_rb1 ../engine/source/constraints/general/rbody/rby_imp0.F
889!||====================================================================
890 SUBROUTINE rby_frk(NS ,M ,X ,ITAB ,IKC ,
891 1 NDOF ,IDDL ,IDDLM,IADK ,JDIK ,
892 2 DIAG_K,LT_K ,B ,A ,KSS ,
893 3 KSM ,KNM ,KRM ,IDLM ,ISS,ISM )
894C-----------------------------------------------
895C I m p l i c i t T y p e s
896C-----------------------------------------------
897#include "implicit_f.inc"
898C-----------------------------------------------
899C D u m m y A r g u m e n t s
900C-----------------------------------------------
901 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*),IDDLM(*),IKC(*),
902 . M, NS,ITAB(*),IDLM ,ISS,ISM
903 my_real
904 . X(3,*),DIAG_K(*),LT_K(*),B(*),A(3,*),
905 . KSS(6),KSM(3,3),KNM(3,3),KRM(3,3)
906C-----------------------------------------------
907C L o c a l V a r i a b l e s
908C-----------------------------------------------
909 INTEGER I, J, K,ID,NL,NI,NJ,NDOFI,ND,IR,IDM
910 my_real kdd(6,6),bd(6),xs,ys,zs
911C------------------------------------
912C VITESSES DES NOEUDS SECONDS
913C------------------------------------
914 i=ns
915 ndofi = 3
916 nd = 6
917C-----
918 xs=x(1,i)-x(1,m)
919 ys=x(2,i)-x(2,m)
920 zs=x(3,i)-x(3,m)
921 IF (iss>0) THEN
922 DO k=1,ndofi
923 bd(k) = a(k,i)
924 kdd(k,k) = kss(k)
925 ENDDO
926 DO k=ndofi+1,6
927 bd(k)=zero
928 ENDDO
929 kdd(1,2) = kss(4)
930 kdd(1,3) = kss(5)
931 kdd(2,3) = kss(6)
932 CALL updkb_rb(ndofi,xs,ys,zs,kdd,bd)
933 CALL put_kmii(idlm,iadk,diag_k,lt_k,kdd,nd)
934 ENDIF
935 IF (ism>0) THEN
936C--------no diag--Kjm=sum(KjsCsm)--
937 DO k=1,ndofi
938 DO j=1,ndofi
939 kdd(k,j) = ksm(k,j)
940 ENDDO
941 ENDDO
942C------- Update ---
943 CALL updkb_rb1(ndofi,ndofi,xs,ys,zs,kdd)
944 DO k=1,ndofi
945 DO j=1,ndofi
946 knm(k,j)=kdd(j,k)
947 krm(k,j)=kdd(j,k+ndofi)
948 ENDDO
949 ENDDO
950 ENDIF
951C
952 RETURN
953 END
i2updk0
subroutine i2updk0(nsn, nmn, irect, crst, msr, nsv, irtl, ms, x, weight, itab, nsc, isi, ns, nods, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
Definition i2_imp1.F:225
i2_imp1
subroutine i2_imp1(ipari, intbuf_tab, itab, nsc2, isij2, nss2, iss2, x, ms, in, weight, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
Definition i2_imp1.F:39
print_wkij
subroutine print_wkij(ni, nj, iflag)
Definition imp_glob_k.F:890
put_kmii
subroutine put_kmii(id, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:1186
put_kii
subroutine put_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:653
put_kij
subroutine put_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:810
get_kii
subroutine get_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:591
get_kij
subroutine get_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:713
updfr_rb
subroutine updfr_rb(xs, ys, zs, kii, k)
Definition rby_imp0.F:652
rby_frk
subroutine rby_frk(ns, m, x, itab, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, idlm, iss, ism)
Definition rby_imp0.F:894
rby_impr1
subroutine rby_impr1(x, rby, nod, nby, ndof, iddl, b)
Definition rby_imp0.F:707
rby_impm
subroutine rby_impm(x, nmc, imi, isi, skew, iskew, itab, weight, ms, in, iadk, jdik, lt_k, ndof, iddl)
Definition rby_imp0.F:266
rby_impf
subroutine rby_impf(x, m, n, ndof, a, ar)
Definition rby_imp0.F:612
rby_impi
subroutine rby_impi(x, rby, lpby, npby, skew, nrbyac, irbyac, nss, iss, iskew, itab, weight, ms, in, nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b)
Definition rby_imp0.F:98
updkb_rb
subroutine updkb_rb(ndl, xs, ys, zs, kdd, bd)
Definition rby_imp0.F:324
updb_rb
subroutine updb_rb(ndl, xs, ys, zs, bd)
Definition rby_imp0.F:773
updkb_rb1
subroutine updkb_rb1(ni, nj, xs, ys, zs, kdd)
Definition rby_imp0.F:425
rby_imp1
subroutine rby_imp1(x, rby, nod, nby, nsc, isi, ns, nods, skew, iskew, itab, weight, ms, in, nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b)
Definition rby_imp0.F:160
updkb_rb2
subroutine updkb_rb2(ni, nj, xs, ys, zs, xs1, ys1, zs1, kdd, isym)
Definition rby_imp0.F:489
rby_imp0
subroutine rby_imp0(x, rby, lpby, npby, skew, nrbyac, irbyac, nsc, isij, nmc, imij, nss, iss, iskew, itab, weight, ms, in, nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b)
Definition rby_imp0.F:37
rby_impr2
subroutine rby_impr2(x, rby, nod, nby, ndof, iddl, b, ac, acr)
Definition rby_imp0.F:820