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 uses place of first secondary node (just like change node number)
189 IF (m<0) RETURN
190 nsn =nby(2)
191 imd = iddl(m)+1
192 nd = 6
193C--------secondary nodes loop--
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-------end of secondary nodes loop--
233C--------due to 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 uses place of first secondary node (just like change node number)
733 IF ((m<0).OR.ndof(m)==0) RETURN
734 nsn =nby(2)
735 nd = 6
736C--------secondary nodes loop--
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 uses place of first secondary node (just like change node number)
846 IF (m<0) RETURN
847 nsn =nby(2)
848 nd = 6
849C--------secondary nodes loop--
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 velocities of the secondary nodes
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
print_wkij
subroutine print_wkij(ni, nj, iflag)
Definition imp_glob_k.F:892
put_kmii
subroutine put_kmii(id, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:1188
put_kii
subroutine put_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:655
put_kij
subroutine put_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:812
get_kii
subroutine get_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:593
get_kij
subroutine get_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:715
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