OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rbe3_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!|| rbe3_imp0 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
25!||--- called by ------------------------------------------------------
26!|| upd_glob_k ../engine/source/implicit/upd_glob_k.F
27!||--- calls -----------------------------------------------------
28!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
29!|| rbe3_imp1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
30!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
31!||====================================================================
32 SUBROUTINE rbe3_imp0(
33 1 IRBE3 ,LRBE3 ,FRBE3 ,X ,SKEW ,
34 2 ISS3 ,IKC ,NDOF ,IDDL ,IADK ,
35 3 JDIK ,DIAG_K ,LT_K ,B ,WEIGHT ,
36 4 ITAB )
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"
46#include "tabsiz_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER WEIGHT(*),IRBE3(NRBE3L,*),LRBE3(*),
51 . IADK(*),JDIK(*),NDOF(*),ITAB(*),
52 . IDDL(*),IKC(*),ISS3(*)
53C REAL
54 my_real
55 . x(3,*), skew(lskew,*), frbe3(*),
56 . diag_k(*),lt_k(*),b(*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
61 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,NSJ,IADJ
62C REAL
63 my_real,
64 . DIMENSION(:),ALLOCATABLE :: fdstnb ,mdstnb
65
66C-----------------------------------------------
67 iads = slrbe3/2
68 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
69 ALLOCATE(fdstnb(18*max_m))
70 IF (irotg>0) ALLOCATE(mdstnb(18*max_m))
71 iadj=1
72 DO n=1,nrbe3
73 iad = irbe3(1,n)
74 ns = irbe3(3,n)
75 nml = irbe3(5,n)
76 irot =irbe3(6,n)
77 nsj =irbe3(8,n)
78 IF (ns==0.OR.ndof(ns)==0) cycle
79 IF (weight(ns)/=0) THEN
80 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
81 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
82 . mdstnb ,irbe3(2,n))
83 CALL rbe3_imp1(ns ,nml ,lrbe3(iad+1) ,x ,irot ,
84 2 nsj ,iss3(iadj),jt(1,n) ,jr(1,n),fdstnb ,
85 3 mdstnb,ikc ,ndof ,iddl ,iadk ,
86 4 jdik ,diag_k,lt_k ,b ,itab )
87 END IF
88 iadj=iadj+nsj
89 ENDDO
90C
91 DEALLOCATE(fdstnb)
92 IF (irotg>0) DEALLOCATE(mdstnb)
93C
94 RETURN
95 END
96!||====================================================================
97!|| rbe3_impi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
98!||--- called by ------------------------------------------------------
99!|| upd_int_k ../engine/source/implicit/upd_glob_k.F
100!||--- calls -----------------------------------------------------
101!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
102!|| rbe3_imp1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
103!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.f
104!||====================================================================
105 SUBROUTINE rbe3_impi(
106 1 IRBE3 ,LRBE3 ,FRBE3 ,X ,SKEW ,
107 2 NSS3 ,ISS3 ,IKC ,NDOF ,IDDL ,
108 3 IADK ,JDIK ,DIAG_K ,LT_K ,B ,
109 4 WEIGHT ,ITAB )
110C-----------------------------------------------
111C I m p l i c i t T y p e s
112C-----------------------------------------------
113#include "implicit_f.inc"
114C-----------------------------------------------
115C C o m m o n B l o c k s
116C-----------------------------------------------
117#include "com04_c.inc"
118#include "param_c.inc"
119#include "tabsiz_c.inc"
120C-----------------------------------------------
121C D u m m y A r g u m e n t s
122C-----------------------------------------------
123 INTEGER WEIGHT(*),IRBE3(NRBE3L,*),LRBE3(*),
124 . IADK(*),JDIK(*),NDOF(*),ITAB(*),
125 . IDDL(*),IKC(*),NSS3(*),ISS3(*)
126C REAL
127 my_real
128 . X(3,*), SKEW(LSKEW,*), FRBE3(*),
129 . DIAG_K(*),LT_K(*),B(*)
130C-----------------------------------------------
131C L o c a l V a r i a b l e s
132C-----------------------------------------------
133 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
134 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,NSJ,IADJ
135C REAL
136 my_real,
137 . DIMENSION(:),ALLOCATABLE :: fdstnb ,mdstnb
138
139C-----------------------------------------------
140 iads = slrbe3/2
141 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
142 ALLOCATE(fdstnb(18*max_m))
143 IF (irotg>0) ALLOCATE(mdstnb(18*max_m))
144 iadj=1
145 DO n=1,nrbe3
146 iad = irbe3(1,n)
147 ns = irbe3(3,n)
148 IF (ns==0) cycle
149 nml = irbe3(5,n)
150 irot =irbe3(6,n)
151 DO j =1,3
152 jr(j,n)=0
153 ENDDO
154 IF (weight(ns)/=0.AND.ndof(ns)>0) THEN
155 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
156 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
157 . mdstnb ,irbe3(2,n))
158 CALL rbe3_imp1(ns ,nml ,lrbe3(iad+1) ,x ,irot ,
159 2 nss3(n),iss3(iadj),jt(1,n) ,jr(1,n),fdstnb ,
160 3 mdstnb,ikc ,ndof ,iddl ,iadk ,
161 4 jdik ,diag_k,lt_k ,b ,itab )
162 iadj=iadj+nss3(n)
163 END IF
164 ENDDO
165C
166 DEALLOCATE(fdstnb)
167 IF (irotg>0) DEALLOCATE(mdstnb)
168C
169 RETURN
170 END
171!||====================================================================
172!|| rbe3_imp1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
173!||--- called by ------------------------------------------------------
174!|| rbe3_imp0 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
175!|| rbe3_impi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
176!||--- calls -----------------------------------------------------
177!|| get_kii ../engine/source/implicit/imp_glob_k.F
178!|| get_kij ../engine/source/implicit/imp_glob_k.F
179!|| print_wkij ../engine/source/implicit/imp_glob_k.F
180!|| put_kii ../engine/source/implicit/imp_glob_k.f
181!|| put_kij ../engine/source/implicit/imp_glob_k.F
182!|| updb_cdi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
183!|| updk_cdi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
184!|| updk_cdii ../engine/source/constraints/general/rbe3/rbe3_imp0.F
185!|| updk_cdij ../engine/source/constraints/general/rbe3/rbe3_imp0.F
186!||====================================================================
187 SUBROUTINE rbe3_imp1(NS ,NML ,IML ,X ,IROT ,
188 2 NSJ ,ISJ ,JT ,JR ,FDSTNB ,
189 3 MDSTNB,IKC ,NDOF ,IDDL ,IADK ,
190 4 JDIK ,DIAG_K,LT_K ,B ,ITAB )
191C-----------------------------------------------
192C I m p l i c i t T y p e s
193C-----------------------------------------------
194#include "implicit_f.inc"
195C-----------------------------------------------
196C D u m m y A r g u m e n t s
197C-----------------------------------------------
198 INTEGER NS, NML,IML(*),NSJ,ISJ(*) ,JT(3),JR(3),IROT
199 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*),ITAB(*)
200 my_real
201 . X(3,*),DIAG_K(*),LT_K(*),B(*),FDSTNB(18,*),MDSTNB(18,*)
202C-----------------------------------------------
203C L o c a l V a r i a b l e s
204C-----------------------------------------------
205 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
206 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
207 . NIR1,IR,IP,ISTIF
208C REAL
209 my_real
210 . kdd(6,6),bd(6),kii(6,6),kij(6,6),bi(6)
211C------------------------------------
212C VITESSES DES NOEUDS SECONDS
213C------------------------------------
214 IF (ndof(ns)<=0) RETURN
215C
216 ip=4
217 i = ns
218 ndm = ndof(ns)
219 DO k=1,6
220 DO j=k,6
221 kdd(k,j)=zero
222 ENDDO
223 ENDDO
224 DO k=1,ndof(i)
225 id = iddl(i)+k
226 ikc(id)=13
227 bd(k)=b(id)
228 ENDDO
229 DO k=ndof(i)+1,6
230 bd(k)=zero
231 ENDDO
232 DO k=1,3
233 bd(k)=bd(k)*jt(k)
234 bd(k+3)=bd(k+3)*jr(k)
235 ENDDO
236 CALL get_kii(i ,iddl ,iadk,diag_k,lt_k ,kdd,ndof(i))
237 DO k=1,6
238 DO j=k,6
239 kdd(j,k)=kdd(k,j)
240 ENDDO
241 ENDDO
242C CALL UPDK_BC(JT,JR,KDD,ISTIF)
243C
244C-------Update K(main node)---
245C IF (ISTIF>0) THEN
246 DO j=1,nml
247 nj=iml(j)
248 nd = ndof(nj)
249C-------Update CDI^t[KDD]CDI---
250 CALL updk_cdii(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndm)
251 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,nd)
252 DO i1=j+1,nml
253 nm=iml(i1)
254C-------Update CDI^t[KDD]CDJ---
255 CALL updk_cdij(fdstnb(1,j),mdstnb(1,j),fdstnb(1,i1),
256 . mdstnb(1,i1),kdd,kij,irot,ndm )
257 CALL put_kij(nj,nm,iddl,iadk,jdik,lt_k,kij,nd,ndof(nm),ir)
258 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,ip )
259 ENDDO
260 ENDDO
261C END IF
262 DO j=1,nml
263 nj=iml(j)
264 nd = ndof(nj)
265 CALL updb_cdi(fdstnb(1,j),mdstnb(1,j),bd,bi,irot)
266 DO k=1,nd
267 id = iddl(nj)+k
268 b(id) = b(id) + bi(k)
269 ENDDO
270 ENDDO
271C--------no diag--Kjm=sum(KjsCsm)--
272 DO i1 = 1,nsj
273 ni=isj(i1)
274 nidof=ndof(ni)
275 ndm = max(ndm,nidof)
276 DO k=1,6
277 DO j=1,6
278 kdd(k,j)=zero
279 ENDDO
280 ENDDO
281 CALL get_kij(ni,i,iddl,iadk,jdik,lt_k,kdd,nidof,ndof(i),ir)
282 IF (ir==1) CALL print_wkij(itab(ni) ,itab(i) ,ip )
283C------- Update ---
284C CALL UPDK_BC2(JT,JR,KDD,ISTIF)
285C IF (ISTIF>0) THEN
286 DO j=1,nml
287 nj=iml(j)
288 ndj = ndof(nj)
289 IF (ni==nj) THEN
290 CALL updk_cdi(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndm,1)
291 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,ndj)
292 ELSE
293 CALL updk_cdi(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndm,0)
294 CALL put_kij(ni,nj,iddl,iadk,jdik,lt_k,kii,nidof,ndj,ir)
295 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,ip )
296 ENDIF
297 ENDDO
298C ENDIF
299 ENDDO
300C
301 RETURN
302 END
303!||====================================================================
304!|| rbe3_impr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
305!||--- called by ------------------------------------------------------
306!|| imp_dykv ../engine/source/implicit/imp_dyna.F
307!|| imp_dykv0 ../engine/source/implicit/imp_dyna.F
308!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
309!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
310!||--- calls -----------------------------------------------------
311!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
312!|| rbe3_impb0 ../engine/source/constraints/general/rbe3/rbe3_imp0.f
313!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
314!||====================================================================
315 SUBROUTINE rbe3_impr1(
316 1 IRBE3 ,LRBE3 ,FRBE3 ,X ,SKEW ,
317 2 NDOF ,IDDL ,B ,WEIGHT)
318C-----------------------------------------------
319C I m p l i c i t T y p e s
320C-----------------------------------------------
321#include "implicit_f.inc"
322C-----------------------------------------------
323C C o m m o n B l o c k s
324C-----------------------------------------------
325#include "com04_c.inc"
326#include "param_c.inc"
327#include "tabsiz_c.inc"
328C-----------------------------------------------
329C D u m m y A r g u m e n t s
330C-----------------------------------------------
331 INTEGER WEIGHT(*),IRBE3(NRBE3L,*),LRBE3(*),
332 . NDOF(*),IDDL(*)
333C REAL
334 my_real
335 . X(3,*), SKEW(LSKEW,*), FRBE3(*),B(*)
336C-----------------------------------------------
337C L o c a l V a r i a b l e s
338C-----------------------------------------------
339 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
340 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,NSJ
341C REAL
342 my_real,
343 . DIMENSION(:),ALLOCATABLE :: FDSTNB ,MDSTNB
344
345C-----------------------------------------------
346 iads = slrbe3/2
347 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
348 ALLOCATE(fdstnb(18*max_m))
349 IF (irotg>0) ALLOCATE(mdstnb(18*max_m))
350 DO n=1,nrbe3
351 iad = irbe3(1,n)
352 ns = irbe3(3,n)
353 IF (ns==0) cycle
354 nml = irbe3(5,n)
355 irot =irbe3(6,n)
356 IF (weight(ns)/=0) THEN
357 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
358 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
359 . mdstnb ,irbe3(2,n) )
360 CALL rbe3_impb0(ns ,nml ,lrbe3(iad+1),x ,irot ,
361 2 jt(1,n),jr(1,n),fdstnb ,mdstnb ,ndof ,
362 4 iddl ,b )
363 END IF
364 ENDDO
365C
366 DEALLOCATE(fdstnb)
367 IF (irotg>0) DEALLOCATE(mdstnb)
368C
369 RETURN
370 END
371!||====================================================================
372!|| rbe3_impb0 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
373!||--- called by ------------------------------------------------------
374!|| rbe3_impr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
375!||--- calls -----------------------------------------------------
376!|| updb_cdi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
377!||====================================================================
378 SUBROUTINE rbe3_impb0(NS ,NML ,IML ,X ,IROT ,
379 2 JT ,JR ,FDSTNB ,MDSTNB,NDOF ,
380 3 IDDL ,B )
381C-----------------------------------------------
382C I m p l i c i t T y p e s
383C-----------------------------------------------
384#include "implicit_f.inc"
385C-----------------------------------------------
386C D u m m y A r g u m e n t s
387C-----------------------------------------------
388 INTEGER NS, NML,IML(*),JT(3),JR(3),NDOF(*),IDDL(*),IROT
389 my_real
390 . X(3,*),B(*),FDSTNB(18,*),MDSTNB(18,*)
391C-----------------------------------------------
392C L o c a l V a r i a b l e s
393C-----------------------------------------------
394 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
395 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
396 . NIR1,IR,IP
397C REAL
398 my_real
399 . BD(6),BI(6)
400C------------------------------------
401C VITESSES DES NOEUDS SECONDS
402C------------------------------------
403 IF (ndof(ns)<=0) RETURN
404C
405 i = ns
406 DO k=1,ndof(i)
407 id = iddl(i)+k
408 bd(k)=b(id)
409 ENDDO
410 DO k=ndof(i)+1,6
411 bd(k)=zero
412 ENDDO
413 DO k=1,3
414 bd(k)=bd(k)*jt(k)
415 bd(k+3)=bd(k+3)*jr(k)
416 ENDDO
417C-------Update K(main node)---
418 DO j=1,nml
419 nj=iml(j)
420 CALL updb_cdi(fdstnb(1,j),mdstnb(1,j),bd,bi,irot)
421 DO k=1,ndof(nj)
422 id = iddl(nj)+k
423 b(id) = b(id) + bi(k)
424 ENDDO
425 ENDDO
426C
427 RETURN
428 END
429!||====================================================================
430!|| rbe3_impr2 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
431!||--- called by ------------------------------------------------------
432!|| imp_dykv ../engine/source/implicit/imp_dyna.F
433!|| imp_dykv0 ../engine/source/implicit/imp_dyna.F
434!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
435!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
436!||--- calls -----------------------------------------------------
437!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
438!|| rbe3_impb2 ../engine/source/constraints/general/rbe3/rbe3_imp0.f
439!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
440!||====================================================================
441 SUBROUTINE rbe3_impr2(
442 1 IRBE3 ,LRBE3 ,FRBE3 ,X ,SKEW ,
443 2 NDOF ,IDDL ,B ,WEIGHT,A ,
444 3 AR )
445C-----------------------------------------------
446C I m p l i c i t T y p e s
447C-----------------------------------------------
448#include "implicit_f.inc"
449C-----------------------------------------------
450C C o m m o n B l o c k s
451C-----------------------------------------------
452#include "com04_c.inc"
453#include "param_c.inc"
454#include "tabsiz_c.inc"
455C-----------------------------------------------
456C D u m m y A r g u m e n t s
457C-----------------------------------------------
458 INTEGER WEIGHT(*),IRBE3(NRBE3L,*),LRBE3(*),
459 . ndof(*),iddl(*)
460C REAL
461 my_real
462 . x(3,*), skew(lskew,*), frbe3(*),b(*),a(*),ar(*)
463C-----------------------------------------------
464C L o c a l V a r i a b l e s
465C-----------------------------------------------
466 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
467 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,NSJ
468C REAL
469 my_real,
470 . DIMENSION(:),ALLOCATABLE :: FDSTNB ,MDSTNB
471
472C-----------------------------------------------
473 IADS = slrbe3/2
474 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
475 ALLOCATE(fdstnb(18*max_m))
476 IF (irotg>0) ALLOCATE(mdstnb(18*max_m))
477 DO n=1,nrbe3
478 iad = irbe3(1,n)
479 ns = irbe3(3,n)
480 IF (ns==0) cycle
481 nml = irbe3(5,n)
482 irot =irbe3(6,n)
483 IF (weight(ns)/=0) THEN
484 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
485 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
486 . mdstnb ,irbe3(2,n))
487 CALL rbe3_impb2(ns ,nml ,lrbe3(iad+1),x ,irot ,
488 2 jt(1,n),jr(1,n),fdstnb ,mdstnb ,ndof ,
489 4 iddl ,b ,a ,ar )
490 END IF
491 ENDDO
492C
493 DEALLOCATE(fdstnb)
494 IF (irotg>0) DEALLOCATE(mdstnb)
495C
496 RETURN
497 END
498!||====================================================================
499!|| rbe3_impb2 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
500!||--- called by ------------------------------------------------------
501!|| rbe3_impr2 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
502!||--- calls -----------------------------------------------------
503!|| updb_cdi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
504!||====================================================================
505 SUBROUTINE rbe3_impb2(NS ,NML ,IML ,X ,IROT ,
506 2 JT ,JR ,FDSTNB ,MDSTNB,NDOF ,
507 3 IDDL ,B ,A ,AR )
508C-----------------------------------------------
509C I m p l i c i t T y p e s
510C-----------------------------------------------
511#include "implicit_f.inc"
512C-----------------------------------------------
513C D u m m y A r g u m e n t s
514C-----------------------------------------------
515 INTEGER NS, NML,IML(*),JT(3),JR(3),NDOF(*),IDDL(*),IROT
516C REAL
517 my_real
518 . x(3,*),b(*),fdstnb(18,*),mdstnb(18,*),a(3,*),ar(3,*)
519C-----------------------------------------------
520C C o m m o n B l o c k s
521C-----------------------------------------------
522#include "com01_c.inc"
523C-----------------------------------------------
524C L o c a l V a r i a b l e s
525C-----------------------------------------------
526 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
527 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
528 . NIR1,IR,IP
529C REAL
530 my_real
531 . BD(6),BI(6)
532C------------------------------------
533C VITESSES DES NOEUDS SECONDS
534C------------------------------------
535C
536 i = ns
537 IF (iroddl/=0) THEN
538 nd = 6
539 ELSE
540 nd = 3
541 ENDIF
542 IF (ndof(i)==0) THEN
543 DO k=1,3
544 bd(k)=a(k,i)
545 ENDDO
546 IF (nd==3) THEN
547 DO k=nd+1,6
548 bd(k)=zero
549 ENDDO
550 ELSE
551 DO k=1,3
552 bd(k+3)=ar(k,i)
553 ENDDO
554 ENDIF
555 DO k=1,3
556 bd(k)=bd(k)*jt(k)
557 bd(k+3)=bd(k+3)*jr(k)
558 ENDDO
559C-------Update K(main node)---
560 DO j=1,nml
561 nj=iml(j)
562 IF (ndof(nj)> 0) THEN
563 CALL updb_cdi(fdstnb(1,j),mdstnb(1,j),bd,bi,irot)
564 DO k=1,3
565 id = iddl(nj)+k
566 b(id)=bi(k)
567 ENDDO
568 IF (irot>0) THEN
569 DO k=4,6
570 id = iddl(nj)+k
571 b(id)=bi(k)
572 ENDDO
573 ENDIF
574 END IF
575 ENDDO
576C
577 ELSE
578 DO k=1,ndof(i)
579 id = iddl(i)+k
580 bd(k)=b(id)
581 ENDDO
582 DO k=ndof(i)+1,6
583 bd(k)=zero
584 ENDDO
585 ENDIF
586C
587 DO k=1,3
588 bd(k)=bd(k)*jt(k)
589 bd(k+3)=bd(k+3)*jr(k)
590 ENDDO
591C-------Update K(main node)---
592 DO j=1,nml
593 nj=iml(j)
594 IF (ndof(nj)==0) THEN
595 CALL updb_cdi(fdstnb(1,j),mdstnb(1,j),bd,bi,irot)
596 DO k=1,3
597 a(k,nj)=a(k,nj)+bi(k)
598 ENDDO
599 IF (irot>0) THEN
600 DO k=1,3
601 ar(k,nj)=ar(k,nj)+bi(k+3)
602 ENDDO
603 ENDIF
604 END IF
605 ENDDO
606C
607 RETURN
608 END
609!||====================================================================
610!|| updk_bc ../engine/source/constraints/general/rbe3/rbe3_imp0.f
611!||--- called by ------------------------------------------------------
612!|| rbe2_imp1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
613!||====================================================================
614 SUBROUTINE updk_bc(JT,JR,K ,ISTIF)
615C-----------------------------------------------
616C I m p l i c i t T y p e s
617C-----------------------------------------------
618#include "implicit_f.inc"
619C-----------------------------------------------
620C D u m m y A r g u m e n t s
621C-----------------------------------------------
622 INTEGER JT(3),JR(3),ISTIF
623C REAL
624 my_real
625 . k(6,6)
626C-----------------------------------------------
627C L o c a l V a r i a b l e s
628C-----------------------------------------------
629 INTEGER I, J
630C REAL
631 my_real
632 . R
633C------------------------------------
634C
635 DO i=1,3
636 DO j=1,3
637 k(i,j)= k(i,j)*jt(i)*jt(j)
638 k(i,j+3)= k(i,j+3)*jt(i)*jr(j)
639 k(i+3,j)= k(i+3,j)*jr(i)*jt(j)
640 k(i+3,j+3)= k(i+3,j+3)*jr(i)*jr(j)
641 ENDDO
642 ENDDO
643 r = zero
644 DO i=1,6
645 DO j=1,6
646 r=r+abs(k(i,j))
647 ENDDO
648 ENDDO
649 IF (r<em30) THEN
650 istif = 0
651 ELSE
652 istif = 1
653 ENDIF
654C
655 RETURN
656 END
657!||====================================================================
658!|| updk_bc2 ../engine/source/constraints/general/rbe3/rbe3_imp0.f
659!||--- called by ------------------------------------------------------
660!|| rbe2_imp1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
661!||====================================================================
662 SUBROUTINE updk_bc2(JT,JR,K ,ISTIF)
663C-----------------------------------------------
664C I m p l i c i t T y p e s
665C-----------------------------------------------
666#include "implicit_f.inc"
667C-----------------------------------------------
668C D u m m y A r g u m e n t s
669C-----------------------------------------------
670 INTEGER JT(3),JR(3),ISTIF
671C REAL
672 my_real
673 . k(6,6)
674C-----------------------------------------------
675C L o c a l V a r i a b l e s
676C-----------------------------------------------
677 INTEGER I, J
678C REAL
679 my_real
680 . R
681C------------------------------------
682C
683 DO i=1,3
684 DO j=1,3
685 k(i,j)= k(i,j)*jt(j)
686 k(i,j+3)= k(i,j+3)*jr(j)
687 k(i+3,j)= k(i+3,j)*jt(j)
688 k(i+3,j+3)= k(i+3,j+3)*jr(j)
689 ENDDO
690 ENDDO
691 r=zero
692 DO i=1,6
693 DO j=1,6
694 r=r+abs(k(i,j))
695 ENDDO
696 ENDDO
697 IF (r<em30) THEN
698 istif = 0
699 ELSE
700 istif = 1
701 ENDIF
702C
703 RETURN
704 END
705!||====================================================================
706!|| updb_cdi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
707!||--- called by ------------------------------------------------------
708!|| rbe3_imp1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
709!|| rbe3_impb0 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
710!|| rbe3_impb2 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
711!||====================================================================
712 SUBROUTINE updb_cdi(FDI,MDI,BD,BI,IROT)
713C-----------------------------------------------
714C I m p l i c i t T y p e s
715C-----------------------------------------------
716#include "implicit_f.inc"
717C-----------------------------------------------
718C D u m m y A r g u m e n t s
719C-----------------------------------------------
720 INTEGER IROT
721C REAL
722 my_real
723 . fdi(3,6),mdi(3,6),bd(6),bi(6)
724C-----------------------------------------------
725C L o c a l V a r i a b l e s
726C-----------------------------------------------
727 INTEGER I, J
728C REAL
729C-------Update =CDI^t[BD]---
730 DO J=1,6
731 bi(j) = zero
732 ENDDO
733C
734 DO i=1,3
735 DO j=1,6
736 bi(i)=bi(i)+fdi(i,j)*bd(j)
737 ENDDO
738 ENDDO
739 IF (irot>0) THEN
740 DO i=4,6
741 DO j=1,6
742 bi(i)=bi(i)+mdi(i-3,j)*bd(j)
743 ENDDO
744 ENDDO
745 END IF
746C
747 RETURN
748 END
749!||====================================================================
750!|| updk_cdii ../engine/source/constraints/general/rbe3/rbe3_imp0.F
751!||--- called by ------------------------------------------------------
752!|| rbe3_fr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
753!|| rbe3_frupd ../engine/source/constraints/general/rbe3/rbe3_imp0.F
754!|| rbe3_imp1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
755!||====================================================================
756 SUBROUTINE updk_cdii(FDI,MDI,KDD,KII,IROT,ND)
757C-----------------------------------------------
758C I m p l i c i t T y p e s
759C-----------------------------------------------
760#include "implicit_f.inc"
761C-----------------------------------------------
762C D u m m y A r g u m e n t s
763C-----------------------------------------------
764 INTEGER IROT,ND
765C REAL
766 my_real
767 . fdi(3,6),mdi(3,6),kdd(6,6),kii(6,6)
768C-----------------------------------------------
769C L o c a l V a r i a b l e s
770C-----------------------------------------------
771 INTEGER I, J,K,L
772C REAL
773C-------Update KII=CDI^t[KDD]CDI----FDI=CDI^t
774 DO I=1,6
775 do j=i,6
776 kii(i,j)=zero
777 ENDDO
778 ENDDO
779C---- FDI[KDD]FDI^t------
780 DO i=1,3
781 DO j=i,3
782 DO k=1,nd
783 DO l=1,nd
784 kii(i,j)=kii(i,j)+fdi(i,k)*kdd(k,l)*fdi(j,l)
785 ENDDO
786 ENDDO
787 ENDDO
788 ENDDO
789 DO i=1,3
790 DO j=i,3
791 kii(j,i)=kii(i,j)
792 ENDDO
793 ENDDO
794 IF (irot>0) THEN
795C---- MDI[KDD]MDI^t------
796 DO i=1,3
797 DO j=i,3
798 DO k=1,nd
799 DO l=1,nd
800 kii(i+3,j+3)=kii(i+3,j+3)+mdi(i,k)*kdd(k,l)*mdi(j,l)
801 ENDDO
802 ENDDO
803 ENDDO
804 ENDDO
805C---- FDI[KDD]MDI^t------
806 DO i=1,3
807 DO j=1,3
808 DO k=1,nd
809 DO l=1,nd
810 kii(i,j+3)=kii(i,j+3)+fdi(i,k)*kdd(k,l)*mdi(j,l)
811 ENDDO
812 ENDDO
813 ENDDO
814 ENDDO
815 DO i=1,3
816 DO j=1,3
817 kii(i+3,j)=kii(j,i+3)
818 ENDDO
819 ENDDO
820 DO i=1,3
821 DO j=i,3
822 kii(j+3,i+3)=kii(i+3,j+3)
823 ENDDO
824 ENDDO
825 ENDIF
826C
827 RETURN
828 END
829!||====================================================================
830!|| updk_cdij ../engine/source/constraints/general/rbe3/rbe3_imp0.F
831!||--- called by ------------------------------------------------------
832!|| rbe3_fr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
833!|| rbe3_imp1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
834!||====================================================================
835 SUBROUTINE updk_cdij(FDI,MDI,FDJ,MDJ,KDD,KIJ,IROT,ND)
836C-----------------------------------------------
837C I m p l i c i t T y p e s
838C-----------------------------------------------
839#include "implicit_f.inc"
840C-----------------------------------------------
841C D u m m y A r g u m e n t s
842C-----------------------------------------------
843 INTEGER IROT,ND
844C REAL
845 my_real
846 . fdi(3,6),mdi(3,6),fdj(3,6),mdj(3,6),kdd(6,6),kij(6,6)
847C-----------------------------------------------
848C L o c a l V a r i a b l e s
849C-----------------------------------------------
850 INTEGER I, J,K,L
851C REAL
852C-------Update KII=CDI^t[KDD]CDJ---
853 DO I=1,6
854 do j=1,6
855 kij(i,j)=zero
856 ENDDO
857 ENDDO
858C---- FDI[KDD]FDJ^t------
859 DO i=1,3
860 DO j=1,3
861 DO k=1,nd
862 DO l=1,nd
863 kij(i,j)=kij(i,j)+fdi(i,k)*kdd(k,l)*fdj(j,l)
864 ENDDO
865 ENDDO
866 ENDDO
867 ENDDO
868 IF (irot>0) THEN
869C---- MDI[KDD]MDJ^t------
870 DO i=1,3
871 DO j=1,3
872 DO k=1,nd
873 DO l=1,nd
874 kij(i+3,j+3)=kij(i+3,j+3)+mdi(i,k)*kdd(k,l)*mdj(j,l)
875 ENDDO
876 ENDDO
877 ENDDO
878 ENDDO
879C---- FDI[KDD]MDI^t------
880 DO i=1,3
881 DO j=1,3
882 DO k=1,nd
883 DO l=1,nd
884 kij(i,j+3)=kij(i,j+3)+fdi(i,k)*kdd(k,l)*mdj(j,l)
885 ENDDO
886 ENDDO
887 ENDDO
888 ENDDO
889C---- MDI[KDD]MDJ^t------
890 DO i=1,3
891 DO j=1,3
892 DO k=1,nd
893 DO l=1,nd
894 kij(i+3,j)=kij(i+3,j)+mdi(i,k)*kdd(k,l)*fdj(j,l)
895 ENDDO
896 ENDDO
897 ENDDO
898 ENDDO
899 ENDIF
900C
901 RETURN
902 END
903!||====================================================================
904!|| updk_cdi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
905!||--- called by ------------------------------------------------------
906!|| rbe3_fr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
907!|| rbe3_imp1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
908!||====================================================================
909 SUBROUTINE updk_cdi(FDI,MDI,KDD,KIJ,IROT,ND,ISYM)
910C-----------------------------------------------
911C I m p l i c i t T y p e s
912C-----------------------------------------------
913#include "implicit_f.inc"
914C-----------------------------------------------
915C D u m m y A r g u m e n t s
916C-----------------------------------------------
917 INTEGER IROT,ND,ISYM
918C REAL
919 my_real
920 . fdi(3,6),mdi(3,6),kdd(6,6),kij(6,6)
921C-----------------------------------------------
922C L o c a l V a r i a b l e s
923C-----------------------------------------------
924 INTEGER I, J,K,L
925C REAL
926C-------Update KIJ=[KDD]CDI---
927 DO I=1,6
928 do j=1,6
929 kij(i,j)=zero
930 ENDDO
931 ENDDO
932C---- FDI[KDD]------
933 DO i=1,nd
934 DO j=1,3
935 DO k=1,nd
936 kij(i,j)=kij(i,j)+kdd(i,k)*fdi(j,k)
937 ENDDO
938 ENDDO
939 ENDDO
940 IF (irot>0) THEN
941C---- MDI[KDD]------
942 DO i=1,nd
943 DO j=1,3
944 DO k=1,nd
945 kij(i,j+3)=kij(i,j+3)+kdd(i,k)*mdi(j,k)
946 ENDDO
947 ENDDO
948 ENDDO
949 ENDIF
950C
951 IF (isym==1) THEN
952 DO i=1,6
953 DO j=1,6
954 kij(i,j)=kij(i,j)+kij(j,i)
955 ENDDO
956 ENDDO
957 ENDIF
958C
959 RETURN
960 END
961!||====================================================================
962!|| updfrk_bc ../engine/source/constraints/general/rbe3/rbe3_imp0.F
963!||--- called by ------------------------------------------------------
964!|| rbe3_frupd ../engine/source/constraints/general/rbe3/rbe3_imp0.F
965!||====================================================================
966 SUBROUTINE updfrk_bc(JT, K ,ISTIF)
967C-----------------------------------------------
968C I m p l i c i t T y p e s
969C-----------------------------------------------
970#include "implicit_f.inc"
971C-----------------------------------------------
972C D u m m y A r g u m e n t s
973C-----------------------------------------------
974 INTEGER JT(3),ISTIF
975C REAL
976 my_real
977 . k(6,6)
978C-----------------------------------------------
979C L o c a l V a r i a b l e s
980C-----------------------------------------------
981 INTEGER I, J
982C REAL
983 my_real
984 . R
985C------------------------------------
986C
987 DO i=1,3
988 DO j=1,3
989 k(i,j)= k(i,j)*jt(i)*jt(j)
990 ENDDO
991 ENDDO
992 r = zero
993 DO i=1,3
994 DO j=1,3
995 r=r+abs(k(i,j))
996 ENDDO
997 ENDDO
998 IF (r<em30) THEN
999 istif = 0
1000 ELSE
1001 istif = 1
1002 ENDIF
1003C
1004 RETURN
1005 END
1006!||====================================================================
1007!|| rbe3_frupd ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1008!||--- called by ------------------------------------------------------
1009!|| diag_int ../engine/source/mpi/implicit/imp_fri.F
1010!|| updk_mv ../engine/source/airbag/monv_imp0.F
1011!||--- calls -----------------------------------------------------
1012!|| updfrk_bc ../engine/source/constraints/general/rbe3/rbe3_imp0.f
1013!|| updk_cdii ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1014!||====================================================================
1015 SUBROUTINE rbe3_frupd(NIR ,IML ,FDSTNB ,MDSTNB ,NDOF ,
1016 1 JT ,IROT ,KSS ,DIAG_M3)
1017C-----------------------------------------------
1018C I m p l i c i t T y p e s
1019C-----------------------------------------------
1020#include "implicit_f.inc"
1021C-----------------------------------------------
1022C D u m m y A r g u m e n t s
1023C-----------------------------------------------
1024 integer
1025 . nir ,iml(*) ,ndof(*),jt(*)
1026C REAL
1027 my_real
1028 . kss(6),diag_m3(6,nir),fdstnb(18,nir),mdstnb(18,nir)
1029C-----------------------------------------------
1030C L o c a l V a r i a b l e s
1031C-----------------------------------------------
1032 INTEGER I, J, JD, L, JJ,NJ,ND,IROT,NS,ISTIF
1033C REAL
1034 my_real
1035 . K0(6,6),KIJ(6,6)
1036C-----------------------------------------------
1037 nd = 3
1038 DO j = 1,3
1039 k0(j,j)=kss(j)
1040 ENDDO
1041 k0(1,2)=kss(4)
1042 k0(1,3)=kss(5)
1043 k0(2,3)=kss(6)
1044 k0(2,1) = k0(1,2)
1045 k0(3,1) = k0(1,3)
1046 k0(3,2) = k0(2,3)
1047 CALL updfrk_bc(jt,k0 ,istif)
1048 IF (istif>0) THEN
1049 DO j=1,nir
1050 CALL updk_cdii(fdstnb(1,j),mdstnb(1,j),
1051 . k0 ,kij ,irot ,nd )
1052 DO jj=1,6
1053 diag_m3(jj,j)=kij(jj,jj)
1054 ENDDO
1055 ENDDO
1056 ENDIF
1057C
1058 RETURN
1059 END
1060!||====================================================================
1061!|| rbe3_fr0 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1062!||--- called by ------------------------------------------------------
1063!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
1064!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.F
1065!||--- calls -----------------------------------------------------
1066!|| rbe3_fr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1067!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
1068!||====================================================================
1069 SUBROUTINE rbe3_fr0(NS ,NML ,IML ,X ,IROT ,
1070 2 JT ,JR ,FRBE3 ,SKEW ,IKC ,
1071 3 NDOF ,IADK ,JDIK ,DIAG_K ,LT_K ,
1072 2 KSS ,KSM ,KNM ,KRM ,IDLM ,
1073 3 ISS ,ISM ,ITAB ,ISK ,ID )
1074C-----------------------------------------------
1075C I m p l i c i t T y p e s
1076C-----------------------------------------------
1077#include "implicit_f.inc"
1078C-----------------------------------------------
1079C D u m m y A r g u m e n t s
1080C-----------------------------------------------
1081 INTEGER NS, NML,IML(*),JT(3),JR(3),IROT
1082 INTEGER IADK(*),JDIK(*),NDOF(*),ITAB(*),
1083 . idlm(*) ,iss ,ism,isk(*),ikc(*),id
1084C REAL
1085 my_real
1086 . x(3,*),diag_k(*),lt_k(*),frbe3(*),skew(*),
1087 . kss(6),ksm(3,3),knm(3,3,*),krm(3,3,*)
1088C-----------------------------------------------
1089C L o c a l V a r i a b l e s
1090C-----------------------------------------------
1091 INTEGER I, J
1092C REAL
1093 my_real
1094 . fdstnb(18,nml),mdstnb(18,nml)
1095C------------------------------------
1096C VITESSES DES NOEUDS SECONDS
1097C------------------------------------
1098 IF (ndof(ns)<=0) RETURN
1099 CALL rbe3cl(iml ,isk ,ns ,x ,frbe3 ,
1100 . skew ,nml ,irot ,fdstnb ,mdstnb ,id)
1101 CALL rbe3_fr1(ns ,nml ,iml ,x ,irot ,
1102 2 jt ,jr ,fdstnb ,mdstnb,ikc ,
1103 3 ndof ,iadk ,jdik ,diag_k ,lt_k ,
1104 2 kss ,ksm ,knm ,krm ,idlm ,
1105 3 iss ,ism ,itab )
1106C
1107 RETURN
1108 END
1109!||====================================================================
1110!|| rbe3_fr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.f
1111!||--- called by ------------------------------------------------------
1112!|| rbe3_fr0 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1113!||--- calls -----------------------------------------------------
1114!|| print_wkij ../engine/source/implicit/imp_glob_k.F
1115!|| put_kmii ../engine/source/implicit/imp_glob_k.F
1116!|| put_kmij ../engine/source/implicit/imp_glob_k.F
1117!|| updk_cdi ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1118!|| updk_cdii ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1119!|| updk_cdij ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1120!||====================================================================
1121 SUBROUTINE rbe3_fr1(NS ,NML ,IML ,X ,IROT ,
1122 2 JT ,JR ,FDSTNB ,MDSTNB,IKC ,
1123 3 NDOF ,IADK ,JDIK ,DIAG_K ,LT_K ,
1124 2 KSS ,KSM ,KNM ,KRM ,IDLM ,
1125 3 ISS ,ISM ,ITAB )
1126C-----------------------------------------------
1127C I m p l i c i t T y p e s
1128C-----------------------------------------------
1129#include "implicit_f.inc"
1130C-----------------------------------------------
1131C D u m m y A r g u m e n t s
1132C-----------------------------------------------
1133 INTEGER NS, NML,IML(*),JT(3),JR(3),IROT
1134 INTEGER IADK(*),JDIK(*),NDOF(*),ITAB(*),
1135 . IDLM(*) ,ISS ,ISM,IKC(*)
1136 my_real
1137 . x(3,*),diag_k(*),lt_k(*),fdstnb(18,*),mdstnb(18,*),
1138 . kss(6),ksm(3,3),knm(3,3,*),krm(3,3,*)
1139C-----------------------------------------------
1140C L o c a l V a r i a b l e s
1141C-----------------------------------------------
1142 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
1143 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
1144 . NIR1,IR,IP,ISTIF,NDOFI
1145 my_real
1146 . KDD(6,6),KII(6,6)
1147C------------------------------------
1148C VITESSES DES NOEUDS SECONDS
1149C------------------------------------
1150 IF (ndof(ns)<=0) RETURN
1151C
1152 ndofi = 3
1153 ip=4
1154 i = ns
1155 DO k=1,6
1156 DO j=1,6
1157 kdd(k,j)=zero
1158 ENDDO
1159 ENDDO
1160 IF (iss>0) THEN
1161 DO k=1,ndofi
1162 kdd(k,k) = kss(k)
1163 ENDDO
1164 kdd(1,2) = kss(4)
1165 kdd(1,3) = kss(5)
1166 kdd(2,3) = kss(6)
1167 kdd(2,1) = kdd(1,2)
1168 kdd(3,1) = kdd(1,3)
1169 kdd(3,2) = kdd(2,3)
1170C CALL UPDFRK_BC(JT,KDD,ISTIF)
1171C
1172C-------Update K(main node)---
1173C IF (ISTIF>0) THEN
1174 DO j=1,nml
1175 nj=iml(j)
1176 nd = ndof(nj)
1177C-------Update CDI^t[KDD]CDI---
1178 CALL updk_cdii(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndofi)
1179 CALL put_kmii(idlm(j),iadk,diag_k,lt_k ,kii,nd)
1180 DO i1=j+1,nml
1181 nm=iml(i1)
1182C-------Update CDI^t[KDD]CDJ---
1183 CALL updk_cdij(fdstnb(1,j),mdstnb(1,j),fdstnb(1,i1),
1184 . mdstnb(1,i1),kdd,kii,irot,ndofi)
1185 CALL put_kmij(idlm(j) ,idlm(i1) ,iadk,jdik,lt_k,
1186 . kii,nd ,nd ,ir )
1187 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,ip )
1188 ENDDO
1189 ENDDO
1190 ELSE
1191 END IF
1192C END IF !(ISS>0) THEN
1193C--------no diag--Kjm=sum(KjsCsm)--
1194 IF (ism>0) THEN
1195C--------no diag--Kjm=sum(KjsCsm)--
1196 DO k=1,ndofi
1197 DO j=1,ndofi
1198 kdd(k,j) = ksm(k,j)
1199 ENDDO
1200 ENDDO
1201C------- Update ---
1202C CALL UPDFRK_BC(JT,KDD,ISTIF)
1203C IF (ISTIF>0) THEN
1204 DO j=1,nml
1205 nj=iml(j)
1206 CALL updk_cdi(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndofi,0)
1207 DO k=1,ndofi
1208 DO j1=1,ndofi
1209 knm(k,j1,j)=kii(j1,k)
1210 krm(k,j1,j)=kii(j1,k+ndofi)
1211 ENDDO
1212 ENDDO
1213 ENDDO
1214 ENDIF
1215C ENDIF
1216C
1217 RETURN
1218 END
my_real
#define my_real
Definition cppsort.cpp:32
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
put_kmij
subroutine put_kmij(ini, inj, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:1238
imp_glob_k
subroutine imp_glob_k(pm, geo, ipm, igeo, elbuf, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iparg, tf, npc, fr_wave, w16, bufmat, thke, bufgeo, rby, skew, x, wa, iddl, ndof, k_diag, k_lt, iadk, jdik, ikgeo, etag, elbuf_tab, stack, drape_sh4n, drape_sh3n, drapeg)
Definition imp_glob_k.F:62
get_kij
subroutine get_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:713
rbe3cl
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
Definition kinchk.F:1586
prerbe3
subroutine prerbe3(irbe3, max_m, irotg, jt, jr)
Definition kinchk.F:1494
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
rbe3_fr1
subroutine rbe3_fr1(ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ikc, ndof, iadk, jdik, diag_k, lt_k, kss, ksm, knm, krm, idlm, iss, ism, itab)
Definition rbe3_imp0.F:1126
updfrk_bc
subroutine updfrk_bc(jt, k, istif)
Definition rbe3_imp0.F:967
updk_cdij
subroutine updk_cdij(fdi, mdi, fdj, mdj, kdd, kij, irot, nd)
Definition rbe3_imp0.F:836
rbe3_fr0
subroutine rbe3_fr0(ns, nml, iml, x, irot, jt, jr, frbe3, skew, ikc, ndof, iadk, jdik, diag_k, lt_k, kss, ksm, knm, krm, idlm, iss, ism, itab, isk, id)
Definition rbe3_imp0.F:1074
updk_cdii
subroutine updk_cdii(fdi, mdi, kdd, kii, irot, nd)
Definition rbe3_imp0.F:757
rbe3_imp0
subroutine rbe3_imp0(irbe3, lrbe3, frbe3, x, skew, iss3, ikc, ndof, iddl, iadk, jdik, diag_k, lt_k, b, weight, itab)
Definition rbe3_imp0.F:37
rbe3_impb2
subroutine rbe3_impb2(ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ndof, iddl, b, a, ar)
Definition rbe3_imp0.F:508
updk_cdi
subroutine updk_cdi(fdi, mdi, kdd, kij, irot, nd, isym)
Definition rbe3_imp0.F:910
rbe3_frupd
subroutine rbe3_frupd(nir, iml, fdstnb, mdstnb, ndof, jt, irot, kss, diag_m3)
Definition rbe3_imp0.F:1017
rbe3_imp1
subroutine rbe3_imp1(ns, nml, iml, x, irot, nsj, isj, jt, jr, fdstnb, mdstnb, ikc, ndof, iddl, iadk, jdik, diag_k, lt_k, b, itab)
Definition rbe3_imp0.F:191
rbe3_impr2
subroutine rbe3_impr2(irbe3, lrbe3, frbe3, x, skew, ndof, iddl, b, weight, a, ar)
Definition rbe3_imp0.F:445
updk_bc2
subroutine updk_bc2(jt, jr, k, istif)
Definition rbe3_imp0.F:663
rbe3_impb0
subroutine rbe3_impb0(ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ndof, iddl, b)
Definition rbe3_imp0.F:381
rbe3_impi
subroutine rbe3_impi(irbe3, lrbe3, frbe3, x, skew, nss3, iss3, ikc, ndof, iddl, iadk, jdik, diag_k, lt_k, b, weight, itab)
Definition rbe3_imp0.F:110
rbe3_impr1
subroutine rbe3_impr1(irbe3, lrbe3, frbe3, x, skew, ndof, iddl, b, weight)
Definition rbe3_imp0.F:318
updk_bc
subroutine updk_bc(jt, jr, k, istif)
Definition rbe3_imp0.F:615
updb_cdi
subroutine updb_cdi(fdi, mdi, bd, bi, irot)
Definition rbe3_imp0.F:713
rbe3f
subroutine rbe3f(irbe3, lrbe3, x, a, ar, ms, in, frbe3, skew, weight, stifn, stifr, jt, jr, irotg, max_m, am, arm, msm, inm, stifnm, stifrm, nmt0, iadmp, pen, v, vr, nmt, dt1, iroddl)
Definition rbe3f.F:280