OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2_imp1.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!|| i2_imp1 ../engine/source/interfaces/interf/i2_imp1.F
25!||--- called by ------------------------------------------------------
26!|| i2_imp0 ../engine/source/interfaces/interf/i2_imp0.F
27!|| i2_impi ../engine/source/interfaces/interf/i2_imp0.f
28!||--- calls -----------------------------------------------------
29!|| i2updk0 ../engine/source/interfaces/interf/i2_imp1.F
30!|| i2updk1 ../engine/source/interfaces/interf/i2_imp1.f
31!||--- uses -----------------------------------------------------
32!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
33!||====================================================================
34 SUBROUTINE i2_imp1(IPARI,INTBUF_TAB,ITAB ,
35 . NSC2 ,ISIJ2,NSS2,ISS2 ,
36 . X ,MS ,IN ,WEIGHT ,
37 . IKC ,NDOF ,NDDL,IDDL ,IADK ,
38 . JDIK ,DIAG_K ,LT_K ,B )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE intbufdef_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER IPARI(*), WEIGHT(*),
51 . NSC2,ISIJ2(*),NSS2(*),ISS2(*),ITAB(*)
52 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
53C REAL
54 my_real
55 . x(*),ms(*),in(*),diag_k(*),lt_k(*),b(*)
56
57 TYPE(intbuf_struct_) INTBUF_TAB
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "param_c.inc"
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 integer
66 . k10, k11, k12, k13, k14, kfi, j10, j11, j12, j21, j22,
67 . jfi,nsn,nmn,nrts,nrtm,ilev
68C-----------------------------------------------
69 nrts =ipari(3)
70 nrtm =ipari(4)
71 nsn =ipari(5)
72 nmn =ipari(6)
73 ilev =ipari(20)
74C
75 k10=1
76 k11=k10+4*nrts
77 k12=k11+4*nrtm
78 k13=k12+nsn
79 k14=k13+nmn
80 kfi=k14+nsn
81 j10=1
82 j11=j10+1
83 j12=j11+nparir
84 j21=j12+2*nsn
85 j22=j21+7*nsn
86 jfi=j22+nmn
87C version spmd avec plus d'un proc nsn = nsn_loc & nmn = nmn_loc
88 IF(ilev==1)THEN
89 CALL i2updk1(nsn ,nmn ,intbuf_tab%IRECTM,
90 1 intbuf_tab%DPARA,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%IRTLM,
91 2 ms ,x ,weight ,itab ,
92 3 nsc2 ,isij2 ,nss2 ,iss2 ,
93 4 ikc ,ndof ,nddl,iddl ,iadk ,
94 5 jdik ,diag_k ,lt_k ,b)
95 ELSE
96 CALL i2updk0(nsn ,nmn ,intbuf_tab%IRECTM,
97 1 intbuf_tab%CSTS,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%IRTLM,
98 2 ms ,x ,weight ,itab ,
99 3 nsc2 ,isij2 ,nss2 ,iss2 ,
100 4 ikc ,ndof ,nddl,iddl ,iadk ,
101 5 jdik ,diag_k ,lt_k ,b)
102 ENDIF
103C
104 RETURN
105 END
106!||====================================================================
107!|| i2_impm ../engine/source/interfaces/interf/i2_imp1.F
108!||--- called by ------------------------------------------------------
109!|| i2_imp0 ../engine/source/interfaces/interf/i2_imp0.F
110!||--- calls -----------------------------------------------------
111!|| get_kij ../engine/source/implicit/imp_glob_k.f
112!|| i2updkm0 ../engine/source/interfaces/interf/i2_imp1.F
113!|| i2updkm1 ../engine/source/interfaces/interf/i2_imp1.F
114!||--- uses -----------------------------------------------------
115!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
116!||====================================================================
117 SUBROUTINE i2_impm(IPARI,INTBUF_TAB,NMC2 ,IMIJ2,
118 . X ,MS ,IN ,WEIGHT ,
119 . NDOF ,NDDL,IDDL ,IADK ,JDIK ,
120 . LT_K ,DIAG_K)
121C-----------------------------------------------
122C M o d u l e s
123C-----------------------------------------------
124 USE intbufdef_mod
125C-----------------------------------------------
126C I m p l i c i t T y p e s
127C-----------------------------------------------
128#include "implicit_f.inc"
129C-----------------------------------------------
130C C o m m o n B l o c k s
131C-----------------------------------------------
132#include "param_c.inc"
133C-----------------------------------------------
134C D u m m y A r g u m e n t s
135C-----------------------------------------------
136 INTEGER IPARI(NPARI,*), WEIGHT(*),
137 . NMC2,IMIJ2(4,*)
138 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*)
139C REAL
140 my_real
141 . X(*),MS(*),IN(*),LT_K(*),DIAG_K(*)
142
143 TYPE(intbuf_struct_) INTBUF_TAB(*)
144C-----------------------------------------------
145C L o c a l V a r i a b l e s
146C-----------------------------------------------
147 integer
148 . k10, k11, k12, k13, k14, kfi, j10, j11, j12, j21, j22,
149 . l10, l11, l12, l13, l14, lfi, m10, m11, m12, m21, m22,
150 . ji,jfi,ji1,nsn,nsn1,ilev,n1,n2,ns1,ns2,ni,nj,i,ir
151 my_real
152 . kdd(6,6)
153C-----------------------------------------------
154 DO i=1,nmc2
155 n1=imij2(1,i)
156 n2=imij2(2,i)
157 ns1=imij2(3,i)
158 ns2=imij2(4,i)
159 nsn = ipari(5,n1)
160 ji=ipari(1,n1)
161 k10=ji
162 k11=k10+4*ipari(3,n1)
163 k12=k11+4*ipari(4,n1)
164 k13=k12+nsn
165 k14=k13+ipari(6,n1)
166 ni=intbuf_tab(n1)%NSV(ns1)
167 j10=ipari(2,n1)
168 j11=j10+1
169 j12=j11+nparir
170 j21=j12+2*nsn
171 nsn1 = ipari(5,n2)
172 ji1=ipari(1,n2)
173 l10=ji1
174 l11=l10+4*ipari(3,n2)
175 l12=l11+4*ipari(4,n2)
176 l13=l12+nsn1
177 l14=l13+ipari(6,n2)
178 nj=intbuf_tab(n2)%IRECTM(ns2)
179 m10=ipari(2,n2)
180 m11=m10+1
181 m12=m11+nparir
182 m21=m12+2*nsn1
183C------supposant ILEV est le meme pour NI,NJ---
184 ilev =ipari(20,n1)
185 IF (ndof(ni)>0.AND.ndof(nj)>0) THEN
186 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,ndof(ni),ndof(nj),ir)
187 IF(ilev==1)THEN
188 CALL i2updkm1(ns1,intbuf_tab(n1)%IRECTM,intbuf_tab(n1)%DPARA,intbuf_tab(n1)%NSV,intbuf_tab(n1)%IRTLM,
189 . ns2,intbuf_tab(n2)%IRECTM,intbuf_tab(n2)%DPARA,intbuf_tab(n2)%NSV,intbuf_tab(n2)%IRTLM,
190 . x ,kdd ,ndof ,iddl ,iadk ,
191 . jdik,lt_k ,diag_k )
192 ELSE
193 CALL i2updkm0(ns1,intbuf_tab(n1)%IRECTM,intbuf_tab(n1)%CSTS,intbuf_tab(n1)%NSV,intbuf_tab(n1)%IRTLM,
194 . ns2,intbuf_tab(n2)%IRECTM,intbuf_tab(n2)%CSTS,intbuf_tab(n2)%NSV,intbuf_tab(n2)%IRTLM,
195 . x ,kdd ,ndof ,iddl ,iadk ,
196 . jdik,lt_k ,diag_k )
197 ENDIF
198 ENDIF
199 ENDDO
200C
201 RETURN
202 END
203!||====================================================================
204!|| i2updk0 ../engine/source/interfaces/interf/i2_imp1.F
205!||--- called by ------------------------------------------------------
206!|| i2_imp1 ../engine/source/interfaces/interf/i2_imp1.F
207!||--- calls -----------------------------------------------------
208!|| get_kii ../engine/source/implicit/imp_glob_k.F
209!|| get_kij ../engine/source/implicit/imp_glob_k.F
210!|| print_wkij ../engine/source/implicit/imp_glob_k.F
211!|| put_kii ../engine/source/implicit/imp_glob_k.F
212!|| put_kij ../engine/source/implicit/imp_glob_k.F
213!|| updkb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
214!|| updkb_rb1 ../engine/source/constraints/general/rbody/rby_imp0.F
215!|| updkb_rb2 ../engine/source/constraints/general/rbody/rby_imp0.F
216!|| updkdd ../engine/source/interfaces/interf/i2_imp1.F
217!|| updkdd1 ../engine/source/interfaces/interf/i2_imp1.F
218!|| updkdd2 ../engine/source/interfaces/interf/i2_imp1.F
219!||====================================================================
220 SUBROUTINE i2updk0(NSN,NMN,IRECT,CRST,MSR ,
221 1 NSV,IRTL,MS ,X ,WEIGHT,
222 2 ITAB,NSC, ISI ,NS ,NODS,
223 3 IKC ,NDOF ,NDDL,IDDL ,IADK ,
224 4 JDIK ,DIAG_K ,LT_K ,B)
225C-----------------------------------------------
226C I m p l i c i t T y p e s
227C-----------------------------------------------
228#include "implicit_f.inc"
229C-----------------------------------------------
230C D u m m y A r g u m e n t s
231C-----------------------------------------------
232 INTEGER NSN, NMN,
233 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*),
234 . NSC,ISI(2,NSC) ,NS(*),NODS(*),ITAB(*)
235 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
236C REAL
237 my_real
238 . CRST(2,*),X(3,*),MS(*),DIAG_K(*),LT_K(*),B(*)
239C-----------------------------------------------
240C L o c a l V a r i a b l e s
241C-----------------------------------------------
242 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
243 . i1,id,nl,ni,nj,nidof,nd,ndi,ndj,ndm,nm,l1,nm1,
244 . nir1,ir
245C REAL
246 my_real
247 . h(4,nsn),h2(4), ss, tt, sp,sm,tp,tm,kdd(6,6),bd(6),
248 . kii(6,6),bi(6),xs0(nsn),ys0(nsn),zs0(nsn),
249 . xs,ys,zs,xs1,ys1,zs1,facm,nun
250C------------------------------------
251C VITESSES DES NOEUDS SECONDS
252C------------------------------------
253C-------pour simplement etre coherent avec INTTI2, on ne distinque pas 3n,4n
254C-------on est oblige de distinque quand meme, sinon la matrice n'est plus positive
255C FACM = ONE / NIR
256 nun=-one
257 j1=0
258 DO ii=1,nsn
259 i=nsv(ii)
260 l=irtl(ii)
261 IF (ndof(i)>0) THEN
262 DO k=1,ndof(i)
263 id = iddl(i)+k
264 ikc(id)=5
265 bd(k)=b(id)
266 ENDDO
267 DO k=ndof(i)+1,6
268 bd(k)=zero
269 ENDDO
270 CALL get_kii(i ,iddl ,iadk,diag_k,lt_k ,kdd,ndof(i))
271C
272 ss=crst(1,ii)
273 tt=crst(2,ii)
274 ss = min(one,ss)
275 tt = min(one,tt)
276 ss = max(nun,ss)
277 tt = max(nun,tt)
278 sp=one + ss
279 sm=one - ss
280 IF (irect(3,l)==irect(4,l)) THEN
281 nir=3
282 tp=fourth*(one + tt)
283 tm=fourth*(one - tt)
284 h(1,ii)=tm*sm
285 h(2,ii)=tm*sp
286 h(3,ii)=one-h(1,ii)-h(2,ii)
287 h2(1)=h(1,ii)*h(1,ii)
288 h2(2)=h(2,ii)*h(2,ii)
289 h2(3)=h(3,ii)*h(3,ii)
290 ELSE
291 nir=4
292 tp=fourth*(one + tt)
293 tm=fourth*(one - tt)
294 h(1,ii)=tm*sm
295 h(2,ii)=tm*sp
296 h(3,ii)=tp*sp
297 h(4,ii)=tp*sm
298 h2(1)=h(1,ii)*h(1,ii)
299 h2(2)=h(2,ii)*h(2,ii)
300 h2(3)=h(3,ii)*h(3,ii)
301 h2(4)=h(4,ii)*h(4,ii)
302 ENDIF
303 ndm = 0
304 DO j=1,nir
305 nj=irect(j,l)
306 ndm = max(ndm,ndof(nj))
307 ENDDO
308C-------NDOF(M)> 3 comme rigid body---
309 IF (ndm==6) THEN
310 xs0(ii)=zero
311 ys0(ii)=zero
312 zs0(ii)=zero
313 DO j=1,nir
314 nj=irect(j,l)
315 xs0(ii)=xs0(ii)+x(1,nj)*h(j,ii)
316 ys0(ii)=ys0(ii)+x(2,nj)*h(j,ii)
317 zs0(ii)=zs0(ii)+x(3,nj)*h(j,ii)
318 ENDDO
319 xs=x(1,i)-xs0(ii)
320 ys=x(2,i)-ys0(ii)
321 zs=x(3,i)-zs0(ii)
322 CALL updkb_rb(ndof(i),xs,ys,zs,kdd,bd)
323 ENDIF
324CC-------Update K(main node),B---
325 DO j=1,nir
326 nj=irect(j,l)
327 nd = min(ndm,ndof(nj))
328 CALL updkdd(nd,kdd,kii,h2(j),1)
329 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,nd)
330 DO k=1,nd
331 id = iddl(nj)+k
332 b(id) = b(id) + h(j,ii)*bd(k)
333 ENDDO
334 DO i1=j+1,nir
335 nm=irect(i1,l)
336 tm=h(j,ii)*h(i1,ii)
337 nd = min(nd,ndof(nm))
338 CALL updkdd(nd,kdd,kii,tm,0)
339 CALL put_kij(nj,nm,iddl,iadk,jdik,lt_k,kii,nd,nd,ir)
340 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,2 )
341 ENDDO
342 ENDDO
343C--------no diag--Kjm=sum(KjsCsm)--
344 DO i1 = 1,ns(ii)
345 ni=nods(j1+i1)
346 nidof=ndof(ni)
347 CALL get_kij(ni,i,iddl,iadk,jdik,lt_k,kdd,nidof,ndof(i),ir)
348 IF (ir==1) CALL print_wkij(itab(ni) ,itab(i) ,2 )
349C------- Update ---
350 IF (ndm==6) CALL updkb_rb1(nidof,ndof(i),xs,ys,zs,kdd)
351 DO j=1,nir
352 nj=irect(j,l)
353 ndi = min(ndm,nidof)
354 ndj = min(ndm,ndof(nj))
355 IF (ni==nj.AND.ndj>0) THEN
356 CALL updkdd1(ndi,ndof(i),kdd,kii,h(j,ii),1)
357 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,ndj)
358 ELSEIF (ndj>0) THEN
359 CALL updkdd1(ndi,ndof(i),kdd,kii,h(j,ii),0)
360 CALL put_kij(ni,nj,iddl,iadk,jdik,lt_k,kii,ndi,ndj,ir)
361 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,2 )
362 ENDIF
363 ENDDO
364 ENDDO
365 j1=j1+ns(ii)
366 ENDIF
367 ENDDO
368C--------due au coupled block KIJ--
369 DO i=1,nsc
370 ii =isi(1,i)
371 jj =isi(2,i)
372 ni =nsv(ii)
373 nj =nsv(jj)
374 l=irtl(ii)
375 l1=irtl(jj)
376 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,ndof(ni),ndof(nj),ir)
377 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,2 )
378 IF (irect(3,l)==irect(4,l)) THEN
379 nir=3
380 ELSE
381 nir=4
382 ENDIF
383 IF (l==l1) THEN
384 ndm = 0
385 DO j=1,nir
386 nm=irect(j,l)
387 ndm = max(ndm,ndof(nm))
388 ENDDO
389 IF (ndm==6) THEN
390 xs=x(1,ni)-xs0(ii)
391 ys=x(2,ni)-ys0(ii)
392 zs=x(3,ni)-zs0(ii)
393 xs1=x(1,nj)-xs0(jj)
394 ys1=x(2,nj)-ys0(jj)
395 zs1=x(3,nj)-zs0(jj)
396 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,0)
397 ENDIF
398 DO j=1,nir
399 nm=irect(j,l)
400 tm=h(j,ii)*h(j,jj)
401 CALL updkdd2(ndm,kdd,kii,tm,tm)
402 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k,kii,ndof(nm))
403 DO j1=j+1,nir
404 nm1=irect(j1,l)
405 ndm = min(ndof(nm),ndof(nm1))
406 IF (ndm>0) THEN
407 tm=h(j,ii)*h(j1,jj)
408 tp=h(j,jj)*h(j1,ii)
409 CALL updkdd2(ndm,kdd,kii,tm,tp)
410C--------update --
411 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,
412 . ndof(nm),ndof(nm1),ir)
413 IF (ir==1) CALL print_wkij(itab(nm) ,itab(nm1) ,2 )
414 ENDIF
415 ENDDO
416 ENDDO
417C----- (L/=L1)-----
418 ELSE
419 ndm = 0
420 IF (irect(3,l1)==irect(4,l1)) THEN
421 nir1=3
422 ELSE
423 nir1=4
424 ENDIF
425 DO j=1,max(nir,nir1)
426 nm=irect(j,l)
427 nm1=irect(j,l1)
428 ndm = max(ndm,ndof(nm),ndof(nm1))
429 ENDDO
430 IF (ndm==6) THEN
431 xs=x(1,ni)-xs0(ii)
432 ys=x(2,ni)-ys0(ii)
433 zs=x(3,ni)-zs0(ii)
434 xs1=x(1,nj)-xs0(jj)
435 ys1=x(2,nj)-ys0(jj)
436 zs1=x(3,nj)-zs0(jj)
437 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,0)
438 ENDIF
439 DO j=1,nir
440 nm=irect(j,l)
441 DO j1=1,nir1
442 nm1=irect(j1,l1)
443 tm=h(j,ii)*h(j1,jj)
444C--------update --
445 ndm = min(ndof(nm),ndof(nm1))
446 IF (nm==nm1.AND.ndm>0) THEN
447 CALL updkdd1(ndof(ni),ndof(nj),kdd,kii,tm,1)
448 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k,kii,ndof(nm))
449 ELSEIF (ndm>0) THEN
450 CALL updkdd1(ndof(ni),ndof(nj),kdd,kii,tm,0)
451 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,
452 . ndof(nm),ndof(nm1),ir)
453 IF (ir==1) CALL print_wkij(itab(nm) ,itab(nm1) ,2 )
454 ENDIF
455 ENDDO
456 ENDDO
457 ENDIF
458 ENDDO
459C
460 RETURN
461 END
462!||====================================================================
463!|| i2updkm0 ../engine/source/interfaces/interf/i2_imp1.F
464!||--- called by ------------------------------------------------------
465!|| i2_impm ../engine/source/interfaces/interf/i2_imp1.F
466!||--- calls -----------------------------------------------------
467!|| put_kii ../engine/source/implicit/imp_glob_k.F
468!|| put_kij ../engine/source/implicit/imp_glob_k.F
469!|| updkb_rb2 ../engine/source/constraints/general/rbody/rby_imp0.F
470!|| updkdd1 ../engine/source/interfaces/interf/i2_imp1.F
471!||====================================================================
472 SUBROUTINE i2updkm0(NS1,IRECT,CRST,NSV,IRTL,
473 . NS2,IRECT1,CRST1,NSV1,IRTL1,
474 . X ,KDD ,NDOF ,IDDL ,IADK ,
475 . JDIK,LT_K ,DIAG_K)
476C-----------------------------------------------
477C I m p l i c i t T y p e s
478C-----------------------------------------------
479#include "implicit_f.inc"
480C-----------------------------------------------
481C D u m m y A r g u m e n t s
482C-----------------------------------------------
483 INTEGER NS1,IRECT(4,*), NSV(*), IRTL(*),
484 . NS2,IRECT1(4,*), NSV1(*), IRTL1(*),
485 . NDOF(*) ,IDDL(*) ,IADK(*),JDIK(*)
486C REAL
487 my_real
488 . crst(2,*),crst1(2,*),x(3,*),kdd(6,6),lt_k(*),diag_k(*)
489C-----------------------------------------------
490C L o c a l V a r i a b l e s
491C-----------------------------------------------
492 INTEGER J, L, J1,L1,NI,NJ,K,NIR,NIR1,NM,NM1,NDM,IR
493C REAL
494 my_real
495 . H(4),H1(4),SS, TT, SP,SM,TP,TM,NUN,
496 . KII(6,6),XS,YS,ZS,XS1,YS1,ZS1,XM0,YM0,ZM0,XM1,YM1,ZM1
497C------------------------------------
498 nun=-one
499 l=irtl(ns1)
500 l1=irtl1(ns2)
501 ss=crst(1,ns1)
502 tt=crst(2,ns1)
503 ss = min(one,ss)
504 tt = min(one,tt)
505 ss = max(nun,ss)
506 tt = max(nun,tt)
507 sp=one + ss
508 sm=one - ss
509 IF (irect(3,l)==irect(4,l)) THEN
510 nir=3
511 tp=fourth*(one + tt)
512 tm=fourth*(one - tt)
513 h(1)=tm*sm
514 h(2)=tm*sp
515 h(3)=one-h(1)-h(2)
516 ELSE
517 nir=4
518 tp=fourth*(one + tt)
519 tm=fourth*(one - tt)
520 h(1)=tm*sm
521 h(2)=tm*sp
522 h(3)=tp*sp
523 h(4)=tp*sm
524 ENDIF
525 xm0=zero
526 ym0=zero
527 zm0=zero
528 DO j=1,nir
529 nj=irect(j,l)
530 xm0=xm0+x(1,nj)*h(j)
531 ym0=ym0+x(2,nj)*h(j)
532 zm0=zm0+x(3,nj)*h(j)
533 ENDDO
534C---------NJ------
535 ss=crst1(1,ns2)
536 tt=crst1(2,ns2)
537 ss = min(one,ss)
538 tt = min(one,tt)
539 ss = max(nun,ss)
540 tt = max(nun,tt)
541 sp=one + ss
542 sm=one - ss
543 IF (irect1(3,l1)==irect1(4,l1)) THEN
544 nir1=3
545 tp=fourth*(one + tt)
546 tm=fourth*(one - tt)
547 h1(1)=tm*sm
548 h1(2)=tm*sp
549 h1(3)=one-h1(1)-h1(2)
550 ELSE
551 nir1=4
552 tp=fourth*(one + tt)
553 tm=fourth*(one - tt)
554 h1(1)=tm*sm
555 h1(2)=tm*sp
556 h1(3)=tp*sp
557 h1(4)=tp*sm
558 ENDIF
559 xm1=zero
560 ym1=zero
561 zm1=zero
562 DO j=1,nir1
563 nj=irect1(j,l1)
564 xm1=xm1+x(1,nj)*h1(j)
565 ym1=ym1+x(2,nj)*h1(j)
566 zm1=zm1+x(3,nj)*h1(j)
567 ENDDO
568 ni = nsv(ns1)
569 nj = nsv1(ns2)
570 ndm = max(ndof(ni),ndof(nj))
571 DO j=1,max(nir,nir1)
572 nm=irect(j,l)
573 nm1=irect1(j,l1)
574 ndm = max(ndm,ndof(nm),ndof(nm1))
575 ENDDO
576C-------NDOF(M)> 3 comme rigid body---
577 IF (ndm==6) THEN
578 xs=x(1,ni)-xm0
579 ys=x(2,ni)-ym0
580 zs=x(3,ni)-zm0
581 xs1=x(1,nj)-xm1
582 ys1=x(2,nj)-ym1
583 zs1=x(3,nj)-zm1
584 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,0)
585 ENDIF
586 DO j=1,nir
587 nm=irect(j,l)
588 DO j1=1,nir1
589 nm1=irect1(j1,l1)
590 tm=h(j)*h1(j1)
591C--------update --
592 IF (nm==nm1) THEN
593 CALL updkdd1(ndof(ni),ndof(nj),kdd,kii,tm,1)
594 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k,kii,ndof(nm))
595 ELSE
596 CALL updkdd1(ndof(ni),ndof(nj),kdd,kii,tm,0)
597 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,
598 . ndof(nm),ndof(nm1),ir)
599 ENDIF
600 ENDDO
601 ENDDO
602C
603 RETURN
604 END
605!||====================================================================
606!|| i2updk1 ../engine/source/interfaces/interf/i2_imp1.F
607!||--- called by ------------------------------------------------------
608!|| i2_imp1 ../engine/source/interfaces/interf/i2_imp1.F
609!||--- calls -----------------------------------------------------
610!|| get_kii ../engine/source/implicit/imp_glob_k.F
611!|| get_kij ../engine/source/implicit/imp_glob_k.F
612!|| i2matc ../engine/source/interfaces/interf/i2_imp1.F
613!|| print_wkij ../engine/source/implicit/imp_glob_k.F
614!|| put_kii ../engine/source/implicit/imp_glob_k.F
615!|| put_kij ../engine/source/implicit/imp_glob_k.F
616!|| updk1_ii ../engine/source/interfaces/interf/i2_imp1.F
617!|| updk1_ij ../engine/source/interfaces/interf/i2_imp1.F
618!|| updk1_jj ../engine/source/interfaces/interf/i2_imp1.F
619!||====================================================================
620 SUBROUTINE i2updk1(NSN,NMN,IRECT,DPARA,MSR ,
621 1 NSV,IRTL,MS ,X ,WEIGHT,
622 2 ITAB,NSC, ISI ,NS ,NODS,
623 3 IKC ,NDOF ,NDDL,IDDL ,IADK ,
624 4 JDIK ,DIAG_K ,LT_K ,B)
625C-----------------------------------------------
626C I m p l i c i t T y p e s
627C-----------------------------------------------
628#include "implicit_f.inc"
629C-----------------------------------------------
630C D u m m y A r g u m e n t s
631C-----------------------------------------------
632 INTEGER NSN, NMN,
633 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*),
634 . NSC,ISI(2,NSC) ,NS(*),NODS(*),ITAB(*)
635 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
636C REAL
637 my_real
638 . dpara(7,*),x(*),ms(*),diag_k(*),lt_k(*),b(*)
639C-----------------------------------------------
640C L o c a l V a r i a b l e s
641C-----------------------------------------------
642 INTEGER NIR(NSN),I, J, K, JD, II, L, JJ,I1,ID,NL,
643 . NI,NJ,J1,NIDOF,ND,NM,IDOF,L1,NM1,NDM,ND1,IR
644C REAL
645 my_real
646 . RJ(9,4,NSN),RJT(9,4,NSN)
647 my_real
648 . KDD(6,6),BD(6),KII(6,6),BI(6),XS,YS,ZS,XS1,YS1,ZS1
649C------------------------------------
650C VITESSES DES NOEUDS SECONDS
651C------------------------------------
652 CALL i2matc(nsn,irect,dpara,nsv,irtl,x,nir,rj ,rjt )
653 j1=0
654 nd = 3
655 ndm = 3
656 DO ii=1,nsn
657 i=nsv(ii)
658 idof=ndof(i)
659 IF (idof>0) THEN
660 l=irtl(ii)
661 DO k=1,idof
662 id = iddl(i)+k
663 ikc(id)=5
664 bd(k)=b(id)
665 ENDDO
666 DO k=idof+1,6
667 bd(k)=zero
668 ENDDO
669 CALL get_kii(i ,iddl ,iadk,diag_k,lt_k ,kdd,idof)
670 DO j=1,idof
671 DO k=j+1,idof
672 kdd(k,j)=kdd(j,k)
673 ENDDO
674 ENDDO
675C-------Update K(main node),B---
676 DO j=1,nir(ii)
677 nj=irect(j,l)
678 nd=min(ndm,ndof(nj))
679 CALL updk1_ii(idof,rj(1,j,ii),rjt(1,j,ii),kdd,kii,bd,bi)
680 CALL put_kii(nj ,iddl ,iadk,diag_k,lt_k ,kii,nd)
681 DO k=1,nd
682 id = iddl(nj)+k
683 b(id) = b(id) + bi(k)
684 ENDDO
685 DO i1=j+1,nir(ii)
686 nm=irect(i1,l)
687 nd1=min(ndm,ndof(nj))
688 CALL updk1_ij(idof,idof,rj(1,j,ii),rjt(1,j,ii),
689 1 rj(1,i1,ii),rjt(1,i1,ii),kdd,kii,0)
690 CALL put_kij(nj,nm,iddl,iadk,jdik,lt_k,kii,nd,nd1,ir)
691 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,2 )
692 ENDDO
693 ENDDO
694C--------no diag--Kmj=sum(KjsCsm)--
695 DO i1 = 1,ns(ii)
696 ni=nods(j1+i1)
697 nidof=ndof(ni)
698 CALL get_kij(ni,i,iddl,iadk,jdik,lt_k,kdd,nidof,idof,ir)
699 IF (ir==1) CALL print_wkij(itab(ni) ,itab(i) ,2 )
700C------- Update ---
701 DO j=1,nir(ii)
702 nj=irect(j,l)
703 nd=min(ndm,ndof(nj))
704 IF (ni==nj.AND.nd>0) THEN
705 CALL updk1_jj(nidof,idof,rj(1,j,ii),rjt(1,j,ii),kdd,kii)
706 DO k=1,3
707 DO l1=1,3
708 kii(k,l1)=kii(k,l1)+kii(l1,k)
709 ENDDO
710 ENDDO
711 CALL put_kii(nj ,iddl ,iadk,diag_k,lt_k ,kii,nd)
712 ELSEIF (nd>0) THEN
713 CALL updk1_jj(nidof,idof,rj(1,j,ii),rjt(1,j,ii),kdd,kii)
714 CALL put_kij(ni,nj,iddl,iadk,jdik,lt_k,kii,nidof,nd,ir)
715 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,2 )
716 ENDIF
717 ENDDO
718 ENDDO
719 j1=j1+ns(ii)
720 ENDIF
721 ENDDO
722C--------due au coupled block KIJ-attension ISI different que rigid body-
723 DO i=1,nsc
724 ii =isi(1,i)
725 jj =isi(2,i)
726 ni =nsv(ii)
727 nj =nsv(jj)
728 l=irtl(ii)
729 l1=irtl(jj)
730 nidof=ndof(ni)
731 idof=ndof(nj)
732 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,nidof,idof,ir)
733 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,2 )
734 IF (l==l1) THEN
735 DO j=1,nir(ii)
736 nm=irect(j,l)
737C--------update --
738 nd=min(ndm,ndof(nm))
739 CALL updk1_ij(nidof,idof,rj(1,j,ii),rjt(1,j,ii),
740 1 rj(1,j,jj),rjt(1,j,jj),kdd,kii,1)
741 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k ,kii,nd)
742 DO j1=j+1,nir(jj)
743 nm1=irect(j1,l)
744 nd1=min(ndm,ndof(nm1))
745 IF (nd1>0) THEN
746 CALL updk1_ij(nidof,idof,rj(1,j,ii),rjt(1,j,ii),
747 1 rj(1,j1,jj),rjt(1,j1,jj),kdd,kii,0)
748 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,nd,nd1,ir)
749 IF (ir==1) CALL print_wkij(itab(nm) ,itab(nm1) ,2 )
750 CALL updk1_ij(nidof,idof,rj(1,j1,ii),rjt(1,j1,ii),
751 1 rj(1,j,jj),rjt(1,j,jj),kdd,kii,0)
752 CALL put_kij(nm1,nm,iddl,iadk,jdik,lt_k,kii,nd1,nd,ir)
753 IF (ir==1) CALL print_wkij(itab(nm1) ,itab(nm) ,2 )
754 ENDIF
755 ENDDO
756 ENDDO
757 ELSE
758 DO j=1,nir(ii)
759 nm=irect(j,l)
760 nd=min(ndm,ndof(nm))
761 DO j1=1,nir(jj)
762 nm1=irect(j1,l1)
763 nd1=min(ndm,ndof(nm1))
764 IF (nm==nm1.AND.nd1>0) THEN
765 CALL updk1_ij(nidof,idof,rj(1,j,ii),rjt(1,j,ii),
766 1 rj(1,j1,jj),rjt(1,j1,jj),kdd,kii,1)
767 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k ,kii,nd)
768 ELSEIF (nd1>0) THEN
769 CALL updk1_ij(nidof,idof,rj(1,j,ii),rjt(1,j,ii),
770 1 rj(1,j1,jj),rjt(1,j1,jj),kdd,kii,0)
771 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,nd,nd1,ir)
772 IF (ir==1) CALL print_wkij(itab(nm) ,itab(nm1) ,2 )
773 ENDIF
774 ENDDO
775 ENDDO
776 ENDIF
777 ENDDO
778C
779 RETURN
780 END
781C-------------produit {K'}=[CDI]^t[K][CDI] B'=[CDI]^tB with [CDI]=-[RJT RJ]^t
782!||====================================================================
783!|| updk1_ii ../engine/source/interfaces/interf/i2_imp1.F
784!||--- called by ------------------------------------------------------
785!|| i2_frk1 ../engine/source/interfaces/interf/i2_imp1.F
786!|| i2updk1 ../engine/source/interfaces/interf/i2_imp1.F
787!||====================================================================
788 SUBROUTINE updk1_ii(NDL,RJ,RJT,KDD,K,BD,B)
789C-----------------------------------------------
790C I m p l i c i t T y p e s
791C-----------------------------------------------
792#include "implicit_f.inc"
793C-----------------------------------------------
794C D u m m y A r g u m e n t s
795C-----------------------------------------------
796 INTEGER NDL
797C REAL
798 my_real
799 . b(3),k(6,6),rj(3,3), rjt(3,3), bd(6),kdd(6,6)
800C-----------------------------------------------
801C L o c a l V a r i a b l e s
802C-----------------------------------------------
803 INTEGER I, J
804C REAL
805 my_real
806 . k1(3,3)
807C------------------------------------
808 DO i=1,3
809 DO j=i,3
810 k(i,j)=rjt(1,i)*(kdd(1,1)*rjt(1,j)+
811 1 kdd(1,2)*rjt(2,j)+kdd(1,3)*rjt(3,j))+
812 2 rjt(2,i)*(kdd(1,2)*rjt(1,j)+
813 3 kdd(2,2)*rjt(2,j)+kdd(2,3)*rjt(3,j))+
814 4 rjt(3,i)*(kdd(1,3)*rjt(1,j)+
815 5 kdd(2,3)*rjt(2,j)+kdd(3,3)*rjt(3,j))
816 ENDDO
817 ENDDO
818 DO i=1,3
819 b(i)=rjt(1,i)*bd(1)+rjt(2,i)*bd(2)+rjt(3,i)*bd(3)
820 ENDDO
821C
822 IF (ndl==6) THEN
823 DO i=1,3
824 DO j=1,3
825 k1(i,j)= rjt(1,i)*(kdd(1,4)*rj(1,j)+
826 1 kdd(1,5)*rj(2,j)+kdd(1,6)*rj(3,j))+
827 2 rjt(2,i)*(kdd(2,4)*rj(1,j)+
828 3 kdd(2,5)*rj(2,j)+kdd(2,6)*rj(3,j))+
829 4 rjt(3,i)*(kdd(3,4)*rj(1,j)+
830 5 kdd(3,5)*rj(2,j)+kdd(3,6)*rj(3,j))
831 ENDDO
832 ENDDO
833 DO i=1,3
834 DO j=i,3
835 k(i,j)= k(i,j)+k1(i,j)+k1(j,i)+
836 1 rj(1,i)*(kdd(4,4)*rj(1,j)+kdd(4,5)*rj(2,j)+
837 2 kdd(4,6)*rj(3,j) ) +
838 3 rj(2,i)*(kdd(4,5)*rj(1,j)+kdd(5,5)*rj(2,j)+
839 4 kdd(5,6)*rj(3,j) ) +
840 5 rj(3,i)*(kdd(4,6)*rj(1,j)+kdd(5,6)*rj(2,j)+
841 6 kdd(6,6)*rj(3,j) )
842 ENDDO
843 ENDDO
844 DO i=1,3
845 b(i)=b(i)+rj(1,i)*bd(4)+rj(2,i)*bd(5)+rj(3,i)*bd(6)
846 ENDDO
847 ENDIF
848C
849 RETURN
850 END
851C-------------produit {K'}=[CDI]^t[K][CDI] with [CDI]=-[RJT RJ]^t
852!||====================================================================
853!|| upfr1_ii ../engine/source/interfaces/interf/i2_imp1.F
854!||--- called by ------------------------------------------------------
855!|| i2_frup1 ../engine/source/interfaces/interf/i2_imp1.F
856!||====================================================================
857 SUBROUTINE upfr1_ii(RJ,RJT,KII,K)
858C-----------------------------------------------
859C I m p l i c i t T y p e s
860C-----------------------------------------------
861#include "implicit_f.inc"
862C-----------------------------------------------
863C D u m m y A r g u m e n t s
864C-----------------------------------------------
865 INTEGER NDL
866C REAL
867 my_real
868 . k(6),rj(3,3), rjt(3,3), kii(6)
869C-----------------------------------------------
870C L o c a l V a r i a b l e s
871C-----------------------------------------------
872 INTEGER I, J
873C REAL
874 my_real
875 . kdd(3,3)
876C------------------------------------
877 DO i=1,3
878 kdd(i,i)=kii(i)
879 ENDDO
880 kdd(1,2)=kii(4)
881 kdd(1,3)=kii(5)
882 kdd(2,3)=kii(6)
883 kdd(2,1)=kdd(1,2)
884 kdd(3,1)=kdd(1,3)
885 kdd(3,2)=kdd(2,3)
886C
887 DO i=1,3
888 j = i
889 k(i)=k(i)+rjt(1,i)*(kdd(1,1)*rjt(1,j)+
890 1 kdd(1,2)*rjt(2,j)+kdd(1,3)*rjt(3,j))+
891 2 rjt(2,i)*(kdd(1,2)*rjt(1,j)+
892 3 kdd(2,2)*rjt(2,j)+kdd(2,3)*rjt(3,j))+
893 4 rjt(3,i)*(kdd(1,3)*rjt(1,j)+
894 5 kdd(2,3)*rjt(2,j)+kdd(3,3)*rjt(3,j))
895 ENDDO
896C
897 RETURN
898 END
899C-------------produit {K'}=[CDI(I)]^t[KIJ][CDI(J)] with [CDI]=-[RJT RJ]^t
900!||====================================================================
901!|| updk1_ij ../engine/source/interfaces/interf/i2_imp1.F
902!||--- called by ------------------------------------------------------
903!|| i2_frk1 ../engine/source/interfaces/interf/i2_imp1.F
904!|| i2updk1 ../engine/source/interfaces/interf/i2_imp1.F
905!|| i2updkm1 ../engine/source/interfaces/interf/i2_imp1.F
906!||====================================================================
907 SUBROUTINE updk1_ij(NDI,NDJ,R1J,R1JT,R2J,R2JT,KDD,KII,ISYM)
908C-----------------------------------------------
909C I m p l i c i t T y p e s
910C-----------------------------------------------
911#include "implicit_f.inc"
912C-----------------------------------------------
913C D u m m y A r g u m e n t s
914C-----------------------------------------------
915 INTEGER NDI,NDJ,ISYM
916C REAL
917 my_real
918 . r1j(3,3), r1jt(3,3),r2j(3,3), r2jt(3,3), kdd(6,6),
919 . kii(6,6)
920C-----------------------------------------------
921C L o c a l V a r i a b l e s
922C-----------------------------------------------
923 INTEGER I, J
924C REAL
925 my_real
926 . k(3,3)
927C------------------------------------
928 DO i=1,3
929 DO j=1,3
930 k(i,j)=r1jt(1,i)*(kdd(1,1)*r2jt(1,j)+
931 1 kdd(1,2)*r2jt(2,j)+kdd(1,3)*r2jt(3,j))+
932 2 r1jt(2,i)*(kdd(2,1)*r2jt(1,j)+
933 3 kdd(2,2)*r2jt(2,j)+kdd(2,3)*r2jt(3,j))+
934 4 r1jt(3,i)*(kdd(3,1)*r2jt(1,j)+
935 5 kdd(3,2)*r2jt(2,j)+kdd(3,3)*r2jt(3,j))
936 ENDDO
937 ENDDO
938C
939 IF (ndi==6) THEN
940 DO i=1,3
941 DO j=1,3
942 k(i,j)=k(i,j)+ r1j(1,i)*(kdd(4,1)*r2jt(1,j)+
943 1 kdd(4,2)*r2jt(2,j)+kdd(4,3)*r2jt(3,j))+
944 2 r1j(2,i)*(kdd(5,1)*r2jt(1,j)+
945 3 kdd(5,2)*r2jt(2,j)+kdd(5,3)*r2jt(3,j))+
946 4 r1j(3,i)*(kdd(6,1)*r2jt(1,j)+
947 5 kdd(6,2)*r2jt(2,j)+kdd(6,3)*r2jt(3,j))
948 ENDDO
949 ENDDO
950 ENDIF
951 IF (ndj==6) THEN
952 DO i=1,3
953 DO j=1,3
954 k(i,j)=k(i,j)+ r1jt(1,i)*(kdd(1,4)*r2j(1,j)+
955 1 kdd(1,5)*r2j(2,j)+kdd(1,6)*r2j(3,j))+
956 2 r1jt(2,i)*(kdd(2,4)*r2j(1,j)+
957 3 kdd(2,5)*r2j(2,j)+kdd(2,6)*r2j(3,j))+
958 4 r1jt(3,i)*(kdd(3,4)*r2j(1,j)+
959 5 kdd(3,5)*r2j(2,j)+kdd(3,6)*r2j(3,j))
960 ENDDO
961 ENDDO
962 ENDIF
963 IF (ndi==6.AND.ndj==6) THEN
964 DO i=1,3
965 DO j=1,3
966 k(i,j)= k(i,j)+
967 1 r1j(1,i)*(kdd(4,4)*r2j(1,j)+kdd(4,5)*r2j(2,j)+
968 2 kdd(4,6)*r2j(3,j) ) +
969 3 r1j(2,i)*(kdd(5,4)*r2j(1,j)+kdd(5,5)*r2j(2,j)+
970 4 kdd(5,6)*r2j(3,j) ) +
971 5 r1j(3,i)*(kdd(6,4)*r2j(1,j)+kdd(6,5)*r2j(2,j)+
972 6 kdd(6,6)*r2j(3,j) )
973 ENDDO
974 ENDDO
975 ENDIF
976C
977 IF (isym==1) THEN
978 DO i=1,3
979 DO j=1,3
980 kii(i,j)=k(i,j)+k(j,i)
981 ENDDO
982 ENDDO
983 ELSE
984 DO i=1,3
985 DO j=1,3
986 kii(i,j)=k(i,j)
987 ENDDO
988 ENDDO
989 ENDIF
990C
991 RETURN
992 END
993C-------------produit {K'}=[K][CDI] [CDI]=-[RJT RJ]^t
994!||====================================================================
995!|| updk1_jj ../engine/source/interfaces/interf/i2_imp1.f
996!||--- called by ------------------------------------------------------
997!|| i2_frk1 ../engine/source/interfaces/interf/i2_imp1.F
998!|| i2updk1 ../engine/source/interfaces/interf/i2_imp1.F
999!||====================================================================
1000 SUBROUTINE updk1_jj(NDI,NDJ,RJ,RJT,KDD,KII)
1001C-----------------------------------------------
1002C I m p l i c i t T y p e s
1003C-----------------------------------------------
1004#include "implicit_f.inc"
1005C-----------------------------------------------
1006C D u m m y A r g u m e n t s
1007C-----------------------------------------------
1008 INTEGER NDI,NDJ
1009C REAL
1010 my_real
1011 . rj(3,3), rjt(3,3), kdd(6,6), kii(6,6)
1012C-----------------------------------------------
1013C L o c a l V a r i a b l e s
1014C-----------------------------------------------
1015 INTEGER I, J,MI
1016C REAL
1017 my_real
1018 . k(6,3)
1019C----------K RJT--------------------------
1020 DO i=1,3
1021 DO j=1,3
1022 k(i,j)=kdd(i,1)*rjt(1,j)+
1023 1 kdd(i,2)*rjt(2,j)+kdd(i,3)*rjt(3,j)
1024 ENDDO
1025 ENDDO
1026C
1027 IF (ndj==6) THEN
1028 DO i=1,3
1029 DO j=1,3
1030 k(i,j)=k(i,j)+kdd(i,4)*rj(1,j)+
1031 1 kdd(i,5)*rj(2,j)+kdd(i,6)*rj(3,j)
1032 ENDDO
1033 ENDDO
1034 ENDIF
1035 IF (ndi==6) THEN
1036 DO i=1,3
1037 mi=i+3
1038 DO j=1,3
1039 k(mi,j)= kdd(mi,1)*rjt(1,j)+
1040 1 kdd(mi,2)*rjt(2,j)+kdd(mi,3)*rjt(3,j)
1041 ENDDO
1042 ENDDO
1043 ENDIF
1044 IF (ndi==6.AND.ndj==6) THEN
1045 DO i=1,3
1046 mi=i+3
1047 DO j=1,3
1048 k(mi,j)= k(mi,j)+ kdd(mi,4)*rj(1,j)+
1049 1 kdd(mi,5)*rj(2,j)+kdd(mi,6)*rj(3,j)
1050 ENDDO
1051 ENDDO
1052 ENDIF
1053C
1054 DO i=1,ndi
1055 DO j=1,3
1056 kii(i,j)=k(i,j)
1057 ENDDO
1058 ENDDO
1059C
1060 RETURN
1061 END
1062C-------------produit {K'}=[CDI]^t[K][CDI] with [CDI]=-H*[I]
1063!||====================================================================
1064!|| updkdd ../engine/source/interfaces/interf/i2_imp1.F
1065!||--- called by ------------------------------------------------------
1066!|| i2_frk0 ../engine/source/interfaces/interf/i2_imp1.F
1067!|| i2updk0 ../engine/source/interfaces/interf/i2_imp1.F
1068!|| rm_imp1 ../engine/source/model/remesh/rm_imp0.F
1069!||====================================================================
1070 SUBROUTINE updkdd(NDL,KDD,KII,H2,ISYM)
1071C-----------------------------------------------
1072C I m p l i c i t T y p e s
1073C-----------------------------------------------
1074#include "implicit_f.inc"
1075C-----------------------------------------------
1076C D u m m y A r g u m e n t s
1077C-----------------------------------------------
1078 INTEGER NDL,ISYM
1079C REAL
1080 my_real
1081 . kdd(6,6),kii(6,6),h2
1082C-----------------------------------------------
1083C L o c a l V a r i a b l e s
1084C-----------------------------------------------
1085 INTEGER I, J
1086C REAL
1087C------------------------------------
1088 DO i=1,6
1089 DO j=1,6
1090 kii(i,j) = zero
1091 ENDDO
1092 ENDDO
1093 DO i=1,ndl
1094 DO j=i,ndl
1095 kii(i,j)=h2*kdd(i,j)
1096 ENDDO
1097 ENDDO
1098 IF(isym/=1) THEN
1099 DO i=1,ndl
1100 DO j=i,ndl
1101 kii(j,i)=kii(i,j)
1102 ENDDO
1103 ENDDO
1104 ENDIF
1105C
1106 RETURN
1107 END
1108C-------------produit {K'}=[K][CDI] with [CDI]=-H*[I]
1109!||====================================================================
1110!|| updkdd1 ../engine/source/interfaces/interf/i2_imp1.F
1111!||--- called by ------------------------------------------------------
1112!|| i2_frk0 ../engine/source/interfaces/interf/i2_imp1.F
1113!|| i2updk0 ../engine/source/interfaces/interf/i2_imp1.F
1114!|| i2updkm0 ../engine/source/interfaces/interf/i2_imp1.F
1115!|| rm_imp1 ../engine/source/model/remesh/rm_imp0.F
1116!||====================================================================
1117 SUBROUTINE updkdd1(NDI,NDJ,KDD,KII,H,ISYM)
1118C-----------------------------------------------
1119C I m p l i c i t T y p e s
1120C-----------------------------------------------
1121#include "implicit_f.inc"
1122C-----------------------------------------------
1123C D u m m y A r g u m e n t s
1124C-----------------------------------------------
1125 INTEGER NDI,NDJ,ISYM
1126C REAL
1127 my_real
1128 . KDD(6,6),KII(6,6),H
1129C-----------------------------------------------
1130C L o c a l V a r i a b l e s
1131C-----------------------------------------------
1132 INTEGER I, J
1133C REAL
1134C------------------------------------
1135 DO i=1,6
1136 DO j=1,6
1137 kii(i,j) = zero
1138 ENDDO
1139 ENDDO
1140 IF(isym==1) THEN
1141 DO i=1,ndi
1142 DO j=1,ndj
1143 kii(i,j)=h*(kdd(i,j)+kdd(j,i))
1144 ENDDO
1145 ENDDO
1146 ELSE
1147 DO i=1,ndi
1148 DO j=1,ndj
1149 kii(i,j)=h*kdd(i,j)
1150 ENDDO
1151 ENDDO
1152 ENDIF
1153C
1154 RETURN
1155 END
1156C-------------produit {K'}=[CDI]^t[KDD][CDJ] with [CDI]=-HI*[KDD]
1157!||====================================================================
1158!|| updkdd2 ../engine/source/interfaces/interf/i2_imp1.F
1159!||--- called by ------------------------------------------------------
1160!|| i2updk0 ../engine/source/interfaces/interf/i2_imp1.F
1161!||====================================================================
1162 SUBROUTINE updkdd2(NDL,KDD,KII,H1,H2)
1163C-----------------------------------------------
1164C I m p l i c i t T y p e s
1165C-----------------------------------------------
1166#include "implicit_f.inc"
1167C-----------------------------------------------
1168C D u m m y A r g u m e n t s
1169C-----------------------------------------------
1170 INTEGER NDL,ISYM
1171C REAL
1172 my_real
1173 . kdd(6,6),kii(6,6),h1,h2
1174C-----------------------------------------------
1175C L o c a l V a r i a b l e s
1176C-----------------------------------------------
1177 INTEGER I, J
1178C REAL
1179C------------------------------------
1180 DO i=1,ndl
1181 DO j=1,ndl
1182 kii(i,j)=h1*kdd(i,j)+h2*kdd(j,i)
1183 ENDDO
1184 ENDDO
1185C
1186 RETURN
1187 END
1188!||====================================================================
1189!|| i2matc ../engine/source/interfaces/interf/i2_imp1.F
1190!||--- called by ------------------------------------------------------
1191!|| i2recu1 ../engine/source/interfaces/interf/i2_imp2.F
1192!|| i2recu2 ../engine/source/interfaces/interf/i2_imp2.F
1193!|| i2updb1 ../engine/source/interfaces/interf/i2_imp1.F
1194!|| i2updb12 ../engine/source/interfaces/interf/i2_imp1.F
1195!|| i2updk1 ../engine/source/interfaces/interf/i2_imp1.F
1196!||====================================================================
1197 SUBROUTINE i2matc(NSN,IRECT,DPARA,NSV,IRTL,X ,
1198 1 NIRI,RJ ,RJT )
1199C-----------------------------------------------
1200C I m p l i c i t T y p e s
1201C-----------------------------------------------
1202#include "implicit_f.inc"
1203C-----------------------------------------------
1204C D u m m y A r g u m e n t s
1205C-----------------------------------------------
1206 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*),NIRI(*)
1207C REAL
1208 my_real
1209 . DPARA(7,*),X(3,*),RJ(3,3,4,NSN),RJT(3,3,4,NSN)
1210C-----------------------------------------------
1211C L o c a l V a r i a b l e s
1212C-----------------------------------------------
1213 INTEGER I, J, II, L, JJ,NJ,K,NIR
1214C REAL
1215 my_real
1216 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
1217 . b1,b2,b3,c1,c2,c3,facm,
1218 . x22,y22,z22,det,xm(4),ym(4),zm(4),x0,y0,z0
1219 my_real
1220 . xs,ys,zs
1221C------------------------------------
1222C MATRICE DE JACOBIEN [C]
1223C------------------------------------
1224 DO ii=1,nsn
1225 i=nsv(ii)
1226 l=irtl(ii)
1227 nir=4
1228 DO j=1,nir
1229 nj=irect(j,l)
1230 xm(j)=x(1,nj)
1231 ym(j)=x(2,nj)
1232 zm(j)=x(3,nj)
1233 ENDDO
1234 IF(irect(3,l)==irect(4,l)) THEN
1235 nir=3
1236 xm(4)=zero
1237 ym(4)=zero
1238 zm(4)=zero
1239 ENDIF
1240 facm = one / nir
1241C----------------------------------------------------
1242C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
1243C----------------------------------------------------
1244 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
1245 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
1246 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
1247 DO j=1,nir
1248 xm(j)=xm(j)-x0
1249 ym(j)=ym(j)-y0
1250 zm(j)=zm(j)-z0
1251 ENDDO
1252 xs=x(1,i)-x0
1253 ys=x(2,i)-y0
1254 zs=x(3,i)-z0
1255C--------cette partie est une double travail que INTTI1
1256 xx=0
1257 yy=0
1258 zz=0
1259 xy=0
1260 yz=0
1261 zx=0
1262 DO j=1,nir
1263 xx=xx+ xm(j)*xm(j)
1264 yy=yy+ ym(j)*ym(j)
1265 zz=zz+ zm(j)*zm(j)
1266 xy=xy+ xm(j)*ym(j)
1267 yz=yz+ ym(j)*zm(j)
1268 zx=zx+ zm(j)*xm(j)
1269 ENDDO
1270 zzz=xx+yy
1271 xxx=yy+zz
1272 yyy=zz+xx
1273 xy2=xy*xy
1274 yz2=yz*yz
1275 zx2=zx*zx
1276 det= xxx*yyy*zzz -xxx*yz2 -yyy*zx2 -zzz*xy2 -two*xy*yz*zx
1277 det=one/det
1278 b1=(zzz*yyy-yz2)*det
1279 b2=(xxx*zzz-zx2)*det
1280 b3=(yyy*xxx-xy2)*det
1281 c3=(zzz*xy+yz*zx)*det
1282 c1=(xxx*yz+zx*xy)*det
1283 c2=(yyy*zx+xy*yz)*det
1284c DET= DPARA(1,II)
1285c B1=DPARA(2,II)
1286c B2=DPARA(3,II)
1287c B3=DPARA(4,II)
1288c C1=DPARA(5,II)
1289c C2=DPARA(6,II)
1290c C3=DPARA(7,II)
1291 DO j=1,nir
1292 x22 = c1*xm(j)
1293 y22 = c2*ym(j)
1294 z22 = c3*zm(j)
1295C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
1296 rj(1,1,j,ii)=z22-y22
1297 rj(2,1,j,ii)=b2*zm(j)-c1*ym(j)
1298 rj(3,1,j,ii)=c1*zm(j)-b3*ym(j)
1299 rj(1,2,j,ii)=-b1*zm(j)+c2*xm(j)
1300 rj(2,2,j,ii)=-z22+x22
1301 rj(3,2,j,ii)=-c2*zm(j)+b3*xm(j)
1302 rj(1,3,j,ii)=b1*ym(j)-c3*xm(j)
1303 rj(2,3,j,ii)=c3*ym(j)-b2*xm(j)
1304 rj(3,3,j,ii)=y22-x22
1305C-------RJT=1/4[I]+(Rs)RJ---
1306 DO k=1,3
1307 rjt(1,k,j,ii)=rj(2,k,j,ii)*zs-rj(3,k,j,ii)*ys
1308 rjt(2,k,j,ii)=-rj(1,k,j,ii)*zs+rj(3,k,j,ii)*xs
1309 rjt(3,k,j,ii)=rj(1,k,j,ii)*ys-rj(2,k,j,ii)*xs
1310 ENDDO
1311 DO k=1,3
1312 rjt(k,k,j,ii)=rjt(k,k,j,ii)+facm
1313 ENDDO
1314 ENDDO
1315 niri(ii)=nir
1316 ENDDO
1317C
1318 RETURN
1319 END
1320!||====================================================================
1321!|| i2updkm1 ../engine/source/interfaces/interf/i2_imp1.F
1322!||--- called by ------------------------------------------------------
1323!|| i2_impm ../engine/source/interfaces/interf/i2_imp1.F
1324!||--- calls -----------------------------------------------------
1325!|| i2matcm ../engine/source/interfaces/interf/i2_imp1.F
1326!|| put_kii ../engine/source/implicit/imp_glob_k.F
1327!|| put_kij ../engine/source/implicit/imp_glob_k.F
1328!|| updk1_ij ../engine/source/interfaces/interf/i2_imp1.F
1329!||====================================================================
1330 SUBROUTINE i2updkm1(NS1,IRECT,DPARA,NSV,IRTL,
1331 . NS2,IRECT1,DPARA1,NSV1,IRTL1,
1332 . X ,KDD ,NDOF ,IDDL ,IADK ,
1333 . JDIK,LT_K ,DIAG_K)
1334C-----------------------------------------------
1335C I m p l i c i t T y p e s
1336C-----------------------------------------------
1337#include "implicit_f.inc"
1338C-----------------------------------------------
1339C D u m m y A r g u m e n t s
1340C-----------------------------------------------
1341 INTEGER NS1,IRECT(4,*), NSV(*), IRTL(*),
1342 . NS2,IRECT1(4,*), NSV1(*), IRTL1(*),
1343 . NDOF(*) ,IDDL(*) ,IADK(*),JDIK(*)
1344C REAL
1345 my_real
1346 . DPARA(7,*),DPARA1(7,*),X(3,*),KDD(6,6),LT_K(*),DIAG_K(*)
1347C-----------------------------------------------
1348C L o c a l V a r i a b l e s
1349C-----------------------------------------------
1350 INTEGER J, L, J1,L1,NI,NJ,K,NIR,NIR1,NM,NM1,IR
1351C REAL
1352 my_real
1353 . kii(6,6),rj(3,3,4),rjt(3,3,4),rj1(3,3,4),rjt1(3,3,4)
1354C------------------------------------
1355 CALL i2matcm(ns1,irect,dpara,nsv,irtl,
1356 . x ,nir ,rj ,rjt )
1357 CALL i2matcm(ns2,irect1,dpara1,nsv1,irtl1,
1358 . x ,nir1 ,rj1 ,rjt1 )
1359 ni=nsv(ns1)
1360 nj=nsv1(ns2)
1361 l=irtl(ns1)
1362 l1=irtl1(ns2)
1363 DO j=1,nir
1364 nm=irect(j,l)
1365 DO j1=1,nir1
1366 nm1=irect1(j1,l1)
1367 IF (nm==nm1) THEN
1368 CALL updk1_ij(ndof(ni),ndof(nj),rj(1,1,j),rjt(1,1,j),
1369 1 rj1(1,1,j1),rjt1(1,1,j1),kdd,kii,1)
1370 CALL put_kii(nm,iddl,iadk,diag_k,lt_k,kii,3)
1371 ELSE
1372 CALL updk1_ij(ndof(ni),ndof(nj),rj(1,1,j),rjt(1,1,j),
1373 1 rj1(1,1,j1),rjt1(1,1,j1),kdd,kii,0)
1374 CALL put_kij(nm1,nm,iddl,iadk,jdik,lt_k,kii,3,3,ir)
1375 ENDIF
1376 ENDDO
1377 ENDDO
1378C
1379 RETURN
1380 END
1381!||====================================================================
1382!|| i2matcm ../engine/source/interfaces/interf/i2_imp1.F
1383!||--- called by ------------------------------------------------------
1384!|| i2updkm1 ../engine/source/interfaces/interf/i2_imp1.F
1385!||====================================================================
1386 SUBROUTINE i2matcm(II,IRECT,DPARA,NSV,IRTL,X ,
1387 1 NIRI,RJ ,RJT )
1388C-----------------------------------------------
1389C I m p l i c i t T y p e s
1390C-----------------------------------------------
1391#include "implicit_f.inc"
1392C-----------------------------------------------
1393C D u m m y A r g u m e n t s
1394C-----------------------------------------------
1395 INTEGER IRECT(4,*), NSV(*), IRTL(*),NIRI
1396C REAL
1397 my_real
1398 . dpara(7,*),x(3,*),rj(3,3,4),rjt(3,3,4)
1399C-----------------------------------------------
1400C L o c a l V a r i a b l e s
1401C-----------------------------------------------
1402 INTEGER I, J, II, L, JJ,NJ,K,NIR
1403C REAL
1404 my_real
1405 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
1406 . b1,b2,b3,c1,c2,c3,facm,
1407 . x22,y22,z22,det,xm(4),ym(4),zm(4),x0,y0,z0
1408 my_real
1409 . xs,ys,zs
1410C------------------------------------
1411C MATRICE DE JACOBIEN [C]
1412C------------------------------------
1413 i=nsv(ii)
1414 l=irtl(ii)
1415 nir=4
1416 DO j=1,nir
1417 nj=irect(j,l)
1418 xm(j)=x(1,nj)
1419 ym(j)=x(2,nj)
1420 zm(j)=x(3,nj)
1421 ENDDO
1422 IF(irect(3,l)==irect(4,l)) THEN
1423 nir=3
1424 xm(4)=zero
1425 ym(4)=zero
1426 zm(4)=zero
1427 ENDIF
1428 facm = one / nir
1429C----------------------------------------------------
1430C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
1431C----------------------------------------------------
1432 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
1433 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
1434 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
1435 DO j=1,nir
1436 xm(j)=xm(j)-x0
1437 ym(j)=ym(j)-y0
1438 zm(j)=zm(j)-z0
1439 ENDDO
1440 xs=x(1,i)-x0
1441 ys=x(2,i)-y0
1442 zs=x(3,i)-z0
1443C--------cette partie est une double travail que INTTI1
1444 xx=0
1445 yy=0
1446 zz=0
1447 xy=0
1448 yz=0
1449 zx=0
1450 DO j=1,nir
1451 xx=xx+ xm(j)*xm(j)
1452 yy=yy+ ym(j)*ym(j)
1453 zz=zz+ zm(j)*zm(j)
1454 xy=xy+ xm(j)*ym(j)
1455 yz=yz+ ym(j)*zm(j)
1456 zx=zx+ zm(j)*xm(j)
1457 ENDDO
1458 zzz=xx+yy
1459 xxx=yy+zz
1460 yyy=zz+xx
1461 xy2=xy*xy
1462 yz2=yz*yz
1463 zx2=zx*zx
1464 det= xxx*yyy*zzz -xxx*yz2 -yyy*zx2 -zzz*xy2 -two*xy*yz*zx
1465 det=one/det
1466 b1=(zzz*yyy-yz2)*det
1467 b2=(xxx*zzz-zx2)*det
1468 b3=(yyy*xxx-xy2)*det
1469 c3=(zzz*xy+yz*zx)*det
1470 c1=(xxx*yz+zx*xy)*det
1471 c2=(yyy*zx+xy*yz)*det
1472 DO j=1,nir
1473 x22 = c1*xm(j)
1474 y22 = c2*ym(j)
1475 z22 = c3*zm(j)
1476C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
1477 rj(1,1,j)=z22-y22
1478 rj(2,1,j)=b2*zm(j)-c1*ym(j)
1479 rj(3,1,j)=c1*zm(j)-b3*ym(j)
1480 rj(1,2,j)=-b1*zm(j)+c2*xm(j)
1481 rj(2,2,j)=-z22+x22
1482 rj(3,2,j)=-c2*zm(j)+b3*xm(j)
1483 rj(1,3,j)=b1*ym(j)-c3*xm(j)
1484 rj(2,3,j)=c3*ym(j)-b2*xm(j)
1485 rj(3,3,j)=y22-x22
1486C-------RJT=1/4[I]+(Rs)RJ---
1487 DO k=1,3
1488 rjt(1,k,j)=rj(2,k,j)*zs-rj(3,k,j)*ys
1489 rjt(2,k,j)=-rj(1,k,j)*zs+rj(3,k,j)*xs
1490 rjt(3,k,j)=rj(1,k,j)*ys-rj(2,k,j)*xs
1491 ENDDO
1492 DO k=1,3
1493 rjt(k,k,j)=rjt(k,k,j)+facm
1494 ENDDO
1495 ENDDO
1496 niri=nir
1497C
1498 RETURN
1499 END
1500!||====================================================================
1501!|| i2_frfm1 ../engine/source/interfaces/interf/i2_imp1.F
1502!||--- called by ------------------------------------------------------
1503!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
1504!|| upd_fr ../engine/source/mpi/implicit/imp_fri.F
1505!||====================================================================
1506 SUBROUTINE i2_frfm1(X ,IRECT,DPARA ,NSV ,IRTL ,
1507 1 A ,II )
1508C-----------------------------------------------
1509C I m p l i c i t T y p e s
1510C-----------------------------------------------
1511#include "implicit_f.inc"
1512C-----------------------------------------------
1513C D u m m y A r g u m e n t s
1514C-----------------------------------------------
1515 INTEGER
1516 . irect(4,*), nsv(*), irtl(*),ii
1517C REAL
1518 my_real
1519 . a(3,*),x(3,*),dpara(7,*)
1520C-----------------------------------------------
1521C L o c a l V a r i a b l e s
1522C-----------------------------------------------
1523 INTEGER I, J, J1,J2,J3,J4, L, JJ,NIR
1524C REAL
1525 my_real
1526 . FXS, FYS, FZS,MX,MY,MZ,DET,FX0,FY0,FZ0,
1527 . X0,X1,X2,X3,X4,XS,Y0,Y1,Y2,Y3,Y4,YS,Z0,Z1,Z2,Z3,Z4,ZS,
1528 . A1,A2,A3,B1,B2,B3,C1,C2,C3,FACM,XM(4),YM(4),ZM(4)
1529C-----------------------------------------------
1530 i=nsv(ii)
1531 l=irtl(ii)
1532 nir=4
1533 DO jj=1,nir
1534 j=irect(jj,l)
1535 xm(jj)=x(1,j)
1536 ym(jj)=x(2,j)
1537 zm(jj)=x(3,j)
1538 ENDDO
1539 IF(irect(3,l)==irect(4,l)) THEN
1540 nir=3
1541 xm(4)=zero
1542 ym(4)=zero
1543 zm(4)=zero
1544 ENDIF
1545 facm = one / nir
1546 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
1547 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
1548 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
1549 DO j=1,nir
1550 xm(j)=xm(j)-x0
1551 ym(j)=ym(j)-y0
1552 zm(j)=zm(j)-z0
1553 ENDDO
1554 xs=x(1,i)-x0
1555 ys=x(2,i)-y0
1556 zs=x(3,i)-z0
1557C
1558 det=dpara(1,ii)
1559 b1=dpara(2,ii)
1560 b2=dpara(3,ii)
1561 b3=dpara(4,ii)
1562 c1=dpara(5,ii)
1563 c2=dpara(6,ii)
1564 c3=dpara(7,ii)
1565C
1566 fxs=a(1,i)
1567 fys=a(2,i)
1568 fzs=a(3,i)
1569 mx= ys*fzs - zs*fys
1570 my= zs*fxs - xs*fzs
1571 mz= xs*fys - ys*fxs
1572C
1573 a1=det*(mx*b1+my*c3+mz*c2)
1574 a2=det*(my*b2+mz*c1+mx*c3)
1575 a3=det*(mz*b3+mx*c2+my*c1)
1576C
1577 fx0=fxs*facm
1578 fy0=fys*facm
1579 fz0=fzs*facm
1580C------------------------------------------------------
1581C FORCES TRANSMISES AUX NOEUDS MAINS
1582C------------------------------------------------------
1583 DO jj=1,nir
1584 j=irect(jj,l)
1585 a(1,j)=a(1,j) + fx0 + a2*zm(jj) - a3*ym(jj)
1586 a(2,j)=a(2,j) + fy0 + a3*xm(jj) - a1*zm(jj)
1587 a(3,j)=a(3,j) + fz0 + a1*ym(jj) - a2*xm(jj)
1588 ENDDO
1589C
1590 RETURN
1591 END
1592!||====================================================================
1593!|| i2_frfm0 ../engine/source/interfaces/interf/i2_imp1.f
1594!||--- called by ------------------------------------------------------
1595!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
1596!|| upd_fr ../engine/source/mpi/implicit/imp_fri.F
1597!||====================================================================
1598 SUBROUTINE i2_frfm0(X ,IRECT,CRST ,NSV ,IRTL,
1599 1 A ,AR ,II ,NDOF )
1600C-----------------------------------------------
1601C I m p l i c i t T y p e s
1602C-----------------------------------------------
1603#include "implicit_f.inc"
1604C-----------------------------------------------
1605C D u m m y A r g u m e n t s
1606C-----------------------------------------------
1607 INTEGER
1608 . irect(4,*), nsv(*), irtl(*), ii,ndof(*)
1609C REAL
1610 my_real
1611 . x(3,*),a(3,*), ar(3,*), crst(2,*)
1612C-----------------------------------------------
1613C L o c a l V a r i a b l e s
1614C-----------------------------------------------
1615 INTEGER NIR, I, J, I1, J1, L, NJ,NDM
1616C REAL
1617 my_real
1618 . h(4), ss, tt, fxi, fyi, fzi,sp,sm,tp,tm,nun,
1619 . mxi, myi, mzi,xs,ys,zs,xs0,ys0,zs0
1620C-----------------------------------------------
1621 nun=-one
1622C
1623C
1624 i=nsv(ii)
1625 l=irtl(ii)
1626C
1627 ss=crst(1,ii)
1628 tt=crst(2,ii)
1629 ss = min(one,ss)
1630 tt = min(one,tt)
1631 ss = max(nun,ss)
1632 tt = max(nun,tt)
1633C
1634 fxi=a(1,i)
1635 fyi=a(2,i)
1636 fzi=a(3,i)
1637C
1638 sp=one + ss
1639 sm=one - ss
1640 tp=fourth*(one + tt)
1641 tm=fourth*(one - tt)
1642 IF (irect(3,l)==irect(4,l)) THEN
1643 nir=3
1644 tp=fourth*(one + tt)
1645 tm=fourth*(one - tt)
1646 h(1)=tm*sm
1647 h(2)=tm*sp
1648 h(3)=one-h(1)-h(2)
1649 ELSE
1650 nir=4
1651 tp=fourth*(one + tt)
1652 tm=fourth*(one - tt)
1653 h(1)=tm*sm
1654 h(2)=tm*sp
1655 h(3)=tp*sp
1656 h(4)=tp*sm
1657 ENDIF
1658 ndm = 0
1659 DO j=1,nir
1660 nj=irect(j,l)
1661 a(1,nj)=a(1,nj)+fxi*h(j)
1662 a(2,nj)=a(2,nj)+fyi*h(j)
1663 a(3,nj)=a(3,nj)+fzi*h(j)
1664 ndm = max(ndm,ndof(j))
1665 ENDDO
1666 IF(ndm==6)THEN
1667 xs0=zero
1668 ys0=zero
1669 zs0=zero
1670 DO j=1,nir
1671 nj=irect(j,l)
1672 xs0=xs0+x(1,nj)*h(j)
1673 ys0=ys0+x(2,nj)*h(j)
1674 zs0=zs0+x(3,nj)*h(j)
1675 ENDDO
1676 xs=x(1,i)-xs0
1677 ys=x(2,i)-ys0
1678 zs=x(3,i)-zs0
1679 mxi = ys * fzi - zs * fyi
1680 myi = zs * fxi - xs * fzi
1681 mzi = xs * fyi - ys * fxi
1682 DO j=1,nir
1683 nj=irect(j,l)
1684 ar(1,nj)=ar(1,nj)-mxi*h(j)
1685 ar(2,nj)=ar(2,nj)-myi*h(j)
1686 ar(3,nj)=ar(3,nj)-mzi*h(j)
1687 ENDDO
1688 ENDIF
1689C
1690 RETURN
1691 END
1692!||====================================================================
1693!|| i2_frup0 ../engine/source/interfaces/interf/i2_imp1.F
1694!||--- called by ------------------------------------------------------
1695!|| diag_int ../engine/source/mpi/implicit/imp_fri.F
1696!|| updk_mv ../engine/source/airbag/monv_imp0.F
1697!||--- calls -----------------------------------------------------
1698!|| updfr_rb ../engine/source/constraints/general/rbody/rby_imp0.F
1699!||====================================================================
1700 SUBROUTINE i2_frup0(X ,IRECT,CRST ,NSV ,IRTL ,
1701 1 II ,NDOF ,KSS ,K )
1702C-----------------------------------------------
1703C I m p l i c i t T y p e s
1704C-----------------------------------------------
1705#include "implicit_f.inc"
1706C-----------------------------------------------
1707C D u m m y A r g u m e n t s
1708C-----------------------------------------------
1709 INTEGER
1710 . irect(4,*), nsv(*), irtl(*), ii,ndof(*)
1711C REAL
1712 my_real
1713 . x(3,*),kss(6),k(6,4), crst(2,*)
1714C-----------------------------------------------
1715C L o c a l V a r i a b l e s
1716C-----------------------------------------------
1717 INTEGER NIR, I, J, JD, L, JJ,NJ,ND
1718C REAL
1719 my_real
1720 . H(4), SS, TT, SP,SM,TP,TM,K0(6),XS,YS,ZS,
1721 . XS0,YS0,ZS0,H2
1722C-----------------------------------------------
1723 NIR=4
1724 i=nsv(ii)
1725 l=irtl(ii)
1726C
1727 ss=crst(1,ii)
1728 tt=crst(2,ii)
1729 sp=one + ss
1730 sm=one - ss
1731 IF(irect(3,l)==irect(4,l)) THEN
1732 nir = 3
1733 tp=fourth*(one + tt)
1734 tm=fourth*(one - tt)
1735 h(1)=tm*sm
1736 h(2)=tm*sp
1737 h(3)=one-h(1)-h(2)
1738 ELSE
1739 tp=fourth*(one + tt)
1740 tm=fourth*(one - tt)
1741 h(1)=tm*sm
1742 h(2)=tm*sp
1743 h(3)=tp*sp
1744 h(4)=tp*sm
1745 ENDIF
1746 nd = 0
1747 DO j=1,nir
1748 nj=irect(j,l)
1749 nd = max(nd,ndof(nj))
1750 ENDDO
1751C-------NDOF(M)> 3 comme rigid body---
1752 IF (nd==6) THEN
1753 xs0=zero
1754 ys0=zero
1755 zs0=zero
1756 DO j=1,nir
1757 nj=irect(j,l)
1758 xs0=xs0+x(1,nj)*h(j)
1759 ys0=ys0+x(2,nj)*h(j)
1760 zs0=zs0+x(3,nj)*h(j)
1761 ENDDO
1762 xs=x(1,i)-xs0
1763 ys=x(2,i)-ys0
1764 zs=x(3,i)-zs0
1765 CALL updfr_rb(xs,ys,zs,kss,k0)
1766 ELSE
1767 DO jj =1,3
1768 k0(jj)=kss(jj)
1769 ENDDO
1770 ENDIF
1771C-------Update K(main node),B---
1772 DO j=1,nir
1773 nj=irect(j,l)
1774 h2=h(j)*h(j)
1775 DO jj =1,ndof(nj)
1776 k(jj,j)=k(jj,j)+h2*k0(jj)
1777 ENDDO
1778 ENDDO
1779C
1780 RETURN
1781 END
1782!||====================================================================
1783!|| i2_frup1 ../engine/source/interfaces/interf/i2_imp1.F
1784!||--- called by ------------------------------------------------------
1785!|| diag_int ../engine/source/mpi/implicit/imp_fri.F
1786!|| updk_mv ../engine/source/airbag/monv_imp0.F
1787!||--- calls -----------------------------------------------------
1788!|| upfr1_ii ../engine/source/interfaces/interf/i2_imp1.f
1789!||====================================================================
1790 SUBROUTINE i2_frup1(X ,IRECT,DPARA ,NSV ,IRTL ,
1791 1 II ,KII ,KJJ )
1792C-----------------------------------------------
1793C I m p l i c i t T y p e s
1794C-----------------------------------------------
1795#include "implicit_f.inc"
1796C-----------------------------------------------
1797C D u m m y A r g u m e n t s
1798C-----------------------------------------------
1799 INTEGER
1800 . irect(4,*), nsv(*), irtl(*),ii
1801C REAL
1802 my_real
1803 . x(3,*),kii(6),kjj(6,4),dpara(7,*)
1804C-----------------------------------------------
1805C L o c a l V a r i a b l e s
1806C-----------------------------------------------
1807 INTEGER I, J, L, JJ,NJ,K,NIR
1808C REAL
1809 my_real
1810 . rj(3,3,4),rjt(3,3,4),
1811 . b1,b2,b3,c1,c2,c3,facm,
1812 . x22,y22,z22,det,xm(4),ym(4),zm(4),x0,y0,z0
1813 my_real
1814 . xs,ys,zs
1815C-----------------------------------------------
1816C
1817 i=nsv(ii)
1818 l=irtl(ii)
1819 nir=4
1820 DO j=1,nir
1821 nj=irect(j,l)
1822 xm(j)=x(1,nj)
1823 ym(j)=x(2,nj)
1824 zm(j)=x(3,nj)
1825 ENDDO
1826 IF(irect(3,l)==irect(4,l)) THEN
1827 nir=3
1828 xm(4)=zero
1829 ym(4)=zero
1830 zm(4)=zero
1831 ENDIF
1832 facm = one / nir
1833C----------------------------------------------------
1834C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
1835C----------------------------------------------------
1836 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
1837 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
1838 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
1839 DO j=1,nir
1840 xm(j)=xm(j)-x0
1841 ym(j)=ym(j)-y0
1842 zm(j)=zm(j)-z0
1843 ENDDO
1844 xs=x(1,i)-x0
1845 ys=x(2,i)-y0
1846 zs=x(3,i)-z0
1847 det= dpara(1,ii)
1848 b1=dpara(2,ii)
1849 b2=dpara(3,ii)
1850 b3=dpara(4,ii)
1851 c1=dpara(5,ii)
1852 c2=dpara(6,ii)
1853 c3=dpara(7,ii)
1854 DO j=1,nir
1855 x22 = c1*xm(j)
1856 y22 = c2*ym(j)
1857 z22 = c3*zm(j)
1858C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
1859 rj(1,1,j)=z22-y22
1860 rj(2,1,j)=b2*zm(j)-c1*ym(j)
1861 rj(3,1,j)=c1*zm(j)-b3*ym(j)
1862 rj(1,2,j)=-b1*zm(j)+c2*xm(j)
1863 rj(2,2,j)=-z22+x22
1864 rj(3,2,j)=-c2*zm(j)+b3*xm(j)
1865 rj(1,3,j)=b1*ym(j)-c3*xm(j)
1866 rj(2,3,j)=c3*ym(j)-b2*xm(j)
1867 rj(3,3,j)=y22-x22
1868C-------RJT=1/4[I]+(Rs)RJ---
1869 DO k=1,3
1870 rjt(1,k,j)=rj(2,k,j)*zs-rj(3,k,j)*ys
1871 rjt(2,k,j)=-rj(1,k,j)*zs+rj(3,k,j)*xs
1872 rjt(3,k,j)=rj(1,k,j)*ys-rj(2,k,j)*xs
1873 ENDDO
1874 DO k=1,3
1875 rjt(k,k,j)=rjt(k,k,j)+facm
1876 ENDDO
1877 ENDDO
1878C
1879 DO j=1,nir
1880 nj=irect(j,l)
1881 CALL upfr1_ii(rj(1,1,j),rjt(1,1,j),kii,kjj(1,j))
1882 ENDDO
1883C
1884 RETURN
1885 END
1886!||====================================================================
1887!|| i2_impr1 ../engine/source/interfaces/interf/i2_imp1.F
1888!||--- called by ------------------------------------------------------
1889!|| imp_dykv ../engine/source/implicit/imp_dyna.F
1890!|| imp_dykv0 ../engine/source/implicit/imp_dyna.F
1891!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
1892!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
1893!||--- calls -----------------------------------------------------
1894!|| i2updb0 ../engine/source/interfaces/interf/i2_imp1.F
1895!|| i2updb1 ../engine/source/interfaces/interf/i2_imp1.F
1896!||--- uses -----------------------------------------------------
1897!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1898!||====================================================================
1899 SUBROUTINE i2_impr1(IPARI,INTBUF_TAB,
1900 . X ,NDOF ,IDDL ,B )
1901C-----------------------------------------------
1902C M o d u l e s
1903C-----------------------------------------------
1904 USE intbufdef_mod
1905C-----------------------------------------------
1906C I m p l i c i t T y p e s
1907C-----------------------------------------------
1908#include "implicit_f.inc"
1909C-----------------------------------------------
1910C D u m m y A r g u m e n t s
1911C-----------------------------------------------
1912 INTEGER IPARI(*)
1913 INTEGER NDOF(*),IDDL(*)
1914C REAL
1915 my_real
1916 . X(*),B(*)
1917 TYPE(INTBUF_STRUCT_) INTBUF_TAB
1918C-----------------------------------------------
1919C C o m m o n B l o c k s
1920C-----------------------------------------------
1921#include "param_c.inc"
1922C-----------------------------------------------
1923C L o c a l V a r i a b l e s
1924C-----------------------------------------------
1925 INTEGER
1926 . K10, K11, K12, K13, K14, KFI, J10, J11, J12, J21, J22,
1927 . jfi,nsn,nmn,nrts,nrtm,ilev
1928C-----------------------------------------------
1929 nrts =ipari(3)
1930 nrtm =ipari(4)
1931 nsn =ipari(5)
1932 nmn =ipari(6)
1933 ilev =ipari(20)
1934C
1935 k10=1
1936 k11=k10+4*nrts
1937 k12=k11+4*nrtm
1938 k13=k12+nsn
1939 k14=k13+nmn
1940 kfi=k14+nsn
1941 j10=1
1942 j11=j10+1
1943 j12=j11+nparir
1944 j21=j12+2*nsn
1945 j22=j21+7*nsn
1946 jfi=j22+nmn
1947C
1948 IF(ilev==1)THEN
1949 CALL i2updb1(nsn ,intbuf_tab%IRECTM,intbuf_tab%DPARA,
1950 1 intbuf_tab%NSV,intbuf_tab%IRTLM,x ,ndof ,iddl ,
1951 2 b )
1952 ELSE
1953 CALL i2updb0(nsn ,intbuf_tab%IRECTM,intbuf_tab%CSTS,
1954 1 intbuf_tab%NSV,intbuf_tab%IRTLM,x ,ndof ,iddl ,
1955 2 b )
1956 ENDIF
1957C
1958 RETURN
1959 END
1960!||====================================================================
1961!|| i2updb0 ../engine/source/interfaces/interf/i2_imp1.F
1962!||--- called by ------------------------------------------------------
1963!|| i2_impr1 ../engine/source/interfaces/interf/i2_imp1.F
1964!||--- calls -----------------------------------------------------
1965!|| updb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
1966!||====================================================================
1967 SUBROUTINE i2updb0(NSN,IRECT,CRST,NSV,IRTL,
1968 1 X ,NDOF ,IDDL,B )
1969C-----------------------------------------------
1970C I m p l i c i t T y p e s
1971C-----------------------------------------------
1972#include "implicit_f.inc"
1973C-----------------------------------------------
1974C D u m m y A r g u m e n t s
1975C-----------------------------------------------
1976 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*)
1977 INTEGER NDOF(*),IDDL(*)
1978C REAL
1979 my_real
1980 . crst(2,*),x(3,*),b(*)
1981C-----------------------------------------------
1982C L o c a l V a r i a b l e s
1983C-----------------------------------------------
1984 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
1985 . i1,id,nl,ni,nj,nidof,nd,ndi,ndj,ndm,nm
1986C REAL
1987 my_real
1988 . h(4),ss, tt, sp,sm,tp,tm,bd(6),
1989 . bi(6),xs0,ys0,zs0,xs,ys,zs,nun
1990C------------------------------------
1991C VITESSES DES NOEUDS SECONDS
1992C------------------------------------
1993C-------pour simplement etre coherent avec INTTI2, on ne distinque pas 3n,4n
1994C-------on est oblige de distinque quand meme, sinon la matrice n'est plus positive
1995 nun=-one
1996 j1=0
1997 DO ii=1,nsn
1998 i=nsv(ii)
1999 l=irtl(ii)
2000 IF (ndof(i)>0) THEN
2001 DO k=1,ndof(i)
2002 id = iddl(i)+k
2003 bd(k)=b(id)
2004 ENDDO
2005 DO k=ndof(i)+1,6
2006 bd(k)=zero
2007 ENDDO
2008C
2009 ss=crst(1,ii)
2010 tt=crst(2,ii)
2011 ss = min(one,ss)
2012 tt = min(one,tt)
2013 ss = max(nun,ss)
2014 tt = max(nun,tt)
2015 sp=one + ss
2016 sm=one - ss
2017 IF (irect(3,l)==irect(4,l)) THEN
2018 nir=3
2019 tp=fourth*(one + tt)
2020 tm=fourth*(one - tt)
2021 h(1)=tm*sm
2022 h(2)=tm*sp
2023 h(3)=one-h(1)-h(2)
2024 ELSE
2025 nir=4
2026 tp=fourth*(one + tt)
2027 tm=fourth*(one - tt)
2028 h(1)=tm*sm
2029 h(2)=tm*sp
2030 h(3)=tp*sp
2031 h(4)=tp*sm
2032 ENDIF
2033 ndm = 0
2034 DO j=1,nir
2035 nj=irect(j,l)
2036 ndm = max(ndm,ndof(nj))
2037 ENDDO
2038C-------NDOF(M)> 3 comme rigid body---
2039 IF (ndm==6) THEN
2040 xs0=zero
2041 ys0=zero
2042 zs0=zero
2043 DO j=1,nir
2044 nj=irect(j,l)
2045 xs0=xs0+x(1,nj)*h(j)
2046 ys0=ys0+x(2,nj)*h(j)
2047 zs0=zs0+x(3,nj)*h(j)
2048 ENDDO
2049 xs=x(1,i)-xs0
2050 ys=x(2,i)-ys0
2051 zs=x(3,i)-zs0
2052 CALL updb_rb(ndof(i),xs,ys,zs,bd)
2053 ENDIF
2054CC-------Update B---
2055 DO j=1,nir
2056 nj=irect(j,l)
2057 nd = min(ndm,ndof(nj))
2058 DO k=1,nd
2059 id = iddl(nj)+k
2060 b(id) = b(id) + h(j)*bd(k)
2061 ENDDO
2062 ENDDO
2063 ENDIF
2064 ENDDO
2065C
2066 RETURN
2067 END
2068!||====================================================================
2069!|| i2updb1 ../engine/source/interfaces/interf/i2_imp1.F
2070!||--- called by ------------------------------------------------------
2071!|| i2_impr1 ../engine/source/interfaces/interf/i2_imp1.F
2072!||--- calls -----------------------------------------------------
2073!|| i2matc ../engine/source/interfaces/interf/i2_imp1.F
2074!|| updb1_ii ../engine/source/interfaces/interf/i2_imp1.F
2075!||====================================================================
2076 SUBROUTINE i2updb1(NSN,IRECT,DPARA,NSV,IRTL,
2077 1 X ,NDOF ,IDDL ,B )
2078C-----------------------------------------------
2079C I m p l i c i t T y p e s
2080C-----------------------------------------------
2081#include "implicit_f.inc"
2082C-----------------------------------------------
2083C D u m m y A r g u m e n t s
2084C-----------------------------------------------
2085 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*)
2086 INTEGER NDOF(*),IDDL(*)
2087C REAL
2088 my_real
2089 . dpara(7,*),x(*),b(*)
2090C-----------------------------------------------
2091C L o c a l V a r i a b l e s
2092C-----------------------------------------------
2093 INTEGER NIR(NSN),I, J, K, JD, II, L, JJ,I1,ID,NL,
2094 . ni,nj,j1,nidof,nd,nm,idof,l1,nm1
2095C REAL
2096 my_real
2097 . rj(9,4,nsn),rjt(9,4,nsn)
2098 my_real
2099 . bd(6),bi(6),xs,ys,zs
2100C------------------------------------
2101C VITESSES DES NOEUDS SECONDS
2102C------------------------------------
2103 CALL i2matc(nsn,irect,dpara,nsv,irtl,x,nir,rj ,rjt )
2104 nd = 3
2105 DO ii=1,nsn
2106 i=nsv(ii)
2107 idof=ndof(i)
2108 IF (idof>0) THEN
2109 l=irtl(ii)
2110 DO k=1,idof
2111 id = iddl(i)+k
2112 bd(k)=b(id)
2113 ENDDO
2114 DO k=idof+1,6
2115 bd(k)=zero
2116 ENDDO
2117C-------Update B---
2118 DO j=1,nir(ii)
2119 nj=irect(j,l)
2120 CALL updb1_ii(idof,rj(1,j,ii),rjt(1,j,ii),bd,bi)
2121 DO k=1,nd
2122 id = iddl(nj)+k
2123 b(id) = b(id) + bi(k)
2124 ENDDO
2125 ENDDO
2126 ENDIF
2127 ENDDO
2128C
2129 RETURN
2130 END
2131C-------------produit B'=[CDI]^tB with [CDI]=-[RJT RJ]^t
2132!||====================================================================
2133!|| updb1_ii ../engine/source/interfaces/interf/i2_imp1.F
2134!||--- called by ------------------------------------------------------
2135!|| i2updb1 ../engine/source/interfaces/interf/i2_imp1.F
2136!|| i2updb12 ../engine/source/interfaces/interf/i2_imp1.F
2137!||====================================================================
2138 SUBROUTINE updb1_ii(NDL,RJ,RJT,BD,B)
2139C-----------------------------------------------
2140C I m p l i c i t T y p e s
2141C-----------------------------------------------
2142#include "implicit_f.inc"
2143C-----------------------------------------------
2144C D u m m y A r g u m e n t s
2145C-----------------------------------------------
2146 INTEGER NDL
2147C REAL
2148 my_real
2149 . b(3),rj(3,3), rjt(3,3), bd(6)
2150C-----------------------------------------------
2151C L o c a l V a r i a b l e s
2152C-----------------------------------------------
2153 INTEGER I, J
2154C REAL
2155C------------------------------------
2156 DO i=1,3
2157 b(i)=rjt(1,i)*bd(1)+rjt(2,i)*bd(2)+rjt(3,i)*bd(3)
2158 ENDDO
2159C
2160 IF (ndl==6) THEN
2161 DO i=1,3
2162 b(i)=b(i)+rj(1,i)*bd(4)+rj(2,i)*bd(5)+rj(3,i)*bd(6)
2163 ENDDO
2164 ENDIF
2165C
2166 RETURN
2167 END
2168!||====================================================================
2169!|| i2_impr2 ../engine/source/interfaces/interf/i2_imp1.F
2170!||--- called by ------------------------------------------------------
2171!|| imp_dykv ../engine/source/implicit/imp_dyna.f
2172!|| imp_dykv0 ../engine/source/implicit/imp_dyna.F
2173!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
2174!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
2175!||--- calls -----------------------------------------------------
2176!|| i2updb02 ../engine/source/interfaces/interf/i2_imp1.F
2177!|| i2updb12 ../engine/source/interfaces/interf/i2_imp1.F
2178!||--- uses -----------------------------------------------------
2179!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
2180!||====================================================================
2181 SUBROUTINE i2_impr2(IPARI,INTBUF_TAB,A ,AR ,
2182 . X ,NDOF ,IDDL ,B )
2183C-----------------------------------------------
2184C M o d u l e s
2185C-----------------------------------------------
2186 USE intbufdef_mod
2187C-----------------------------------------------
2188C I m p l i c i t T y p e s
2189C-----------------------------------------------
2190#include "implicit_f.inc"
2191C-----------------------------------------------
2192C D u m m y A r g u m e n t s
2193C-----------------------------------------------
2194 INTEGER IPARI(*)
2195 INTEGER NDOF(*),IDDL(*)
2196C REAL
2197 my_real
2198 . x(*),b(*),a(*),ar(*)
2199 TYPE(intbuf_struct_) INTBUF_TAB
2200C-----------------------------------------------
2201C C o m m o n B l o c k s
2202C-----------------------------------------------
2203#include "param_c.inc"
2204C-----------------------------------------------
2205C L o c a l V a r i a b l e s
2206C-----------------------------------------------
2207 INTEGER
2208 . K10, K11, K12, K13, K14, KFI, J10, J11, J12, J21, J22,
2209 . JFI,NSN,NMN,NRTS,NRTM,ILEV
2210C-----------------------------------------------
2211 NRTS =ipari(3)
2212 nrtm =ipari(4)
2213 nsn =ipari(5)
2214 nmn =ipari(6)
2215 ilev =ipari(20)
2216C
2217 k10=1
2218 k11=k10+4*nrts
2219 k12=k11+4*nrtm
2220 k13=k12+nsn
2221 k14=k13+nmn
2222 kfi=k14+nsn
2223 j10=1
2224 j11=j10+1
2225 j12=j11+nparir
2226 j21=j12+2*nsn
2227 j22=j21+7*nsn
2228 jfi=j22+nmn
2229C
2230 IF(ilev==1)THEN
2231 CALL i2updb12(nsn ,intbuf_tab%IRECTM,intbuf_tab%DPARA,
2232 1 intbuf_tab%NSV,intbuf_tab%IRTLM,x ,ndof ,iddl ,
2233 2 b ,a ,ar )
2234 ELSE
2235 CALL i2updb02(nsn ,intbuf_tab%IRECTM,intbuf_tab%CSTS,
2236 1 intbuf_tab%NSV,intbuf_tab%IRTLM,x ,ndof ,iddl ,
2237 2 b ,a ,ar )
2238 ENDIF
2239C
2240 RETURN
2241 END
2242!||====================================================================
2243!|| i2updb02 ../engine/source/interfaces/interf/i2_imp1.F
2244!||--- called by ------------------------------------------------------
2245!|| i2_impr2 ../engine/source/interfaces/interf/i2_imp1.F
2246!||--- calls -----------------------------------------------------
2247!|| updb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
2248!||====================================================================
2249 SUBROUTINE i2updb02(NSN,IRECT,CRST,NSV,IRTL,
2250 1 X ,NDOF ,IDDL,B ,A ,AR )
2251C-----------------------------------------------
2252C I m p l i c i t T y p e s
2253C-----------------------------------------------
2254#include "implicit_f.inc"
2255C-----------------------------------------------
2256C D u m m y A r g u m e n t s
2257C-----------------------------------------------
2258 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*)
2259 INTEGER NDOF(*),IDDL(*)
2260C REAL
2261 my_real
2262 . crst(2,*),x(3,*),b(*),a(3,*),ar(3,*)
2263C-----------------------------------------------
2264C C o m m o n B l o c k s
2265C-----------------------------------------------
2266#include "com01_c.inc"
2267C-----------------------------------------------
2268C L o c a l V a r i a b l e s
2269C-----------------------------------------------
2270 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
2271 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM
2272C REAL
2273 my_real
2274 . h(4),ss, tt, sp,sm,tp,tm,bd(6),
2275 . bi(6),xs0,ys0,zs0,xs,ys,zs,nun
2276C------------------------------------
2277C VITESSES DES NOEUDS SECONDS
2278C------------------------------------
2279C-------pour simplement etre coherent avec INTTI2, on ne distinque pas 3n,4n
2280C-------on est oblige de distinque quand meme, sinon la matrice n'est plus positive
2281 nun=-one
2282 j1=0
2283 IF (iroddl/=0) THEN
2284 nd = 6
2285 ELSE
2286 nd = 3
2287 ENDIF
2288 DO ii=1,nsn
2289 i=nsv(ii)
2290 l=irtl(ii)
2291 IF (ndof(i)==0) THEN
2292 DO k=1,3
2293 bd(k)=a(k,i)
2294 ENDDO
2295 IF (nd==3) THEN
2296 DO k=nd+1,6
2297 bd(k)=zero
2298 ENDDO
2299 ELSE
2300 DO k=1,3
2301 bd(k+3)=ar(k,i)
2302 ENDDO
2303 ENDIF
2304C
2305 ss=crst(1,ii)
2306 tt=crst(2,ii)
2307 ss = min(one,ss)
2308 tt = min(one,tt)
2309 ss = max(nun,ss)
2310 tt = max(nun,tt)
2311 sp=one + ss
2312 sm=one - ss
2313 IF (irect(3,l)==irect(4,l)) THEN
2314 nir=3
2315 tp=fourth*(one + tt)
2316 tm=fourth*(one - tt)
2317 h(1)=tm*sm
2318 h(2)=tm*sp
2319 h(3)=one-h(1)-h(2)
2320 ELSE
2321 nir=4
2322 tp=fourth*(one + tt)
2323 tm=fourth*(one - tt)
2324 h(1)=tm*sm
2325 h(2)=tm*sp
2326 h(3)=tp*sp
2327 h(4)=tp*sm
2328 ENDIF
2329C-------comme rigid body---
2330 IF (nd==6) THEN
2331 xs0=zero
2332 ys0=zero
2333 zs0=zero
2334 DO j=1,nir
2335 nj=irect(j,l)
2336 xs0=xs0+x(1,nj)*h(j)
2337 ys0=ys0+x(2,nj)*h(j)
2338 zs0=zs0+x(3,nj)*h(j)
2339 ENDDO
2340 xs=x(1,i)-xs0
2341 ys=x(2,i)-ys0
2342 zs=x(3,i)-zs0
2343 CALL updb_rb(nd,xs,ys,zs,bd)
2344 ENDIF
2345CC-------Update B---
2346 DO j=1,nir
2347 nj=irect(j,l)
2348 IF (ndof(nj)==0) THEN
2349 DO k=1,3
2350 a(k,nj)=a(k,nj)+bd(k)
2351 ENDDO
2352 IF (nd==6) THEN
2353 DO k=1,3
2354 ar(k,nj)=ar(k,nj)+bd(k+3)
2355 ENDDO
2356 ENDIF
2357 ELSE
2358 DO k=1,nd
2359 id = iddl(nj)+k
2360 b(id) = b(id) + h(j)*bd(k)
2361 ENDDO
2362 ENDIF
2363 ENDDO
2364 ENDIF
2365 ENDDO
2366C
2367 RETURN
2368 END
2369!||====================================================================
2370!|| i2updb12 ../engine/source/interfaces/interf/i2_imp1.F
2371!||--- called by ------------------------------------------------------
2372!|| i2_impr2 ../engine/source/interfaces/interf/i2_imp1.F
2373!||--- calls -----------------------------------------------------
2374!|| i2matc ../engine/source/interfaces/interf/i2_imp1.F
2375!|| updb1_ii ../engine/source/interfaces/interf/i2_imp1.F
2376!||====================================================================
2377 SUBROUTINE i2updb12(NSN,IRECT,DPARA,NSV,IRTL,
2378 1 X ,NDOF ,IDDL ,B ,A ,AR )
2379C-----------------------------------------------
2380C I m p l i c i t T y p e s
2381C-----------------------------------------------
2382#include "implicit_f.inc"
2383C-----------------------------------------------
2384C D u m m y A r g u m e n t s
2385C-----------------------------------------------
2386 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*)
2387 INTEGER NDOF(*),IDDL(*)
2388C REAL
2389 my_real
2390 . dpara(7,*),x(*),b(*),a(3,*),ar(3,*)
2391C-----------------------------------------------
2392C C o m m o n B l o c k s
2393C-----------------------------------------------
2394#include "com01_c.inc"
2395C-----------------------------------------------
2396C L o c a l V a r i a b l e s
2397C-----------------------------------------------
2398 INTEGER NIR(NSN),I, J, K, JD, II, L, JJ,I1,ID,NL,
2399 . NI,NJ,J1,NIDOF,ND,NM,IDOF,L1,NM1
2400C REAL
2401 my_real
2402 . rj(9,4,nsn),rjt(9,4,nsn)
2403 my_real
2404 . bd(6),bi(6),xs,ys,zs
2405C------------------------------------
2406C VITESSES DES NOEUDS SECONDS
2407C------------------------------------
2408 CALL i2matc(nsn,irect,dpara,nsv,irtl,x,nir,rj ,rjt )
2409 IF (iroddl/=0) THEN
2410 nd = 6
2411 ELSE
2412 nd = 3
2413 ENDIF
2414 DO ii=1,nsn
2415 i=nsv(ii)
2416 idof=ndof(i)
2417 IF (idof==0) THEN
2418 l=irtl(ii)
2419 DO k=1,3
2420 bd(k)=a(k,i)
2421 ENDDO
2422 IF (nd==3) THEN
2423 DO k=nd+1,6
2424 bd(k)=zero
2425 ENDDO
2426 ELSE
2427 DO k=1,3
2428 bd(k+3)=ar(k,i)
2429 ENDDO
2430 ENDIF
2431C-------Update B---
2432 DO j=1,nir(ii)
2433 nj=irect(j,l)
2434 CALL updb1_ii(nd,rj(1,j,ii),rjt(1,j,ii),bd,bi)
2435 IF (ndof(nj)==0) THEN
2436 DO k=1,3
2437 a(k,nj)=a(k,nj)+bi(k)
2438 ENDDO
2439 ELSE
2440 DO k=1,3
2441 id = iddl(nj)+k
2442 b(id) = b(id) + bi(k)
2443 ENDDO
2444 ENDIF
2445 ENDDO
2446 ENDIF
2447 ENDDO
2448C
2449 RETURN
2450 END
2451!||====================================================================
2452!|| i2_frk0 ../engine/source/interfaces/interf/i2_imp1.F
2453!||--- called by ------------------------------------------------------
2454!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
2455!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.f
2456!||--- calls -----------------------------------------------------
2457!|| print_wkij ../engine/source/implicit/imp_glob_k.F
2458!|| put_kmii ../engine/source/implicit/imp_glob_k.F
2459!|| put_kmij ../engine/source/implicit/imp_glob_k.F
2460!|| updkb_rb ../engine/source/constraints/general/rbody/rby_imp0.F
2461!|| updkb_rb1 ../engine/source/constraints/general/rbody/rby_imp0.F
2462!|| updkdd ../engine/source/interfaces/interf/i2_imp1.F
2463!|| updkdd1 ../engine/source/interfaces/interf/i2_imp1.F
2464!||====================================================================
2465 SUBROUTINE i2_frk0(IRECT,CRST ,X ,ITAB ,NSV ,
2466 1 IRTL ,IKC ,NDOF ,IDDL ,IDDLM,
2467 2 IADK ,JDIK ,DIAG_K,LT_K ,B ,
2468 3 A ,KSS ,KSM ,KNM ,KRM ,
2469 4 II ,IDLM ,ISS ,ISM )
2470C-----------------------------------------------
2471C I m p l i c i t T y p e s
2472C-----------------------------------------------
2473#include "implicit_f.inc"
2474C-----------------------------------------------
2475C D u m m y A r g u m e n t s
2476C-----------------------------------------------
2477 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*),IDDLM(*),IKC(*),
2478 . irect(4,*), nsv(*),irtl(*),itab(*),ii,
2479 . idlm(*) ,iss ,ism
2480C REAL
2481 my_real
2482 . crst(2,*),x(3,*),diag_k(*),lt_k(*),b(*),a(3,*),
2483 . kss(6),ksm(3,3),knm(3,3,*),krm(3,3,*)
2484C-----------------------------------------------
2485C L o c a l V a r i a b l e s
2486C-----------------------------------------------
2487 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, L, JJ,
2488 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
2489 . IR,IDM,NDOFI
2490C REAL
2491 my_real
2492 . H(4),H2(4), SS, TT, SP,SM,TP,TM,KDD(6,6),BD(6),
2493 . KII(6,6),BI(6),XS0,YS0,ZS0,XS,YS,ZS,XS1,YS1,ZS1,NUN
2494C------------------------------------
2495C VITESSES DES NOEUDS SECONDS
2496C------------------------------------
2497 NUN=-one
2498 i=nsv(ii)
2499 l=irtl(ii)
2500 ndofi = 3
2501C
2502 ss=crst(1,ii)
2503 tt=crst(2,ii)
2504 ss = min(one,ss)
2505 tt = min(one,tt)
2506 ss = max(nun,ss)
2507 tt = max(nun,tt)
2508 sp=one + ss
2509 sm=one - ss
2510 IF (irect(3,l)==irect(4,l)) THEN
2511 nir=3
2512 tp=third*(one + tt)
2513 tm=third*(one - tt)
2514 h(1)=tm*sm
2515 h(2)=tm*sp
2516 h(3)=one-h(1)-h(2)
2517 ELSE
2518 nir=4
2519 tp=fourth*(one + tt)
2520 tm=fourth*(one - tt)
2521 h(1)=tm*sm
2522 h(2)=tm*sp
2523 h(3)=tp*sp
2524 h(4)=tp*sm
2525 ENDIF
2526 ndm = 0
2527 DO j=1,nir
2528 nj=irect(j,l)
2529 ndm = max(ndm,ndof(nj))
2530 ENDDO
2531C-------NDOF(M)> 3 comme rigid body---
2532 IF (ndm==6) THEN
2533 xs0=zero
2534 ys0=zero
2535 zs0=zero
2536 DO j=1,nir
2537 nj=irect(j,l)
2538 xs0=xs0+x(1,nj)*h(j)
2539 ys0=ys0+x(2,nj)*h(j)
2540 zs0=zs0+x(3,nj)*h(j)
2541 ENDDO
2542 xs=x(1,i)-xs0
2543 ys=x(2,i)-ys0
2544 zs=x(3,i)-zs0
2545 ENDIF
2546 IF (iss>0) THEN
2547C-------Update KSS(main node),B---
2548 IF (irect(3,l)==irect(4,l)) THEN
2549 h2(1)=h(1)*h(1)
2550 h2(2)=h(2)*h(2)
2551 h2(3)=h(3)*h(3)
2552 ELSE
2553 h2(1)=h(1)*h(1)
2554 h2(2)=h(2)*h(2)
2555 h2(3)=h(3)*h(3)
2556 h2(4)=h(4)*h(4)
2557 ENDIF
2558 DO k=1,ndofi
2559 bd(k)=a(k,i)
2560 kdd(k,k) = kss(k)
2561 ENDDO
2562 DO k=ndofi+1,6
2563 bd(k)=zero
2564 ENDDO
2565 kdd(1,2) = kss(4)
2566 kdd(1,3) = kss(5)
2567 kdd(2,3) = kss(6)
2568 IF (ndm==6) CALL updkb_rb(ndofi,xs,ys,zs,kdd,bd)
2569 DO j=1,nir
2570 nj=irect(j,l)
2571 nd = min(ndm,ndof(nj))
2572 CALL updkdd(nd,kdd,kii,h2(j),1)
2573 CALL put_kmii(idlm(j),iadk,diag_k,lt_k ,kii,nd)
2574 DO i1=j+1,nir
2575 nm=irect(i1,l)
2576 tm=h(j)*h(i1)
2577 nd = min(nd,ndof(nm))
2578 CALL updkdd(nd,kdd,kii,tm,0)
2579 CALL put_kmij(idlm(j) ,idlm(i1) ,iadk,jdik,lt_k,
2580 . kii,nd ,nd ,ir )
2581 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,2 )
2582 ENDDO
2583 ENDDO
2584 ENDIF
2585C
2586 IF (ism>0) THEN
2587C--------no diag--Kjm=sum(KjsCsm)--
2588 DO k=1,ndofi
2589 DO j=1,ndofi
2590 kdd(k,j) = ksm(k,j)
2591 ENDDO
2592 ENDDO
2593C------- Update ---
2594 IF (ndm==6) CALL updkb_rb1(ndofi,ndofi,xs,ys,zs,kdd)
2595 DO j=1,nir
2596 nj=irect(j,l)
2597 ndi = min(ndm,ndofi)
2598 ndj = min(ndm,ndof(nj))
2599 IF (ndj>0)CALL updkdd1(ndi,ndj,kdd,kii,h(j),0)
2600 DO k=1,ndofi
2601 DO j1=1,ndofi
2602 knm(k,j1,j)=kii(j1,k)
2603 krm(k,j1,j)=kii(j1,k+ndofi)
2604 ENDDO
2605 ENDDO
2606 ENDDO
2607 ENDIF
2608C
2609 RETURN
2610 END
2611!||====================================================================
2612!|| i2_frk1 ../engine/source/interfaces/interf/i2_imp1.F
2613!||--- called by ------------------------------------------------------
2614!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
2615!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.F
2616!||--- calls -----------------------------------------------------
2617!|| print_wkij ../engine/source/implicit/imp_glob_k.F
2618!|| put_kmii ../engine/source/implicit/imp_glob_k.F
2619!|| put_kmij ../engine/source/implicit/imp_glob_k.F
2620!|| updk1_ii ../engine/source/interfaces/interf/i2_imp1.F
2621!|| updk1_ij ../engine/source/interfaces/interf/i2_imp1.F
2622!|| updk1_jj ../engine/source/interfaces/interf/i2_imp1.F
2623!||====================================================================
2624 SUBROUTINE i2_frk1(IRECT,DPARA ,X ,ITAB ,NSV ,
2625 1 IRTL ,IKC ,NDOF ,IDDL ,IDDLM,
2626 2 IADK ,JDIK ,DIAG_K,LT_K ,B ,
2627 3 A ,KSS ,KSM ,KNM ,KRM ,
2628 4 II ,IDLM ,ISS ,ISM )
2629C-----------------------------------------------
2630C I m p l i c i t T y p e s
2631C-----------------------------------------------
2632#include "implicit_f.inc"
2633C-----------------------------------------------
2634C D u m m y A r g u m e n t s
2635C-----------------------------------------------
2636 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*),IDDLM(*),IKC(*),
2637 . irect(4,*), nsv(*),irtl(*),itab(*),ii,
2638 . idlm(*) ,iss ,ism
2639C REAL
2640 my_real
2641 . dpara(7,*),x(3,*),diag_k(*),lt_k(*),b(*),a(3,*),
2642 . kss(6),ksm(3,3),knm(3,3,*),krm(3,3,*)
2643C-----------------------------------------------
2644C L o c a l V a r i a b l e s
2645C-----------------------------------------------
2646 INTEGER NIR, I, J, J1, J2, J3, J4, K,L,JD, JJ,
2647 . i1,id,nl,ni,nj,nidof,nd,ndi,ndj,ndm,nm,l1,nm1,
2648 . nir1,ir,idm,nd1,ndofi
2649C REAL
2650 my_real
2651 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
2652 . b1,b2,b3,c1,c2,c3,facm,
2653 . x22,y22,z22,det,xm(4),ym(4),zm(4),kdd(6,6),bd(6),
2654 . kii(6,6),bi(6),x0,y0,z0,xs,ys,zs,xs1,ys1,zs1,nun,
2655 . rj(3,3,4),rjt(3,3,4)
2656C------------------------------------
2657C VITESSES DES NOEUDS SECONDS
2658C------------------------------------
2659 i=nsv(ii)
2660 l=irtl(ii)
2661 ndofi = 3
2662C
2663 nir=4
2664 DO j=1,nir
2665 nj=irect(j,l)
2666 xm(j)=x(1,nj)
2667 ym(j)=x(2,nj)
2668 zm(j)=x(3,nj)
2669 ENDDO
2670 IF (irect(3,l)==irect(4,l)) THEN
2671 nir=3
2672 xm(4)=zero
2673 ym(4)=zero
2674 zm(4)=zero
2675 ENDIF
2676 facm = one / nir
2677 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
2678 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
2679 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
2680 DO j=1,nir
2681 xm(j)=xm(j)-x0
2682 ym(j)=ym(j)-y0
2683 zm(j)=zm(j)-z0
2684 ENDDO
2685 xs=x(1,i)-x0
2686 ys=x(2,i)-y0
2687 zs=x(3,i)-z0
2688C--------cette partie est une double travail que INTTI1
2689 xx=0
2690 yy=0
2691 zz=0
2692 xy=0
2693 yz=0
2694 zx=0
2695 DO j=1,nir
2696 xx=xx+ xm(j)*xm(j)
2697 yy=yy+ ym(j)*ym(j)
2698 zz=zz+ zm(j)*zm(j)
2699 xy=xy+ xm(j)*ym(j)
2700 yz=yz+ ym(j)*zm(j)
2701 zx=zx+ zm(j)*xm(j)
2702 ENDDO
2703 zzz=xx+yy
2704 xxx=yy+zz
2705 yyy=zz+xx
2706 xy2=xy*xy
2707 yz2=yz*yz
2708 zx2=zx*zx
2709 det= xxx*yyy*zzz -xxx*yz2 -yyy*zx2 -zzz*xy2 -two*xy*yz*zx
2710 det=one/det
2711 b1=(zzz*yyy-yz2)*det
2712 b2=(xxx*zzz-zx2)*det
2713 b3=(yyy*xxx-xy2)*det
2714 c3=(zzz*xy+yz*zx)*det
2715 c1=(xxx*yz+zx*xy)*det
2716 c2=(yyy*zx+xy*yz)*det
2717 DO j=1,nir
2718 x22 = c1*xm(j)
2719 y22 = c2*ym(j)
2720 z22 = c3*zm(j)
2721C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
2722 rj(1,1,j)=z22-y22
2723 rj(2,1,j)=b2*zm(j)-c1*ym(j)
2724 rj(3,1,j)=c1*zm(j)-b3*ym(j)
2725 rj(1,2,j)=-b1*zm(j)+c2*xm(j)
2726 rj(2,2,j)=-z22+x22
2727 rj(3,2,j)=-c2*zm(j)+b3*xm(j)
2728 rj(1,3,j)=b1*ym(j)-c3*xm(j)
2729 rj(2,3,j)=c3*ym(j)-b2*xm(j)
2730 rj(3,3,j)=y22-x22
2731C-------RJT=1/4[I]+(Rs)RJ---
2732 DO k=1,3
2733 rjt(1,k,j)=rj(2,k,j)*zs-rj(3,k,j)*ys
2734 rjt(2,k,j)=-rj(1,k,j)*zs+rj(3,k,j)*xs
2735 rjt(3,k,j)=rj(1,k,j)*ys-rj(2,k,j)*xs
2736 ENDDO
2737 DO k=1,3
2738 rjt(k,k,j)=rjt(k,k,j)+facm
2739 ENDDO
2740 ENDDO
2741C
2742 ndm = 3
2743 IF (iss>0) THEN
2744CC-------Update KSS(main node),B---
2745 DO k=1,ndofi
2746 bd(k)=a(k,i)
2747 kdd(k,k) = kss(k)
2748 ENDDO
2749 DO k=ndofi+1,6
2750 bd(k)=zero
2751 ENDDO
2752 kdd(1,2) = kss(4)
2753 kdd(1,3) = kss(5)
2754 kdd(2,3) = kss(6)
2755 DO j=1,nir
2756 nj=irect(j,l)
2757 nd = min(ndm,ndof(nj))
2758 CALL updk1_ii(ndofi,rj(1,1,j),rjt(1,1,j),kdd,kii,bd,bi)
2759 CALL put_kmii(idlm(j),iadk,diag_k,lt_k ,kii,nd)
2760 DO i1=j+1,nir
2761 nm=irect(i1,l)
2762 nd1 = min(nd,ndof(nm))
2763 CALL updk1_ij(ndofi,ndofi,rj(1,1,j),rjt(1,1,j),
2764 1 rj(1,1,i1),rjt(1,1,i1),kdd,kii,0)
2765 CALL put_kmij(idlm(j) ,idlm(i1) ,iadk,jdik,lt_k,
2766 . kii,nd ,nd1 ,ir )
2767 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,2 )
2768 ENDDO
2769 ENDDO
2770 ENDIF
2771C
2772 IF (ism>0) THEN
2773C--------no diag--Kjm=sum(KjsCsm)--
2774 DO k=1,ndofi
2775 DO j=1,ndofi
2776 kdd(k,j) = ksm(k,j)
2777 ENDDO
2778 ENDDO
2779C------- Update ---
2780 DO j=1,nir
2781 nj=irect(j,l)
2782 ndj = min(ndm,ndof(nj))
2783 IF (ndj>0)THEN
2784 CALL updk1_jj(ndofi,ndofi,rj(1,1,j),rjt(1,1,j),kdd,kii)
2785 DO k=1,ndofi
2786 DO j1=1,ndofi
2787 knm(k,j1,j)=kii(j1,k)
2788 krm(k,j1,j)=kii(j1,k+ndofi)
2789 ENDDO
2790 ENDDO
2791 ENDIF
2792 ENDDO
2793 ENDIF
2794C
2795 RETURN
2796 END
2797
my_real
#define my_real
Definition cppsort.cpp:32
i2_impi
subroutine i2_impi(nint2, iint2, ipari, intbuf_tab, x, ms, in, nss2, iss2, weight, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, iaint2, b, itab)
Definition i2_imp0.F:109
i2_imp0
subroutine i2_imp0(nint2, iint2, ipari, intbuf_tab, x, ms, in, nmc2, imij2, itab, nsc2, isij2, nss2, iss2, weight, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
Definition i2_imp0.F:39
i2_frfm0
subroutine i2_frfm0(x, irect, crst, nsv, irtl, a, ar, ii, ndof)
Definition i2_imp1.F:1600
i2updb0
subroutine i2updb0(nsn, irect, crst, nsv, irtl, x, ndof, iddl, b)
Definition i2_imp1.F:1969
updk1_ii
subroutine updk1_ii(ndl, rj, rjt, kdd, k, bd, b)
Definition i2_imp1.F:789
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_frfm1
subroutine i2_frfm1(x, irect, dpara, nsv, irtl, a, ii)
Definition i2_imp1.F:1508
i2_frup1
subroutine i2_frup1(x, irect, dpara, nsv, irtl, ii, kii, kjj)
Definition i2_imp1.F:1792
i2updb02
subroutine i2updb02(nsn, irect, crst, nsv, irtl, x, ndof, iddl, b, a, ar)
Definition i2_imp1.F:2251
i2_impr1
subroutine i2_impr1(ipari, intbuf_tab, x, ndof, iddl, b)
Definition i2_imp1.F:1901
updkdd
subroutine updkdd(ndl, kdd, kii, h2, isym)
Definition i2_imp1.F:1071
i2_impm
subroutine i2_impm(ipari, intbuf_tab, nmc2, imij2, x, ms, in, weight, ndof, nddl, iddl, iadk, jdik, lt_k, diag_k)
Definition i2_imp1.F:121
i2updkm0
subroutine i2updkm0(ns1, irect, crst, nsv, irtl, ns2, irect1, crst1, nsv1, irtl1, x, kdd, ndof, iddl, iadk, jdik, lt_k, diag_k)
Definition i2_imp1.F:476
updkdd1
subroutine updkdd1(ndi, ndj, kdd, kii, h, isym)
Definition i2_imp1.F:1118
upfr1_ii
subroutine upfr1_ii(rj, rjt, kii, k)
Definition i2_imp1.F:858
i2updb1
subroutine i2updb1(nsn, irect, dpara, nsv, irtl, x, ndof, iddl, b)
Definition i2_imp1.F:2078
updb1_ii
subroutine updb1_ii(ndl, rj, rjt, bd, b)
Definition i2_imp1.F:2139
updkdd2
subroutine updkdd2(ndl, kdd, kii, h1, h2)
Definition i2_imp1.F:1163
updk1_ij
subroutine updk1_ij(ndi, ndj, r1j, r1jt, r2j, r2jt, kdd, kii, isym)
Definition i2_imp1.F:908
i2_frk0
subroutine i2_frk0(irect, crst, x, itab, nsv, irtl, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, ii, idlm, iss, ism)
Definition i2_imp1.F:2470
i2matcm
subroutine i2matcm(ii, irect, dpara, nsv, irtl, x, niri, rj, rjt)
Definition i2_imp1.F:1388
i2_frup0
subroutine i2_frup0(x, irect, crst, nsv, irtl, ii, ndof, kss, k)
Definition i2_imp1.F:1702
i2matc
subroutine i2matc(nsn, irect, dpara, nsv, irtl, x, niri, rj, rjt)
Definition i2_imp1.F:1199
updk1_jj
subroutine updk1_jj(ndi, ndj, rj, rjt, kdd, kii)
Definition i2_imp1.F:1001
i2updb12
subroutine i2updb12(nsn, irect, dpara, nsv, irtl, x, ndof, iddl, b, a, ar)
Definition i2_imp1.F:2379
i2updkm1
subroutine i2updkm1(ns1, irect, dpara, nsv, irtl, ns2, irect1, dpara1, nsv1, irtl1, x, kdd, ndof, iddl, iadk, jdik, lt_k, diag_k)
Definition i2_imp1.F:1334
i2updk1
subroutine i2updk1(nsn, nmn, irect, dpara, 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:625
i2_frk1
subroutine i2_frk1(irect, dpara, x, itab, nsv, irtl, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, ii, idlm, iss, ism)
Definition i2_imp1.F:2629
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
i2_impr2
subroutine i2_impr2(ipari, intbuf_tab, a, ar, x, ndof, iddl, b)
Definition i2_imp1.F:2183
imp_dykv
subroutine imp_dykv(nodft, nodlt, iddl, ndof, ikc, diag_k, iadk, jdik, lt_k, weight, rby, x, skew, lpby, npby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, irbe3, lrbe3, frbe3, irbe2, lrbe2, v, vr, nddl, fr_elem, iad_elem, ms, in)
Definition imp_dyna.F:1758
upd_ksl
subroutine upd_ksl(ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, inloc, nsl, iad_m, iddl, ikc, ndof, iddlm, ud, a, b, kss, ksl_fr, ksi_fr, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition imp_fri.F:5749
imp_fri
subroutine imp_fri(num_imp, ns_imp, ne_imp, ipari, intbuf_tab, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, lj, skew, xframe, iskew, icodt, a, ud, lb, ifdis, nddl, urd, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition imp_fri.F:45
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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
imp_dyna
Definition impbufdef_mod.F:314
updfr_rb
subroutine updfr_rb(xs, ys, zs, kii, k)
Definition rby_imp0.F:652
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
updkb_rb2
subroutine updkb_rb2(ni, nj, xs, ys, zs, xs1, ys1, zs1, kdd, isym)
Definition rby_imp0.F:489
nl
character *2 function nl()
Definition message.F:2354