OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ind_glob_k.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!|| dim_elems1 ../engine/source/implicit/ind_glob_k.F
25!||--- called by ------------------------------------------------------
26!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
27!||--- calls -----------------------------------------------------
28!|| reorder_i ../engine/source/implicit/ind_glob_k.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!||====================================================================
33 SUBROUTINE dim_elems1(
34 1 IGEO ,ELBUF ,IPARG ,IXS ,IXQ ,
35 2 IXC ,IXT ,IXP ,IXR ,IXTG ,
36 3 IXTG1 ,IXS10 ,IXS20 ,IXS16 ,
37 4 NDOF ,NROW ,ELBUF_TAB )
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
43C----6---------------------------------------------------------------7---------8
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "param_c.inc"
52#include "com04_c.inc"
53C-----------------------------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IPARG(NPARG,*),IGEO(NPROPGI,*)
57 INTEGER
58 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
59 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
60 . ixs16(8,*),ixtg1(4,*),ndof(*),nrow(*)
61C REAL
62 my_real
63 . elbuf(*)
64 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
69 . I,J,K,N,M,EP,L,IGTYP,NNOD,K1,IHBE,EP1,IAD0,NPT,IDRIL
70 my_real
71 . IOF
72C--------NROW(NUMNOD) : number of connected nodes (sym)
73C----6---------------------------------------------------------------7---------8
74 DO 100 ng=1,ngroup
75 IF (iparg(8,ng)/=1) THEN
76 ity=iparg(5,ng)
77 nel=iparg(2,ng)
78 nft=iparg(3,ng)
79 iad=iparg(4,ng)
80 npt=iparg(6,ng)
81 icnod=iparg(11,ng)
82 isnod=iparg(28,ng)
83 idril=iparg(41,ng)
84 iad0 = iad-1
85C----------no ndof defined for void, rigid mat add dof to pass U_D later-
86 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) THEN
87C----------------deformable
88 ELSE
89C-----------------------
90C 1. ELEMENTS SOLIDES
91C-----------------------
92 IF (ity==1) THEN
93 DO i=1,nel
94 iof = elbuf_tab(ng)%GBUF%OFF(i)
95 IF(iof>zero)THEN
96 nnod=8
97 ep=i+nft
98 IF (isnod==4) THEN
99 nnod=4
100 nc(1)=ixs(2,ep)
101 nc(2)=ixs(4,ep)
102 nc(3)=ixs(7,ep)
103 nc(4)=ixs(6,ep)
104 ELSEIF (isnod==6) THEN
105 nnod=6
106 nc(1)=ixs(2,ep)
107 nc(2)=ixs(3,ep)
108 nc(3)=ixs(4,ep)
109 nc(4)=ixs(6,ep)
110 nc(5)=ixs(7,ep)
111 nc(6)=ixs(8,ep)
112 ELSEIF (isnod==10) THEN
113 nnod=4
114 nc(1)=ixs(2,ep)
115 nc(2)=ixs(4,ep)
116 nc(3)=ixs(7,ep)
117 nc(4)=ixs(6,ep)
118 ep1=ep-numels8
119 DO j=1,6
120 IF (ixs10(j,ep1)>0) THEN
121 nnod = nnod + 1
122 nc(nnod) = ixs10(j,ep1)
123 ENDIF
124 ENDDO
125 ELSEIF (isnod==8) THEN
126 nnod=8
127 DO j=1,nnod
128 nc(j)=ixs(j+1,ep)
129 ENDDO
130 ELSEIF (isnod==20) THEN
131 nnod=20
132 DO j=1,8
133 nc(j)=ixs(j+1,ep)
134 ENDDO
135 ep1=ep-(numels8+numels10)
136 DO j=9,20
137 nc(j)=ixs20(j-8,ep1)
138 ENDDO
139
140 ELSE
141 nnod=0
142 ENDIF
143 CALL reorder_i(nnod,nc)
144 DO j=1,nnod
145 n=nc(j)
146 ndof(n)=max(3,ndof(n))
147 DO l=j+1,nnod
148 IF (n/=nc(l)) nrow(n)=nrow(n)+1
149 ENDDO
150 ENDDO
151 ENDIF
152 ENDDO
153C-----------------------
154C 2. ELEMENTS 2D
155C-----------------------
156 ELSEIF(ity==2)THEN
157 DO i=1,nel
158 iof = elbuf_tab(ng)%GBUF%OFF(i)
159 IF(iof>zero)THEN
160C
161 nnod=4
162 ep=i+nft
163C IF (ISNOD==4) THEN
164C NNOD=4
165 DO j=1,nnod
166 nc(j)=ixq(j+1,ep)
167 ENDDO
168C ELSE
169C NNOD=0
170C ENDIF
171C
172 CALL reorder_i(nnod,nc)
173 DO j=1,nnod
174 n=nc(j)
175 ndof(n)=max(3,ndof(n)) !3
176 DO l=j+1,nnod
177 IF (n/=nc(l)) nrow(n)=nrow(n)+1
178 ENDDO
179 ENDDO
180C
181 ENDIF
182 ENDDO
183C-----------------------
184C 3. ELEMENTS COQUES
185C-----------------------
186 ELSEIF(ity==3)THEN
187 DO i=1,nel
188 iof = elbuf_tab(ng)%GBUF%OFF(i)
189 IF(iof>zero)THEN
190 nnod=4
191 ep=i+nft
192 DO j=1,nnod
193 nc(j)=ixc(j+1,ep)
194 ENDDO
195 CALL reorder_i(nnod,nc)
196 DO j=1,nnod
197 n=nc(j)
198 IF (npt==1.AND.idril==0) THEN
199 ndof(n)=max(3,ndof(n))
200 ELSE
201 ndof(n)=6
202 END IF
203 DO l=j+1,nnod
204 IF (n/=nc(l)) nrow(n)=nrow(n)+1
205 ENDDO
206 ENDDO
207 ENDIF
208 ENDDO
209C-----------------------
210C 4. ELEMENTS TIGES
211C-----------------------
212 ELSEIF(ity==4)THEN
213 nnod=2
214 DO i=1,nel
215 iof=elbuf_tab(ng)%GBUF%OFF(i)
216 IF(iof>zero)THEN
217 ep=i+nft
218 nc(1)=ixt(2,ep)
219 nc(2)=ixt(3,ep)
220 CALL reorder_i(nnod,nc)
221 DO j=1,nnod
222 n=nc(j)
223 ndof(n)=max(3,ndof(n))
224 DO l=1,nnod
225 IF (n/=nc(l)) nrow(n)=nrow(n)+1
226 ENDDO
227 ENDDO
228 ENDIF
229 ENDDO
230C-----------------------
231C 5. ELEMENTS POUTRES
232C-----------------------
233 ELSEIF(ity==5)THEN
234 nnod=2
235 DO i=1,nel
236 iof=elbuf_tab(ng)%GBUF%OFF(i)
237 IF(iof>zero)THEN
238 ep=i+nft
239 nc(1)=ixp(2,ep)
240 nc(2)=ixp(3,ep)
241 CALL reorder_i(nnod,nc)
242 DO j=1,nnod
243 n=nc(j)
244 ndof(n)=6
245 DO l=j+1,nnod
246 IF (n/=nc(l)) nrow(n)=nrow(n)+1
247 ENDDO
248 ENDDO
249 ENDIF
250 ENDDO
251C-----------------------
252C 6. ELEMENTS RESSORTS
253C-----------------------
254 ELSEIF(ity==6)THEN
255 nnod=2
256 DO i=1,nel
257 iof=elbuf_tab(ng)%GBUF%OFF(i)
258 IF(iof>zero)THEN
259 ep=i+nft
260 nc(1)=ixr(2,ep)
261 nc(2)=ixr(3,ep)
262 igtyp = igeo(11,ixr(1,ep))
263 IF (igtyp==12) THEN
264 nnod=3
265 nc(3)=ixr(4,ep)
266 ENDIF
267 CALL reorder_i(nnod,nc)
268 DO j=1,nnod
269 n=nc(j)
270 DO l=j+1,nnod
271 IF (n/=nc(l)) nrow(n)=nrow(n)+1
272 ENDDO
273 ENDDO
274 IF (igtyp==8.OR.igtyp==13) THEN
275 DO j=1,nnod
276 ndof(nc(j))=6
277 ENDDO
278 ELSEIF (igtyp==4.OR.igtyp==12.OR.igtyp==32) THEN
279 DO j=1,nnod
280 ndof(nc(j))=max(3,ndof(nc(j)))
281 ENDDO
282 ENDIF
283 ENDIF
284 ENDDO
285C-----------------------
286C 7. ELEMENTS COQUES 3N
287C-----------------------
288 ELSEIF(ity==7.AND.icnod/=6)THEN
289 nnod=3
290 DO i=1,nel
291 iof = elbuf_tab(ng)%GBUF%OFF(i)
292 IF(iof>zero)THEN
293 ep=i+nft
294 DO j=1,nnod
295 nc(j)=ixtg(j+1,ep)
296 ENDDO
297 CALL reorder_i(nnod,nc)
298 DO j=1,nnod
299 n=nc(j)
300 IF (npt==1.AND.idril==0) THEN
301 ndof(n)=max(3,ndof(n))
302 ELSE
303 ndof(n)=6
304 END IF
305 DO l=j+1,nnod
306 IF (n/=nc(l)) nrow(n)=nrow(n)+1
307 ENDDO
308 ENDDO
309 ENDIF
310 ENDDO
311 ENDIF
312C
313 END IF !(IPARG(1,NG) == 0 .OR. IPARG(1,NG) == 13) THEN
314 ENDIF
315 100 CONTINUE
316 RETURN
317 END
318C------version \\-----
319!||====================================================================
320!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
321!||--- called by ------------------------------------------------------
322!|| dim_elemax ../engine/source/implicit/ind_glob_k.F
323!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
324!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
325!||--- calls -----------------------------------------------------
326!|| reorder_a ../engine/source/implicit/ind_glob_k.F
327!||--- uses -----------------------------------------------------
328!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
329!|| element_mod ../common_source/modules/elements/element_mod.f90
330!||====================================================================
331 SUBROUTINE dim_elems3(
332 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
333 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
334 3 IXS10 ,IXS20 ,IXS16 ,NROW ,
335 4 INLOC ,NKMAX ,ICOK ,IGEO ,ELBUF_TAB )
336C-----------------------------------------------
337C M o d u l e s
338C-----------------------------------------------
339 USE elbufdef_mod
340 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
341C----6---------------------------------------------------------------7---------8
342C I m p l i c i t T y p e s
343C-----------------------------------------------
344#include "implicit_f.inc"
345C-----------------------------------------------
346C C o m m o n B l o c k s
347C-----------------------------------------------
348#include "com01_c.inc"
349#include "param_c.inc"
350#include "com04_c.inc"
351C-----------------------------------------------------------------
352C D u m m y A r g u m e n t s
353C-----------------------------------------------
354 INTEGER IPARG(NPARG,*),NKMAX,IGEO(NPROPGI,*)
355 INTEGER
356 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
357 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
358 . IXS16(8,*),IXTG1(4,*),NROW(*),ICOK(NKMAX,*),INLOC(*)
359C REAL
360 my_real
361 . ELBUF(*)
362 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
363C-----------------------------------------------
364C L o c a l V a r i a b l e s
365C-----------------------------------------------
366 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
367 . I,J,K,N,M,EP,L,IGTYP,NNOD,K1,IHBE,NK,EP1,IAD0
368 my_real
369 . iof
370C--------NROW(NUMNOD) : number of connected nodes (non sym)
371C----6---------------------------------------------------------------7---------8
372 DO 100 ng=1,ngroup
373 IF (iparg(8,ng)/=1) THEN
374 ity=iparg(5,ng)
375 nel=iparg(2,ng)
376C----------void, rigid mat
377 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) cycle
378 nft=iparg(3,ng)
379 iad=iparg(4,ng)
380 icnod=iparg(11,ng)
381 isnod=iparg(28,ng)
382 iad0 = iad-1
383C-----------------------
384C 1. ELEMENTS SOLIDES
385C-----------------------
386 IF (ity==1) THEN
387 nnod=8
388 DO i=1,nel
389 iof = elbuf_tab(ng)%GBUF%OFF(i)
390 IF(iof>zero)THEN
391 ep=i+nft
392 IF (isnod==4) THEN
393 nnod=4
394 nc(1)=ixs(2,ep)
395 nc(2)=ixs(4,ep)
396 nc(3)=ixs(7,ep)
397 nc(4)=ixs(6,ep)
398 ELSEIF (isnod==6) THEN
399 nnod=6
400 nc(1)=ixs(2,ep)
401 nc(2)=ixs(3,ep)
402 nc(3)=ixs(4,ep)
403 nc(4)=ixs(6,ep)
404 nc(5)=ixs(7,ep)
405 nc(6)=ixs(8,ep)
406 ELSEIF (isnod==10) THEN
407 nnod=4
408 nc(1)=ixs(2,ep)
409 nc(2)=ixs(4,ep)
410 nc(3)=ixs(7,ep)
411 nc(4)=ixs(6,ep)
412 ep1=ep-numels8
413 DO j=1,6
414 IF (ixs10(j,ep1)>0) THEN
415 nnod = nnod + 1
416 nc(nnod) = ixs10(j,ep1)
417 ENDIF
418 ENDDO
419 ELSEIF (isnod==8) THEN
420 nnod=8
421 DO j=1,nnod
422 nc(j)=ixs(j+1,ep)
423 ENDDO
424
425C add solid element 20
426 ELSEIF (isnod==20) THEN
427 nnod=20
428 DO j=1,8
429 nc(j)=ixs(j+1,ep)
430 ENDDO
431 ep1=ep-(numels8+numels10)
432 DO j=9,20
433 nc(j)=ixs20(j-8,ep1)
434 ENDDO
435
436 ELSE
437 nnod=0
438 ENDIF
439 DO j=1,nnod
440 n=nc(j)
441 nk=inloc(n)
442 IF (nk>0) THEN
443 DO l=1,nnod
444 IF (n/=nc(l)) THEN
445 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
446 ENDIF
447 ENDDO
448 ENDIF
449 ENDDO
450 ENDIF
451 ENDDO
452C-----------------------
453C 2. ELEMENTS 2D
454C-----------------------
455 ELSEIF(ity==2)THEN
456 nnod=4
457 DO i=1,nel
458 iof = elbuf_tab(ng)%GBUF%OFF(i)
459 IF(iof>zero)THEN
460C
461 ep=i+nft
462C IF (ISNOD==4) THEN
463C NNOD=4
464 DO j=1,nnod
465 nc(j)=ixq(j+1,ep)
466 ENDDO
467C ELSE
468C NNOD=0
469C ENDIF
470C
471 DO j=1,nnod
472 n=nc(j)
473 nk=inloc(n)
474 IF (nk>0) THEN
475 DO l=1,nnod
476 IF (n/=nc(l)) THEN
477 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
478 ENDIF
479 ENDDO
480 ENDIF
481 ENDDO
482C
483 ENDIF
484 ENDDO
485C-----------------------
486C 3. ELEMENTS COQUES
487C-----------------------
488 ELSEIF(ity==3)THEN
489 nnod=4
490 DO i=1,nel
491 iof = elbuf_tab(ng)%GBUF%OFF(i)
492 IF(iof>zero)THEN
493 ep=i+nft
494 DO j=1,nnod
495 nc(j)=ixc(j+1,ep)
496 ENDDO
497 DO j=1,nnod
498 n=nc(j)
499 nk=inloc(n)
500 IF (nk>0) THEN
501 DO l=1,nnod
502 IF (n/=nc(l)) THEN
503 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
504 ENDIF
505 ENDDO
506 ENDIF
507 ENDDO
508 ENDIF
509 ENDDO
510C-----------------------
511C 4. ELEMENTS TIGES
512C-----------------------
513 ELSEIF(ity==4)THEN
514 nnod=2
515 DO i=1,nel
516 iof=elbuf_tab(ng)%GBUF%OFF(i)
517 IF(iof>zero)THEN
518 ep=i+nft
519 nc(1)=ixt(2,ep)
520 nc(2)=ixt(3,ep)
521 DO j=1,nnod
522 n=nc(j)
523 nk=inloc(n)
524 IF (nk>0) THEN
525 DO l=1,nnod
526 IF (n/=nc(l)) THEN
527 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
528 ENDIF
529 ENDDO
530 ENDIF
531 ENDDO
532 ENDIF
533 ENDDO
534C-----------------------
535C 5. ELEMENTS POUTRES
536C-----------------------
537 ELSEIF(ity==5)THEN
538 nnod=2
539 DO i=1,nel
540 iof=elbuf_tab(ng)%GBUF%OFF(i)
541 IF(iof>zero)THEN
542 ep=i+nft
543 nc(1)=ixp(2,ep)
544 nc(2)=ixp(3,ep)
545 DO j=1,nnod
546 n=nc(j)
547 nk=inloc(n)
548 IF (nk>0) THEN
549 DO l=1,nnod
550 IF (n/=nc(l)) THEN
551 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
552 ENDIF
553 ENDDO
554 ENDIF
555 ENDDO
556 ENDIF
557 ENDDO
558C-----------------------
559C 6. ELEMENTS RESSORTS
560C-----------------------
561 ELSEIF(ity==6)THEN
562 nnod=2
563 DO i=1,nel
564 iof=elbuf_tab(ng)%GBUF%OFF(i)
565 IF(iof>zero)THEN
566 ep=i+nft
567 nc(1)=ixr(2,ep)
568 nc(2)=ixr(3,ep)
569 igtyp = igeo(11,ixr(1,ep))
570 IF (igtyp==12) THEN
571 nnod=3
572 nc(3)=ixr(4,ep)
573 ENDIF
574 DO j=1,nnod
575 n=nc(j)
576 nk=inloc(n)
577 IF (nk>0) THEN
578 DO l=1,nnod
579 IF (n/=nc(l)) THEN
580 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
581 ENDIF
582 ENDDO
583 ENDIF
584 ENDDO
585 ENDIF
586 ENDDO
587C-----------------------
588C 7. ELEMENTS COQUES 3N
589C-----------------------
590 ELSEIF(ity==7.AND.icnod/=6)THEN
591 nnod=3
592 DO i=1,nel
593 iof = elbuf_tab(ng)%GBUF%OFF(i)
594 IF(iof>zero)THEN
595 ep=i+nft
596 DO j=1,nnod
597 nc(j)=ixtg(j+1,ep)
598 ENDDO
599 DO j=1,nnod
600 n=nc(j)
601 nk=inloc(n)
602 IF (nk>0) THEN
603 DO l=1,nnod
604 IF (n/=nc(l)) THEN
605 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
606 ENDIF
607 ENDDO
608 ENDIF
609 ENDDO
610 ENDIF
611 ENDDO
612 ENDIF
613C
614 ENDIF
615 100 CONTINUE
616 RETURN
617 END
618!||====================================================================
619!|| dim_elems2 ../engine/source/implicit/ind_glob_k.f
620!||--- called by ------------------------------------------------------
621!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
622!||--- calls -----------------------------------------------------
623!|| reorder_a ../engine/source/implicit/ind_glob_k.F
624!||--- uses -----------------------------------------------------
625!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
626!|| element_mod ../common_source/modules/elements/element_mod.F90
627!||====================================================================
628 SUBROUTINE dim_elems2(
629 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
630 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
631 3 IXS10 ,IXS20 ,IXS16 ,NROW ,
632 4 INLOC ,NNMAX ,ICOK ,NKMAX ,ICOKM ,
633 5 INK ,IGEO ,ELBUF_TAB )
634C-----------------------------------------------
635C M o d u l e s
636C-----------------------------------------------
637 USE elbufdef_mod
638 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
639C----6---------------------------------------------------------------7---------8
640C I m p l i c i t T y p e s
641C-----------------------------------------------
642#include "implicit_f.inc"
643C-----------------------------------------------
644C C o m m o n B l o c k s
645C-----------------------------------------------
646#include "com01_c.inc"
647#include "param_c.inc"
648#include "com04_c.inc"
649C-----------------------------------------------------------------
650C D u m m y A r g u m e n t s
651C-----------------------------------------------
652 INTEGER IPARG(NPARG,*),NNMAX,NKMAX,IGEO(NPROPGI,*)
653 INTEGER
654 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
655 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
656 . IXS16(8,*),IXTG1(4,*),
657 . NROW(*),ICOK(NNMAX,*),ICOKM(NKMAX,*),INLOC(*),INK
658C REAL
659 my_real
660 . ELBUF(*)
661 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
662C-----------------------------------------------
663C L o c a l V a r i a b l e s
664C-----------------------------------------------
665 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
666 . i,j,k,n,m,ep,l,igtyp,nnod,k1,ihbe,nk,ep1,iad0
667 my_real
668 . iof
669C----6---------------------------------------------------------------7---------8
670 DO 100 ng=1,ngroup
671 IF (iparg(8,ng)/=1) THEN
672 ity=iparg(5,ng)
673 nel=iparg(2,ng)
674C----------void, rigid mat
675 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) cycle
676 nft=iparg(3,ng)
677 iad=iparg(4,ng)
678 icnod=iparg(11,ng)
679 isnod=iparg(28,ng)
680 iad0 = iad-1
681C-----------------------
682C 1. ELEMENTS SOLIDES
683C-----------------------
684 IF (ity==1) THEN
685 nnod=8
686 DO i=1,nel
687 iof = elbuf_tab(ng)%GBUF%OFF(i)
688 IF(iof>zero)THEN
689 ep=i+nft
690 IF (isnod==4) THEN
691 nnod=4
692 nc(1)=ixs(2,ep)
693 nc(2)=ixs(4,ep)
694 nc(3)=ixs(7,ep)
695 nc(4)=ixs(6,ep)
696 ELSEIF (isnod==6) THEN
697 nnod=6
698 nc(1)=ixs(2,ep)
699 nc(2)=ixs(3,ep)
700 nc(3)=ixs(4,ep)
701 nc(4)=ixs(6,ep)
702 nc(5)=ixs(7,ep)
703 nc(6)=ixs(8,ep)
704 ELSEIF (isnod==10) THEN
705 nnod=4
706 nc(1)=ixs(2,ep)
707 nc(2)=ixs(4,ep)
708 nc(3)=ixs(7,ep)
709 nc(4)=ixs(6,ep)
710 ep1=ep-numels8
711 DO j=1,6
712 IF (ixs10(j,ep1)>0) THEN
713 nnod = nnod + 1
714 nc(nnod) = ixs10(j,ep1)
715 ENDIF
716 ENDDO
717 ELSEIF (isnod==8) THEN
718 nnod=8
719 DO j=1,nnod
720 nc(j)=ixs(j+1,ep)
721 ENDDO
722
723C add solid element 20
724 ELSEIF (isnod==20) THEN
725 nnod=20
726 DO j=1,8
727 nc(j)=ixs(j+1,ep)
728 ENDDO
729 ep1=ep-(numels8+numels10)
730 DO j=9,20
731 nc(j)=ixs20(j-8,ep1)
732 ENDDO
733
734 ENDIF
735 DO j=1,nnod
736 n=nc(j)
737 nk=inloc(n)
738 IF (nk>ink) THEN
739 DO l=1,nnod
740 IF (n/=nc(l)) THEN
741 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
742 ENDIF
743 ENDDO
744 ELSEIF (nk>0) THEN
745 DO l=1,nnod
746 IF (n/=nc(l)) THEN
747 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
748 ENDIF
749 ENDDO
750 ENDIF
751 ENDDO
752 ENDIF
753 ENDDO
754C-----------------------
755C 2. ELEMENTS 2D
756C-----------------------
757 ELSEIF(ity==2)THEN
758 nnod=4
759 DO i=1,nel
760 iof = elbuf_tab(ng)%GBUF%OFF(i)
761 IF(iof>zero)THEN
762C
763 ep=i+nft
764C IF (ISNOD==4) THEN
765C NNOD=4
766 DO j=1,nnod
767 nc(j)=ixq(j+1,ep)
768 ENDDO
769C ELSE
770C NNOD=0
771C ENDIF
772C
773 DO j=1,nnod
774 n=nc(j)
775 nk=inloc(n)
776 IF (nk>ink) THEN
777 DO l=1,nnod
778 IF (n/=nc(l)) THEN
779 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
780 ENDIF
781 ENDDO
782 ELSEIF (nk>0) THEN
783 DO l=1,nnod
784 IF (n/=nc(l)) THEN
785 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
786 ENDIF
787 ENDDO
788 ENDIF
789 ENDDO
790C
791 ENDIF
792 ENDDO
793C-----------------------
794C 3. ELEMENTS COQUES
795C-----------------------
796 ELSEIF(ity==3)THEN
797 nnod=4
798 DO i=1,nel
799 iof = elbuf_tab(ng)%GBUF%OFF(i)
800 IF(iof>zero)THEN
801 ep=i+nft
802 DO j=1,nnod
803 nc(j)=ixc(j+1,ep)
804 ENDDO
805 DO j=1,nnod
806 n=nc(j)
807 nk=inloc(n)
808 IF (nk>ink) THEN
809 DO l=1,nnod
810 IF (n/=nc(l)) THEN
811 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
812 ENDIF
813 ENDDO
814 ELSEIF (nk>0) THEN
815 DO l=1,nnod
816 IF (n/=nc(l)) THEN
817 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
818 ENDIF
819 ENDDO
820 ENDIF
821 ENDDO
822 ENDIF
823 ENDDO
824C-----------------------
825C 4. ELEMENTS TIGES
826C-----------------------
827 ELSEIF(ity==4)THEN
828 nnod=2
829 DO i=1,nel
830 iof=elbuf_tab(ng)%GBUF%OFF(i)
831 IF(iof>zero)THEN
832 ep=i+nft
833 nc(1)=ixt(2,ep)
834 nc(2)=ixt(3,ep)
835 DO j=1,nnod
836 n=nc(j)
837 nk=inloc(n)
838 IF (nk>ink) THEN
839 DO l=1,nnod
840 IF (n/=nc(l)) THEN
841 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
842 ENDIF
843 ENDDO
844 ELSEIF (nk>0) THEN
845 DO l=1,nnod
846 IF (n/=nc(l)) THEN
847 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
848 ENDIF
849 ENDDO
850 ENDIF
851 ENDDO
852 ENDIF
853 ENDDO
854C-----------------------
855C 5. ELEMENTS POUTRES
856C-----------------------
857 ELSEIF(ity==5)THEN
858 nnod=2
859 DO i=1,nel
860 iof=elbuf_tab(ng)%GBUF%OFF(i)
861 IF(iof>zero)THEN
862 ep=i+nft
863 nc(1)=ixp(2,ep)
864 nc(2)=ixp(3,ep)
865 DO j=1,nnod
866 n=nc(j)
867 nk=inloc(n)
868 IF (nk>ink) THEN
869 DO l=1,nnod
870 IF (n/=nc(l)) THEN
871 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
872 ENDIF
873 ENDDO
874 ELSEIF (nk>0) THEN
875 DO l=1,nnod
876 IF (n/=nc(l)) THEN
877 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
878 ENDIF
879 ENDDO
880 ENDIF
881 ENDDO
882 ENDIF
883 ENDDO
884C-----------------------
885C 6. ELEMENTS RESSORTS
886C-----------------------
887 ELSEIF(ity==6)THEN
888 nnod=2
889 DO i=1,nel
890 iof=elbuf_tab(ng)%GBUF%OFF(i)
891 IF(iof>zero)THEN
892 ep=i+nft
893 nc(1)=ixr(2,ep)
894 nc(2)=ixr(3,ep)
895 igtyp = igeo(11,ixr(1,ep))
896 IF (igtyp==12) THEN
897 nnod=3
898 nc(3)=ixr(4,ep)
899 ENDIF
900 DO j=1,nnod
901 n=nc(j)
902 nk=inloc(n)
903 IF (nk>ink) THEN
904 DO l=1,nnod
905 IF (n/=nc(l)) THEN
906 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
907 ENDIF
908 ENDDO
909 ELSEIF (nk>0) THEN
910 DO l=1,nnod
911 IF (n/=nc(l)) THEN
912 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
913 ENDIF
914 ENDDO
915 ENDIF
916 ENDDO
917 ENDIF
918 ENDDO
919C-----------------------
920C 7. ELEMENTS COQUES 3N
921C-----------------------
922 ELSEIF(ity==7.AND.icnod/=6)THEN
923 nnod=3
924 DO i=1,nel
925 iof = elbuf_tab(ng)%GBUF%OFF(i)
926 IF(iof>zero)THEN
927 ep=i+nft
928 DO j=1,nnod
929 nc(j)=ixtg(j+1,ep)
930 ENDDO
931 DO j=1,nnod
932 n=nc(j)
933 nk=inloc(n)
934 IF (nk>ink) THEN
935 DO l=1,nnod
936 IF (n/=nc(l)) THEN
937 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
938 ENDIF
939 ENDDO
940 ELSEIF (nk>0) THEN
941 DO l=1,nnod
942 IF (n/=nc(l)) THEN
943 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
944 ENDIF
945 ENDDO
946 ENDIF
947 ENDDO
948 ENDIF
949 ENDDO
950 ENDIF
951C
952 ENDIF
953 100 CONTINUE
954 RETURN
955 END
956C------version \\-----
957!||====================================================================
958!|| dim_elems4 ../engine/source/implicit/ind_glob_k.F
959!||--- called by ------------------------------------------------------
960!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
961!||--- calls -----------------------------------------------------
962!|| reorder_a ../engine/source/implicit/ind_glob_k.F
963!||--- uses -----------------------------------------------------
964!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
965!|| element_mod ../common_source/modules/elements/element_mod.F90
966!||====================================================================
967 SUBROUTINE dim_elems4(
968 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
969 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
970 3 IXS10 ,IXS20 ,IXS16 ,NROW ,
971 4 INLOC ,NNMAX ,ICOK ,NKMAX ,ICOKM ,
972 5 INK ,IGEO ,ELBUF_TAB )
973C-----------------------------------------------
974C M o d u l e s
975C-----------------------------------------------
976 USE elbufdef_mod
977 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
978C----6---------------------------------------------------------------7---------8
979C I m p l i c i t T y p e s
980C-----------------------------------------------
981#include "implicit_f.inc"
982C-----------------------------------------------
983C C o m m o n B l o c k s
984C-----------------------------------------------
985#include "com01_c.inc"
986#include "param_c.inc"
987#include "com04_c.inc"
988C-----------------------------------------------------------------
989C D u m m y A r g u m e n t s
990C-----------------------------------------------
991 INTEGER IPARG(NPARG,*),NNMAX,NKMAX,IGEO(NPROPGI,*)
992 INTEGER
993 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
994 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
995 . ixs16(8,*),ixtg1(4,*),
996 . nrow(*),icok(nnmax,*),icokm(nkmax,*),inloc(*),ink
997C REAL
998 my_real
999 . elbuf(*)
1000 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
1001C-----------------------------------------------
1002C L o c a l V a r i a b l e s
1003C-----------------------------------------------
1004 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
1005 . I,J,K,N,M,EP,L,IGTYP,NNOD,K1,IHBE,NK,NK1,EP1,IAD0
1006 my_real
1007 . IOF
1008C--------NROW(NUMNOD) : number of connected nodes (non sym)
1009C----6---------------------------------------------------------------7---------8
1010 DO 100 ng=1,ngroup
1011 IF (iparg(8,ng)/=1) THEN
1012 ity=iparg(5,ng)
1013 nel=iparg(2,ng)
1014C----------void, rigid mat
1015 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) cycle
1016 nft=iparg(3,ng)
1017 iad=iparg(4,ng)
1018 icnod=iparg(11,ng)
1019 isnod=iparg(28,ng)
1020 iad0 = iad-1
1021C-----------------------
1022C 1. ELEMENTS SOLIDES
1023C-----------------------
1024 IF (ity==1) THEN
1025 nnod=8
1026 DO i=1,nel
1027 iof = elbuf_tab(ng)%GBUF%OFF(i)
1028 IF(iof>zero)THEN
1029 ep=i+nft
1030 IF (isnod==4) THEN
1031 nnod=4
1032 nc(1)=ixs(2,ep)
1033 nc(2)=ixs(4,ep)
1034 nc(3)=ixs(7,ep)
1035 nc(4)=ixs(6,ep)
1036 ELSEIF (isnod==6) THEN
1037 nnod=6
1038 nc(1)=ixs(2,ep)
1039 nc(2)=ixs(3,ep)
1040 nc(3)=ixs(4,ep)
1041 nc(4)=ixs(6,ep)
1042 nc(5)=ixs(7,ep)
1043 nc(6)=ixs(8,ep)
1044 ELSEIF (isnod==10) THEN
1045 nnod=4
1046 nc(1)=ixs(2,ep)
1047 nc(2)=ixs(4,ep)
1048 nc(3)=ixs(7,ep)
1049 nc(4)=ixs(6,ep)
1050 ep1=ep-numels8
1051 DO j=1,6
1052 IF (ixs10(j,ep1)>0) THEN
1053 nnod = nnod + 1
1054 nc(nnod) = ixs10(j,ep1)
1055 ENDIF
1056 ENDDO
1057 ELSEIF (isnod==8) THEN
1058 nnod=8
1059 DO j=1,nnod
1060 nc(j)=ixs(j+1,ep)
1061 ENDDO
1062
1063C add solid element 20
1064 ELSEIF (isnod==20) THEN
1065 nnod=20
1066 DO j=1,8
1067 nc(j)=ixs(j+1,ep)
1068 ENDDO
1069 ep1=ep-(numels8+numels10)
1070 DO j=9,20
1071 nc(j)=ixs20(j-8,ep1)
1072 ENDDO
1073
1074 ELSE
1075 nnod=0
1076 ENDIF
1077 DO j=1,nnod
1078 n=nc(j)
1079 nk=inloc(n)
1080 IF (nk>ink) THEN
1081 nk1=nk-ink
1082 DO l=1,nnod
1083 IF (n/=nc(l)) THEN
1084 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1085 ENDIF
1086 ENDDO
1087 ELSEIF (nk>0) THEN
1088 DO l=1,nnod
1089 IF (n/=nc(l)) THEN
1090 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1091 ENDIF
1092 ENDDO
1093 ENDIF
1094 ENDDO
1095 ENDIF
1096 ENDDO
1097C-----------------------
1098C 2. ELEMENTS 2D
1099C-----------------------
1100 ELSEIF(ity==2)THEN
1101 nnod=4
1102 DO i=1,nel
1103 iof = elbuf_tab(ng)%GBUF%OFF(i)
1104 IF(iof>zero)THEN
1105C
1106 ep=i+nft
1107C IF (ISNOD==4) THEN
1108C NNOD=4
1109 DO j=1,nnod
1110 nc(j)=ixq(j+1,ep)
1111 ENDDO
1112C ELSE
1113C NNOD=0
1114C ENDIF
1115C
1116 DO j=1,nnod
1117 n=nc(j)
1118 nk=inloc(n)
1119 IF (nk>ink) THEN
1120 nk1=nk-ink
1121 DO l=1,nnod
1122 IF (n/=nc(l)) THEN
1123 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1124 ENDIF
1125 ENDDO
1126 ELSEIF (nk>0) THEN
1127 DO l=1,nnod
1128 IF (n/=nc(l)) THEN
1129 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1130 ENDIF
1131 ENDDO
1132 ENDIF
1133 ENDDO
1134C
1135 ENDIF
1136 ENDDO
1137C-----------------------
1138C 3. ELEMENTS COQUES
1139C-----------------------
1140 ELSEIF(ity==3)THEN
1141 nnod=4
1142 DO i=1,nel
1143 iof = elbuf_tab(ng)%GBUF%OFF(i)
1144 IF(iof>zero)THEN
1145 ep=i+nft
1146 DO j=1,nnod
1147 nc(j)=ixc(j+1,ep)
1148 ENDDO
1149 DO j=1,nnod
1150 n=nc(j)
1151 nk=inloc(n)
1152 IF (nk>ink) THEN
1153 nk1=nk-ink
1154 DO l=1,nnod
1155 IF (n/=nc(l)) THEN
1156 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1157 ENDIF
1158 ENDDO
1159 ELSEIF (nk>0) THEN
1160 DO l=1,nnod
1161 IF (n/=nc(l)) THEN
1162 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1163 ENDIF
1164 ENDDO
1165 ENDIF
1166 ENDDO
1167 ENDIF
1168 ENDDO
1169C-----------------------
1170C 4. ELEMENTS TIGES
1171C-----------------------
1172 ELSEIF(ity==4)THEN
1173 nnod=2
1174 DO i=1,nel
1175 iof=elbuf_tab(ng)%GBUF%OFF(i)
1176 IF(iof>zero)THEN
1177 ep=i+nft
1178 nc(1)=ixt(2,ep)
1179 nc(2)=ixt(3,ep)
1180 DO j=1,nnod
1181 n=nc(j)
1182 nk=inloc(n)
1183 IF (nk>ink) THEN
1184 nk1=nk-ink
1185 DO l=1,nnod
1186 IF (n/=nc(l)) THEN
1187 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1188 ENDIF
1189 ENDDO
1190 ELSEIF (nk>0) THEN
1191 DO l=1,nnod
1192 IF (n/=nc(l)) THEN
1193 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1194 ENDIF
1195 ENDDO
1196 ENDIF
1197 ENDDO
1198 ENDIF
1199 ENDDO
1200C-----------------------
1201C 5. ELEMENTS POUTRES
1202C-----------------------
1203 ELSEIF(ity==5)THEN
1204 nnod=2
1205 DO i=1,nel
1206 iof=elbuf_tab(ng)%GBUF%OFF(i)
1207 IF(iof>zero)THEN
1208 ep=i+nft
1209 nc(1)=ixp(2,ep)
1210 nc(2)=ixp(3,ep)
1211 DO j=1,nnod
1212 n=nc(j)
1213 nk=inloc(n)
1214 IF (nk>ink) THEN
1215 nk1=nk-ink
1216 DO l=1,nnod
1217 IF (n/=nc(l)) THEN
1218 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1219 ENDIF
1220 ENDDO
1221 ELSEIF (nk>0) THEN
1222 DO l=1,nnod
1223 IF (n/=nc(l)) THEN
1224 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1225 ENDIF
1226 ENDDO
1227 ENDIF
1228 ENDDO
1229 ENDIF
1230 ENDDO
1231C-----------------------
1232C 6. ELEMENTS RESSORTS
1233C-----------------------
1234 ELSEIF(ity==6)THEN
1235 nnod=2
1236 DO i=1,nel
1237 iof=elbuf_tab(ng)%GBUF%OFF(i)
1238 IF(iof>zero)THEN
1239 ep=i+nft
1240 nc(1)=ixr(2,ep)
1241 nc(2)=ixr(3,ep)
1242 igtyp = igeo(11,ixr(1,ep))
1243 IF (igtyp==12) THEN
1244 nnod=3
1245 nc(3)=ixr(4,ep)
1246 ENDIF
1247 DO j=1,nnod
1248 n=nc(j)
1249 nk=inloc(n)
1250 IF (nk>ink) THEN
1251 nk1=nk-ink
1252 DO l=1,nnod
1253 IF (n/=nc(l)) THEN
1254 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1255 ENDIF
1256 ENDDO
1257 ELSEIF (nk>0) THEN
1258 DO l=1,nnod
1259 IF (n/=nc(l)) THEN
1260 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1261 ENDIF
1262 ENDDO
1263 ENDIF
1264 ENDDO
1265 ENDIF
1266 ENDDO
1267C-----------------------
1268C 7. ELEMENTS COQUES 3N
1269C-----------------------
1270 ELSEIF(ity==7.AND.icnod/=6)THEN
1271 nnod=3
1272 DO i=1,nel
1273 iof = elbuf_tab(ng)%GBUF%OFF(i)
1274 IF(iof>zero)THEN
1275 ep=i+nft
1276 DO j=1,nnod
1277 nc(j)=ixtg(j+1,ep)
1278 ENDDO
1279 DO j=1,nnod
1280 n=nc(j)
1281 nk=inloc(n)
1282 IF (nk>ink) THEN
1283 nk1=nk-ink
1284 DO l=1,nnod
1285 IF (n/=nc(l)) THEN
1286 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1287 ENDIF
1288 ENDDO
1289 ELSEIF (nk>0) THEN
1290 DO l=1,nnod
1291 IF (n/=nc(l)) THEN
1292 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1293 ENDIF
1294 ENDDO
1295 ENDIF
1296 ENDDO
1297 ENDIF
1298 ENDDO
1299 ENDIF
1300C
1301 ENDIF
1302 100 CONTINUE
1303 RETURN
1304 END
1305C------version \\-----
1306!||====================================================================
1307!|| dim_elemsp ../engine/source/implicit/ind_glob_k.F
1308!||--- called by ------------------------------------------------------
1309!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
1310!|| ind_fr_k ../engine/source/mpi/implicit/imp_fri.F
1311!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.F
1312!||--- calls -----------------------------------------------------
1313!|| reorder_a ../engine/source/implicit/ind_glob_k.F
1314!||--- uses -----------------------------------------------------
1315!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1316!|| element_mod ../common_source/modules/elements/element_mod.f90
1317!||====================================================================
1318 SUBROUTINE dim_elemsp(
1319 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
1320 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
1321 3 IXS10 ,IXS20 ,IXS16 ,NROW ,
1322 4 INLOC ,NKMAX ,ICOK ,IGEO ,ELBUF_TAB )
1323C-----------------------------------------------
1324C M o d u l e s
1325C-----------------------------------------------
1326 USE elbufdef_mod
1327 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
1328C----6---------------------------------------------------------------7---------8
1329C I m p l i c i t T y p e s
1330C-----------------------------------------------
1331#include "implicit_f.inc"
1332C-----------------------------------------------
1333C C o m m o n B l o c k s
1334C-----------------------------------------------
1335#include "com01_c.inc"
1336#include "param_c.inc"
1337#include "com04_c.inc"
1338C-----------------------------------------------------------------
1339C D u m m y A r g u m e n t s
1340C-----------------------------------------------
1341 INTEGER IPARG(NPARG,*),NKMAX,IGEO(NPROPGI,*)
1342 INTEGER
1343 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
1344 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
1345 . IXS16(8,*),IXTG1(4,*),NROW(*),ICOK(NKMAX,*),INLOC(*)
1346C REAL
1347 my_real
1348 . elbuf(*)
1349 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
1350C-----------------------------------------------
1351C L o c a l V a r i a b l e s
1352C-----------------------------------------------
1353 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
1354 . I,J,K,N,M,EP,L,IGTYP,NNOD,K1,IHBE,NK,NJ,EP1,IAD0
1355 my_real
1356 . IOF
1357C--------NROW(NUMNOD) : number of connected nodes (non sym)
1358C----6---------------------------------------------------------------7---------8
1359 DO 100 NG=1,ngroup
1360 IF (iparg(8,ng)/=1) THEN
1361 ity=iparg(5,ng)
1362 nel=iparg(2,ng)
1363C----------void, rigid mat
1364 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) cycle
1365 nft=iparg(3,ng)
1366 iad=iparg(4,ng)
1367 icnod=iparg(11,ng)
1368 isnod=iparg(28,ng)
1369 iad0 = iad-1
1370C-----------------------
1371C 1. ELEMENTS SOLIDES
1372C-----------------------
1373 IF (ity==1) THEN
1374 nnod=8
1375 DO i=1,nel
1376 iof = elbuf_tab(ng)%GBUF%OFF(i)
1377 IF(iof>zero)THEN
1378 ep=i+nft
1379 IF (isnod==4) THEN
1380 nnod=4
1381 nc(1)=ixs(2,ep)
1382 nc(2)=ixs(4,ep)
1383 nc(3)=ixs(7,ep)
1384 nc(4)=ixs(6,ep)
1385 ELSEIF (isnod==6) THEN
1386 nnod=6
1387 nc(1)=ixs(2,ep)
1388 nc(2)=ixs(3,ep)
1389 nc(3)=ixs(4,ep)
1390 nc(4)=ixs(6,ep)
1391 nc(5)=ixs(7,ep)
1392 nc(6)=ixs(8,ep)
1393 ELSEIF (isnod==10) THEN
1394 nnod=4
1395 nc(1)=ixs(2,ep)
1396 nc(2)=ixs(4,ep)
1397 nc(3)=ixs(7,ep)
1398 nc(4)=ixs(6,ep)
1399 ep1=ep-numels8
1400 DO j=1,6
1401 IF (ixs10(j,ep1)>0) THEN
1402 nnod = nnod + 1
1403 nc(nnod) = ixs10(j,ep1)
1404 ENDIF
1405 ENDDO
1406 ELSEIF (isnod==8) THEN
1407 nnod=8
1408 DO j=1,nnod
1409 nc(j)=ixs(j+1,ep)
1410 ENDDO
1411
1412C add solid element 20
1413 ELSEIF (isnod==20) THEN
1414 nnod=20
1415 DO j=1,8
1416 nc(j)=ixs(j+1,ep)
1417 ENDDO
1418 ep1=ep-(numels8+numels10)
1419 DO j=9,20
1420 nc(j)=ixs20(j-8,ep1)
1421 ENDDO
1422
1423 ELSE
1424 nnod=0
1425 ENDIF
1426 DO j=1,nnod
1427 n=nc(j)
1428 nk=inloc(n)
1429 IF (nk>0) THEN
1430 DO l=1,nnod
1431 nj=nc(l)
1432 IF (n/=nj.AND.inloc(nj)>0) THEN
1433 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1434 ENDIF
1435 ENDDO
1436 ENDIF
1437 ENDDO
1438 ENDIF
1439 ENDDO
1440C-----------------------
1441C 2. ELEMENTS 2D
1442C-----------------------
1443 ELSEIF(ity==2)THEN
1444 nnod=4
1445 DO i=1,nel
1446 iof = elbuf_tab(ng)%GBUF%OFF(i)
1447 IF(iof>zero)THEN
1448C
1449 ep=i+nft
1450C IF (ISNOD==4) THEN
1451C NNOD=4
1452 DO j=1,nnod
1453 nc(j)=ixq(j+1,ep)
1454 ENDDO
1455C ELSE
1456C NNOD=0
1457C ENDIF
1458C
1459 DO j=1,nnod
1460 n=nc(j)
1461 nk=inloc(n)
1462 IF (nk>0) THEN
1463 DO l=1,nnod
1464 nj=nc(l)
1465 IF (n/=nj.AND.inloc(nj)>0) THEN
1466 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1467 ENDIF
1468 ENDDO
1469 ENDIF
1470 ENDDO
1471C
1472 ENDIF
1473 ENDDO
1474C-----------------------
1475C 3. ELEMENTS COQUES
1476C-----------------------
1477 ELSEIF(ity==3)THEN
1478 nnod=4
1479 DO i=1,nel
1480 iof = elbuf_tab(ng)%GBUF%OFF(i)
1481 IF(iof>zero)THEN
1482 ep=i+nft
1483 DO j=1,nnod
1484 nc(j)=ixc(j+1,ep)
1485 ENDDO
1486 DO j=1,nnod
1487 n=nc(j)
1488 nk=inloc(n)
1489 IF (nk>0) THEN
1490 DO l=1,nnod
1491 nj=nc(l)
1492 IF (n/=nj.AND.inloc(nj)>0) THEN
1493 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1494 ENDIF
1495 ENDDO
1496 ENDIF
1497 ENDDO
1498 ENDIF
1499 ENDDO
1500C-----------------------
1501C 4. ELEMENTS TIGES
1502C-----------------------
1503 ELSEIF(ity==4)THEN
1504 nnod=2
1505 DO i=1,nel
1506 iof=elbuf_tab(ng)%GBUF%OFF(i)
1507 IF(iof>zero)THEN
1508 ep=i+nft
1509 nc(1)=ixt(2,ep)
1510 nc(2)=ixt(3,ep)
1511 DO j=1,nnod
1512 n=nc(j)
1513 nk=inloc(n)
1514 IF (nk>0) THEN
1515 DO l=1,nnod
1516 nj=nc(l)
1517 IF (n/=nj.AND.inloc(nj)>0) THEN
1518 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1519 ENDIF
1520 ENDDO
1521 ENDIF
1522 ENDDO
1523 ENDIF
1524 ENDDO
1525C-----------------------
1526C 5. ELEMENTS POUTRES
1527C-----------------------
1528 ELSEIF(ity==5)THEN
1529 nnod=2
1530 DO i=1,nel
1531 iof=elbuf_tab(ng)%GBUF%OFF(i)
1532 IF(iof>zero)THEN
1533 ep=i+nft
1534 nc(1)=ixp(2,ep)
1535 nc(2)=ixp(3,ep)
1536 DO j=1,nnod
1537 n=nc(j)
1538 nk=inloc(n)
1539 IF (nk>0) THEN
1540 DO l=1,nnod
1541 nj=nc(l)
1542 IF (n/=nj.AND.inloc(nj)>0) THEN
1543 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1544 ENDIF
1545 ENDDO
1546 ENDIF
1547 ENDDO
1548 ENDIF
1549 ENDDO
1550C-----------------------
1551C 6. ELEMENTS RESSORTS
1552C-----------------------
1553 ELSEIF(ity==6)THEN
1554 nnod=2
1555 DO i=1,nel
1556 iof=elbuf_tab(ng)%GBUF%OFF(i)
1557 IF(iof>zero)THEN
1558 ep=i+nft
1559 nc(1)=ixr(2,ep)
1560 nc(2)=ixr(3,ep)
1561 igtyp = igeo(11,ixr(1,ep))
1562 IF (igtyp==12) THEN
1563 nnod=3
1564 nc(3)=ixr(4,ep)
1565 ENDIF
1566 DO j=1,nnod
1567 n=nc(j)
1568 nk=inloc(n)
1569 IF (nk>0) THEN
1570 DO l=1,nnod
1571 nj=nc(l)
1572 IF (n/=nj.AND.inloc(nj)>0) THEN
1573 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1574 ENDIF
1575 ENDDO
1576 ENDIF
1577 ENDDO
1578 ENDIF
1579 ENDDO
1580C-----------------------
1581C 7. ELEMENTS COQUES 3N
1582C-----------------------
1583 ELSEIF(ity==7.AND.icnod/=6)THEN
1584 nnod=3
1585 DO i=1,nel
1586 iof = elbuf_tab(ng)%GBUF%OFF(i)
1587 IF(iof>zero)THEN
1588 ep=i+nft
1589 DO j=1,nnod
1590 nc(j)=ixtg(j+1,ep)
1591 ENDDO
1592 DO j=1,nnod
1593 n=nc(j)
1594 nk=inloc(n)
1595 IF (nk>0) THEN
1596 DO l=1,nnod
1597 nj=nc(l)
1598 IF (n/=nj.AND.inloc(nj)>0) THEN
1599 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1600 ENDIF
1601 ENDDO
1602 ENDIF
1603 ENDDO
1604 ENDIF
1605 ENDDO
1606 ENDIF
1607C
1608 ENDIF
1609 100 CONTINUE
1610 RETURN
1611 END
1612!||====================================================================
1613!|| dim_elemax ../engine/source/implicit/ind_glob_k.F
1614!||--- called by ------------------------------------------------------
1615!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
1616!||--- calls -----------------------------------------------------
1617!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
1618!||--- uses -----------------------------------------------------
1619!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1620!|| element_mod ../common_source/modules/elements/element_mod.F90
1621!||====================================================================
1622 SUBROUTINE dim_elemax(
1623 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
1624 2 IXR ,IXTG ,IXTG1 ,IXS10 ,IXS20 ,
1625 3 IXS16 ,IPARG ,ELBUF ,NDOF ,
1626 4 NROW ,INLOC ,NNMAX ,L_MAX ,C_MAX ,
1627 5 IGEO ,ELBUF_TAB )
1628C-----------------------------------------------
1629C M o d u l e s
1630C-----------------------------------------------
1631 USE elbufdef_mod
1632 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
1633C----6---------------------------------------------------------------7---------8
1634C I m p l i c i t T y p e s
1635C-----------------------------------------------
1636#include "implicit_f.inc"
1637C-----------------------------------------------
1638C C o m m o n B l o c k s
1639C-----------------------------------------------
1640#include "com01_c.inc"
1641#include "com04_c.inc"
1642#include "param_c.inc"
1643C-----------------------------------------------------------------
1644C D u m m y A r g u m e n t s
1645C-----------------------------------------------
1646 INTEGER IPARG(NPARG,*),IGEO(NPROPGI,*)
1647 INTEGER
1648 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
1649 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
1650 . ixs16(8,*),ixtg1(4,*),ndof(*),nrow(*),inloc(*),
1651 . nnmax,l_max,c_max
1652C REAL
1653 my_real
1654 . elbuf(*)
1655 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
1656C-----------------------------------------------
1657C L o c a l V a r i a b l e s
1658C-----------------------------------------------
1659 INTEGER ICOL(L_MAX,C_MAX),I,J,K,N,NFT,JLT,NK
1660C-----------------------------------------------
1661 NNMAX=0
1662 do n =1,numnod
1663 nrow(n)=0
1664 inloc(n)=0
1665 ENDDO
1666 DO nft = 0 , numnod-1 ,c_max
1667 jlt = min( c_max, numnod - nft )
1668 DO nk=1,jlt
1669 n=nk+nft
1670 inloc(n)=nk
1671 ENDDO
1672 CALL dim_elems3(
1673 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
1674 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
1675 3 ixs10 ,ixs20 ,ixs16 ,nrow(nft+1) ,
1676 4 inloc ,l_max ,icol ,igeo ,elbuf_tab )
1677 DO nk=1,jlt
1678 n=nk+nft
1679 inloc(n)=0
1680 nnmax=max(nnmax,nrow(n))
1681 ENDDO
1682 ENDDO
1683C----6---------------------------------------------------------------7---------8
1684 RETURN
1685 END
1686!||====================================================================
1687!|| dim_kine_p ../engine/source/implicit/ind_glob_k.F
1688!||--- called by ------------------------------------------------------
1689!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
1690!||--- uses -----------------------------------------------------
1691!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1692!||====================================================================
1693 SUBROUTINE dim_kine_p(
1694 1 IGEO ,NPBY ,LPBY ,ITAB ,NRBYAC ,
1695 2 IRBYAC ,NINT2 ,IINT2 ,IPARI ,
1696 3 NDOF ,NSI2 ,NSRB ,NKINE ,
1697 7 INLOC ,IRBE3 ,IRBE2 ,LRBE2 ,NKINM ,
1698 8 INTBUF_TAB )
1699C-----------------------------------------------
1700C M o d u l e s
1701C-----------------------------------------------
1702 USE intbufdef_mod
1703C-----------------------------------------------
1704C----6---------------------------------------------------------------7---------8
1705C I m p l i c i t T y p e s
1706C-----------------------------------------------
1707#include "implicit_f.inc"
1708C-----------------------------------------------
1709C C o m m o n B l o c k s
1710C-----------------------------------------------
1711#include "com04_c.inc"
1712#include "param_c.inc"
1713C-----------------------------------------------
1714C D u m m y A r g u m e n t s
1715C-----------------------------------------------
1716 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
1717 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),NSI2,NSRB,
1718 . NDOF(*),NKINE,INLOC(*),IGEO(*),IRBE3(NRBE3L,*),
1719 . IRBE2(NRBE2L,*),LRBE2(*),NKINM
1720C REAL
1721 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
1722C-----------------------------------------------
1723C L o c a l V a r i a b l e s
1724C-----------------------------------------------
1725 INTEGER NSN,I,J,K,N,M,NS
1726C-----------------------------------------------
1727 NKINE=0
1728C----- main of rigid body first------
1729 do i=1,nrbyac
1730 n=irbyac(i)
1731 m=npby(1,n)
1732 IF (inloc(m)==0) THEN
1733 nkine=nkine+1
1734 inloc(m)=-nkine
1735 ENDIF
1736 ENDDO
1737C----- rbe2 main------
1738 DO i=1,nrbe2
1739 k = irbe2(1,i)
1740 m = irbe2(3,i)
1741 IF (inloc(m)==0) THEN
1742 nkine=nkine+1
1743 inloc(m)=nkine
1744 ENDIF
1745 ENDDO
1746C-----will be stored in ICOKM(NKMAX,*)
1747 nkinm=nkine
1748C-----for IND_GLOB_K, pass NKINM via include or module, modify in IND_KINE_-----
1749C K=0
1750C------interface 2--------------
1751 DO i=1,nint2
1752 n=iint2(i)
1753 nsn = ipari(5,n)
1754 DO j=1,nsn
1755 ns=intbuf_tab(n)%NSV(j)
1756 IF (inloc(ns)==0.AND.ndof(ns)>0) THEN
1757 nkine=nkine+1
1758 inloc(ns)=nkine
1759 ENDIF
1760 ENDDO
1761 ENDDO
1762C----- rbe3 ------
1763 DO i=1,nrbe3
1764 ns=irbe3(3,i)
1765 IF (ns==0) cycle
1766 IF (inloc(ns)==0.AND.ndof(ns)>0) THEN
1767 nkine=nkine+1
1768 inloc(ns)=nkine
1769 ENDIF
1770 ENDDO
1771C----- rbe2 ------
1772 DO i=1,nrbe2
1773 k = irbe2(1,i)
1774 m = irbe2(3,i)
1775 nsn = irbe2(5,i)
1776 DO j=1,nsn
1777 ns=lrbe2(k+j)
1778 IF (inloc(ns)==0.AND.ndof(ns)>0) THEN
1779 nkine=nkine+1
1780 inloc(ns)=nkine
1781 ENDIF
1782 ENDDO
1783 ENDDO
1784C----- rigid body ------
1785 DO i=1,nrbyac
1786 n=irbyac(i)
1787 k=irbyac(i+nrbykin)
1788 nsn =npby(2,n)
1789 DO j=1,nsn
1790 ns=lpby(k+j)
1791 IF (inloc(ns)==0.AND.ndof(ns)>0) THEN
1792 nkine=nkine+1
1793 inloc(ns)=nkine
1794 ENDIF
1795 ENDDO
1796 ENDDO
1797C----6---------------------------------------------------------------7---------8
1798 RETURN
1799 END
1800!||====================================================================
1801!|| dim_ndof_i ../engine/source/implicit/ind_glob_k.F
1802!||--- called by ------------------------------------------------------
1803!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
1804!||--- calls -----------------------------------------------------
1805!|| i2_prem ../engine/source/interfaces/interf/i2_prem.F
1806!|| intab ../engine/source/implicit/ind_glob_k.F
1807!|| rbyac_imp ../engine/source/constraints/general/rbody/rbyac_imp.F
1808!||--- uses -----------------------------------------------------
1809!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1810!||====================================================================
1811 SUBROUTINE dim_ndof_i(
1812 1 NPBY ,LPBY ,ITAB ,NRBYAC ,
1813 2 IRBYAC ,NDOF ,NSRB ,IPARI ,
1814 3 NINT2 ,IINT2 ,NSI2 ,NPRW ,IRBE3 ,
1815 4 IRBE2 ,NSRB2 ,FR_ELEM ,IAD_ELEM ,INTBUF_TAB)
1816C-----------------------------------------------
1817C M o d u l e s
1818C-----------------------------------------------
1819 USE intbufdef_mod
1820C----6---------------------------------------------------------------7---------8
1821C I m p l i c i t T y p e s
1822C-----------------------------------------------
1823#include "implicit_f.inc"
1824C-----------------------------------------------
1825C C o m m o n B l o c k s
1826C-----------------------------------------------
1827#include "param_c.inc"
1828#include "com01_c.inc"
1829#include "com09_c.inc"
1830#include "com04_c.inc"
1831#include "task_c.inc"
1832C-----------------------------------------------------------------
1833C D u m m y A r g u m e n t s
1834C-----------------------------------------------
1835 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
1836 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),NSI2
1837 INTEGER NSRB,NDOF(*),NPRW(*),IRBE3(NRBE3L,*),IRBE2(NRBE2L,*),
1838 . NSRB2,FR_ELEM(*),IAD_ELEM(2,*)
1839C REAL
1840 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1841C-----------------------------------------------
1842C External function
1843C-----------------------------------------------
1844 LOGICAL INTAB
1845 EXTERNAL INTAB
1846C-----------------------------------------------
1847C L o c a l V a r i a b l e s
1848C-----------------------------------------------
1849 INTEGER NMN,JI,K10,K11,K12,K13,K14,J,K,NDOFI,NSN
1850 INTEGER I,N,M,IC,ICT,ICR,INS(NRBE3),NP,NIN,NTY,
1851 . KD(50),KFI,JIN
1852C-----------------------------------------------
1853 NSI2=0
1854 nint2=0
1855 DO k=0,nhin2
1856 CALL i2_prem(ipari,k,nint2,iint2,nsi2)
1857 ENDDO
1858C------rigid body main-------------
1859 CALL rbyac_imp(npby,itab,nrbyac,irbyac,nsrb)
1860 DO i=1,nrbyac
1861 n=irbyac(i)
1862 m=npby(1,n)
1863 ndof(m)=6
1864 ENDDO
1865C
1866 ndofi=3
1867 IF (iroddl>0) ndofi=6
1868 DO i=1,nrwall
1869 n = i + 2*nrwall
1870 m = nprw(n)
1871 IF (m>0) ndof(m)=ndofi
1872 ENDDO
1873C--------temporarily to avoid issue w/ contact +spmd
1874 IF (nspmd > 1 .AND.ninter > 0) THEN
1875 DO i=1,nrbe3
1876 n=irbe3(3,i)
1877 ins(i)=0
1878 DO nin=1,ninter
1879 nsn =ipari(5,nin)
1880 nty =ipari(7,nin)
1881 IF (ispmd/=0.AND.(nty<7.OR.nty==8
1882 . .OR.nty==14.OR.nty==15)) cycle
1883 IF(nty==5.OR.nty==7.OR.nty==10.OR.nty==11
1884 . .OR.nty==24) THEN
1885C
1886 IF (intab(nsn,intbuf_tab(nin)%NSV(1),n)) ins(i)=1
1887 ENDIF
1888 ENDDO
1889 ENDDO !
1890 DO i=1,nrbe3
1891 n = irbe3(3,i)
1892 IF (n==0.OR.ins(i)==0) cycle
1893 ic = irbe3(4,i)
1894 ict=ic/512
1895 icr=(ic-512*ict)/64
1896 IF (icr>0) THEN
1897 ndof(n) = 6
1898 ELSE
1899 ndof(n) = 3
1900 ENDIF
1901 ENDDO
1902 END IF !(NSPMD > 1 .AND.NINTER > 0) THEN
1903C-----if m is second of rb
1904 nsrb2=0
1905 DO n=1,nrbe2
1906 m=irbe2(3,n)
1907 nsn =irbe2(5,n)
1908C--------case NSN=1 is treated in DIM_NDOF_II
1909 IF(ndof(m)==0.AND.nsn >1) ndof(m)=ndofi
1910 nsrb2= nsrb2+nsn
1911 ENDDO
1912C----6---------------------------------------------------------------7---------8
1913 RETURN
1914 END
1915!||====================================================================
1916!|| dim_ndof_ii ../engine/source/implicit/ind_glob_k.F
1917!||--- called by ------------------------------------------------------
1918!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
1919!||--- uses -----------------------------------------------------
1920!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1921!||====================================================================
1922 SUBROUTINE dim_ndof_ii(
1923 1 NINT2 ,IINT2 ,IPARI ,NDOF ,
1924 2 NRBE3 ,IRBE3 ,LRBE3 ,NRBE2 ,IRBE2 ,
1925 3 LRBE2 ,INTBUF_TAB)
1926C-----------------------------------------------
1927C M o d u l e s
1928C-----------------------------------------------
1929 USE intbufdef_mod
1930C----6---------------------------------------------------------------7---------8
1931C I m p l i c i t T y p e s
1932C-----------------------------------------------
1933#include "implicit_f.inc"
1934C-----------------------------------------------
1935C C o m m o n B l o c k s
1936C-----------------------------------------------
1937#include "param_c.inc"
1938C-----------------------------------------------
1939C D u m m y A r g u m e n t s
1940C-----------------------------------------------
1941 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),NDOF(*),
1942 . NRBE3 ,IRBE3(NRBE3L,*),LRBE3(*),NRBE2,IRBE2(NRBE2L,*),
1943 . lrbe2(*)
1944C REAL
1945
1946 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
1947C-----------------------------------------------
1948C L o c a l V a r i a b l e s
1949C-----------------------------------------------
1950 INTEGER NMN,J,K
1951 INTEGER I,N,M,L,NS,ID,NM,NSN,IAD,ILEV,NDOFM,IROT,IC
1952C-----------------------------------------------
1953C------ interface 2 --- In case main surface is deactivated ------------
1954 DO i=1,nint2
1955 n=iint2(i)
1956 nsn = ipari(5,n)
1957 nmn = ipari(6,n)
1958 ilev = ipari(20,n)
1959C------IRTL(NSN)--main el number---
1960 ndofm=3
1961 IF (ilev == 0) ndofm=6
1962 DO j=1,nsn
1963 ns=intbuf_tab(n)%NSV(j)
1964 IF (ndof(ns)>0) THEN
1965 l=intbuf_tab(n)%IRTLM(j)
1966 id=4*(l-1)
1967 DO m=1,4
1968 nm=intbuf_tab(n)%IRECTM(id+m)
1969 IF (ndof(nm)<=0) ndof(nm)=min(ndof(nm),-ndofm)
1970 ENDDO
1971 ENDIF
1972 ENDDO
1973 ENDDO
1974C
1975 DO i=1,nint2
1976 n=iint2(i)
1977 nsn = ipari(5,n)
1978 nmn = ipari(6,n)
1979C------IRTL(NSN)--main el number---
1980 DO j=1,nsn
1981 ns=intbuf_tab(n)%NSV(j)
1982 IF (ndof(ns)>0) THEN
1983 l=intbuf_tab(n)%IRTLM(j)
1984 id=4*(l-1)
1985 DO m=1,4
1986 nm=intbuf_tab(n)%IRECTM(id+m)
1987 IF (ndof(nm)<0) ndof(nm)=-ndof(nm)
1988 ENDDO
1989 ENDIF
1990 ENDDO
1991 ENDDO
1992C
1993 DO i=1,nrbe3
1994 iad=irbe3(1,i)
1995 ns =irbe3(3,i)
1996 irot =irbe3(6,i)
1997 IF (ns==0.OR.ndof(ns)==0) cycle
1998 ndofm=3
1999 IF (irot > 0) ndofm=6
2000 nmn=irbe3(5,i)
2001 DO j=1,nmn
2002 nm=lrbe3(iad+j)
2003 IF (ndof(nm)<=0) ndof(nm)=min(ndof(nm),-ndofm)
2004 ENDDO
2005 ENDDO
2006C
2007 DO i=1,nrbe3
2008 iad=irbe3(1,i)
2009 ns =irbe3(3,i)
2010 IF (ns==0.OR.ndof(ns)==0) cycle
2011 nmn=irbe3(5,i)
2012 DO j=1,nmn
2013 nm=lrbe3(iad+j)
2014 IF (ndof(nm)<=0) ndof(nm)=-ndof(nm)
2015 ENDDO
2016 ENDDO
2017C
2018 DO i=1,nrbe2
2019 m=irbe2(3,i)
2020 nsn =irbe2(5,i)
2021C--------case NSN=1 -------------
2022 IF(nsn==1) THEN
2023 iad=irbe2(1,i)
2024 ns=lrbe2(iad+1)
2025 ic = irbe2(4,i)/512
2026 IF (ndof(ns)<=3) irbe2(4,i)=ic*512
2027 ndof(m)=max(ndof(m),ndof(ns))
2028 END IF
2029 ENDDO
2030C----6---------------------------------------------------------------7---------8
2031 RETURN
2032 END
2033!||====================================================================
2034!|| dim_ndof_d ../engine/source/implicit/ind_glob_k.F
2035!||--- called by ------------------------------------------------------
2036!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
2037!||--- calls -----------------------------------------------------
2038!|| spmd_i2d ../engine/source/mpi/implicit/imp_spmd.F
2039!||====================================================================
2040 SUBROUTINE dim_ndof_d(
2041 1 NPBY ,LPBY ,NRBYAC ,IRBYAC ,NDOF ,
2042 2 IAD_RBY ,FR_RBY )
2043C----6---------------------------------------------------------------7---------8
2044C I m p l i c i t T y p e s
2045C-----------------------------------------------
2046#include "implicit_f.inc"
2047C-----------------------------------------------
2048C C o m m o n B l o c k s
2049C-----------------------------------------------
2050#include "param_c.inc"
2051#include "com01_c.inc"
2052#include "com04_c.inc"
2053C-----------------------------------------------
2054C D u m m y A r g u m e n t s
2055C-----------------------------------------------
2056 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*)
2057 INTEGER NDOF(*),IAD_RBY(*),FR_RBY(*)
2058C REAL
2059C-----------------------------------------------
2060C L o c a l V a r i a b l e s
2061C-----------------------------------------------
2062 INTEGER I,J,K,N,M,NSN,NS,IE,NN
2063C-----------------------------------------------
2064 IF (nrbyac==0) RETURN
2065 DO i=1,nrbyac
2066 n=irbyac(i)
2067 k=irbyac(i+nrbykin)
2068 m=npby(1,n)
2069 nsn =npby(2,n)
2070 ie = 0
2071 DO j=1,nsn
2072 ns=lpby(k+j)
2073 IF (ndof(ns)>0) ie = 1
2074 ENDDO
2075 IF (ie==0) THEN
2076 ndof(m) = 0
2077 ENDIF
2078 ENDDO
2079 IF (nspmd>1) THEN
2080 nn=iad_rby(nspmd+1)-iad_rby(1)
2081 IF (nn>0) CALL spmd_i2d(ndof,fr_rby,iad_rby,nn)
2082 ENDIF
2083C-------actualise NRBYAC,IRBYAC-------
2084 ie = 0
2085 DO i=1,nrbyac
2086 n=irbyac(i)
2087 m=npby(1,n)
2088 IF (ndof(m)>0) THEN
2089 ie = ie + 1
2090 irbyac(ie) = irbyac(i)
2091 irbyac(ie+nrbykin) = irbyac(i+nrbykin)
2092 ENDIF
2093 ENDDO
2094 nrbyac = ie
2095C----6---------------------------------------------------------------7---------8
2096 RETURN
2097 END
2098!||====================================================================
2099!|| dim_kine_s ../engine/source/implicit/ind_glob_k.F
2100!||--- called by ------------------------------------------------------
2101!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
2102!||--- calls -----------------------------------------------------
2103!|| intab ../engine/source/implicit/ind_glob_k.F
2104!||--- uses -----------------------------------------------------
2105!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2106!||====================================================================
2107 SUBROUTINE dim_kine_s(
2108 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
2109 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,NDOF ,
2110 3 NNMAX ,NROW ,NROWI ,NKINE ,INLOC ,
2111 4 ICOK ,IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
2112C-----------------------------------------------
2113C M o d u l e s
2114C-----------------------------------------------
2115 USE intbufdef_mod
2116C----6---------------------------------------------------------------7---------8
2117C I m p l i c i t T y p e s
2118C-----------------------------------------------
2119#include "implicit_f.inc"
2120C-----------------------------------------------
2121C C o m m o n B l o c k s
2122C-----------------------------------------------
2123#include "com04_c.inc"
2124#include "param_c.inc"
2125C-----------------------------------------------
2126C D u m m y A r g u m e n t s
2127C-----------------------------------------------
2128 INTEGER NNMAX
2129 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
2130 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),
2131 . ndof(*),nkine,inloc(*),irbe3(nrbe3l,*),lrbe3(*),
2132 . irbe2(nrbe2l,*),lrbe2(*)
2133 INTEGER NROW(*),NROWI(*),ICOK(NNMAX,*)
2134
2135 TYPE(intbuf_struct_) INTBUF_TAB(*)
2136C REAL
2137C-----------------------------------------------
2138C External function
2139C-----------------------------------------------
2140 LOGICAL INTAB
2141 EXTERNAL intab
2142C-----------------------------------------------
2143C L o c a l V a r i a b l e s
2144C-----------------------------------------------
2145 INTEGER NKS,NKM
2146 INTEGER NSN,NMN,I,J,K,N,M,EP,L,NI,NJ,K12,ID,NS,NK,NM,NNOD,N1,L1,NL1,NL,J1,NM1,
2147 . JI1,L10,L11,L12,L13,L14,NNOD1,I1,NSN1,M1,NKE,IAD,IC
2148C NROW(NUMNOD) :number of connected nodes (non sym)
2149C Nrow (Kine): Local index <= nnmax (Nrow can possibly exceed nnmax)
2150C INLOC (NUMNOD): Local index of "Kinematic Nodes"
2151C-----------------------------------------------
2152C------interface 2--------------
2153 DO i=1,nint2
2154 n=iint2(i)
2155 nsn = ipari(5,n)
2156 nmn = ipari(6,n)
2157 DO 20 j=1,nsn
2158 ns=intbuf_tab(n)%NSV(j)
2159 IF (ndof(ns)>0) THEN
2160 l=intbuf_tab(n)%IRTLM(j)
2161 id=4*(l-1)
2162 IF (intbuf_tab(n)%IRECTM(id+3)==intbuf_tab(n)%IRECTM(id+4)) THEN
2163 nnod=3
2164 ELSE
2165 nnod=4
2166 ENDIF
2167 DO m=1,nnod
2168 nm=intbuf_tab(n)%IRECTM(id+m)
2169 IF (ndof(nm)>0)nrow(nm)=nrow(nm)+nnod-1
2170 ENDDO
2171 nks=inloc(ns)
2172 DO nk=1,nrowi(nks)
2173 nj=icok(nk,nks)
2174 IF (.NOT.intab(nsn,intbuf_tab(n)%NSV(1) ,nj)) THEN
2175 IF (inloc(nj)==0.AND.ndof(nj)>0) THEN
2176 nkine=nkine+1
2177 inloc(nj)=nkine
2178 ENDIF
2179 DO m=1,nnod
2180 nm=intbuf_tab(n)%IRECTM(id+m)
2181 nrow(nm)=nrow(nm)+1
2182 nrow(nj)=nrow(nj)+1
2183 ENDDO
2184 ENDIF
2185 ENDDO
2186C-----with Kij block-(i,j have the same M)-----
2187 DO n1=j+1,nsn
2188 nj=intbuf_tab(n)%NSV(n1)
2189 l1=intbuf_tab(n)%IRTLM(n1)
2190 IF (ndof(nj)>0.AND.l/=l1) THEN
2191 IF (intab(nrowi(nks),icok(1,nks),nj)) THEN
2192 nl1=4*(l1-1)
2193 DO m=1,nnod
2194 nm=intbuf_tab(n)%IRECTM(id+m)
2195 DO j1=1,4
2196 nm1=intbuf_tab(n)%IRECTM(nl1+j1)
2197 IF (nm/=nm1) THEN
2198 nrow(nm)=nrow(nm)+1
2199 nrow(nm1)=nrow(nm1)+1
2200 ENDIF
2201 ENDDO
2202 ENDDO
2203 ENDIF
2204 ENDIF
2205 ENDDO
2206 ENDIF
2207 20 CONTINUE
2208 DO j=1,nmn
2209 nm=intbuf_tab(n)%MSR(j)
2210 IF (inloc(nm)==0.AND.ndof(nm)>0) THEN
2211 nkine=nkine+1
2212 inloc(nm)=nkine
2213 ENDIF
2214 ENDDO
2215 ENDDO
2216C+++ coupling between int2 ----
2217 IF (nint2>1) THEN
2218 DO j=1,nint2
2219 n=iint2(j)
2220 nsn = ipari(5,n)
2221 DO j1=j+1,nint2
2222 n1=iint2(j1)
2223 nsn1 = ipari(5,n1)
2224 ji1=ipari(1,n1)
2225 l10=ji1-1
2226 l11=l10+4*ipari(3,n1)
2227 l12=l11+4*ipari(4,n1)
2228 l13=l12+nsn1
2229 l14=l13+ipari(6,n1)
2230 DO i=1,nsn
2231 ni=intbuf_tab(n)%NSV(i)
2232 IF (ndof(ni)>0) THEN
2233 nke=inloc(ni)
2234C------search for second pairs-entre int2---
2235 DO i1=1,nsn1
2236 nj=intbuf_tab(n1)%NSV(i1)
2237 IF (ndof(nj)>0.AND.
2238 . intab(nrowi(nke),icok(1,nke),nj)) THEN
2239 l=intbuf_tab(n)%IRTLM(i)
2240 nl=4*(l-1)
2241 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2242 nnod=3
2243 ELSE
2244 nnod=4
2245 ENDIF
2246 l1=intbuf_tab(n1)%IRTLM(i1)
2247 nl1=4*(l1-1)
2248 IF (intbuf_tab(n1)%IRECTM(nl1+3)==intbuf_tab(n1)%IRECTM(nl1+4)) THEN
2249 nnod1=3
2250 ELSE
2251 nnod1=4
2252 ENDIF
2253 DO m=1,nnod
2254 nm=intbuf_tab(n)%IRECTM(nl+m)
2255 DO m1=1,nnod1
2256 nm1=intbuf_tab(n1)%IRECTM(nl1+m1)
2257 IF (ndof(nm)>0.AND.ndof(nm1)>0) THEN
2258 nrow(nm)=nrow(nm)+1
2259 nrow(nm1)=nrow(nm1)+1
2260 ENDIF
2261 ENDDO
2262 ENDDO
2263C----------endif NDOF(NJ)>0----
2264 ENDIF
2265C----------enddo DO I1=1,NSN1----
2266 ENDDO
2267C----------endif NDOF(NI)>0----
2268 ENDIF
2269C----------enddo DO I=1,NSN----
2270 ENDDO
2271C----------enddo DO J1=----
2272 ENDDO
2273 ENDDO
2274 ENDIF
2275C----- Rbe2 ------
2276 DO i=1,nrbe2
2277 k=irbe2(1,i)
2278 m=irbe2(3,i)
2279 nsn =irbe2(5,i)
2280 ic = 7*512+7*64-irbe2(4,i)
2281 DO j=1,nsn
2282 ns=lrbe2(k+j)
2283 IF (ndof(ns)>0) THEN
2284 nks=inloc(ns)
2285 DO nk=1,nrowi(nks)
2286 nj=icok(nk,nks)
2287 IF (ndof(nj)>0) THEN
2288 nrow(m)=nrow(m)+1
2289 nrow(nj)=nrow(nj)+1+nhrbe2
2290 IF (inloc(nj)==0) THEN
2291 nkine=nkine+1
2292 inloc(nj)=nkine
2293 ENDIF
2294 ENDIF
2295 ENDDO
2296C-----Due to hierarchy----
2297 IF (nrow(ns)>nrowi(nks)) nrow(m)=nrow(m)+ nrow(ns)-nrowi(nks)
2298C+++++++Knsns -> Kmns
2299 IF (ic>0) THEN
2300 nrow(m)=nrow(m)+1
2301 nrow(ns)=nrow(ns)+1
2302 ENDIF
2303 ENDIF
2304 ENDDO
2305C+++coupling estimation ----
2306 nrow(m)=nrow(m)+1
2307 ENDDO
2308C------RBE3--------------
2309 DO i=1,nrbe3
2310 ns = irbe3(3,i)
2311 IF (ns==0.OR.ndof(ns)==0) cycle
2312 iad = irbe3(1,i)
2313 nnod = irbe3(5,i)
2314 nks=inloc(ns)
2315 DO m=1,nnod
2316 nm=lrbe3(iad+m)
2317 IF (ndof(nm)>0)nrow(nm)=nrow(nm)+nnod-1
2318 ENDDO
2319 DO nk=1,nrowi(nks)
2320 nj=icok(nk,nks)
2321 IF (inloc(nj)==0.AND.ndof(nj)>0) THEN
2322 nkine=nkine+1
2323 inloc(nj)=nkine
2324 ENDIF
2325 DO m=1,nnod
2326 nm=lrbe3(iad+m)
2327 nrow(nm)=nrow(nm)+1
2328 nrow(nj)=nrow(nj)+1
2329 ENDDO
2330 ENDDO
2331C-----Due to hierarchy----
2332 IF (nrow(ns)>nrowi(nks)) THEN
2333 k12 = nrow(ns)-nrowi(nks)
2334 DO m=1,nnod
2335 nm=lrbe3(iad+m)
2336 nrow(nm)=nrow(nm)+ k12 + k12
2337 ENDDO
2338 END IF
2339C-----with Kij (i,j -> NSi,NSj-----
2340 DO i1=i+1,nrbe3
2341 nj=irbe3(3,i1)
2342 IF (nj==0.OR.ndof(nj)==0) cycle
2343 IF (intab(nrowi(nks),icok(1,nks),nj)) THEN
2344 m1 = irbe3(1,i1)
2345 n1 = irbe3(5,i1)
2346 DO m=1,nnod
2347 nm=lrbe3(iad+m)
2348 DO j1=1,n1
2349 nm1=lrbe3(m1+j1)
2350 IF (nm/=nm1) THEN
2351 nrow(nm)=nrow(nm)+1
2352 nrow(nm1)=nrow(nm1)+1
2353 ENDIF
2354 ENDDO
2355 ENDDO
2356 ENDIF
2357 ENDDO
2358C
2359 DO m=1,nnod
2360 nm=lrbe3(iad+m)
2361 IF (inloc(nm)==0.AND.ndof(nm)>0) THEN
2362 nkine=nkine+1
2363 inloc(nm)=nkine
2364 ENDIF
2365 ENDDO
2366 ENDDO
2367C----- rigid body ------
2368 DO i=1,nrbyac
2369 n=irbyac(i)
2370 k=irbyac(i+nrbykin)
2371 m=npby(1,n)
2372 IF (inloc(m)<0) inloc(m)=-inloc(m)
2373 nsn =npby(2,n)
2374 IF (ndof(m)>0) THEN
2375 DO j=1,nsn
2376 ns=lpby(k+j)
2377 IF (ndof(ns)>0) THEN
2378 nks=inloc(ns)
2379 DO nk=1,nrowi(nks)
2380 nj=icok(nk,nks)
2381 IF (ndof(nj)>0) THEN
2382 IF (.NOT.intab(nsn,lpby(k+1),nj)) THEN
2383 nrow(m)=nrow(m)+1
2384 nrow(nj)=nrow(nj)+1
2385 IF (inloc(nj)==0) THEN
2386 nkine=nkine+1
2387 inloc(nj)=nkine
2388 ENDIF
2389 ENDIF
2390 ENDIF
2391 ENDDO
2392 IF (nrow(ns)>nrowi(nks)) nrow(m)=nrow(m)+ nrow(ns)-nrowi(nks)
2393 END IF !IF (NDOF(NS)>0)
2394 ENDDO
2395 ENDIF
2396C+++coupling estimation ----
2397 nrow(m)=nrow(m)+nsn
2398 ENDDO
2399C
2400C----6---------------------------------------------------------------7---------8
2401 RETURN
2402 END
2403!||====================================================================
2404!|| dim_kine_t ../engine/source/implicit/ind_glob_k.F
2405!||--- called by ------------------------------------------------------
2406!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
2407!||--- calls -----------------------------------------------------
2408!|| intab ../engine/source/implicit/ind_glob_k.F
2409!|| reorder_a ../engine/source/implicit/ind_glob_k.F
2410!||--- uses -----------------------------------------------------
2411!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2412!||====================================================================
2413 SUBROUTINE dim_kine_t(
2414 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
2415 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,NDOF ,
2416 3 NNMAX ,NROWI ,NKINE ,INLOC ,ICOK ,
2417 4 NSS ,NSIJ ,NMIJ ,NSS2 ,NSIJ2 ,
2418 5 NMIJ2 ,NKMAX ,ICOKM ,INK ,IRBE3 ,
2419 6 LRBE3 ,NSS3 ,IRBE2 ,LRBE2 ,NSB2 )
2420C-----------------------------------------------
2421C M o d u l e s
2422C-----------------------------------------------
2423 USE intbufdef_mod
2424C-----------------------------------------------
2425C I m p l i c i t T y p e s
2426C-----------------------------------------------
2427#include "implicit_f.inc"
2428C-----------------------------------------------
2429C C o m m o n B l o c k s
2430C-----------------------------------------------
2431#include "com04_c.inc"
2432#include "param_c.inc"
2433C-----------------------------------------------
2434C D u m m y A r g u m e n t s
2435C-----------------------------------------------
2436 INTEGER NNMAX
2437 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
2438 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),
2439 . ndof(*),nkine,inloc(*),nmij2,nss3
2440 INTEGER NROWI(*),ICOK(NNMAX,*),NSS ,NSIJ ,NMIJ,NSS2 ,NSIJ2
2441 INTEGER NKMAX,ICOKM(NKMAX,*),INK,IRBE3(NRBE3L,*),LRBE3(*),
2442 . irbe2(nrbe2l,*),lrbe2(*),nsb2
2443
2444 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2445C REAL
2446C-----------------------------------------------
2447C External function
2448C-----------------------------------------------
2449 LOGICAL INTAB
2450 EXTERNAL INTAB
2451C-----------------------------------------------
2452C L o c a l V a r i a b l e s
2453C-----------------------------------------------
2454 INTEGER NKS,NKM,NKE1,NKE2,NKM1,NKE
2455 INTEGER NSN,NMN,I,J,K,N,M,EP,L,NI,NJ,JI,K10,K11,K12,K13,
2456 . K14,KFI,ID,NS,NK,NM,NNOD,N1,L1,NL1,NL,J1,NM1,N2,
2457 . JI1,L10,L11,L12,L13,L14,NNOD1,I1,NSN1,M1,IAD,IC
2458C NROWI(NKINE) :INDICE LOCALE <=NNMAX
2459C INLOC (NUMNOD): Local index of "Kinematic Nodes"
2460C-----------------------------------------------
2461C------interface 2--------------
2462 NSS2=0
2463 nsij2=0
2464 DO i=1,nint2
2465 n=iint2(i)
2466 nsn = ipari(5,n)
2467 nmn = ipari(6,n)
2468 ji=ipari(1,n)
2469 k10=ji-1
2470 k11=k10+4*ipari(3,n)
2471C------IRECT(4,NSN)-----
2472 k12=k11+4*ipari(4,n)
2473C------NSV(NSN)--node number---
2474 k13=k12+nsn
2475C------MSR(NMN)-----
2476 k14=k13+nmn
2477C------IRTL(NSN)--main el number---
2478 kfi=k14+nsn
2479 DO 20 j=1,nsn
2480 ns=intbuf_tab(n)%NSV(j)
2481 IF (ndof(ns)>0) THEN
2482 l=intbuf_tab(n)%IRTLM(j)
2483 id=4*(l-1)
2484 IF (intbuf_tab(n)%IRECTM(id+3)==intbuf_tab(n)%IRECTM(id+4)) THEN
2485 nnod=3
2486 ELSE
2487 nnod=4
2488 ENDIF
2489 DO m=1,nnod
2490 nm=intbuf_tab(n)%IRECTM(id+m)
2491 IF (ndof(nm)>0) THEN
2492 nke1=inloc(nm)
2493 DO j1=1,nnod
2494 nm1=intbuf_tab(n)%IRECTM(id+j1)
2495 IF (nm/=nm1) CALL reorder_a(nrowi(nke1),icok(1,nke1),nm1)
2496 ENDDO
2497 ENDIF
2498 ENDDO
2499 nks=inloc(ns)
2500 DO nk=1,nrowi(nks)
2501 nj=icok(nk,nks)
2502 IF (ndof(nj)>0.AND.
2503 . (.NOT.intab(nsn,intbuf_tab(n)%NSV(1),nj))) THEN
2504 nss2=nss2+1
2505 nke2=inloc(nj)
2506 DO m=1,nnod
2507 nm=intbuf_tab(n)%IRECTM(id+m)
2508 IF (ndof(nm)>0) THEN
2509 nke1=inloc(nm)
2510 CALL reorder_a(nrowi(nke1),icok(1,nke1),nj)
2511 CALL reorder_a(nrowi(nke2),icok(1,nke2),nm)
2512 ENDIF
2513 ENDDO
2514 ENDIF
2515 ENDDO
2516C-----with Kij block-(i,j have the same M)-----
2517 DO n1=j+1,nsn
2518 nj=intbuf_tab(n)%NSV(n1)
2519 l1=intbuf_tab(n)%IRTLM(n1)
2520 IF (ndof(nj)>0.AND.
2521 . intab(nrowi(nks),icok(1,nks),nj)) THEN
2522 nsij2=nsij2+2
2523 IF (l/=l1) THEN
2524 nl1=4*(l1-1)
2525 DO m=1,nnod
2526 nm=intbuf_tab(n)%IRECTM(id+m)
2527 IF (ndof(nm)>0) THEN
2528 nke1=inloc(nm)
2529 DO j1=1,4
2530 nm1=intbuf_tab(n)%IRECTM(nl1+j1)
2531 IF (nm/=nm1.AND.ndof(nm1)>0) THEN
2532 nke2=inloc(nm1)
2533 CALL reorder_a(nrowi(nke1),icok(1,nke1),nm1)
2534 CALL reorder_a(nrowi(nke2),icok(1,nke2),nm)
2535 ENDIF
2536 ENDDO
2537 ENDIF
2538 ENDDO
2539 ENDIF
2540 ENDIF
2541 ENDDO
2542 ENDIF
2543 20 CONTINUE
2544 ENDDO
2545C------Rbe2------
2546 nsb2=0
2547 DO n=1,nrbe2
2548 k=irbe2(1,n)
2549 m=irbe2(3,n)
2550 nsn =irbe2(5,n)
2551 nke1=inloc(m)
2552 ic = 7*512+7*64-irbe2(4,n)
2553 DO j=1,nsn
2554 ns=lrbe2(k+j)
2555 IF (ndof(ns)>0) THEN
2556 nks=inloc(ns)
2557 DO nk=1,nrowi(nks)
2558 IF (nks >ink) THEN
2559 nj=icok(nk,nks)
2560 ELSE
2561 nj=icokm(nk,nks)
2562 END IF
2563 nke2=inloc(nj)
2564 IF (ndof(nj)>0.AND.nj/=ns) THEN
2565 nsb2=nsb2+1
2566 CALL reorder_a(nrowi(nke1),icokm(1,nke1),nj)
2567 IF (nke2>ink) THEN
2568 CALL reorder_a(nrowi(nke2),icok(1,nke2),m)
2569 ELSEIF (nke2>0) THEN
2570 CALL reorder_a(nrowi(nke2),icokm(1,nke2),m)
2571 ENDIF
2572 ENDIF
2573 ENDDO
2574 IF (ic>0) THEN
2575 CALL reorder_a(nrowi(nke1),icokm(1,nke1),ns)
2576 IF (nks > ink) THEN
2577 CALL reorder_a(nrowi(nks),icok(1,nks),m)
2578 ELSEIF (nks > 0) THEN
2579 CALL reorder_a(nrowi(nks),icokm(1,nks),m)
2580 END IF
2581 ENDIF
2582 ENDIF
2583 ENDDO
2584 ENDDO
2585C------RBE3--------------
2586 nss3=0
2587 DO i=1,nrbe3
2588 iad=irbe3(1,i)
2589 ns =irbe3(3,i)
2590 IF (ns==0) cycle
2591 nnod=irbe3(5,i)
2592 IF (ndof(ns)>0) THEN
2593C
2594 DO m=1,nnod
2595 nm=lrbe3(iad+m)
2596 IF (ndof(nm)>0) THEN
2597 nke1=inloc(nm)
2598 DO j1=m+1,nnod
2599 nm1=lrbe3(iad+j1)
2600 IF (nke1>ink.AND.nm/=nm1) THEN
2601 CALL reorder_a(nrowi(nke1),icok(1,nke1),nm1)
2602 ELSEIF (nke1>0.AND.nm/=nm1) THEN
2603 CALL reorder_a(nrowi(nke1),icokm(1,nke1),nm1)
2604 ENDIF
2605 nke2=inloc(nm1)
2606 IF (nke2>ink) THEN
2607 CALL reorder_a(nrowi(nke2),icok(1,nke2),nm)
2608 ELSEIF (nke2>0) THEN
2609 CALL reorder_a(nrowi(nke2),icokm(1,nke2),nm)
2610 ENDIF
2611 ENDDO
2612 ENDIF
2613 ENDDO
2614 nks=inloc(ns)
2615 DO nk=1,nrowi(nks)
2616C-----due to change of RBE2- (M used ICOKM now) --
2617 IF (nks > ink) THEN
2618 nj=icok(nk,nks)
2619 ELSE
2620 nj=icokm(nk,nks)
2621 END IF
2622 IF (ndof(nj)>0 ) THEN
2623 nss3=nss3+1
2624 nke2=inloc(nj)
2625 DO m=1,nnod
2626 nm=lrbe3(iad+m)
2627 IF (ndof(nm)>0) THEN
2628 nke1=inloc(nm)
2629
2630 IF (nke1>ink) THEN
2631 CALL reorder_a(nrowi(nke1),icok(1,nke1),nj)
2632 ELSEIF (nke1>0) THEN
2633 CALL reorder_a(nrowi(nke1),icokm(1,nke1),nj)
2634 ENDIF
2635
2636 IF (nke2>ink) THEN
2637 CALL reorder_a(nrowi(nke2),icok(1,nke2),nm)
2638 ELSEIF (nke2>0) THEN
2639 CALL reorder_a(nrowi(nke2),icokm(1,nke2),nm)
2640 ENDIF
2641
2642 ENDIF
2643 ENDDO
2644 ENDIF
2645 ENDDO
2646 ENDIF
2647 ENDDO
2648C+++ coupling between int2 ----
2649 nmij2=0
2650C
2651 nss=0
2652 nsij=0
2653 DO i=1,nrbyac
2654 n=irbyac(i)
2655 k=irbyac(i+nrbykin)
2656 m=npby(1,n)
2657 nsn =npby(2,n)
2658 IF (ndof(m)>0) THEN
2659 nke1=inloc(m)
2660 DO j=1,nsn
2661 ns=lpby(k+j)
2662 IF (ndof(ns)>0) THEN
2663 nks=inloc(ns)
2664 DO nk=1,nrowi(nks)
2665 IF (nks > ink) THEN
2666 nj=icok(nk,nks)
2667 ELSE
2668 nj=icokm(nk,nks)
2669 END IF
2670 nke2=inloc(nj)
2671 IF (ndof(nj)>0.AND.
2672 . (.NOT.intab(nsn,lpby(k+1),nj))) THEN
2673 nss=nss+1
2674 CALL reorder_a(nrowi(nke1),icokm(1,nke1),nj)
2675 IF (nke2>ink) THEN
2676 CALL reorder_a(nrowi(nke2),icok(1,nke2),m)
2677 ELSEIF (nke2>0) THEN
2678 CALL reorder_a(nrowi(nke2),icokm(1,nke2),m)
2679 ENDIF
2680 ENDIF
2681 ENDDO
2682C-----create rigid body second nodes with Kij block-(i,j have the same M)-----
2683 DO n1=j+1,nsn
2684 nj=lpby(k+n1)
2685 IF (nks > ink) THEN
2686 IF (ndof(nj)>0.AND.
2687 . (intab(nrowi(nks),icok(1,nks),nj))) THEN
2688 nsij=nsij+2
2689 ENDIF
2690 ELSE
2691 IF (ndof(nj)>0.AND.
2692 . (intab(nrowi(nks),icokm(1,nks),nj))) THEN
2693 nsij=nsij+2
2694 ENDIF
2695 END IF
2696 ENDDO
2697 ENDIF
2698 ENDDO
2699 ENDIF
2700 ENDDO
2701C+++ Coupling between Rigid Bodies ----
2702 nmij=0
2703 IF (nrbyac>1) THEN
2704 DO j=1,nrbyac
2705 n=irbyac(j)
2706 k=irbyac(j+nrbykin)
2707 m =npby(1,n)
2708 ns=npby(2,n)
2709 IF (ndof(m)>0) THEN
2710 nke1=inloc(m)
2711 DO j1=j+1,nrbyac
2712 n1=irbyac(j1)
2713 l1=irbyac(j1+nrbykin)
2714 nm =npby(1,n1)
2715 nsn =npby(2,n1)
2716 IF (intab(nrowi(nke1),icokm(1,nke1),nm)) THEN
2717 DO i=1,nsn
2718 id = i+l1
2719 ni=lpby(id)
2720 IF (ndof(ni)>0) THEN
2721 nks=inloc(ni)
2722 IF (nks > ink) THEN
2723 IF (intab(nrowi(nks),icok(1,nks),m)) THEN
2724C------search for second pairs----
2725 DO n1=1,ns
2726 n2=lpby(k+n1)
2727 IF (ndof(n2)>0.AND.
2728 . intab(nrowi(nks),icok(1,nks),n2)) THEN
2729 nmij=nmij+2
2730 ENDIF
2731 ENDDO
2732 ENDIF
2733 ELSE
2734 IF (intab(nrowi(nks),icokm(1,nks),m)) THEN
2735C------search for second pairs----
2736 DO n1=1,ns
2737 n2=lpby(k+n1)
2738 IF (ndof(n2)>0.AND.
2739 . intab(nrowi(nks),icokm(1,nks),n2)) THEN
2740 nmij=nmij+2
2741 ENDIF
2742 ENDDO
2743 ENDIF
2744 END IF
2745 ENDIF
2746 ENDDO
2747 ENDIF
2748 ENDDO
2749 ENDIF
2750 ENDDO
2751 ENDIF
2752 nsij=nsij+nmij
2753C----6---------------------------------------------------------------7---------8
2754 RETURN
2755 END
2756!||====================================================================
2757!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
2758!||--- called by ------------------------------------------------------
2759!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
2760!||--- calls -----------------------------------------------------
2761!|| intab ../engine/source/implicit/ind_glob_k.F
2762!|| reorder_a ../engine/source/implicit/ind_glob_k.F
2763!|| rmind_imp ../engine/source/model/remesh/rm_imp0.F
2764!||--- uses -----------------------------------------------------
2765!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2766!||====================================================================
2767 SUBROUTINE ind_kine_k(NPBY,LPBY,
2768 1 ITAB ,NRBYAC ,IRBYAC ,NSC ,ISIJ ,
2769 2 NMC ,IMIJ ,NSS ,ISS ,NINT2 ,
2770 3 IINT2 ,IPARI ,INTBUF_TAB,NSC2 ,ISIJ2 ,
2771 4 NSS2 ,ISS2 ,NDOF ,NNMAX ,NKINE ,
2772 5 INLOC ,NKMAX ,NROWK ,ICOK ,ICOKM ,
2773 6 NMC2 ,IMIJ2 ,INK ,IRBE3 ,LRBE3 ,
2774 7 ISS3 ,IRBE2 ,LRBE2 ,ISB2 ,NSRB2 )
2775C----6---------------------------------------------------------------7---------8
2776C-----------------------------------------------
2777C M o d u l e s
2778C-----------------------------------------------
2779 USE intbufdef_mod
2780C-----------------------------------------------
2781C I m p l i c i t T y p e s
2782C-----------------------------------------------
2783#include "implicit_f.inc"
2784C-----------------------------------------------
2785C C o m m o n B l o c k s
2786C-----------------------------------------------
2787#include "com04_c.inc"
2788#include "param_c.inc"
2789#include "remesh_c.inc"
2790C-----------------------------------------------
2791C D u m m y A r g u m e n t s
2792C-----------------------------------------------
2793 INTEGER NNMAX,NKMAX
2794 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
2795 . nsc(*),isij(*),nss(*),iss(*),nint2,iint2(*),
2796 . nsc2(*),isij2(*),nss2(*),iss2(*),ipari(npari,*),
2797 . nmc,imij(*),icok(nnmax,*),icokm(nkmax,*),nrowk(*),
2798 . nmc2,imij2(*),irbe2(nrbe2l,*),lrbe2(*),isb2(*),nsrb2(*)
2799 INTEGER
2800 . ndof(*),nkine,inloc(*),ink,irbe3(nrbe3l,*),lrbe3(*),iss3(*)
2801
2802 TYPE(intbuf_struct_) INTBUF_TAB(*)
2803C-----------------------------------------------
2804C External function
2805C-----------------------------------------------
2806 LOGICAL INTAB
2807 EXTERNAL intab
2808C REAL
2809C-----------------------------------------------
2810C L o c a l V a r i a b l e s
2811C-----------------------------------------------
2812C------ICOK,ICOKM use the same NROWK------
2813 INTEGER NKE,NKE1,NKE2,IK,NKM1,IAD
2814 INTEGER
2815 . I,J,K,N,L,NL,NJ,NI,J1,M,NSN,N1,N2,NK,ID,
2816 . JI,K10,K11,K12,K13,K14,KFI,NS,NNOD,NM,L1,NL1,NM1,
2817 . JI1,L10,L11,L12,L13,L14,NNOD1,I1,NSN1,M1,K1,IC
2818c----------------------
2819 K=0
2820 ns= 0
2821 nk=1
2822 DO j=1,nint2
2823 n=iint2(j)
2824 nsn = ipari(5,n)
2825 ji=ipari(1,n)
2826 k10=ji-1
2827 k11=k10+4*ipari(3,n)
2828C------IRECT(4,NSN)-----
2829 k12=k11+4*ipari(4,n)
2830C------NSV(NSN)--node number---
2831 k13=k12+nsn
2832C------MSR(NMN)-----
2833 k14=k13+ipari(6,n)
2834C------IRTL(NSN)--main el number---
2835 kfi=k14+nsn
2836 nsc2(j)=0
2837 DO i=1,nsn
2838 id = i+k
2839 nss2(id)=0
2840 ni=intbuf_tab(n)%NSV(i)
2841 IF (ndof(ni)>0) THEN
2842 l=intbuf_tab(n)%IRTLM(i)
2843 nl=4*(l-1)
2844 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2845 nnod=3
2846 ELSE
2847 nnod=4
2848 ENDIF
2849 DO m=1,nnod
2850 nm=intbuf_tab(n)%IRECTM(nl+m)
2851 IF (ndof(nm)>0) THEN
2852 nke1=inloc(nm)
2853 DO j1=1,nnod
2854 nm1=intbuf_tab(n)%IRECTM(nl+j1)
2855 IF (nm/=nm1) CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
2856 ENDDO
2857 ENDIF
2858 ENDDO
2859 nke=inloc(ni)
2860 DO n1=1,nrowk(nke)
2861 nj=icok(n1,nke)
2862 IF (ndof(nj)>0.AND.
2863 . (.NOT.intab(nsn,intbuf_tab(n)%NSV(1),nj))) THEN
2864 j1=ns+nss2(id)+1
2865 iss2(j1)=nj
2866 nss2(id)=nss2(id)+1
2867 nke2=inloc(nj)
2868 DO m=1,nnod
2869 nm=intbuf_tab(n)%IRECTM(nl+m)
2870 IF (ndof(nm)>0) THEN
2871 nke1=inloc(nm)
2872 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
2873 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
2874 ENDIF
2875 ENDDO
2876 ENDIF
2877 ENDDO
2878 ns=ns+nss2(id)
2879C-----with Kij block-(i,j second)-----
2880 DO n1=i+1,nsn
2881 nj=intbuf_tab(n)%NSV(n1)
2882 l1=intbuf_tab(n)%IRTLM(n1)
2883 IF (ndof(nj)>0.AND.
2884 . intab(nrowk(nke),icok(1,nke),nj)) THEN
2885 nsc2(j)=nsc2(j)+1
2886 id =nk+2*(nsc2(j)-1)
2887 isij2(id)=i
2888 isij2(id+1)=n1
2889 IF(l/=l1) THEN
2890 nl1=4*(l1-1)
2891 DO m=1,nnod
2892 nm=intbuf_tab(n)%IRECTM(nl+m)
2893 IF (ndof(nm)>0) THEN
2894 nke1=inloc(nm)
2895 DO j1=1,4
2896 nm1=intbuf_tab(n)%IRECTM(nl1+j1)
2897 IF (nm/=nm1.AND.ndof(nm1)>0) THEN
2898 nke2=inloc(nm1)
2899 CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
2900 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
2901 ENDIF
2902 ENDDO
2903 ENDIF
2904 ENDDO
2905 ENDIF
2906 ENDIF
2907 ENDDO
2908 ENDIF
2909 ENDDO
2910 k=k+nsn
2911 nk=nk+2*nsc2(j)
2912 ENDDO
2913C+++ coupling between int2 ----
2914 nmc2=0
2915C-----RBE2------
2916 k=0
2917 DO n=1,nrbe2
2918 k1=irbe2(1,n)
2919 m =irbe2(3,n)
2920 nsn=irbe2(5,n)
2921 nke1=inloc(m)
2922 ns = 0
2923 ic = 7*512+7*64-irbe2(4,n)
2924 DO i=1,nsn
2925 ni=lrbe2(i+k1)
2926 nsrb2(i+k1)=0
2927 IF (ndof(ni)>0) THEN
2928 nke=inloc(ni)
2929 DO n1=1,nrowk(nke)
2930 IF (nke <= ink) THEN
2931 nj=icok(n1,nke)
2932 ELSE
2933 nj=icokm(n1,nke-ink)
2934 END IF
2935 nke2=inloc(nj)
2936 IF (ndof(nj)>0.AND.nj/=ni) THEN
2937 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nj)
2938 IF (nke2<=ink) THEN
2939 CALL reorder_a(nrowk(nke2),icok(1,nke2),m)
2940 ELSEIF (nke2>0) THEN
2941 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),m)
2942 ENDIF
2943 k=k+1
2944 nsrb2(i+k1)=nsrb2(i+k1)+1
2945 isb2(k)=nj
2946 ns=ns+1
2947 ENDIF
2948 ENDDO
2949 IF (ic>0) THEN
2950 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),ni)
2951 IF (nke <= ink) THEN
2952 CALL reorder_a(nrowk(nke),icok(1,nke),m)
2953 ELSEIF (nke > 0) THEN
2954 CALL reorder_a(nrowk(nke),icokm(1,nke-ink),m)
2955 END IF
2956 ENDIF
2957 ENDIF
2958 ENDDO
2959 irbe2(8,n) = ns
2960 ENDDO
2961C------------RBE3-----
2962 k = 0
2963 DO i=1,nrbe3
2964 iad=irbe3(1,i)
2965 ni =irbe3(3,i)
2966 IF (ni==0) cycle
2967 nnod=irbe3(5,i)
2968 ns=0
2969 IF (ndof(ni)>0) THEN
2970 DO m=1,nnod
2971 nm=lrbe3(iad+m)
2972 IF (ndof(nm)>0) THEN
2973 nke1=inloc(nm)
2974 DO j1=1,nnod
2975 nm1=lrbe3(iad+j1)
2976 IF (nke1<=ink.AND.nm/=nm1) THEN
2977 CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
2978 ELSEIF (nm/=nm1) THEN
2979 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nm1)
2980 ENDIF
2981 ENDDO
2982 ENDIF
2983 ENDDO
2984 nke=inloc(ni)
2985 DO n1=1,nrowk(nke)
2986 IF (nke <= ink) THEN
2987 nj=icok(n1,nke)
2988 ELSE
2989 nj=icokm(n1,nke-ink)
2990 END IF
2991 IF (ndof(nj)>0.AND.ni/=nj) THEN
2992 ns=ns+1
2993 k = k + 1
2994 iss3(k)=nj
2995 nke2=inloc(nj)
2996 DO m=1,nnod
2997 nm=lrbe3(iad+m)
2998 IF (ndof(nm)>0) THEN
2999 nke1=inloc(nm)
3000
3001 IF (nke1<=ink) THEN
3002 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
3003 ELSE
3004 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nj)
3005 ENDIF
3006
3007 IF (nke2<=ink) THEN
3008 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
3009 ELSE
3010 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),nm)
3011 ENDIF
3012
3013 ENDIF
3014 ENDDO
3015 ENDIF
3016 ENDDO
3017 ENDIF
3018 irbe3(8,i) = ns
3019 ENDDO
3020C-----active rigid body main nodes------
3021 k=0
3022 ns= 0
3023 nk=1
3024 DO j=1,nrbyac
3025 n=irbyac(j)
3026 k1=irbyac(j+nrbykin)
3027 m =npby(1,n)
3028 nsn =npby(2,n)
3029 nsc(j)=0
3030 IF (ndof(m)>0) THEN
3031 nke1=inloc(m)
3032 nkm1=nke1-ink
3033 DO i=1,nsn
3034 id = i+k
3035 ni=lpby(i+k1)
3036 nss(id)=0
3037 IF (ndof(ni)>0) THEN
3038 nke=inloc(ni)
3039 DO n1=1,nrowk(nke)
3040 IF (nke <= ink) THEN
3041 nj=icok(n1,nke)
3042 ELSE
3043 nj=icokm(n1,nke-ink)
3044 END IF
3045 nke2=inloc(nj)
3046 IF (ndof(nj)>0.AND.
3047 . (.NOT.intab(nsn,lpby(k1+1),nj))) THEN
3048 CALL reorder_a(nrowk(nke1),icokm(1,nkm1),nj)
3049 IF (nke2<=ink) THEN
3050 CALL reorder_a(nrowk(nke2),icok(1,nke2),m)
3051 j1=ns+nss(id)+1
3052 iss(j1)=nj
3053 nss(id)=nss(id)+1
3054 ELSE
3055 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),m)
3056 ENDIF
3057 ENDIF
3058 ENDDO
3059 ns=ns+nss(id)
3060C-----create rigid body second nodes with Kij block-(i,j have the same M)-----
3061 DO n1=i+1,nsn
3062 nj=lpby(k1+n1)
3063 IF (nke <= ink) THEN
3064 IF (ndof(nj)>0.AND.
3065 . (intab(nrowk(nke),icok(1,nke),nj))) THEN
3066 nsc(j)=nsc(j)+1
3067 id =nk+2*(nsc(j)-1)
3068 isij(id)=ni
3069 isij(id+1)=nj
3070 ENDIF
3071 ELSE
3072 IF (ndof(nj)>0.AND.
3073 . (intab(nrowk(nke),icokm(1,nke-ink),nj))) THEN
3074 nsc(j)=nsc(j)+1
3075 id =nk+2*(nsc(j)-1)
3076 isij(id)=ni
3077 isij(id+1)=nj
3078 ENDIF
3079 END IF
3080 ENDDO
3081 ENDIF
3082 ENDDO
3083 ENDIF
3084 k=k+nsn
3085 nk=nk+2*nsc(j)
3086 ENDDO
3087C+++ Coupling between Rigid Bodies ----
3088 nmc=0
3089 IF (nrbyac>1) THEN
3090 DO j=1,nrbyac
3091 n=irbyac(j)
3092 k=irbyac(j+nrbykin)
3093 m =npby(1,n)
3094 ns=npby(2,n)
3095C
3096 IF (ndof(m)>0) THEN
3097 nke1=inloc(m)
3098 nkm1=nke1-ink
3099 DO j1=j+1,nrbyac
3100 n1=irbyac(j1)
3101 l1=irbyac(j1+nrbykin)
3102 nm =npby(1,n1)
3103 nsn =npby(2,n1)
3104 IF (ndof(nm)>0.AND. nkmax>0) THEN
3105 IF (intab(nrowk(nke1),icokm(1,nkm1),nm)) THEN
3106 DO i=1,nsn
3107 id = i+l1
3108 ni=lpby(id)
3109 IF (ndof(ni)>0) THEN
3110 nke=inloc(ni)
3111 IF (nke <= ink) THEN
3112 IF (intab(nrowk(nke),icok(1,nke),m)) THEN
3113 nj=0
3114C------search for second pairs----
3115 DO n1=1,ns
3116 n2=lpby(k+n1)
3117 IF (ndof(n2)>0.AND.
3118 . intab(nrowk(nke),icok(1,nke),n2)) THEN
3119 nj=n2
3120 nmc=nmc+1
3121 id =2*(nmc-1)+1
3122 imij(id)=m
3123 imij(id+1)=nm
3124 isij(nk+id)=ni
3125 isij(nk+id-1)=nj
3126 ENDIF
3127 ENDDO
3128 ENDIF
3129 ELSE
3130 IF (intab(nrowk(nke),icokm(1,nke-ink),m)) THEN
3131 nj=0
3132C------search for second pairs----
3133 DO n1=1,ns
3134 n2=lpby(k+n1)
3135 IF (ndof(n2)>0.AND.
3136 . intab(nrowk(nke),icokm(1,nke-ink),n2)) THEN
3137 nj=n2
3138 nmc=nmc+1
3139 id =2*(nmc-1)+1
3140 imij(id)=m
3141 imij(id+1)=nm
3142 isij(nk+id)=ni
3143 isij(nk+id-1)=nj
3144 ENDIF
3145 ENDDO
3146 ENDIF
3147 END IF !(NKE <= INK) THEN
3148 ENDIF
3149 ENDDO
3150 END IF !IF (INTAB(NROWK(NKE1)
3151 END IF !IF (NDOF(NM)>0.AND. NKMAX>0)
3152C
3153 ENDDO
3154 ENDIF
3155C
3156 ENDDO
3157 ENDIF
3158 IF (nadmesh > 0) CALL rmind_imp(nnmax,inloc,nrowk,icok )
3159C----6---------------------------------------------------------------7---------8
3160 RETURN
3161 END
3162C------computation for NNMAX,NKMAX------
3163!||====================================================================
3164!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
3165!||--- called by ------------------------------------------------------
3166!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
3167!||--- calls -----------------------------------------------------
3168!|| dim_elems2 ../engine/source/implicit/ind_glob_k.F
3169!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
3170!|| dim_kine_p ../engine/source/implicit/ind_glob_k.F
3171!|| dim_kine_s ../engine/source/implicit/ind_glob_k.F
3172!|| dim_kine_t ../engine/source/implicit/ind_glob_k.F
3173!|| kin_nrmax ../engine/source/mpi/implicit/imp_fri.F
3174!|| kin_nrmax0 ../engine/source/mpi/implicit/imp_fri.F
3175!|| rmdim_imp ../engine/source/model/remesh/rm_imp0.F
3176!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
3177!||--- uses -----------------------------------------------------
3178!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3179!|| element_mod ../common_source/modules/elements/element_mod.F90
3180!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3181!||====================================================================
3182 SUBROUTINE dim_kinmax(
3183 1 IGEO ,NPBY ,LPBY ,ITAB ,NRBYAC ,
3184 2 IRBYAC ,NINT2 ,IINT2 ,IPARI ,
3185 3 INTBUF_TAB,IXS ,IXQ ,IXC ,IXT ,
3186 4 IXP ,IXR ,IXTG ,IXTG1 ,IXS10 ,
3187 5 IXS20 ,IXS16 ,IPARG ,NDOF ,
3188 6 NSI2 ,NSRB ,ELBUF ,NKINE ,INLOC ,
3189 7 NROW ,NNMAX ,NKMAX ,NSS ,NSIJ ,
3190 8 NMIJ ,NSS2 ,NSIJ2 ,NMIJ2 ,FR_ELEM ,
3191 9 IAD_ELEM ,SH4TREE ,SH3TREE ,IRBE3 ,LRBE3 ,
3192 A NSS3 ,IRBE2 ,LRBE2 ,NSB2 ,ELBUF_TAB )
3193C-----------------------------------------------
3194C M o d u l e s
3195C-----------------------------------------------
3196 USE elbufdef_mod
3197 USE intbufdef_mod
3198 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
3199C-----------------------------------------------
3200C I m p l i c i t T y p e s
3201C-----------------------------------------------
3202#include "implicit_f.inc"
3203C-----------------------------------------------
3204C C o m m o n B l o c k s
3205C-----------------------------------------------
3206#include "com01_c.inc"
3207#include "com04_c.inc"
3208#include "param_c.inc"
3209#include "impl1_c.inc"
3210#include "remesh_c.inc"
3211C-----------------------------------------------
3212C D u m m y A r g u m e n t s
3213C-----------------------------------------------
3214 INTEGER IPARG(NPARG,*),IGEO(*),IRBE3(*),LRBE3(*)
3215 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
3216 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),NSI2,NSRB
3217 INTEGER FR_ELEM(*),IAD_ELEM(2,*),SH4TREE(*),SH3TREE(*)
3218 INTEGER
3219 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*), ixp(nixp,*),
3220 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3221 . ixs16(8,*),ixtg1(4,*),ndof(*),nrow(*),nnmax,nkine,
3222 . inloc(*),nkmax,nss,nsij,nmij,nss2,nsij2,nmij2,nss3,
3223 . irbe2(*),lrbe2(*),nsb2
3224C REAL
3225 my_real elbuf(*)
3226 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3227 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
3228C-----------------------------------------------
3229C L o c a l V a r i a b l e s
3230C-----------------------------------------------
3231 INTEGER I,J,K,N,M,L,NKINE0,NNMAX0,NK,L1,L2,IERR,LNK
3232 INTEGER, DIMENSION(:),ALLOCATABLE :: ICOK,NROWI
3233C-----------------------------------------------
3234 DO N =1,numnod
3235 inloc(n)=0
3236 ENDDO
3237c-----2. prepare icol for second nodes using ikine;
3238 CALL dim_kine_p(
3239 1 igeo ,npby ,lpby ,itab ,nrbyac ,
3240 2 irbyac ,nint2 ,iint2 ,ipari ,
3241 3 ndof ,nsi2 ,nsrb ,nkine ,
3242 7 inloc ,irbe3 ,irbe2 ,lrbe2 ,lnk ,
3243 8 intbuf_tab )
3244C----- pass for IND_GLOB_K, including RBE2 main
3245 lcokm=lnk
3246 nkine0=nkine
3247 IF (nkine0>0) THEN
3248 ALLOCATE(icok(nkine*nnmax))
3249 ALLOCATE(nrowi(nkine))
3250 ENDIF
3251 DO n =1,nkine0
3252 nrowi(n)=0
3253 ENDDO
3254 CALL dim_elems3(
3255 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3256 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3257 3 ixs10 ,ixs20 ,ixs16 ,nrowi ,
3258 4 inloc ,nnmax ,icok ,igeo ,elbuf_tab )
3259 IF (nspmd>1) THEN
3260 CALL kin_nrmax(
3261 1 nnmax ,nnmax ,nrowi ,icok ,icok ,
3262 2 inloc ,numnod ,fr_elem ,iad_elem )
3263 ENDIF
3264 DO n =1,numnod
3265 nk=inloc(n)
3266 IF (nk > 0) nrow(n) = max(nrow(n),nrowi(nk))
3267 ENDDO
3268c-----3. calculation NNMAX,NKMAX and creating INLOC,NKINE;
3269 CALL dim_kine_s(
3270 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
3271 2 nint2 ,iint2 ,ipari ,intbuf_tab,ndof ,
3272 3 nnmax ,nrow ,nrowi ,nkine ,inloc ,
3273 4 icok ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
3274 IF (nkine0>0) THEN
3275 DEALLOCATE(icok)
3276 DEALLOCATE(nrowi)
3277 ENDIF
3278C
3279 nkmax=nnmax
3280 nnmax0=nnmax
3281 DO n =1,numnod
3282 nk=inloc(n)
3283 IF (nk>lnk) THEN
3284 nnmax=max(nnmax,nrow(n))
3285 ELSEIF (nk>0) THEN
3286 nkmax=max(nkmax,nrow(n))
3287 ENDIF
3288 ENDDO
3289C----for some special case (hierarchy kinematic RBE2/RBE3),NKMAX is underestimated
3290 IF (nspmd>1)CALL spmd_max_i(nnmax)
3291 nkmax=max(nkmax,nnmax)
3292 IF (nspmd>1)CALL spmd_max_i(nkmax)
3293C
3294 nkine0=nkine
3295 IF (nkine0>0) THEN
3296 nk = lnk*nkmax+nkine*nnmax
3297 ALLOCATE(icok(nk))
3298 ALLOCATE(nrowi(nkine))
3299 ENDIF
3300 DO n =1,nkine0
3301 nrowi(n)=0
3302 ENDDO
3303 l1 = 1
3304 l2 = 1 + lnk*nkmax
3305 CALL dim_elems2(
3306 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3307 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3308 3 ixs10 ,ixs20 ,ixs16 ,nrowi ,
3309 4 inloc ,nnmax ,icok(l2) ,nkmax ,icok(l1) ,
3310 5 lnk ,igeo ,elbuf_tab )
3311c
3312 IF (nspmd>1) THEN
3313 CALL kin_nrmax0(
3314 1 nnmax ,nkmax ,nrowi ,icok(l2) ,icok(l1) ,
3315 2 inloc ,lnk ,fr_elem ,iad_elem )
3316 ENDIF
3317c-----3. calculation NNMAX,NKMAX and creating INLOC,NKINE;
3318 CALL dim_kine_t(
3319 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
3320 2 nint2 ,iint2 ,ipari ,intbuf_tab,ndof ,
3321 3 nnmax ,nrowi ,nkine ,inloc ,icok(l2) ,
3322 4 nss ,nsij ,nmij ,nss2 ,nsij2 ,
3323 5 nmij2 ,nkmax ,icok(l1) ,lnk ,irbe3 ,
3324 6 lrbe3 ,nss3 ,irbe2 ,lrbe2 ,nsb2 )
3325 nkmax=0
3326 nnmax=nnmax0
3327 DO n =1,numnod
3328 nk=inloc(n)
3329 IF (nk>lnk) THEN
3330 nnmax=max(nnmax,nrowi(nk))
3331 ELSEIF (nk>0) THEN
3332 nkmax=max(nkmax,nrowi(nk))
3333 ENDIF
3334 ENDDO
3335 DO n =1,numnod
3336 nk=inloc(n)
3337 IF (nk>0)nrow(n)=nrowi(nk)
3338 ENDDO
3339 IF (nkine0>0) THEN
3340 DEALLOCATE(icok)
3341 DEALLOCATE(nrowi)
3342 ENDIF
3343 IF (nadmesh > 0) CALL rmdim_imp(ixc ,ixtg ,ndof ,nnmax,nkine,
3344 1 inloc,nrow ,itab ,sh4tree,sh3tree)
3345C----6---------------------------------------------------------------7---------8
3346 RETURN
3347 END
3348C------estimation for NNMAX,NKMAX,NNZK, prepare data for IND_GLOB_K
3349!||====================================================================
3350!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
3351!||--- called by ------------------------------------------------------
3352!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
3353!||--- calls -----------------------------------------------------
3354!|| dim_elemax ../engine/source/implicit/ind_glob_k.F
3355!|| dim_elems1 ../engine/source/implicit/ind_glob_k.F
3356!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
3357!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
3358!|| dim_ndof_d ../engine/source/implicit/ind_glob_k.F
3359!|| dim_ndof_i ../engine/source/implicit/ind_glob_k.F
3360!|| dim_ndof_ii ../engine/source/implicit/ind_glob_k.F
3361!|| dim_nrmax ../engine/source/mpi/implicit/imp_fri.F
3362!|| monv_prem ../engine/source/airbag/monv_imp0.F
3363!|| ndof_fv ../engine/source/implicit/ind_glob_k.F
3364!|| set_ikin2g ../engine/source/mpi/implicit/imp_fri.F
3365!|| spmd_ndof ../engine/source/mpi/implicit/imp_spmd.F
3366!||--- uses -----------------------------------------------------
3367!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3368!|| element_mod ../common_source/modules/elements/element_mod.F90
3369!|| groupdef_mod ../common_source/modules/groupdef_mod.F
3370!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3371!||====================================================================
3372 SUBROUTINE dim_glob_k(
3373 1 GEO ,NPBY ,LPBY ,ITAB ,NRBYAC ,
3374 2 IRBYAC ,NINT2 ,IINT2 ,IPARI ,
3375 3 IXS ,IXQ ,IXC ,IXT ,
3376 4 IXP ,IXR ,IXTG ,IXTG1 ,IXS10 ,
3377 5 IXS20 ,IXS16 ,IPARG ,NDOF ,
3378 6 IDDL ,NDDL ,NNZK ,ELBUF ,INLOC ,
3379 7 LSIZE ,FR_ELEM ,IAD_ELEM ,FR_I2M ,IAD_I2M ,
3380 8 NPRW ,NMONV ,IMONV ,MONVOL ,IGRSURF ,
3381 9 FR_MV ,IPM ,IGEO ,IAD_RBY ,
3382 A FR_RBY ,SH4TREE ,SH3TREE ,IRBE3 ,LRBE3 ,
3383 B FR_RBE3M ,IAD_RBE3M ,IRBE2 ,LRBE2 ,IBFV ,
3384 C VEL ,ELBUF_TAB ,IFRAME ,INTBUF_TAB )
3385C-----------------------------------------------
3386C M o d u l e s
3387C-----------------------------------------------
3388 USE elbufdef_mod
3389 USE intbufdef_mod
3390 USE groupdef_mod
3391 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
3392C-----------------------------------------------
3393C I m p l i c i t T y p e s
3394C-----------------------------------------------
3395#include "implicit_f.inc"
3396C-----------------------------------------------
3397C C o m m o n B l o c k s
3398C-----------------------------------------------
3399#include "com01_c.inc"
3400#include "com04_c.inc"
3401#include "param_c.inc"
3402#include "impl1_c.inc"
3403#include "task_c.inc"
3404C-----------------------------------------------
3405C D u m m y A r g u m e n t s
3406C-----------------------------------------------
3407 INTEGER IPARG(NPARG,*),FR_ELEM(*) ,IAD_ELEM(2,*)
3408 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
3409 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),
3410 . fr_i2m(*),iad_i2m(*),fr_rby(*),iad_rby(*)
3411 INTEGER NMONV,IMONV(*),MONVOL(*),
3412 . fr_mv(nspmd+2,nvolu),nprw(*),fr_rbe3m(*),iad_rbe3m(*)
3413 INTEGER IPM(NPROPMI,*),IGEO(NPROPGI,*),IFRAME(LISKN,*)
3414 INTEGER
3415 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*), ixp(nixp,*),
3416 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3417 . ixs16(8,*),ixtg1(4,*),iddl(*),ndof(*),irbe3(*),lrbe3(*),
3418 . nddl ,nnzk,inloc(*),lsize(*),sh4tree(*), sh3tree(*),
3419 . irbe2(*),lrbe2(*),ibfv(*)
3420C REAL
3421 my_real
3422 . geo(npropg,*),elbuf(*),vel(*)
3423 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3424 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
3425 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
3426C-----------------------------------------------
3427C L o c a l V a r i a b l e s
3428C-----------------------------------------------
3429 INTEGER NKINE,NKMAX,NNMAX,NSI2,NSRB,NSS,NSIJ,NMIJ,NSS2,NSIJ2,NSS3
3430 INTEGER I,J,K,N,M,L,NDOFI,NDOFJ,NKINE0,NMIJ2,IP,NPN,NPP,IER1
3431 INTEGER IAD_M(NSPMD+1),NSB2,NSRB2
3432 INTEGER, DIMENSION(:),ALLOCATABLE :: FR_M
3433C-----------------------------------------------
3434C-----NNMAX:max number of connected nodes(excepting main nodes of rbodies)
3435C INLOC(NUMNOD) : global numnod in order of IDDL
3436C actuel order : non kinematical nodes;kinematical nodes; main nodes of rbodies
3437C ICOL(NKMAX,NRBYAC) for main nodes
3438C ICOL(NNMAX,NKINE-NRBYAC) for kine. nodes
3439C ICOL(NNMAX,NNSIZ) for other nodes
3440C NROW(NUMNOD) number of connected nodes use the mem. of iddl
3441C---- For SPMD we no longer distinguish node Kine ------------------------------------------------------------------------------
3442C et INLOC(NUMNOD) : local(pi) numnod in order of IDDL
3443C Current order: fountry nodes with pj (j <i);nodes;fountry nodes with pj (j> i)
3444c-----1. calcule NNMAX,NDOF;
3445 DO N =1,numnod
3446 iddl(n)=0
3447 ndof(n)=0
3448 ENDDO
3449 CALL dim_ndof_i(
3450 1 npby ,lpby ,itab ,nrbyac ,
3451 2 irbyac ,ndof ,nsrb ,ipari ,
3452 3 nint2 ,iint2 ,nsi2 ,nprw ,irbe3 ,
3453 4 irbe2 ,nsrb2 ,fr_elem ,iad_elem ,intbuf_tab )
3454 CALL dim_elems1(
3455 1 igeo ,elbuf ,iparg ,ixs ,ixq ,
3456 2 ixc ,ixt ,ixp ,ixr ,ixtg ,
3457 3 ixtg1 ,ixs10 ,ixs20 ,ixs16 ,
3458 4 ndof ,iddl ,elbuf_tab )
3459 CALL dim_ndof_ii(
3460 1 nint2 ,iint2 ,ipari ,ndof ,
3461 2 nrbe3 ,irbe3 ,lrbe3 ,nrbe2 ,irbe2 ,
3462 3 lrbe2 ,intbuf_tab )
3463C+++ not allowing imposed rotations on solid element..---
3464 CALL ndof_fv(ibfv ,vel ,ndof ,iframe )
3465 IF (imp_rby==1) CALL dim_ndof_d(
3466 1 npby ,lpby ,nrbyac ,irbyac ,ndof ,
3467 2 iad_rby ,fr_rby )
3468 IF (nspmd>1) THEN
3469 nnmax=iad_elem(1,nspmd+1)-iad_elem(1,1)
3470 IF (nnmax>0) CALL spmd_ndof(ndof,fr_elem,iad_elem,nnmax)
3471 ENDIF
3472 CALL monv_prem(
3473 1 nmonv ,imonv ,monvol ,igrsurf ,
3474 2 fr_mv ,inloc ,npby ,lpby ,nrbyac ,
3475 3 irbyac ,nint2 ,iint2 ,ipari ,intbuf_tab,
3476 4 ndof ,iprec ,irbe3 ,irbe2 ,lrbe2 )
3477 nnmax=0
3478 DO n =1,numnod
3479 IF (ndof(n)>0) nnmax=max(nnmax,iddl(n))
3480 ENDDO
3481c-----raffine NNMAX;
3482 nkine0=2*nnmax
3483 IF (nspmd>1) THEN
3484 npp=iad_elem(1,nspmd+1)-iad_elem(1,1)
3485 m = iad_i2m(nspmd+1)-iad_i2m(1)+
3486 . iad_rbe3m(nspmd+1)-iad_rbe3m(1)
3487 ALLOCATE(fr_m(m))
3488 m = 0
3489 iad_m(1)=1
3490 DO ip =1,nspmd
3491 iad_m(ip+1)=m+1
3492 ENDDO
3493C
3494 CALL dim_fr_k(
3495 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3496 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3497 3 ixs10 ,ixs20 ,ixs16 ,ndof ,
3498 4 nkine0 ,inloc ,fr_elem ,iad_elem ,npp ,
3499 5 igeo ,fr_m ,iad_m ,elbuf_tab )
3500 DEALLOCATE(fr_m)
3501 ENDIF
3502 CALL dim_elemax(
3503 1 ixs ,ixq ,ixc ,ixt ,ixp ,
3504 2 ixr ,ixtg ,ixtg1 ,ixs10 ,ixs20 ,
3505 3 ixs16 ,iparg ,elbuf ,ndof ,
3506 4 iddl ,inloc ,nnmax ,nkine0 ,nnsiz ,
3507 5 igeo ,elbuf_tab )
3508 IF (nspmd>1) THEN
3509 CALL dim_nrmax(iddl ,fr_elem ,iad_elem ,nnmax )
3510 ENDIF
3511C
3512 CALL dim_kinmax(
3513 1 igeo ,npby ,lpby ,itab ,nrbyac ,
3514 2 irbyac ,nint2 ,iint2 ,ipari ,
3515 3 intbuf_tab,ixs ,ixq ,ixc ,ixt ,
3516 4 ixp ,ixr ,ixtg ,ixtg1 ,ixs10 ,
3517 5 ixs20 ,ixs16 ,iparg ,ndof ,
3518 6 nsi2 ,nsrb ,elbuf ,nkine ,inloc ,
3519 7 iddl ,nnmax ,nkmax ,nss ,nsij ,
3520 8 nmij ,nss2 ,nsij2 ,nmij2 ,fr_elem ,
3521 9 iad_elem ,sh4tree ,sh3tree ,irbe3 ,lrbe3 ,
3522 a nss3 ,irbe2 ,lrbe2 ,nsb2 ,elbuf_tab )
3523c-----4. calculation NNZK,;
3524 IF (iroddl==0) THEN
3525 ndofj=3
3526 ELSE
3527C------ This over-dimensioner Kij in case of the Mix Model (solid +shell) but not too thanks
3528 ndofj=6
3529 ENDIF
3530 nnzk = 0
3531 DO n=1,numnod
3532 DO k=1,ndof(n)
3533C-------termes knn-------
3534 DO j=1,ndof(n)
3535 IF (j/=k) nnzk = nnzk+1
3536c NNZK = NNZK+NDOF(N)-1
3537 ENDDO
3538C-------termes kn,nj-------
3539 DO j=1,iddl(n)
3540 DO l=1,ndofj
3541 nnzk = nnzk+1
3542c NNZK = NNZK+NDOFJ*IDDL(N)
3543 ENDDO
3544 ENDDO
3545 ENDDO
3546 ENDDO
3547 nnzk = nnzk/2+1
3548 npn=0
3549 npp=0
3550 IF (nspmd>1) THEN
3551 CALL set_ikin2g(nkine,inloc)
3552 j=0
3553 l=0
3554 DO n =1,numnod
3555 iddl(n)=0
3556 ENDDO
3557C------d'abord frontieres with precedent procs j<i
3558 DO ip =1,ispmd
3559 DO m=iad_elem(1,ip),iad_elem(1,ip+1)-1
3560 n=fr_elem(m)
3561 IF (iddl(n)==0) THEN
3562 j=j+1
3563 inloc(j)=n
3564 iddl(n)=j
3565 ENDIF
3566 ENDDO
3567 ENDDO
3568C------boundaries with procs behind at the end j>i------
3569 DO ip =ispmd+2,nspmd
3570 DO m=iad_elem(1,ip),iad_elem(1,ip+1)-1
3571 n=fr_elem(m)
3572 IF (iddl(n)==0) THEN
3573 l=l+1
3574 iddl(n)=-l
3575 ENDIF
3576 ENDDO
3577 ENDDO
3578 npn=j
3579 npp=l
3580 DO n =1,numnod
3581 IF (iddl(n)==0) THEN
3582 j=j+1
3583 inloc(j)=n
3584 ELSEIF (iddl(n)<0) THEN
3585 k=numnod-l-iddl(n)
3586 inloc(k)=n
3587 ENDIF
3588 ENDDO
3589 ELSE
3590C--------- Set INLOC;For Kine.Nodes ---
3591 DO n =1,numnod
3592 iddl(n)=inloc(n)
3593 ENDDO
3594 IF (ikpat<=1) THEN
3595 j=0
3596 DO n =1,numnod
3597 IF (iddl(n)==0) THEN
3598 j=j+1
3599 inloc(j)=n
3600 ELSE
3601 k=numnod-iddl(n)+1
3602 inloc(k)=n
3603 ENDIF
3604 ENDDO
3605 ELSE
3606 j=nkine
3607 DO n =1,numnod
3608 IF (iddl(n)==0) THEN
3609 j=j+1
3610 inloc(j)=n
3611 ELSE
3612 k=iddl(n)
3613 inloc(k)=n
3614 ENDIF
3615 ENDDO
3616 ENDIF
3617 ENDIF
3618c-----4. calculation IDDL,;
3619 nddl =0
3620 DO j=1,numnod
3621 n=inloc(j)
3622 iddl(n)=nddl
3623 ndofi = ndof(n)
3624 IF (ndofi>0) nddl = nddl + ndofi
3625 ENDDO
3626c-----dimensions divers;
3627 lsize(1)=nsrb
3628 lsize(2)=nsi2
3629 lsize(3)=nss+1
3630 lsize(4)=nsij+1
3631 lsize(5)=nmij+1
3632 lsize(6)=nss2+1
3633 lsize(7)=nsij2+1
3634 lsize(8)=nkine
3635 lsize(9)=nnmax
3636 lsize(10)=nkmax
3637 lsize(11)=nmij2
3638 lsize(12)=npn
3639 lsize(13)=npp
3640 lsize(14)=nss3
3641 lsize(15)=nsb2
3642 lsize(16)=nsrb2
3643C----6---------------------------------------------------------------7---------8
3644 RETURN
3645 END
3646C --------- stockage M.C.R.S + SYM- -----
3647!||====================================================================
3648!|| set_ind_k ../engine/source/implicit/ind_glob_k.F
3649!||--- called by ------------------------------------------------------
3650!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
3651!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
3652!||====================================================================
3653 SUBROUTINE set_ind_k(
3654 1 IDDL ,NDOF ,IADK ,JDIK ,NDDL ,
3655 2 NNZK ,NROW ,ICOL ,N ,IKPAT )
3656C-----------------------------------------------
3657C I m p l i c i t T y p e s
3658C-----------------------------------------------
3659#include "implicit_f.inc"
3660C-----------------------------------------------
3661C D u m m y A r g u m e n t s
3662C-----------------------------------------------
3663 INTEGER
3664 . iddl(*),ndof(*),iadk(*),jdik(*),
3665 . nddl ,nnzk,nrow ,icol(*),n,ikpat
3666C-----------------------------------------------
3667C L o c a l V a r i a b l e s
3668C-----------------------------------------------
3669 INTEGER I,J,K,L,NL,NJ,NDOFI
3670c----- calculation IADK,JDIK,NNZK-----
3671 ndofi = ndof(n)
3672 DO k=1,ndofi
3673C-------termes knn-------
3674 IF (ikpat==0) THEN
3675 DO j=k+1,ndofi
3676 nnzk = nnzk+1
3677 jdik(nnzk) = iddl(n)+j
3678 ENDDO
3679C-------termes kn,nj-------
3680 DO j=1,nrow
3681 nj = icol(j)
3682 DO l=1,ndof(nj)
3683 nnzk = nnzk+1
3684 jdik(nnzk) = iddl(nj)+l
3685 ENDDO
3686 ENDDO
3687 ELSE
3688C-------termes knj,n-------
3689 DO j=1,nrow
3690 nj = icol(j)
3691 DO l=1,ndof(nj)
3692 nnzk = nnzk+1
3693 jdik(nnzk) = iddl(nj)+l
3694 ENDDO
3695 ENDDO
3696 DO j=1,k-1
3697 nnzk = nnzk+1
3698 jdik(nnzk) = iddl(n)+j
3699 ENDDO
3700 ENDIF
3701 nddl = nddl +1
3702 iadk(nddl) = nnzk+1
3703 ENDDO
3704C
3705 RETURN
3706 END
3707C --------- stockage M.C.R.S + SYM- -----
3708!||====================================================================
3709!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
3710!||--- called by ------------------------------------------------------
3711!|| imp_buck ../engine/source/implicit/imp_buck.F
3712!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
3713!|| imp_solv ../engine/source/implicit/imp_solv.F
3714!||--- calls -----------------------------------------------------
3715!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
3716!|| dim_elems4 ../engine/source/implicit/ind_glob_k.F
3717!|| get_ikin2g ../engine/source/mpi/implicit/imp_fri.F
3718!|| ind_fr_k ../engine/source/mpi/implicit/imp_fri.F
3719!|| ind_kine_k ../engine/source/implicit/ind_glob_k.f
3720!|| ind_kine_kp ../engine/source/mpi/implicit/imp_fri.F
3721!|| ind_nrfr ../engine/source/mpi/implicit/imp_fri.F
3722!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.F
3723!|| kin_nrmax ../engine/source/mpi/implicit/imp_fri.F
3724!|| reorder_j ../engine/source/implicit/ind_glob_k.F
3725!|| reorder_l ../engine/source/implicit/ind_glob_k.F
3726!|| set_ind_k ../engine/source/implicit/ind_glob_k.F
3727!|| spc_fr_k ../engine/source/mpi/implicit/imp_fri.F
3728!|| zero_ikin2g ../engine/source/mpi/implicit/imp_fri.F
3729!||--- uses -----------------------------------------------------
3730!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3731!|| element_mod ../common_source/modules/elements/element_mod.F90
3732!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3733!||====================================================================
3734 SUBROUTINE ind_glob_k(NPBY,LPBY,
3735 1 ITAB ,NRBYAC ,IRBYAC ,NSC ,ISIJ ,
3736 2 NMC ,IMIJ ,NSS ,ISS ,NINT2 ,
3737 3 IINT2 ,IPARI ,INTBUF_TAB,NSC2 ,ISIJ2 ,
3738 4 NSS2 ,ISS2 ,IPARG ,ELBUF ,ELBUF_TAB ,
3739 5 IXS ,IXQ ,IXC ,IXT ,IXP ,
3740 6 IXR ,IXTG ,IXTG1 ,IXS10 ,IXS20 ,
3741 7 IXS16 ,IDDL ,NDOF ,IADK ,
3742 8 JDIK ,NDDL ,NNZK ,NNMAX ,NKINE ,
3743 9 INLOC ,NKMAX ,NROWK ,ICOK ,ICOKM ,
3744 A NMC2 ,IMIJ2 ,IRK ,NPN ,NPP ,
3745 B FR_ELEM ,IAD_ELEM ,IPM ,IGEO ,IRBE3 ,
3746 C LRBE3 ,ISS3 ,FR_I2M ,IAD_I2M ,FR_RBE3M ,
3747 D IAD_RBE3M ,IRBE2 ,LRBE2 ,ISB2 ,NSRB2 )
3748C-----------------------------------------------
3749C M o d u l e s
3750C-----------------------------------------------
3751 USE elbufdef_mod
3752 USE intbufdef_mod
3753 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
3754C-----------------------------------------------
3755C I m p l i c i t T y p e s
3756C-----------------------------------------------
3757#include "implicit_f.inc"
3758C-----------------------------------------------
3759C C o m m o n B l o c k s
3760C-----------------------------------------------
3761#include "com01_c.inc"
3762#include "com04_c.inc"
3763#include "param_c.inc"
3764#include "impl1_c.inc"
3765C-----------------------------------------------
3766C D u m m y A r g u m e n t s
3767C-----------------------------------------------
3768 INTEGER IPARG(NPARG,*),NNMAX,IRK,NKMAX
3769 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
3770 . nsc(*),isij(*),nss(*),iss(*),nint2,iint2(*),
3771 . nsc2(*),isij2(*),nss2(*),iss2(*),ipari(npari,*),
3772 . nmc,imij(*),icok(nnmax,*),icokm(nkmax,*),nrowk(*)
3773 INTEGER IPM(NPROPMI,*),IGEO(NPROPGI,*)
3774 INTEGER
3775 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*), ixp(nixp,*),
3776 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3777 . ixs16(8,*),ixtg1(4,*),iddl(*),ndof(*),iadk(*),jdik(*),
3778 . nddl ,nnzk,nkine,inloc(*),nmc2,imij2(*),npn ,npp,
3779 . fr_elem(*),iad_elem(2,*),irbe3(*),lrbe3(*),iss3(*),
3780 . fr_i2m(*),iad_i2m(*),fr_rbe3m(*),iad_rbe3m(*),
3781 . irbe2(*),lrbe2(*),isb2(*),nsrb2(*)
3782 my_real
3783 . elbuf(*)
3784 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3785 TYPE(intbuf_struct_) INTBUF_TAB(*)
3786C=======================================================================
3787C stockage M.C.R.S (Modified Compressed Row Stockage)
3788C Hollow storage: Diagonal + Trangle in lines: Ikpat = 0: Triang_sup Ikpat = 1: Inf
3789C [K](id,jd) -> DIAG(ND)+LT(IK)(exclue diag)
3790C id = 1..nddl : ID = IADK(ID)...IADK(ID+1)-1
3791C jd = 1..NNZK : JD = JDIK(IK)
3792C NDOF(NUMNOD) : number de ddl
3793C DIAG(NDDL)
3794C IADK(NDDL+1)
3795C JDIK(NNZK)
3796C-----------------------------------------------
3797C L o c a l V a r i a b l e s
3798C-----------------------------------------------
3799 INTEGER ICOL(NNMAX,NNSIZ),NROW(NNSIZ),JLT1,INK,NRMAX
3800 INTEGER I,J,K,N,L,NL,NJ,LENK,M,NK,ID,NFT,JLT,N_FR,IP
3801 INTEGER ILOC(NUMNOD)
3802 INTEGER IAD_M(NSPMD+1)
3803 INTEGER, DIMENSION(:),ALLOCATABLE :: FR_M
3804 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICOKFR
3805C M: Main, S: send nss (nrbyac): number of J: kjm = sum (kjscsm)
3806C NSC (NRBYAC): Number of "send lines": ISIJ (2, NSC, NRBYAC)-
3807C nrowk(NKINE), icok size: NNMAX*(NKINE-NRBYAC)+NKMAX*NRBYAC:icok,icokm
3808C-----
3809C-----1. calculation IADK,JDIK,par each NNSIZ using INLOC.
3810C-----IRK=0, calculation of kinematic tables is skipped-----
3811 IF (NSPMD>1) THEN
3812 DO N = 1 , numnod
3813 iloc(n)=0
3814 ENDDO
3815 n_fr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3816 m = iad_i2m(nspmd+1)-iad_i2m(1)+
3817 . iad_rbe3m(nspmd+1)-iad_rbe3m(1)
3818 ALLOCATE(fr_m(m))
3819 m = 0
3820 iad_m(1)=1
3821 DO ip =1,nspmd
3822 iad_m(ip+1)=m+1
3823 ENDDO
3824 IF (nkine>0) THEN
3825C-------cree ILOC()------
3826 ink=nkine-lcokm
3827c INK=NKINE-NRBYAC
3828 CALL get_ikin2g(nkine,ink,iloc)
3829 IF (irk == 1) THEN
3830 DO nk =1,nkine
3831 nrowk(nk)=0
3832 ENDDO
3833 CALL dim_elems4(
3834 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3835 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3836 3 ixs10 ,ixs20 ,ixs16 ,nrowk ,
3837 4 iloc ,nnmax ,icok ,nkmax ,icokm ,
3838 5 ink ,igeo ,elbuf_tab )
3839 CALL kin_nrmax(
3840 1 nnmax ,nkmax ,nrowk ,icok ,icokm ,
3841 2 iloc ,ink ,fr_elem ,iad_elem )
3842 CALL ind_kine_k(npby,lpby,
3843 1 itab ,nrbyac ,irbyac ,nsc ,isij ,
3844 2 nmc ,imij ,nss ,iss ,nint2 ,
3845 3 iint2 ,ipari ,intbuf_tab,nsc2 ,isij2 ,
3846 4 nss2 ,iss2 ,ndof ,nnmax ,nkine ,
3847 5 iloc ,nkmax ,nrowk ,icok ,icokm ,
3848 6 nmc2 ,imij2 ,ink ,irbe3 ,lrbe3 ,
3849 7 iss3 ,irbe2 ,lrbe2 ,isb2 ,nsrb2 )
3850C
3851 CALL ind_kine_kp(
3852 1 nrowk ,icok ,icokm ,nnmax ,nkmax ,
3853 2 nkine ,ink ,ikpat ,iddl )
3854C
3855 ENDIF
3856 CALL zero_ikin2g(nkine,iloc)
3857 ENDIF
3858 CALL ini_fr_k(
3859 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3860 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3861 3 ixs10 ,ixs20 ,ixs16 ,ndof ,
3862 4 nnmax ,iloc ,fr_elem ,iad_elem ,n_fr ,
3863 5 igeo ,fr_m ,iad_m ,elbuf_tab ,nrmax )
3864 DEALLOCATE(fr_m)
3865 jlt1=numnod
3866 lenk = 0
3867 nl = 1
3868 iadk(nl) = 1
3869 ALLOCATE(icokfr(nrmax,n_fr))
3870C
3871 DO nft = 0 , jlt1-1 , nnsiz
3872 jlt = min( nnsiz, jlt1 - nft )
3873 DO nk=1,jlt
3874 n=nk+nft
3875 k=inloc(n)
3876 iloc(k)=nk
3877 nrow(nk)=0
3878 ENDDO
3879 CALL dim_elems3(
3880 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3881 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3882 3 ixs10 ,ixs20 ,ixs16 ,nrow ,
3883 4 iloc ,nnmax ,icol ,igeo ,elbuf_tab )
3884 CALL ind_nrfr(
3885 1 nft ,jlt ,npn ,npp ,nnmax ,
3886 2 nrow ,icol ,fr_elem ,iad_elem ,n_fr ,
3887 3 icokfr )
3888 DO nk=1,jlt
3889 n=nk+nft
3890 k=inloc(n)
3891 iloc(k)=0
3892 ENDDO
3893 IF (nkine>0) THEN
3894 CALL get_ikin2g(nkine,ink,iloc)
3895 DO nk=1,jlt
3896 n=nk+nft
3897 j=inloc(n)
3898 IF (ndof(j)>0) THEN
3899 k=iloc(j)
3900 IF (k>ink) THEN
3901 nj=k-ink
3902 CALL set_ind_k(
3903 1 iddl ,ndof ,iadk ,jdik ,nl ,
3904 2 lenk ,nrowk(k) ,icokm(1,nj),j ,ikpat )
3905 ELSEIF (k>0) THEN
3906 CALL set_ind_k(
3907 1 iddl ,ndof ,iadk ,jdik ,nl ,
3908 2 lenk ,nrowk(k) ,icok(1,k) ,j ,ikpat )
3909 ELSE
3910 IF (ikpat==0) THEN
3911 CALL reorder_j(nrow(nk),icol(1,nk),j,iddl)
3912 ELSE
3913 CALL reorder_l(nrow(nk),icol(1,nk),j,iddl)
3914 ENDIF
3915 CALL set_ind_k(
3916 1 iddl ,ndof ,iadk ,jdik ,nl ,
3917 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3918 ENDIF
3919 ENDIF
3920 ENDDO
3921 CALL zero_ikin2g(nkine,iloc)
3922 ELSE
3923 IF (ikpat==0) THEN
3924 DO nk=1,jlt
3925 n=nk+nft
3926 j=inloc(n)
3927 CALL reorder_j(nrow(nk),icol(1,nk),j,iddl)
3928 IF (ndof(j)>0) THEN
3929 CALL set_ind_k(
3930 1 iddl ,ndof ,iadk ,jdik ,nl ,
3931 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3932 ENDIF
3933 ENDDO
3934 ELSE
3935 DO nk=1,jlt
3936 n=nk+nft
3937 j=inloc(n)
3938 CALL reorder_l(nrow(nk),icol(1,nk),j,iddl)
3939 IF (ndof(j)>0) THEN
3940 CALL set_ind_k(
3941 1 iddl ,ndof ,iadk ,jdik ,nl ,
3942 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3943 ENDIF
3944 ENDDO
3945 ENDIF
3946 ENDIF
3947 ENDDO
3948C
3949 CALL ind_fr_k(
3950 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3951 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3952 3 ixs10 ,ixs20 ,ixs16 ,ndof ,
3953 4 nnmax ,iloc ,fr_elem ,iad_elem ,n_fr ,
3954 5 igeo ,elbuf_tab )
3955 IF(iautspc>0) THEN
3956 CALL spc_fr_k(
3957 1 iadk ,jdik ,ndof ,iddl ,fr_elem ,
3958 2 iad_elem )
3959 ENDIF
3960 DEALLOCATE(icokfr)
3961C
3962 GOTO 100
3963 ENDIF
3964C----------mono-domaine-------------
3965 DO n = 1 , numnod
3966 iloc(n)=0
3967 ENDDO
3968 lenk = 0
3969 nl = 1
3970 iadk(nl) = 1
3971C
3972 IF (ikpat<=1) THEN
3973 jlt1=numnod-nkine
3974 DO nft = 0 , jlt1-1 , nnsiz
3975 jlt = min( nnsiz, jlt1 - nft )
3976 DO nk=1,jlt
3977 n=nk+nft
3978 k=inloc(n)
3979 iloc(k)=nk
3980 nrow(nk)=0
3981 ENDDO
3982 CALL dim_elems3(
3983 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3984 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3985 3 ixs10 ,ixs20 ,ixs16 ,nrow ,
3986 4 iloc ,nnmax ,icol ,igeo ,elbuf_tab )
3987 IF (ikpat==0) THEN
3988 DO nk=1,jlt
3989 n=nk+nft
3990 j=inloc(n)
3991 IF (ndof(j)>0) THEN
3992 CALL reorder_j(nrow(nk),icol(1,nk),j,iddl)
3993 CALL set_ind_k(
3994 1 iddl ,ndof ,iadk ,jdik ,nl ,
3995 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3996 ENDIF
3997 ENDDO
3998 ELSE
3999 DO nk=1,jlt
4000 n=nk+nft
4001 j=inloc(n)
4002 IF (ndof(j)>0) THEN
4003 CALL reorder_l(nrow(nk),icol(1,nk),j,iddl)
4004 CALL set_ind_k(
4005 1 iddl ,ndof ,iadk ,jdik ,nl ,
4006 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
4007 ENDIF
4008 ENDDO
4009 ENDIF
4010 DO nk=1,jlt
4011 n=nk+nft
4012 k=inloc(n)
4013 iloc(k)=0
4014 ENDDO
4015 ENDDO
4016c-----2. if irk=1 create nrow,icol for all kine. nodes using INLOC()=-INLOC()
4017c modifies nrow,icol .
4018 IF (nkine==0) GOTO 100
4019 nft=numnod-nkine
4020 jlt=nkine
4021 ink=nkine-lcokm
4022C INK=NKINE-NRBYAC
4023 DO nk =1,jlt
4024 n=nk+nft
4025 k=inloc(n)
4026 iloc(k)=nk
4027 ENDDO
4028 IF (irk == 1) THEN
4029 DO nk =1,jlt
4030 nrowk(nk)=0
4031 ENDDO
4032 CALL dim_elems4(
4033 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
4034 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
4035 3 ixs10 ,ixs20 ,ixs16 ,nrowk ,
4036 4 iloc ,nnmax ,icok ,nkmax ,icokm ,
4037 5 ink ,igeo ,elbuf_tab )
4038C
4039 CALL ind_kine_k(npby,lpby,
4040 1 itab ,nrbyac ,irbyac ,nsc ,isij ,
4041 2 nmc ,imij ,nss ,iss ,nint2 ,
4042 3 iint2 ,ipari ,intbuf_tab,nsc2 ,isij2 ,
4043 4 nss2 ,iss2 ,ndof ,nnmax ,nkine ,
4044 5 iloc ,nkmax ,nrowk ,icok ,icokm ,
4045 6 nmc2 ,imij2 ,ink ,irbe3 ,lrbe3 ,
4046 7 iss3 ,irbe2 ,lrbe2 ,isb2 ,nsrb2 )
4047C
4048 IF (ikpat==0) THEN
4049 DO nk =1,jlt
4050 n=nk+nft
4051 j=inloc(n)
4052 IF (nk>ink.AND.nkmax>0) THEN
4053 nj=nk-ink
4054 CALL reorder_j(nrowk(nk),icokm(1,nj),j,iddl)
4055 ELSE
4056 CALL reorder_j(nrowk(nk),icok(1,nk),j,iddl)
4057 ENDIF
4058 ENDDO
4059 ELSE
4060 DO nk =1,jlt
4061 n=nk+nft
4062 j=inloc(n)
4063 IF (nk>ink.AND.nkmax>0) THEN
4064 nj=nk-ink
4065 CALL reorder_l(nrowk(nk),icokm(1,nj),j,iddl)
4066 ELSEIF (nnmax>0) THEN
4067 CALL reorder_l(nrowk(nk),icok(1,nk),j,iddl)
4068 ENDIF
4069 ENDDO
4070 ENDIF
4071 ENDIF
4072C---main nodes of rbodies at last----
4073 DO nk=1,ink
4074 n=nk+nft
4075 j=inloc(n)
4076 IF (ndof(j)>0) THEN
4077 CALL set_ind_k(
4078 1 iddl ,ndof ,iadk ,jdik ,nl ,
4079 2 lenk ,nrowk(nk) ,icok(1,nk),j ,ikpat )
4080 ENDIF
4081 ENDDO
4082 DO nk=1+ink,jlt
4083 n=nk+nft
4084 j=inloc(n)
4085 IF (ndof(j)>0) THEN
4086 nj=nk-ink
4087 CALL set_ind_k(
4088 1 iddl ,ndof ,iadk ,jdik ,nl ,
4089 2 lenk ,nrowk(nk),icokm(1,nj),j ,ikpat )
4090 ENDIF
4091 ENDDO
4092C--------IKPAT=2, rigid body main first----------
4093 ELSE
4094 IF (nkine>0) THEN
4095 nft=0
4096 jlt=nkine
4097 ink=nkine-lcokm
4098C INK=NKINE-NRBYAC
4099 DO nk =1,lcokm
4100 n=nk+nft
4101 k=inloc(n)
4102 iloc(k)=nk+ink
4103 ENDDO
4104 DO nk =1+lcokm,jlt
4105 n=nk+nft
4106 k=inloc(n)
4107 iloc(k)=nk-lcokm
4108 ENDDO
4109 IF (irk == 1) THEN
4110 DO nk =1,jlt
4111 nrowk(nk)=0
4112 ENDDO
4113 CALL dim_elems4(
4114 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
4115 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
4116 3 ixs10 ,ixs20 ,ixs16 ,nrowk ,
4117 4 iloc ,nnmax ,icok ,nkmax ,icokm ,
4118 5 ink ,igeo ,elbuf_tab )
4119C
4120 CALL ind_kine_k(npby,lpby,
4121 1 itab ,nrbyac ,irbyac ,nsc ,isij ,
4122 2 nmc ,imij ,nss ,iss ,nint2 ,
4123 3 iint2 ,ipari ,intbuf_tab,nsc2 ,isij2 ,
4124 4 nss2 ,iss2 ,ndof ,nnmax ,nkine ,
4125 5 iloc ,nkmax ,nrowk ,icok ,icokm ,
4126 6 nmc2 ,imij2 ,ink ,irbe3 ,lrbe3 ,
4127 7 iss3 ,irbe2 ,lrbe2 ,isb2 ,nsrb2 )
4128 DO nk =1,jlt
4129 n=nk+nft
4130 j=inloc(n)
4131 iloc(j)=0
4132 IF (nk>lcokm) THEN
4133 nj=nk-lcokm
4134 CALL reorder_l(nrowk(nj),icok(1,nj),j,iddl)
4135 ELSEIF( nkmax>0) THEN
4136 CALL reorder_l(nrowk(nk+ink),icokm(1,nk),j,iddl)
4137 ENDIF
4138 ENDDO
4139 ENDIF
4140C---main nodes of rbodies first----
4141 DO nk=1,lcokm
4142 n=nk+nft
4143 j=inloc(n)
4144 iloc(j)=0
4145 IF (ndof(j)>0) THEN
4146 CALL set_ind_k(
4147 1 iddl ,ndof ,iadk ,jdik ,nl ,
4148 2 lenk ,nrowk(nk+ink) ,icokm(1,nk),j ,ikpat )
4149 ENDIF
4150 ENDDO
4151 DO nk=lcokm+1,jlt
4152 n=nk+nft
4153 j=inloc(n)
4154 iloc(j)=0
4155 IF (ndof(j)>0) THEN
4156 nj=nk-lcokm
4157 CALL set_ind_k(
4158 1 iddl ,ndof ,iadk ,jdik ,nl ,
4159 2 lenk ,nrowk(nj) ,icok(1,nj),j ,ikpat )
4160 ENDIF
4161 ENDDO
4162 ENDIF
4163 DO nft = nkine , numnod-1 , nnsiz
4164 jlt = min( nnsiz, numnod - nft )
4165 DO nk=1,jlt
4166 n=nk+nft
4167 k=inloc(n)
4168 iloc(k)=nk
4169 nrow(nk)=0
4170 ENDDO
4171 CALL dim_elems3(
4172 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
4173 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
4174 3 ixs10 ,ixs20 ,ixs16 ,nrow ,
4175 4 iloc ,nnmax ,icol ,igeo ,elbuf_tab )
4176 DO nk=1,jlt
4177 n=nk+nft
4178 j=inloc(n)
4179 CALL reorder_l(nrow(nk),icol(1,nk),j,iddl)
4180 IF (ndof(j)>0) THEN
4181 CALL set_ind_k(
4182 1 iddl ,ndof ,iadk ,jdik ,nl ,
4183 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
4184 ENDIF
4185 ENDDO
4186 DO nk=1,jlt
4187 n=nk+nft
4188 k=inloc(n)
4189 iloc(k)=0
4190 ENDDO
4191 ENDDO
4192 ENDIF
4193 100 iadk(nddl+1) = lenk+1
4194 IF (lenk>nnzk.OR.nl/=(nddl+1))
4195 . WRITE(*,*)'--MEMERY PROBLEM 2--:',lenk,nl,nnzk,nddl+1
4196C--- Postive put back ----
4197 nnzk = lenk
4198C----6---------------------------------------------------------------7---------8
4199 RETURN
4200 END
4201!||====================================================================
4202!|| reorder_i ../engine/source/implicit/ind_glob_k.F
4203!||--- called by ------------------------------------------------------
4204!|| dim_elems1 ../engine/source/implicit/ind_glob_k.F
4205!||====================================================================
4206 SUBROUTINE reorder_i(N,IC)
4207C----6---------------------------------------------------------------7---------8
4208C I m p l i c i t T y p e s
4209C-----------------------------------------------
4210#include "implicit_f.inc"
4211C-----------------------------------------------------------------
4212C D u m m y A r g u m e n t s
4213C-----------------------------------------------
4214 INTEGER N ,IC(*)
4215C-----------------------------------------------
4216C L o c a l V a r i a b l e s
4217C-----------------------------------------------
4218 INTEGER I,J,IMIN,IT,II
4219C
4220 IF (N<=0) return
4221 DO i =1,n
4222 imin=ic(i)
4223 ii=i
4224 DO j =i+1,n
4225 IF (ic(j)<imin) THEN
4226 imin=ic(j)
4227 ii=j
4228 ENDIF
4229 ENDDO
4230 it=ic(i)
4231 ic(i)=imin
4232 ic(ii)=it
4233 ENDDO
4234C----delete doubles----------------------------
4235 ii=1
4236 DO i =2,n
4237 IF (ic(i)/=ic(i-1)) THEN
4238 ii =ii +1
4239 ic(ii)=ic(i)
4240 ENDIF
4241 ENDDO
4242 n = ii
4243C----6---------------------------------------------------------------7---------8
4244 RETURN
4245 END
4246!||====================================================================
4247!|| reorder_a ../engine/source/implicit/ind_glob_k.F
4248!||--- called by ------------------------------------------------------
4249!|| dim_elems2 ../engine/source/implicit/ind_glob_k.F
4250!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
4251!|| dim_elems4 ../engine/source/implicit/ind_glob_k.F
4252!|| dim_elemsp ../engine/source/implicit/ind_glob_k.F
4253!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
4254!|| dim_kine_i ../engine/source/implicit/ind_glob_k.f
4255!|| dim_kine_t ../engine/source/implicit/ind_glob_k.f
4256!|| dim_ktot ../engine/source/implicit/ind_glob_k.F
4257!|| dim_spa2 ../engine/source/implicit/ind_glob_k.F
4258!|| dim_span ../engine/source/implicit/ind_glob_k.F
4259!|| ind_fr_k ../engine/source/mpi/implicit/imp_fri.F
4260!|| ind_kine_i ../engine/source/implicit/ind_glob_k.F
4261!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
4262!|| ind_kinfrk ../engine/source/mpi/implicit/imp_fri.F
4263!|| ind_nrfr ../engine/source/mpi/implicit/imp_fri.F
4264!|| ind_nrmax ../engine/source/mpi/implicit/imp_fri.F
4265!|| ind_spa2 ../engine/source/implicit/ind_glob_k.F
4266!|| ind_span ../engine/source/implicit/ind_glob_k.F
4267!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.F
4268!|| kin_nrmax ../engine/source/mpi/implicit/imp_fri.F
4269!|| kin_nrmax0 ../engine/source/mpi/implicit/imp_fri.F
4270!|| rmdim_imp ../engine/source/model/remesh/rm_imp0.F
4271!|| rmind_imp ../engine/source/model/remesh/rm_imp0.F
4272!|| row_adds ../engine/source/implicit/ind_glob_k.F
4273!|| row_int1 ../engine/source/implicit/ind_glob_k.F
4274!|| row_int111 ../engine/source/implicit/ind_glob_k.F
4275!|| row_int2 ../engine/source/implicit/ind_glob_k.F
4276!|| row_int241 ../engine/source/implicit/ind_glob_k.F
4277!|| row_int242 ../engine/source/implicit/ind_glob_k.F
4278!|| row_int51 ../engine/source/implicit/ind_glob_k.F
4279!|| row_int52 ../engine/source/implicit/ind_glob_k.F
4280!|| rowfr_ind ../engine/source/mpi/implicit/imp_fri.f
4281!|| rowfr_ind11 ../engine/source/mpi/implicit/imp_fri.F
4282!|| rowfr_ind24 ../engine/source/mpi/implicit/imp_fri.F
4283!|| spmd_icol ../engine/source/mpi/implicit/imp_spmd.F
4284!||====================================================================
4285 SUBROUTINE reorder_a(N,IC,ID)
4286C----6---------------------------------------------------------------7---------8
4287C I m p l i c i t T y p e s
4288C-----------------------------------------------
4289#include "implicit_f.inc"
4290C-----------------------------------------------------------------
4291C D u m m y A r g u m e n t s
4292C-----------------------------------------------
4293 INTEGER N ,IC(*),ID
4294C-----------------------------------------------
4295C L o c a l V a r i a b l e s
4296C-----------------------------------------------
4297 INTEGER I,IT
4298C
4299C----add ID--at end--------------------------
4300 DO I =1,n
4301 IF (ic(i)==id) RETURN
4302 ENDDO
4303 n =n+1
4304 ic(n)=id
4305C----6---------------------------------------------------------------7---------8
4306 RETURN
4307 END
4308!||====================================================================
4309!|| reorder_a1 ../engine/source/implicit/ind_glob_k.f
4310!||====================================================================
4311 SUBROUTINE reorder_a1(N,IC,ID)
4312C----6---------------------------------------------------------------7---------8
4313C I m p l i c i t T y p e s
4314C-----------------------------------------------
4315#include "implicit_f.inc"
4316C-----------------------------------------------------------------
4317C D u m m y A r g u m e n t s
4318C-----------------------------------------------
4319 INTEGER N ,IC(*),ID
4320C-----------------------------------------------
4321C L o c a l V a r i a b l e s
4322C-----------------------------------------------
4323 INTEGER I,IT
4324C
4325C----add ID--in right order--------------------------
4326 it =n+1
4327 DO i =1,n
4328 IF (ic(i)==id) THEN
4329 RETURN
4330 ELSEIF (ic(i)>id) THEN
4331 it =i
4332 GOTO 10
4333 ENDIF
4334 ENDDO
4335 10 IF (it==1) THEN
4336 DO i =n,it,-1
4337 ic(i+1)=ic(i)
4338 ENDDO
4339 ic(it)=id
4340 n = n+1
4341 ELSEIF (id/=ic(it-1)) THEN
4342 DO i =n,it,-1
4343 ic(i+1)=ic(i)
4344 ENDDO
4345 ic(it)=id
4346 n = n+1
4347 ENDIF
4348C----6---------------------------------------------------------------7---------8
4349 RETURN
4350 END
4351!||====================================================================
4352!|| reorder_j1 ../engine/source/implicit/ind_glob_k.F
4353!||====================================================================
4354 SUBROUTINE reorder_j1(N,IC,NI)
4355C----6---------------------------------------------------------------7---------8
4356C I m p l i c i t T y p e s
4357C-----------------------------------------------
4358#include "implicit_f.inc"
4359C-----------------------------------------------------------------
4360C D u m m y A r g u m e n t s
4361C-----------------------------------------------
4362 INTEGER N ,IC(*),NI
4363C-----------------------------------------------
4364C L o c a l V a r i a b l e s
4365C-----------------------------------------------
4366 INTEGER I,II
4367C
4368 II=0
4369 do i =1,n
4370 IF (ic(i)>ni) THEN
4371 ii =ii +1
4372 ic(ii)=ic(i)
4373 ENDIF
4374 ENDDO
4375 n = ii
4376C----6---------------------------------------------------------------7---------8
4377 RETURN
4378 END
4379!||====================================================================
4380!|| reorder_j ../engine/source/implicit/ind_glob_k.f
4381!||--- called by ------------------------------------------------------
4382!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
4383!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
4384!|| ind_kine_kp ../engine/source/mpi/implicit/imp_fri.F
4385!||====================================================================
4386 SUBROUTINE reorder_j(N,IC,NI,IDDL)
4387C----6---------------------------------------------------------------7---------8
4388C I m p l i c i t T y p e s
4389C-----------------------------------------------
4390#include "implicit_f.inc"
4391C-----------------------------------------------------------------
4392C D u m m y A r g u m e n t s
4393C-----------------------------------------------
4394 INTEGER N ,IC(*),NI,IDDL(*)
4395C-----------------------------------------------
4396C L o c a l V a r i a b l e s
4397C-----------------------------------------------
4398 INTEGER I,J,II,IT,IIC,IMIN,IDIC(N)
4399C
4400 ii=0
4401 it=iddl(ni)
4402 DO i =1,n
4403 iic=iddl(ic(i))
4404 IF (iic>it) THEN
4405 ii =ii +1
4406 ic(ii)=ic(i)
4407 idic(ii)=iic
4408 ENDIF
4409 ENDDO
4410 n = ii
4411 IF (n==0) RETURN
4412C---- In an increasing iddl order -----
4413 DO i =1,n
4414 imin=idic(i)
4415 ii=i
4416 DO j =i+1,n
4417 IF (idic(j)<imin) THEN
4418 imin=idic(j)
4419 ii=j
4420 ENDIF
4421 ENDDO
4422 IF (ii/=i) THEN
4423 it=ic(i)
4424 ic(i)=ic(ii)
4425 ic(ii)=it
4426 it=idic(i)
4427 idic(i)=idic(ii)
4428 idic(ii)=it
4429 ENDIF
4430 ENDDO
4431C----delete doubles----------------------------
4432C II=1
4433C DO I =2,N
4434C IF (IC(I)/=IC(I-1)) THEN
4435C II =II +1
4436C IC(II)=IC(I)
4437C ENDIF
4438C ENDDO
4439C N = II
4440C----6---------------------------------------------------------------7---------8
4441 RETURN
4442 END
4443!||====================================================================
4444!|| reorder_l ../engine/source/implicit/ind_glob_k.F
4445!||--- called by ------------------------------------------------------
4446!|| ind_fr_k0 ../engine/source/mpi/implicit/imp_fri.F
4447!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
4448!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
4449!|| ind_kine_kp ../engine/source/mpi/implicit/imp_fri.F
4450!||====================================================================
4451 SUBROUTINE reorder_l(N,IC,NI,IDDL)
4452C----6---------------------------------------------------------------7---------8
4453C I m p l i c i t T y p e s
4454C-----------------------------------------------
4455#include "implicit_f.inc"
4456C-----------------------------------------------------------------
4457C D u m m y A r g u m e n t s
4458C-----------------------------------------------
4459 INTEGER N ,IC(*),NI,IDDL(*)
4460C-----------------------------------------------
4461C L o c a l V a r i a b l e s
4462C-----------------------------------------------
4463 INTEGER I,J,II,IT,IIC,IMIN,IDIC(N)
4464C
4465 ii=0
4466 it=iddl(ni)
4467 DO i =1,n
4468 iic=iddl(ic(i))
4469 IF (iic<it) THEN
4470 ii =ii +1
4471 ic(ii)=ic(i)
4472 idic(ii)=iic
4473 ENDIF
4474 ENDDO
4475 n = ii
4476 IF (n==0) RETURN
4477C---- In an increasing iddl order -----
4478 DO i =1,n
4479 imin=idic(i)
4480 ii=i
4481 DO j =i+1,n
4482 IF (idic(j)<imin) THEN
4483 imin=idic(j)
4484 ii=j
4485 ENDIF
4486 ENDDO
4487 IF (ii/=i) THEN
4488 it=ic(i)
4489 ic(i)=ic(ii)
4490 ic(ii)=it
4491 it=idic(i)
4492 idic(i)=idic(ii)
4493 idic(ii)=it
4494 ENDIF
4495 ENDDO
4496C----6---------------------------------------------------------------7---------8
4497 RETURN
4498 END
4499!||====================================================================
4500!|| intab ../engine/source/implicit/ind_glob_k.F
4501!||--- called by ------------------------------------------------------
4502!|| degenes8 ../engine/source/elements/solid/solide/degenes8.F
4503!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
4504!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
4505!|| dim_kine_s ../engine/source/implicit/ind_glob_k.F
4506!|| dim_kine_t ../engine/source/implicit/ind_glob_k.F
4507!|| dim_ndof_i ../engine/source/implicit/ind_glob_k.F
4508!|| imp_icomcrit ../engine/source/implicit/imp_int_k.F
4509!|| ind_kine_i ../engine/source/implicit/ind_glob_k.F
4510!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
4511!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.F
4512!|| intabfr ../engine/source/mpi/implicit/imp_fri.f
4513!||====================================================================
4514 LOGICAL FUNCTION intab(NIC,IC,N)
4515C----6---------------------------------------------------------------7---------8
4516C I m p l i c i t T y p e s
4517C-----------------------------------------------
4518#include "implicit_f.inc"
4519C-----------------------------------------------------------------
4520C D u m m y A r g u m e n t s
4521C-----------------------------------------------
4522 INTEGER n ,nic,ic(*)
4523C-----------------------------------------------
4524C L o c a l V a r i a b l e s
4525C-----------------------------------------------
4526 INTEGER i,j
4527C----6---------------------------------------------------------------7---------8
4528 intab=.false.
4529 DO i =1,nic
4530 IF (n==ic(i)) THEN
4531 intab=.true.
4532 RETURN
4533 ENDIF
4534 ENDDO
4535C
4536 RETURN
4537 END
4538!||====================================================================
4539!|| dim_int7 ../engine/source/implicit/ind_glob_k.F
4540!||--- called by ------------------------------------------------------
4541!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
4542!||--- calls -----------------------------------------------------
4543!|| ancmsg ../engine/source/output/message/message.f
4544!|| arret ../engine/source/system/arret.F
4545!|| imp_intbuf_ini ../engine/source/implicit/imp_solv.F
4546!|| intbuf_tab_c_ini ../common_source/interf/copy_intbuf_tab.F
4547!||--- uses -----------------------------------------------------
4548!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
4549!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
4550!|| message_mod ../engine/share/message_module/message_mod.F
4551!||====================================================================
4552 SUBROUTINE dim_int7(
4553 1 NINTER ,IPARI ,INTBUF_TAB ,NNMAX)
4554C-----------------------------------------------
4555C M o d u l e s
4556C-----------------------------------------------
4557 USE imp_intbuf
4558 USE message_mod
4559 USE intbufdef_mod
4560C----6---------------------------------------------------------------7---------8
4561C I m p l i c i t T y p e s
4562C-----------------------------------------------
4563#include "implicit_f.inc"
4564C-----------------------------------------------
4565C C o m m o n B l o c k s
4566C-----------------------------------------------
4567#include "com08_c.inc"
4568#include "param_c.inc"
4569#include "task_c.inc"
4570#include "impl1_c.inc"
4571C-----------------------------------------------------------------
4572C D u m m y A r g u m e n t s
4573C-----------------------------------------------
4574 INTEGER IPARI(NPARI,*),NINTER,NNMAX
4575C REAL
4576 TYPE(intbuf_struct_) INTBUF_TAB(*)
4577C-----------------------------------------------
4578C L o c a l V a r i a b l e s
4579C-----------------------------------------------
4580 INTEGER NIN,NTY,NUM_IMP,NSN,NMN,NRTS,ILEV,NOINT
4581 INTEGER I,J,K,L,NDOFI,N,IAD,IERR,STAT,NIMP(NINTER)
4582 my_real
4583 . startt,stopt
4584C-----------------------------------------------
4585C------interface --------------
4586 nnmax=0
4587 DO nin=1,ninter
4588 nsn =ipari(5,nin)
4589 nmn =ipari(6,nin)
4590 nty =ipari(7,nin)
4591 nimp(nin) = 0
4592C----------deleted int NTY->0
4593 IF (nty ==0 ) cycle
4594 IF (nty ==2 ) THEN
4595 ilev =ipari(20,nin)
4596 noint =ipari(15,nin)
4597 IF (ilev>=10.AND.ilev<=25) THEN
4598 CALL ancmsg(msgid=241,anmode=aninfo,i1=ilev,i2=noint )
4599 CALL arret(2)
4600 END IF
4601 ELSEIF (nty/=5 .AND. nty/=7 .AND. nty/=10
4602 . .AND. nty/=11 .AND. nty/=24) THEN
4603 startt=intbuf_tab(nin)%VARIABLES(3)
4604 stopt =intbuf_tab(nin)%VARIABLES(11)
4605 IF(startt<tstop)
4606 . CALL ancmsg(msgid=232,anmode=aninfo,i1=nty )
4607 END IF
4608C-----as int5 uses only ISPMD=0 ; some values are not initialized w/ ISPMD/=0
4609 IF (ispmd/=0.AND.(nty<7.OR.nty==8
4610 . .OR.nty==14.OR.nty==15)) cycle
4611 startt=intbuf_tab(nin)%VARIABLES(3)
4612 stopt =intbuf_tab(nin)%VARIABLES(11)
4613 IF(startt<=tstop) THEN
4614 IF(nty==3)THEN
4615 ELSEIF(nty==4)THEN
4616 ELSEIF(nty==5)THEN
4617 nnmax=nnmax+nsn
4618 ELSEIF(nty==6)THEN
4619
4620 ELSEIF(nty==7.OR.nty==10.OR.nty==24)THEN
4621 num_imp = ipari(18,nin)*ipari(23,nin)
4622 nnmax=nnmax+num_imp
4623C--------exceptionaly to deactivate kg
4624 IF(nty==24.AND.iikgoff==0.AND.ikg==0)THEN
4625 iikgoff = 1
4626 END IF
4627C-------dispense i24disk---
4628 IF(nty==24) nimp(nin) = num_imp
4629C
4630 ELSEIF(nty==11)THEN
4631 num_imp = ipari(18,nin)*ipari(23,nin)
4632 nnmax=nnmax+num_imp
4633C
4634 ENDIF
4635 ENDIF
4636 ENDDO
4637C-----------Allocate INTBUF_TAB_CP for implicit
4638 ALLOCATE (intbuf_tab_cp(ninter), stat=stat)
4639 CALL intbuf_tab_c_ini(intbuf_tab, intbuf_tab_cp)
4640C-----------Allocate IMP_INTBUF_TAB for implicit
4641 ALLOCATE (intbuf_tab_imp(ninter), stat=stat)
4642 CALL imp_intbuf_ini(intbuf_tab_imp, nimp)
4643C----6---------------------------------------------------------------7---------8
4644 RETURN
4645 END
4646!||====================================================================
4647!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
4648!||--- called by ------------------------------------------------------
4649!|| imp_chkm ../engine/source/implicit/imp_solv.F
4650!|| imp_solv ../engine/source/implicit/imp_solv.f
4651!||--- calls -----------------------------------------------------
4652!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
4653!|| nddl_loc ../engine/source/implicit/ind_glob_k.F
4654!|| row_int ../engine/source/implicit/ind_glob_k.F
4655!|| row_int11 ../engine/source/implicit/ind_glob_k.F
4656!|| row_int24 ../engine/source/implicit/ind_glob_k.F
4657!|| row_int5 ../engine/source/implicit/ind_glob_k.F
4658!||--- uses -----------------------------------------------------
4659!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
4660!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
4661!||====================================================================
4662 SUBROUTINE dim_int_k(
4663 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
4664 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
4665 3 LNSS ,NINT2 ,IINT2 ,IAINT2 ,LNSS2 ,
4666 4 NDDL ,NNZK ,IDDL ,ILOCI ,N_IMPN ,
4667 5 N_IMPM ,NNMAX ,NKMAX ,NDOF ,NSREM ,
4668 6 IRBE3 ,LRBE3 ,LNSS3 ,IRBE2 ,LRBE2 ,
4669 7 LNSB2 ,LNSRB2 ,IND_SUBT )
4670C-----------------------------------------------
4671C M o d u l e s
4672C-----------------------------------------------
4673 USE intbufdef_mod
4674 USE imp_intbuf
4675C----6---------------------------------------------------------------7---------8
4676C I m p l i c i t T y p e s
4677C-----------------------------------------------
4678#include "implicit_f.inc"
4679C-----------------------------------------------
4680C C o m m o n B l o c k s
4681C-----------------------------------------------
4682#include "com04_c.inc"
4683#include "param_c.inc"
4684C-----------------------------------------------------------------
4685C D u m m y A r g u m e n t s
4686C-----------------------------------------------
4687 INTEGER IPARI(NPARI,*),NUM_IMP(*),
4688 . NS_IMP(*),NE_IMP(*),ILOCI(*),NDOF(*)
4689 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
4690 . lnss,nint2,iint2(*),iaint2(*),lnss2,nsrem
4691 INTEGER
4692 . nddl,iddl(*) ,nnzk,n_impn,n_impm,nnmax ,nkmax
4693 INTEGER IRBE3(NRBE3L,*),LRBE3(*),LNSS3,IRBE2(NRBE2L,*),LRBE2(*),
4694 . lnsb2,lnsrb2,ind_subt(*)
4695C REAL
4696
4697 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
4698C-----------------------------------------------
4699C L o c a l V a r i a b l e s
4700C-----------------------------------------------
4701 INTEGER NIN,NTY,NDOF1(NUMNOD),NSN
4702 INTEGER I,J,K,L,NDOFI,N,IAD,N_IMP,
4703 . nrts
4704C-----------------------------------------------
4705C------interface ----iddl used for nrow firstly----------
4706 nddl =0
4707 ndofi=3
4708 DO n =1,numnod
4709 iddl(n)=0
4710 iloci(n)=0
4711 ndof1(n)=ndofi
4712 ENDDO
4713C
4714 iad=1
4715 n_imp=0
4716 DO nin=1,ninter
4717 nty =ipari(7,nin)
4718 nsn =ipari(5,nin)
4719 IF(nty==3)THEN
4720 ELSEIF(nty==4)THEN
4721 ELSEIF(nty==5)THEN
4722 CALL row_int5(num_imp(nin),ns_imp(iad),ne_imp(iad),intbuf_tab(nin)%IRECTM,
4723 . intbuf_tab(nin)%NSV, intbuf_tab(nin)%MSR,iddl ,iloci ,ndofi,n_imp ,
4724 . nsn ,nsrem )
4725 iad=iad+num_imp(nin)
4726 ENDIF
4727 ENDDO
4728C IAD=1
4729 DO nin=1,ninter
4730 nty =ipari(7,nin)
4731 nsn =ipari(5,nin)
4732C MULTIMP=MAX(MULTIMP,IPARI(23,NIN))
4733 IF(nty==3)THEN
4734 ELSEIF(nty==4)THEN
4735 ELSEIF(nty==5)THEN
4736 ELSEIF(nty==6)THEN
4737
4738 ELSEIF(nty==7.OR.nty==10)THEN
4739C
4740 CALL row_int(num_imp(nin),ns_imp(iad),ne_imp(iad),intbuf_tab(nin)%IRECTM,
4741 . intbuf_tab(nin)%NSV, iddl ,iloci ,ndofi,n_imp ,
4742 . nsn ,nsrem )
4743 iad=iad+num_imp(nin)
4744 ELSEIF(nty==24)THEN
4745C
4746c CALL ROW_INT24(NUM_IMP(NIN),NS_IMP(IAD),NE_IMP(IAD),INTBUF_TAB(NIN)%IRECTM,
4747c . INTBUF_TAB(NIN)%NSV, IDDL ,ILOCI ,NDOFI,N_IMP ,
4748c . NSN ,NSREM ,IND_SUBT,INTBUF_TAB(NIN)%NVOISIN)
4749 CALL row_int24(intbuf_tab_imp(nin)%I_STOK(1),intbuf_tab_imp(nin)%CAND_N,
4750 . intbuf_tab_imp(nin)%CAND_E,intbuf_tab(nin)%IRECTM,
4751 . intbuf_tab(nin)%NSV, iddl ,iloci ,ndofi,n_imp ,
4752 . nsn ,nsrem ,intbuf_tab_imp(nin)%INDSUBT,
4753 . intbuf_tab(nin)%NVOISIN)
4754 iad=iad+num_imp(nin)
4755 ELSEIF(nty==11)THEN
4756C
4757 nrts =ipari(3,nin)
4758 CALL row_int11(num_imp(nin),ns_imp(iad),ne_imp(iad),
4759 . intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%IRECTM, iddl ,iloci,
4760 . ndofi,n_imp ,nrts ,nsrem )
4761 iad=iad+num_imp(nin)
4762 ENDIF
4763 ENDDO
4764 nnmax=0
4765 DO n =1,numnod
4766 IF (iloci(n)>0) THEN
4767 nnmax=max(nnmax,iddl(n))
4768 iddl(n)=0
4769 ENDIF
4770 ENDDO
4771C-----coupling with kinematic conditions ------
4772 n_impm=n_imp
4773 CALL dim_kine_i(
4774 1 num_imp ,ns_imp ,ne_imp ,npby ,lpby ,
4775 2 itab ,nrbyac ,irbyac ,nint2 ,iint2 ,
4776 3 ipari ,intbuf_tab,lnss ,lnss2 ,iddl ,
4777 4 n_imp ,iloci ,nnmax ,n_impm ,ndof ,
4778 5 ndof1 ,iaint2 ,irbe3 ,lrbe3 ,lnss3 ,
4779 6 irbe2 ,lrbe2 ,lnsb2 ,lnsrb2 ,ind_subt )
4780c-----1. calcule NNMAX,NKMAX;
4781 n_impn=n_imp-n_impm
4782 nnmax=0
4783 nkmax=0
4784 DO n =1,numnod
4785 IF (iloci(n)>0) THEN
4786 IF (iloci(n)>n_impn) THEN
4787 nkmax=max(nkmax,iddl(n))
4788 ELSE
4789 nnmax=max(nnmax,iddl(n))
4790 ndof1(n)=max(3,ndof1(n))
4791 ENDIF
4792 ENDIF
4793 ENDDO
4794c-----2. calcule NNZK;
4795 nnzk = 0
4796 DO n =1,numnod
4797 IF (iloci(n)>0) THEN
4798 DO k=1,ndof1(n)
4799C-------termes knn-------
4800 DO j=1,ndof1(n)
4801 IF (j/=k) nnzk = nnzk+1
4802 ENDDO
4803C-------termes kn,nj-------
4804 DO j=1,iddl(n)
4805 DO l=1,ndof1(n)
4806 nnzk = nnzk+1
4807 ENDDO
4808 ENDDO
4809 ENDDO
4810 ENDIF
4811 ENDDO
4812 nnzk = nnzk/2+1
4813c write(*,*)'int NNMAX,NKMAX,N_IMP=',NNMAX,NKMAX,N_IMP
4814c-----3. calculation NDDL,IDDL;
4815 CALL nddl_loc(nddl,iddl,iloci,n_imp,ndof1)
4816C----6---------------------------------------------------------------7---------8
4817 RETURN
4818 END
4819C --------- stockage M.C.R.S + SYM- -----
4820!||====================================================================
4821!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
4822!||--- called by ------------------------------------------------------
4823!|| imp_chkm ../engine/source/implicit/imp_solv.F
4824!|| imp_solv ../engine/source/implicit/imp_solv.F
4825!||--- calls -----------------------------------------------------
4826!|| ind_kine_i ../engine/source/implicit/ind_glob_k.F
4827!|| reorder_j ../engine/source/implicit/ind_glob_k.F
4828!|| reorder_l ../engine/source/implicit/ind_glob_k.F
4829!|| row_int112 ../engine/source/implicit/ind_glob_k.F
4830!|| row_int2 ../engine/source/implicit/ind_glob_k.F
4831!|| row_int242 ../engine/source/implicit/ind_glob_k.F
4832!|| row_int52 ../engine/source/implicit/ind_glob_k.F
4833!|| set_ind_k ../engine/source/implicit/ind_glob_k.F
4834!||--- uses -----------------------------------------------------
4835!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
4836!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
4837!||====================================================================
4838 SUBROUTINE ind_int_k(
4839 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
4840 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
4841 3 NSS ,ISS ,NINT2 ,IINT2 ,NSS2 ,
4842 4 ISS2 ,NDDLI ,NNZI ,IADI ,JDII ,
4843 5 IDDLI ,ILOCI ,N_IMPN ,ITOK ,IDDL ,
4844 6 NNMAX ,NKMAX ,N_IMPM ,NDOF ,IAINT2 ,
4845 7 IRBE3 ,LRBE3 ,NSS3 ,ISS3 ,IRBE2 ,
4846 8 LRBE2 ,NSB2 ,ISB2 ,IND_SUBT )
4847C-----------------------------------------------
4848C M o d u l e s
4849C-----------------------------------------------
4850 USE intbufdef_mod
4851 USE imp_intbuf
4852C----6---------------------------------------------------------------7---------8
4853C I m p l i c i t T y p e s
4854C-----------------------------------------------
4855#include "implicit_f.inc"
4856C-----------------------------------------------
4857C C o m m o n B l o c k s
4858C-----------------------------------------------
4859#include "com04_c.inc"
4860#include "param_c.inc"
4861#include "impl1_c.inc"
4862C-----------------------------------------------------------------
4863C D u m m y A r g u m e n t s
4864C-----------------------------------------------
4865 INTEGER NUM_IMP(*),IPARI(NPARI,*),IND_SUBT(*),
4866 . ns_imp(*),ne_imp(*) ,ndof(*),iaint2(*),lrb,li2
4867 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
4868 . nss(*),iss(*),nint2,iint2(*),nss2(*),iss2(*)
4869 INTEGER
4870 . IDDL(*),IADI(*),JDII(*),IDDLI(*),ITOK(*),
4871 . ILOCI(*),NDDLI ,NNZI,NNMAX,N_IMPN,N_IMPM,NKMAX
4872 INTEGER IRBE3(NRBE3L,*),LRBE3(*),NSS3(*),ISS3(*),
4873 . irbe2(nrbe2l,*),lrbe2(*),nsb2(*),isb2(*)
4874C REAL
4875
4876 TYPE(intbuf_struct_) INTBUF_TAB(*)
4877C=======================================================================
4878C stockage M.C.R.S (Modified Compressed Row Stockage)
4879C [K] For interfaces: diagonal + trangle sup in lines:
4880C [K](id,jd) -> DIAG(NDDL)+LT(IK)(exclue diag)
4881C id = 1..nddl : ID = IADI(ID)...IADI(ID+1)-1
4882C jd = 1..NNZI : JD = JDII(IK)
4883C IADI(NDDLI+1)
4884C JDII(NNZK)
4885C ITOK(NDDLI) : L'indice de [K] global:NDDLI->NDDL
4886C-----------------------------------------------
4887C L o c a l V a r i a b l e s
4888C-----------------------------------------------
4889 INTEGER NROW(N_IMPN+N_IMPM),ICOL(NNMAX,N_IMPN),
4890 . NDOF1(N_IMPN+N_IMPM),ICOK(NKMAX,N_IMPM),IKP
4891 INTEGER I,J,K,L,N,KD(50), JFI, KFI,NDOFI,ND,N_IMPT,
4892 . nty,nl,nj,nin,lenk,iad,iloc(n_impn+n_impm),
4893 . nsn,nrts
4894C-----------------------------------------------
4895C------ILOCI is ILOC in IND_GLOB_K --------------
4896C
4897 ikp=ikpat
4898 ndofi=3
4899 nd=0
4900 n_impt=n_impn+n_impm
4901 DO n =1,numnod
4902 IF (iloci(n)>0) THEN
4903 i=iloci(n)
4904 iloc(i)=n
4905 ndof1(i)=ndofi
4906 ENDIF
4907 ENDDO
4908 DO n =1,n_impt
4909 nrow(n)=0
4910 ENDDO
4911C
4912 iad=1
4913 DO nin=1,ninter
4914 nty =ipari(7,nin)
4915 nsn =ipari(5,nin)
4916 IF(nty==3)THEN
4917 ELSEIF(nty==4)THEN
4918 ELSEIF(nty==5)THEN
4919 CALL row_int52(num_imp(nin),ns_imp(iad),ne_imp(iad),
4920 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,
4921 . intbuf_tab(nin)%MSR,nrow ,
4922 . n_impn,iloci ,icol ,nnmax ,icok ,
4923 . nkmax ,nsn )
4924 iad=iad+num_imp(nin)
4925 ENDIF
4926 ENDDO
4927C IAD=1
4928 DO nin=1,ninter
4929 nty =ipari(7,nin)
4930 nsn =ipari(5,nin)
4931 IF(nty==3)THEN
4932 ELSEIF(nty==4)THEN
4933 ELSEIF(nty==5)THEN
4934 ELSEIF(nty==6)THEN
4935
4936 ELSEIF(nty==7.OR.nty==10)THEN
4937C
4938 CALL row_int2(num_imp(nin),ns_imp(iad),ne_imp(iad),
4939 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,nrow ,n_impn,
4940 . iloci ,icol ,nnmax ,icok ,nkmax ,
4941 . nsn )
4942 iad=iad+num_imp(nin)
4943 ELSEIF(nty==24)THEN
4944C
4945c CALL ROW_INT242(NUM_IMP(NIN),NS_IMP(IAD),NE_IMP(IAD),
4946c . INTBUF_TAB(NIN)%IRECTM,INTBUF_TAB(NIN)%NSV,NROW ,N_IMPN,
4947c . ILOCI ,ICOL ,NNMAX ,ICOK ,NKMAX ,
4948c . NSN ,IND_SUBT,INTBUF_TAB(NIN)%NVOISIN)
4949 CALL row_int242(intbuf_tab_imp(nin)%I_STOK(1),intbuf_tab_imp(nin)%CAND_N,
4950 . intbuf_tab_imp(nin)%CAND_E,intbuf_tab(nin)%IRECTM,
4951 . intbuf_tab(nin)%NSV,nrow ,n_impn,
4952 . iloci ,icol ,nnmax ,icok ,nkmax ,
4953 . nsn ,intbuf_tab_imp(nin)%INDSUBT,
4954 . intbuf_tab(nin)%NVOISIN)
4955 iad=iad+num_imp(nin)
4956 ELSEIF(nty==11)THEN
4957C
4958 nrts =ipari(3,nin)
4959 CALL row_int112(num_imp(nin),ns_imp(iad),ne_imp(iad),
4960 . intbuf_tab(nin)%IRECTS ,intbuf_tab(nin)%IRECTM, nrow ,n_impn,
4961 . iloci ,icol ,nnmax ,icok ,nkmax ,
4962 . nrts )
4963 iad=iad+num_imp(nin)
4964 ENDIF
4965 ENDDO
4966 CALL ind_kine_i(
4967 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
4968 2 nss ,iss ,nint2 ,iint2 ,ipari ,
4969 3 intbuf_tab,nss2 ,iss2 ,nnmax ,iloci ,
4970 4 nkmax ,nrow ,icol ,icok ,n_impn ,
4971 5 ndof ,ndof1 ,iaint2 ,irbe3 ,lrbe3 ,
4972 6 nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
4973 7 isb2 )
4974 IF (ikp==0) THEN
4975 DO i =1,n_impn
4976 n=iloc(i)
4977 CALL reorder_j(nrow(i),icol(1,i),n,iddli)
4978 ENDDO
4979 DO i =n_impn+1,n_impt
4980 n=iloc(i)
4981 nj=i-n_impn
4982 CALL reorder_j(nrow(i),icok(1,nj),n,iddli)
4983 ENDDO
4984 ELSE
4985 DO i =1,n_impn
4986 n=iloc(i)
4987 CALL reorder_l(nrow(i),icol(1,i),n,iddli)
4988 ENDDO
4989 DO i =n_impn+1,n_impt
4990 n=iloc(i)
4991 nj=i-n_impn
4992 CALL reorder_l(nrow(i),icok(1,nj),n,iddli)
4993 ENDDO
4994 ENDIF
4995C-----revinir ndof---
4996 DO i =1,n_impn
4997 ndof1(i)=max(3,ndof1(i))
4998 ENDDO
4999 DO i =1,n_impt
5000 n=iloc(i)
5001 iloci(n)=ndof1(i)
5002 ENDDO
5003 nd =0
5004 lenk = 0
5005 nl = 1
5006 iadi(nl) = 1
5007 DO i =1,n_impn
5008 n=iloc(i)
5009 DO k=1,ndof1(i)
5010 nd = nd + 1
5011 itok(nd)=iddl(n)+k
5012 ENDDO
5013 CALL set_ind_k(
5014 1 iddli ,iloci ,iadi ,jdii ,nl ,
5015 2 lenk ,nrow(i) ,icol(1,i) ,n ,ikp )
5016 ENDDO
5017 DO i =n_impn+1,n_impt
5018 n=iloc(i)
5019 nj=i-n_impn
5020 DO k=1,ndof1(i)
5021 nd = nd + 1
5022 itok(nd)=iddl(n)+k
5023 ENDDO
5024 CALL set_ind_k(
5025 1 iddli ,iloci ,iadi ,jdii ,nl ,
5026 2 lenk ,nrow(i) ,icok(1,nj) ,n ,ikp )
5027 ENDDO
5028 IF (lenk>nnzi.OR.nl/=(nddli+1))
5029 . WRITE(*,*)'--MEMERY PROBLEM 5-- :',lenk,nnzi,nl,nddli+1
5030 nnzi = lenk
5031C----6---------------------------------------------------------------7---------8
5032 RETURN
5033 END
5034C --------- ----
5035!||====================================================================
5036!|| nddl_loc ../engine/source/implicit/ind_glob_k.F
5037!||--- called by ------------------------------------------------------
5038!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5039!||====================================================================
5040 SUBROUTINE nddl_loc(
5041 1 NDDL ,IDDL ,ILOC ,NLOC ,NDOF )
5042C----6---------------------------------------------------------------7---------8
5043C I m p l i c i t T y p e s
5044C-----------------------------------------------
5045#include "implicit_f.inc"
5046C-----------------------------------------------
5047C C o m m o n B l o c k s
5048C-----------------------------------------------
5049#include "com04_c.inc"
5050C-----------------------------------------------------------------
5051C D u m m y A r g u m e n t s
5052C-----------------------------------------------
5053 INTEGER NDDL ,IDDL(*) ,ILOC(*) ,NLOC,NDOF(*)
5054C REAL
5055C-----------------------------------------------
5056C L o c a l V a r i a b l e s
5057C-----------------------------------------------
5058 INTEGER I,N,LOCI(NLOC)
5059C-----------------------------------------------
5060 NDDL=0
5061 DO n = 1, numnod
5062 IF (iloc(n)>0) THEN
5063 i=iloc(n)
5064 loci(i)=n
5065 ENDIF
5066 iddl(n)=nddl
5067 ENDDO
5068 DO i=1,nloc
5069 n=loci(i)
5070 iddl(n)=nddl
5071 nddl = nddl + ndof(n)
5072 ENDDO
5073C----6---------------------------------------------------------------7---------8
5074 RETURN
5075 END
5076C --------- ----
5077!||====================================================================
5078!|| row_int ../engine/source/implicit/ind_glob_k.F
5079!||--- called by ------------------------------------------------------
5080!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5081!||====================================================================
5082 SUBROUTINE row_int(
5083 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5084 2 NROW ,ILOC ,NDOFI ,N_IMPN ,NSN ,
5085 3 NSREM )
5086C----6---------------------------------------------------------------7---------8
5087C I m p l i c i t T y p e s
5088C-----------------------------------------------
5089#include "implicit_f.inc"
5090C-----------------------------------------------
5091C D u m m y A r g u m e n t s
5092C-----------------------------------------------
5093 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5094 . iloc(*),ndofi,n_impn,nsn,nsrem
5095C REAL
5096C-----------------------------------------------
5097C L o c a l V a r i a b l e s
5098C-----------------------------------------------
5099 INTEGER I,J,N,N1,N2,NE,IG
5100C-----------------------------------------------
5101 DO i = 1, jlt
5102C--------second node-----
5103 ig = ns_imp(i)
5104 IF (ig<=nsn) THEN
5105 n1 = nsv(ig)
5106 IF (iloc(n1)==0) THEN
5107 n_impn=n_impn+1
5108 iloc(n1)=n_impn
5109 ENDIF
5110 nrow(n1)=nrow(n1)+3
5111 ELSE
5112 nsrem=nsrem+1
5113 ENDIF
5114 ne=ne_imp(i)
5115 DO j=1,3
5116 n=irect(j,ne)
5117 IF (iloc(n)==0) THEN
5118 n_impn=n_impn+1
5119 iloc(n)=n_impn
5120 ENDIF
5121 nrow(n)=nrow(n)+1
5122 ENDDO
5123 IF (irect(3,ne)/=irect(4,ne)) THEN
5124 n=irect(4,ne)
5125 IF (iloc(n)==0) THEN
5126 n_impn=n_impn+1
5127 iloc(n)=n_impn
5128 ENDIF
5129 nrow(n)=nrow(n)+1
5130 IF (ig<=nsn) nrow(n1)=nrow(n1)+1
5131 ENDIF
5132 ENDDO
5133C----6---------------------------------------------------------------7---------8
5134 RETURN
5135 END
5136C --------- ----
5137!||====================================================================
5138!|| row_int1 ../engine/source/implicit/ind_glob_k.F
5139!||--- called by ------------------------------------------------------
5140!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
5141!||--- calls -----------------------------------------------------
5142!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5143!||====================================================================
5144 SUBROUTINE row_int1(
5145 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5146 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
5147 3 NSN )
5148C----6---------------------------------------------------------------7---------8
5149C I m p l i c i t T y p e s
5150C-----------------------------------------------
5151#include "implicit_f.inc"
5152C-----------------------------------------------
5153C D u m m y A r g u m e n t s
5154C-----------------------------------------------
5155 INTEGER NNMAX
5156 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5157 . ILOC(*),ICOL(NNMAX,*),N_IMPN,NSN
5158C REAL
5159C-----------------------------------------------
5160C L o c a l V a r i a b l e s
5161C-----------------------------------------------
5162 INTEGER I,J,N,N1,N2,NE,IG,NI
5163C-----------------------------------------------
5164C---------ICOL : LOCAL NODE NUMBER--------
5165 DO I = 1, jlt
5166C--------second node-----
5167 ig = ns_imp(i)
5168 IF (ig<=nsn) THEN
5169 n1 = nsv(ig)
5170 ne=ne_imp(i)
5171 ni=iloc(n1)
5172 DO j=1,3
5173 n=irect(j,ne)
5174 n2=iloc(n)
5175 CALL reorder_a(nrow(n1),icol(1,ni),n)
5176 CALL reorder_a(nrow(n),icol(1,n2),n1)
5177 ENDDO
5178 IF (irect(3,ne)/=irect(4,ne)) THEN
5179 n=irect(4,ne)
5180 n2 =iloc(n)
5181 CALL reorder_a(nrow(n1),icol(1,ni),n)
5182 CALL reorder_a(nrow(n),icol(1,n2),n1)
5183 ENDIF
5184 ENDIF
5185 ENDDO
5186C----6---------------------------------------------------------------7---------8
5187 RETURN
5188 END
5189C --------- ----
5190!||====================================================================
5191!|| row_int2 ../engine/source/implicit/ind_glob_k.F
5192!||--- called by ------------------------------------------------------
5193!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
5194!||--- calls -----------------------------------------------------
5195!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5196!||====================================================================
5197 SUBROUTINE row_int2(
5198 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5199 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
5200 3 ICOK ,NKMAX ,NSN )
5201C----6---------------------------------------------------------------7---------8
5202C I m p l i c i t T y p e s
5203C-----------------------------------------------
5204#include "implicit_f.inc"
5205C-----------------------------------------------
5206C D u m m y A r g u m e n t s
5207C-----------------------------------------------
5208 INTEGER NNMAX,NKMAX
5209 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5210 . ILOC(*),ICOL(NNMAX,*),ICOK(NKMAX,*),N_IMPN,NSN
5211C REAL
5212C-----------------------------------------------
5213C L o c a l V a r i a b l e s
5214C-----------------------------------------------
5215 INTEGER I,J,N,N1,N2,NE,IG,NI,NM,NIM
5216C-----------------------------------------------
5217C---------ICOL : LOCAL NODE NUMBER--------
5218 DO I = 1, jlt
5219C--------second node-----
5220 ig = ns_imp(i)
5221 IF (ig<=nsn) THEN
5222 n1 = nsv(ig)
5223 ne=ne_imp(i)
5224 ni=iloc(n1)
5225 IF (ni<=n_impn) THEN
5226 DO j=1,3
5227 n=irect(j,ne)
5228 n2=iloc(n)
5229 CALL reorder_a(nrow(ni),icol(1,ni),n)
5230 IF (n2<=n_impn) THEN
5231 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5232 ELSE
5233 nm=n2- n_impn
5234 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5235 ENDIF
5236 ENDDO
5237 IF (irect(3,ne)/=irect(4,ne)) THEN
5238 n=irect(4,ne)
5239 n2 =iloc(n)
5240 CALL reorder_a(nrow(ni),icol(1,ni),n)
5241 IF (n2<=n_impn) THEN
5242 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5243 ELSE
5244 nm=n2- n_impn
5245 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5246 ENDIF
5247 ENDIF
5248 ELSE
5249 nim=ni-n_impn
5250 DO j=1,3
5251 n=irect(j,ne)
5252 n2=iloc(n)
5253 CALL reorder_a(nrow(ni),icok(1,nim),n)
5254 IF (n2<=n_impn) THEN
5255 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5256 ELSE
5257 nm=n2- n_impn
5258 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5259 ENDIF
5260 ENDDO
5261 IF (irect(3,ne)/=irect(4,ne)) THEN
5262 n=irect(4,ne)
5263 n2 =iloc(n)
5264 CALL reorder_a(nrow(ni),icok(1,nim),n)
5265 IF (n2<=n_impn) THEN
5266 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5267 ELSE
5268 nm=n2- n_impn
5269 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5270 ENDIF
5271 ENDIF
5272 ENDIF
5273 END IF
5274 ENDDO
5275C----6---------------------------------------------------------------7---------8
5276 RETURN
5277 END
5278C --------- ----
5279!||====================================================================
5280!|| row_int5 ../engine/source/implicit/ind_glob_k.F
5281!||--- called by ------------------------------------------------------
5282!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5283!||====================================================================
5284 SUBROUTINE row_int5(
5285 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5286 2 MSR ,NROW ,ILOC ,NDOFI ,N_IMPN ,
5287 3 NSN ,NSREM )
5288C----6---------------------------------------------------------------7---------8
5289C I m p l i c i t T y p e s
5290C-----------------------------------------------
5291#include "implicit_f.inc"
5292C-----------------------------------------------
5293C D u m m y A r g u m e n t s
5294C-----------------------------------------------
5295 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5296 . msr(*),iloc(*),ndofi,n_impn,nsn,nsrem
5297C REAL
5298C-----------------------------------------------
5299C L o c a l V a r i a b l e s
5300C-----------------------------------------------
5301 INTEGER I,J,N,N1,N2,NE,IG
5302C-----------------------------------------------
5303 DO i = 1, jlt
5304C--------second node-----
5305 ig = ns_imp(i)
5306 n1 = nsv(ig)
5307 IF (iloc(n1)==0) THEN
5308 n_impn=n_impn+1
5309 iloc(n1)=n_impn
5310 ENDIF
5311 nrow(n1)=nrow(n1)+3
5312 ne=ne_imp(i)
5313 DO j=1,3
5314 n=msr(irect(j,ne))
5315 IF (iloc(n)==0) THEN
5316 n_impn=n_impn+1
5317 iloc(n)=n_impn
5318 ENDIF
5319 nrow(n)=nrow(n)+1
5320 ENDDO
5321 IF (irect(3,ne)/=irect(4,ne)) THEN
5322 n=msr(irect(4,ne))
5323 IF (iloc(n)==0) THEN
5324 n_impn=n_impn+1
5325 iloc(n)=n_impn
5326 ENDIF
5327 nrow(n)=nrow(n)+1
5328 IF (ig<=nsn) nrow(n1)=nrow(n1)+1
5329 ENDIF
5330 ENDDO
5331C----6---------------------------------------------------------------7---------8
5332 RETURN
5333 END
5334C --------- ----
5335!||====================================================================
5336!|| row_int51 ../engine/source/implicit/ind_glob_k.F
5337!||--- called by ------------------------------------------------------
5338!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
5339!||--- calls -----------------------------------------------------
5340!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5341!||====================================================================
5342 SUBROUTINE row_int51(
5343 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5344 2 MSR ,NROW ,N_IMPN ,ILOC ,ICOL ,
5345 3 NNMAX ,NSN )
5346C----6---------------------------------------------------------------7---------8
5347C I m p l i c i t T y p e s
5348C-----------------------------------------------
5349#include "implicit_f.inc"
5350C-----------------------------------------------
5351C D u m m y A r g u m e n t s
5352C-----------------------------------------------
5353 INTEGER NNMAX
5354 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5355 . iloc(*),icol(nnmax,*),n_impn,nsn,msr(*)
5356C REAL
5357C-----------------------------------------------
5358C L o c a l V a r i a b l e s
5359C-----------------------------------------------
5360 INTEGER I,J,N,N1,N2,NE,IG,NI
5361C-----------------------------------------------
5362C---------ICOL : LOCAL NODE NUMBER--------
5363 DO i = 1, jlt
5364C--------second node-----
5365 ig = ns_imp(i)
5366 n1 = nsv(ig)
5367 ne=ne_imp(i)
5368 ni=iloc(n1)
5369 DO j=1,3
5370 n=msr(irect(j,ne))
5371 n2=iloc(n)
5372 CALL reorder_a(nrow(n1),icol(1,ni),n)
5373 CALL reorder_a(nrow(n),icol(1,n2),n1)
5374 ENDDO
5375 IF (irect(3,ne)/=irect(4,ne)) THEN
5376 n=msr(irect(4,ne))
5377 n2 =iloc(n)
5378 CALL reorder_a(nrow(n1),icol(1,ni),n)
5379 CALL reorder_a(nrow(n),icol(1,n2),n1)
5380 ENDIF
5381 ENDDO
5382C----6---------------------------------------------------------------7---------8
5383 RETURN
5384 END
5385C --------- ----
5386!||====================================================================
5387!|| row_int52 ../engine/source/implicit/ind_glob_k.F
5388!||--- called by ------------------------------------------------------
5389!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
5390!||--- calls -----------------------------------------------------
5391!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5392!||====================================================================
5393 SUBROUTINE row_int52(
5394 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5395 2 MSR ,NROW ,N_IMPN ,ILOC ,ICOL ,
5396 3 NNMAX ,ICOK ,NKMAX ,NSN )
5397C----6---------------------------------------------------------------7---------8
5398C I m p l i c i t T y p e s
5399C-----------------------------------------------
5400#include "implicit_f.inc"
5401C-----------------------------------------------
5402C D u m m y A r g u m e n t s
5403C-----------------------------------------------
5404 INTEGER NNMAX,NKMAX
5405 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5406 . iloc(*),icol(nnmax,*),icok(nkmax,*),n_impn,nsn,msr(*)
5407C REAL
5408C-----------------------------------------------
5409C L o c a l V a r i a b l e s
5410C-----------------------------------------------
5411 INTEGER I,J,N,N1,N2,NE,IG,NI,NM,NIM
5412C-----------------------------------------------
5413C---------ICOL : LOCAL NODE NUMBER--------
5414 DO i = 1, jlt
5415C--------second node-----
5416 ig = ns_imp(i)
5417 n1 = nsv(ig)
5418 ne=ne_imp(i)
5419 ni=iloc(n1)
5420 IF (ni<=n_impn) THEN
5421 DO j=1,3
5422 n=msr(irect(j,ne))
5423 n2=iloc(n)
5424 CALL reorder_a(nrow(ni),icol(1,ni),n)
5425 IF (n2<=n_impn) THEN
5426 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5427 ELSE
5428 nm=n2- n_impn
5429 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5430 ENDIF
5431 ENDDO
5432 IF (irect(3,ne)/=irect(4,ne)) THEN
5433 n=msr(irect(4,ne))
5434 n2 =iloc(n)
5435 CALL reorder_a(nrow(ni),icol(1,ni),n)
5436 IF (n2<=n_impn) THEN
5437 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5438 ELSE
5439 nm=n2- n_impn
5440 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5441 ENDIF
5442 ENDIF
5443 ELSE
5444 nim=ni-n_impn
5445 DO j=1,3
5446 n=msr(irect(j,ne))
5447 n2=iloc(n)
5448 CALL reorder_a(nrow(ni),icok(1,nim),n)
5449 IF (n2<=n_impn) THEN
5450 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5451 ELSE
5452 nm=n2- n_impn
5453 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5454 ENDIF
5455 ENDDO
5456 IF (irect(3,ne)/=irect(4,ne)) THEN
5457 n=msr(irect(4,ne))
5458 n2 =iloc(n)
5459 CALL reorder_a(nrow(ni),icok(1,nim),n)
5460 IF (n2<=n_impn) THEN
5461 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5462 ELSE
5463 nm=n2- n_impn
5464 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5465 ENDIF
5466 ENDIF
5467 ENDIF
5468 ENDDO
5469C----6---------------------------------------------------------------7---------8
5470 RETURN
5471 END
5472!||====================================================================
5473!|| row_int24 ../engine/source/implicit/ind_glob_k.F
5474!||--- called by ------------------------------------------------------
5475!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5476!||--- calls -----------------------------------------------------
5477!|| i24msegv ../engine/source/implicit/ind_glob_k.F
5478!||====================================================================
5479 SUBROUTINE row_int24(
5480 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5481 2 NROW ,ILOC ,NDOFI ,N_IMPN ,NSN ,
5482 3 NSREM ,SUBTRIA ,NVOISIN )
5483C----6---------------------------------------------------------------7---------8
5484C I m p l i c i t T y p e s
5485C-----------------------------------------------
5486#include "implicit_f.inc"
5487C-----------------------------------------------
5488C D u m m y A r g u m e n t s
5489C-----------------------------------------------
5490 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5491 . ILOC(*),NDOFI,N_IMPN,NSN,NSREM,SUBTRIA(*),NVOISIN(8,*)
5492C REAL
5493C-----------------------------------------------
5494C L o c a l V a r i a b l e s
5495C-----------------------------------------------
5496 INTEGER I,J,N,N1,N2,NE,IG,IRTLM(4),NEI
5497C-----------------------------------------------
5498 DO i = 1, jlt
5499C--------second node-----
5500 ig = ns_imp(i)
5501 IF (ig<=nsn) THEN
5502 n1 = nsv(ig)
5503 IF (iloc(n1)==0) THEN
5504 n_impn=n_impn+1
5505 iloc(n1)=n_impn
5506 ENDIF
5507 nrow(n1)=nrow(n1)+3
5508C
5509 ELSE
5510 nsrem=nsrem+1
5511 ENDIF
5512 ne=ne_imp(i)
5513 IF (ne<0) THEN
5514 nei=-ne
5515 CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
5516 ELSE
5517 irtlm(1:4) = irect(1:4,ne)
5518 END IF
5519 DO j=1,3
5520 n=irtlm(j)
5521 IF (iloc(n)==0) THEN
5522 n_impn=n_impn+1
5523 iloc(n)=n_impn
5524 ENDIF
5525 nrow(n)=nrow(n)+1
5526 ENDDO
5527 IF (irtlm(3)/=irtlm(4)) THEN
5528 n=irtlm(4)
5529 IF (iloc(n)==0) THEN
5530 n_impn=n_impn+1
5531 iloc(n)=n_impn
5532 ENDIF
5533 nrow(n)=nrow(n)+1
5534
5535 IF (ig<=nsn) nrow(n1)=nrow(n1)+1
5536 ENDIF
5537 ENDDO
5538C----6---------------------------------------------------------------7---------8
5539 RETURN
5540 END
5541C --------- ----
5542!||====================================================================
5543!|| row_int241 ../engine/source/implicit/ind_glob_k.F
5544!||--- called by ------------------------------------------------------
5545!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
5546!||--- calls -----------------------------------------------------
5547!|| i24msegv ../engine/source/implicit/ind_glob_k.F
5548!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5549!||====================================================================
5550 SUBROUTINE row_int241(
5551 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5552 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
5553 3 NSN ,SUBTRIA ,NVOISIN )
5554C----6---------------------------------------------------------------7---------8
5555C I m p l i c i t T y p e s
5556C-----------------------------------------------
5557#include "implicit_f.inc"
5558C-----------------------------------------------
5559C D u m m y A r g u m e n t s
5560C-----------------------------------------------
5561 INTEGER NNMAX
5562 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5563 . iloc(*),icol(nnmax,*),n_impn,nsn,subtria(*),nvoisin(8,*)
5564C REAL
5565C-----------------------------------------------
5566C L o c a l V a r i a b l e s
5567C-----------------------------------------------
5568 INTEGER I,J,N,N1,N2,NE,IG,NI,IRTLM(4),NEI
5569C-----------------------------------------------
5570C---------ICOL : LOCAL NODE NUMBER--------
5571 DO i = 1, jlt
5572C--------second node-----
5573 ig = ns_imp(i)
5574 IF (ig<=nsn) THEN
5575 n1 = nsv(ig)
5576 ne=ne_imp(i)
5577 IF (ne<0) THEN
5578 nei=-ne
5579 CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
5580 ELSE
5581 irtlm(1:4) = irect(1:4,ne)
5582 END IF
5583 ni=iloc(n1)
5584 DO j=1,3
5585 n=irtlm(j)
5586 n2=iloc(n)
5587 CALL reorder_a(nrow(n1),icol(1,ni),n)
5588 CALL reorder_a(nrow(n),icol(1,n2),n1)
5589 ENDDO
5590 IF (irtlm(3)/=irtlm(4)) THEN
5591 n=irtlm(4)
5592 n2 =iloc(n)
5593 CALL reorder_a(nrow(n1),icol(1,ni),n)
5594 CALL reorder_a(nrow(n),icol(1,n2),n1)
5595 ENDIF
5596 ENDIF
5597 ENDDO
5598C----6---------------------------------------------------------------7---------8
5599 RETURN
5600 END
5601C --------- ----
5602!||====================================================================
5603!|| row_int242 ../engine/source/implicit/ind_glob_k.F
5604!||--- called by ------------------------------------------------------
5605!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
5606!||--- calls -----------------------------------------------------
5607!|| i24msegv ../engine/source/implicit/ind_glob_k.F
5608!|| reorder_a ../engine/source/implicit/ind_glob_k.f
5609!||====================================================================
5610 SUBROUTINE row_int242(
5611 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5612 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
5613 3 ICOK ,NKMAX ,NSN ,SUBTRIA ,NVOISIN )
5614C----6---------------------------------------------------------------7---------8
5615C I m p l i c i t T y p e s
5616C-----------------------------------------------
5617#include "implicit_f.inc"
5618C-----------------------------------------------
5619C D u m m y A r g u m e n t s
5620C-----------------------------------------------
5621 INTEGER NNMAX,NKMAX
5622 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5623 . ILOC(*),ICOL(NNMAX,*),ICOK(NKMAX,*),N_IMPN,NSN,
5624 . SUBTRIA(*),NVOISIN(8,*)
5625C REAL
5626C-----------------------------------------------
5627C L o c a l V a r i a b l e s
5628C-----------------------------------------------
5629 INTEGER I,J,N,N1,N2,NE,IG,NI,NM,NIM,IRTLM(4),NEI
5630C-----------------------------------------------
5631C---------ICOL : LOCAL NODE NUMBER--------
5632 DO I = 1, jlt
5633C--------second node-----
5634 ig = ns_imp(i)
5635 IF (ig<=nsn) THEN
5636 n1 = nsv(ig)
5637 ne=ne_imp(i)
5638 ni=iloc(n1)
5639 IF (ne<0) THEN
5640 nei=-ne
5641 CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
5642 ELSE
5643 irtlm(1:4) = irect(1:4,ne)
5644 END IF
5645 IF (ni<=n_impn) THEN
5646 DO j=1,3
5647 n=irtlm(j)
5648 n2=iloc(n)
5649 CALL reorder_a(nrow(ni),icol(1,ni),n)
5650 IF (n2<=n_impn) THEN
5651 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5652 ELSE
5653 nm=n2- n_impn
5654 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5655 ENDIF
5656 ENDDO
5657 IF (irtlm(3)/=irtlm(4)) THEN
5658 n=irtlm(4)
5659 n2 =iloc(n)
5660 CALL reorder_a(nrow(ni),icol(1,ni),n)
5661 IF (n2<=n_impn) THEN
5662 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5663 ELSE
5664 nm=n2- n_impn
5665 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5666 ENDIF
5667 ENDIF
5668 ELSE
5669 nim=ni-n_impn
5670 DO j=1,3
5671 n=irtlm(j)
5672 n2=iloc(n)
5673 CALL reorder_a(nrow(ni),icok(1,nim),n)
5674 IF (n2<=n_impn) THEN
5675 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5676 ELSE
5677 nm=n2- n_impn
5678 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5679 ENDIF
5680 ENDDO
5681 IF (irtlm(3)/=irtlm(4)) THEN
5682 n=irtlm(4)
5683 n2 =iloc(n)
5684 CALL reorder_a(nrow(ni),icok(1,nim),n)
5685 IF (n2<=n_impn) THEN
5686 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5687 ELSE
5688 nm=n2- n_impn
5689 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5690 ENDIF
5691 ENDIF
5692 ENDIF
5693 END IF
5694 ENDDO
5695C----6---------------------------------------------------------------7---------8
5696 RETURN
5697 END
5698!||====================================================================
5699!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
5700!||--- called by ------------------------------------------------------
5701!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5702!||--- calls -----------------------------------------------------
5703!|| intab ../engine/source/implicit/ind_glob_k.F
5704!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5705!|| row_int1 ../engine/source/implicit/ind_glob_k.F
5706!|| row_int111 ../engine/source/implicit/ind_glob_k.F
5707!|| row_int241 ../engine/source/implicit/ind_glob_k.f
5708!|| row_int51 ../engine/source/implicit/ind_glob_k.F
5709!||--- uses -----------------------------------------------------
5710!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
5711!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
5712!||====================================================================
5713 SUBROUTINE dim_kine_i(
5714 1 NUM_IMP ,NS_IMP ,NE_IMP ,NPBY ,LPBY ,
5715 2 ITAB ,NRBYAC ,IRBYAC ,NINT2 ,IINT2 ,
5716 3 IPARI ,INTBUF_TAB,LNSS ,LNSS2 ,NROW ,
5717 4 NKINE ,INLOC ,NNMAX ,N_IMPM ,NDOF ,
5718 5 NDOFI ,IAINT2 ,IRBE3 ,LRBE3 ,LNSS3 ,
5719 6 IRBE2 ,LRBE2 ,LNSB2 ,LNSRB2 ,IND_SUBT )
5720C-----------------------------------------------
5721C M o d u l e s
5722C-----------------------------------------------
5723 USE intbufdef_mod
5724 USE imp_intbuf
5725C----6---------------------------------------------------------------7---------8
5726C I m p l i c i t T y p e s
5727C-----------------------------------------------
5728#include "implicit_f.inc"
5729C-----------------------------------------------
5730C C o m m o n B l o c k s
5731C-----------------------------------------------
5732#include "com04_c.inc"
5733#include "param_c.inc"
5734C-----------------------------------------------
5735C D u m m y A r g u m e n t s
5736C-----------------------------------------------
5737 INTEGER NNMAX,NKINE,N_IMPM
5738 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),
5739 . npby(nnpby,*),lpby(*),itab(*),nrbyac,irbyac(*)
5740 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),IAINT2(*),
5741 . inloc(*),lnss ,lnss2,nrow(*),ndof(*),ndofi(*)
5742 INTEGER IRBE3(NRBE3L,*),LRBE3(*),LNSS3,IRBE2(NRBE2L,*),
5743 . LRBE2(*),LNSB2,LNSRB2,IND_SUBT(*)
5744
5745 TYPE(intbuf_struct_) INTBUF_TAB(*)
5746C REAL
5747C-----------------------------------------------
5748C External function
5749C-----------------------------------------------
5750 LOGICAL INTAB
5751 EXTERNAL INTAB
5752C-----------------------------------------------
5753C L o c a l V a r i a b l e s
5754C-----------------------------------------------
5755 INTEGER IAD,NTY,NIN,KD(50),NKE,NKE2
5756 INTEGER IA(NRBYAC),NROW1(NUMNOD)
5757 INTEGER
5758 . I,J,K,N,L,NL,NJ,NI,J1,M,NSN,N1,N2,NK,ID,
5759 . JI,K10,K11,K12,K13,K14,KFI,NS,NNOD,NM,L1,NL1,NM1,
5760 . NRTS,NKINE0,NMAX,NKE1,M1,IC
5761 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICOK,ICOK1
5762C-----------------------------------------------
5763 NKINE0 = nkine
5764 IF (nkine0>0) ALLOCATE(icok(nnmax,nkine0))
5765C
5766 DO i=1,numnod
5767 nrow1(i) = 0
5768 ENDDO
5769C
5770 iad=1
5771 DO nin=1,ninter
5772 nty =ipari(7,nin)
5773 nsn =ipari(5,nin)
5774 IF(nty==3)THEN
5775 ELSEIF(nty==4)THEN
5776 ELSEIF(nty==5)THEN
5777 CALL row_int51(num_imp(nin),ns_imp(iad),ne_imp(iad),
5778 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,
5779 . intbuf_tab(nin)%MSR,nrow ,
5780 . nkine ,inloc ,icok ,nnmax ,nsn )
5781 iad=iad+num_imp(nin)
5782 ENDIF
5783 ENDDO
5784 DO nin=1,ninter
5785 nty =ipari(7,nin)
5786 nsn =ipari(5,nin)
5787 IF(nty==3)THEN
5788 ELSEIF(nty==4)THEN
5789 ELSEIF(nty==5)THEN
5790 ELSEIF(nty==6)THEN
5791
5792 ELSEIF(nty==7.OR.nty==10)THEN
5793C
5794 CALL row_int1(num_imp(nin),ns_imp(iad),ne_imp(iad),
5795 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,nrow ,nkine ,
5796 . inloc ,icok ,nnmax ,nsn )
5797 iad=iad+num_imp(nin)
5798 ELSEIF(nty==24)THEN
5799C
5800c CALL ROW_INT241(NUM_IMP(NIN),NS_IMP(IAD),NE_IMP(IAD),
5801c . INTBUF_TAB(NIN)%IRECTM,INTBUF_TAB(NIN)%NSV,NROW ,NKINE ,
5802c . INLOC ,ICOK ,NNMAX ,NSN ,IND_SUBT,
5803c . INTBUF_TAB(NIN)%NVOISIN)
5804 CALL row_int241(intbuf_tab_imp(nin)%I_STOK(1),intbuf_tab_imp(nin)%CAND_N,
5805 . intbuf_tab_imp(nin)%CAND_E,intbuf_tab(nin)%IRECTM,
5806 . intbuf_tab(nin)%NSV,nrow ,nkine ,
5807 . inloc ,icok ,nnmax ,nsn ,
5808 . intbuf_tab_imp(nin)%INDSUBT,intbuf_tab(nin)%NVOISIN)
5809 iad=iad+num_imp(nin)
5810 ELSEIF(nty==11)THEN
5811C
5812 nrts =ipari(3,nin)
5813 CALL row_int111(num_imp(nin),ns_imp(iad),ne_imp(iad),
5814 . intbuf_tab(nin)%IRECTS ,intbuf_tab(nin)%IRECTM,nrow ,nkine ,
5815 . inloc ,icok ,nnmax ,nrts )
5816 iad=iad+num_imp(nin)
5817 ENDIF
5818 ENDDO
5819 k=0
5820 lnss2=0
5821 DO j=1,nint2
5822 n=iint2(j)
5823 iaint2(j)=0
5824 nsn = ipari(5,n)
5825 ji=ipari(1,n)
5826 k10=ji-1
5827 k11=k10+4*ipari(3,n)
5828C------IRECT(4,NSN)-----
5829 k12=k11+4*ipari(4,n)
5830C------NSV(NSN)--node number---
5831 k13=k12+nsn
5832C------MSR(NMN)-----
5833 k14=k13+ipari(6,n)
5834C------IRTL(NSN)--main el number---
5835 kfi=k14+nsn
5836 DO i=1,nsn
5837 id = i+k
5838 ni=intbuf_tab(n)%NSV(i)
5839 IF (inloc(ni)>0.AND.inloc(ni)<=nkine0) THEN
5840 iaint2(j)=1
5841 l=intbuf_tab(n)%IRTLM(i)
5842 nl=4*(l-1)
5843 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
5844 nnod=3
5845 ELSE
5846 nnod=4
5847 ENDIF
5848 DO m=1,nnod
5849 nm=intbuf_tab(n)%IRECTM(nl+m)
5850 ndofi(nm)=ndof(nm)
5851 IF (inloc(nm)==0) THEN
5852 nkine=nkine+1
5853 inloc(nm)=nkine
5854 nrow1(nm)=nrow1(nm)+ nnod + nnod
5855 ENDIF
5856 ENDDO
5857 nke=inloc(ni)
5858 DO n1=1,nrow(ni)
5859 nj=icok(n1,nke)
5860 IF (inloc(nj)>0 ) THEN
5861 lnss2=lnss2+1
5862 nke2=inloc(nj)
5863 DO m=1,nnod
5864 nm=intbuf_tab(n)%IRECTM(nl+m)
5865 IF (inloc(nm)>0) THEN
5866 nrow1(nm)=nrow1(nm)+1
5867 IF (nke2>0) nrow1(nj)=nrow1(nj)+1
5868 ELSE
5869 nkine=nkine+1
5870 inloc(nm)=nkine
5871 nrow1(nm)=1
5872 ENDIF
5873 ENDDO
5874 ENDIF
5875 ENDDO
5876 ENDIF
5877 ENDDO
5878 k=k+nsn
5879 ENDDO
5880C-----RBE2------
5881 lnsb2= 0
5882 lnsrb2= 0
5883 DO j=1,nrbe2
5884 k=irbe2(1,j)
5885 m =irbe2(3,j)
5886 nsn =irbe2(5,j)
5887 lnsrb2= lnsrb2+nsn
5888 ic = 7*512+7*64-irbe2(4,j)
5889 DO i=1,nsn
5890 ni=lrbe2(i+k)
5891 IF (inloc(ni)>0) THEN
5892 nke=inloc(ni)
5893 DO n1=1,nrow(ni)
5894 nj=icok(n1,nke)
5895 IF (inloc(nj)>0.AND.nj/=ni) nrow1(nj)=nrow1(nj)+1+nhrbe2
5896 lnsb2= lnsb2+1
5897 ENDDO
5898 IF (inloc(m)==0) THEN
5899 nkine=nkine+1
5900 inloc(m)=nkine
5901 ENDIF
5902 nrow1(m)=nrow1(m)+nrow(ni)+nrow1(ni)
5903 IF (ic>0) THEN
5904 nrow1(m)=nrow1(m)+1
5905 nrow1(ni)=nrow1(ni)+1
5906 END IF
5907 ENDIF
5908C---------for the case with main node--------
5909 lnsb2= lnsb2+1
5910 ENDDO
5911 IF (inloc(m)>0) ndofi(m)=ndof(m)
5912 ENDDO
5913C------------RBE3-------------
5914 DO n=1,nrbe3
5915 iad = irbe3(1,n)
5916 ni = irbe3(3,n)
5917 IF (ni==0.OR.ndofi(ni)==0) cycle
5918 nnod = irbe3(5,n)
5919 IF (inloc(ni)>0) THEN
5920 DO m=1,nnod
5921 nm=lrbe3(iad+m)
5922 ndofi(nm)=ndof(nm)
5923 IF (inloc(nm)==0) THEN
5924 nkine=nkine+1
5925 inloc(nm)=nkine
5926 nrow1(nm)=nrow1(nm)+ nnod
5927 ENDIF
5928 ENDDO
5929 nke=inloc(ni)
5930 DO n1=1,nrow(ni)
5931 nj=icok(n1,nke)
5932 IF (inloc(nj)>0.AND.
5933 . (.NOT.intab(nnod,lrbe3(iad+1),nj))) THEN
5934 nke2=inloc(nj)
5935 DO m=1,nnod
5936 nm=lrbe3(iad+m)
5937 nrow1(nm)=nrow1(nm)+1
5938 IF (nke2>0) nrow1(nj)=nrow1(nj)+1
5939 ENDDO
5940 ENDIF
5941 ENDDO
5942 ENDIF
5943 ENDDO
5944C--------------------
5945 IF (nkine>nkine0) THEN
5946 nmax = nnmax
5947 ALLOCATE(icok1(nnmax,nkine0))
5948 DO i=1,numnod
5949 IF (inloc(i)>0) THEN
5950 nmax=max(nmax,(nrow1(i)+nrow(i)))
5951 nke = inloc(i)
5952 DO j =1,nrow(i)
5953 icok1(j,nke) = icok(j,nke)
5954 ENDDO
5955 ENDIF
5956 nrow1(i) = 0
5957 ENDDO
5958 DEALLOCATE(icok)
5959 ALLOCATE(icok(nmax,nkine))
5960 DO i=1,numnod
5961 IF (inloc(i)>0.AND.nrow(i)>0) THEN
5962 nke = inloc(i)
5963 DO j =1,nrow(i)
5964 icok(j,nke) = icok1(j,nke)
5965 ENDDO
5966 ENDIF
5967 ENDDO
5968 DEALLOCATE(icok1)
5969 lnss2=0
5970 DO j=1,nint2
5971 IF(iaint2(j)==1) THEN
5972 n=iint2(j)
5973 nsn = ipari(5,n)
5974 ji=ipari(1,n)
5975 k10=ji-1
5976 k11=k10+4*ipari(3,n)
5977C------IRECT(4,NSN)-----
5978 k12=k11+4*ipari(4,n)
5979C------NSV(NSN)--node number---
5980 k13=k12+nsn
5981C------MSR(NMN)-----
5982 k14=k13+ipari(6,n)
5983C------IRTL(NSN)--main el number---
5984 kfi=k14+nsn
5985 DO i=1,nsn
5986 ni=intbuf_tab(n)%NSV(i)
5987 IF (inloc(ni)>0) THEN
5988 l=intbuf_tab(n)%IRTLM(i)
5989 nl=4*(l-1)
5990 IF(intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))THEN
5991 nnod=3
5992 ELSE
5993 nnod=4
5994 ENDIF
5995 DO m=1,nnod
5996 nm=intbuf_tab(n)%IRECTM(nl+m)
5997 nke1=inloc(nm)
5998 DO m1=m+1,nnod
5999 nm1=intbuf_tab(n)%IRECTM(nl+m1)
6000 nke2=inloc(nm1)
6001 CALL reorder_a(nrow(nm),icok(1,nke1),nm1)
6002 CALL reorder_a(nrow(nm1),icok(1,nke2),nm)
6003 ENDDO
6004 ENDDO
6005 nke=inloc(ni)
6006 DO n1=1,nrow(ni)
6007 nj=icok(n1,nke)
6008 IF (inloc(nj)>0) THEN
6009 lnss2=lnss2+1
6010 nke2=inloc(nj)
6011 DO m=1,nnod
6012 nm=intbuf_tab(n)%IRECTM(nl+m)
6013 IF (inloc(nm)>0) THEN
6014 nke1=inloc(nm)
6015 CALL reorder_a(nrow(nm),icok(1,nke1),nj)
6016 CALL reorder_a(nrow(nj),icok(1,nke2),nm)
6017 ENDIF
6018 ENDDO
6019 ENDIF
6020 ENDDO
6021 ENDIF
6022 ENDDO
6023 ENDIF
6024 ENDDO
6025 ENDIF
6026C-----RBE2------
6027 DO j=1,nrbe2
6028 k=irbe2(1,j)
6029 m =irbe2(3,j)
6030 IF (inloc(m)==0) cycle
6031 nsn =irbe2(5,j)
6032 ic = 7*512+7*64-irbe2(4,j)
6033 nke1=inloc(m)
6034 DO i=1,nsn
6035 ni=lrbe2(i+k)
6036 IF (inloc(ni)>0) THEN
6037 nke=inloc(ni)
6038 DO n1=1,nrow(ni)
6039 nj=icok(n1,nke)
6040 nke2=inloc(nj)
6041C------------case hierarchy w/ RBE3----
6042 IF (nke2>0.AND.nj/=ni) THEN
6043 CALL reorder_a(nrow(m),icok(1,nke1),nj)
6044 CALL reorder_a(nrow(nj),icok(1,nke2),m)
6045 END IF
6046 ENDDO
6047 IF (ic>0) THEN
6048 CALL reorder_a(nrow(m),icok(1,nke1),ni)
6049 CALL reorder_a(nrow(ni),icok(1,nke),m)
6050 END IF
6051 ENDIF
6052 ENDDO
6053 ENDDO
6054C------------RBE3-------------
6055 lnss3=0
6056 DO n=1,nrbe3
6057 iad = irbe3(1,n)
6058 ni = irbe3(3,n)
6059 IF (ni==0.OR.ndofi(ni)==0) cycle
6060 nnod = irbe3(5,n)
6061 IF (inloc(ni)>0) THEN
6062 nke1=inloc(nm)
6063 DO m=1,nnod
6064 nm=lrbe3(iad+m)
6065 DO m1=m+1,nnod
6066 nm1=lrbe3(iad+m1)
6067 nke2=inloc(nm1)
6068 CALL reorder_a(nrow(nm),icok(1,nke1),nm1)
6069 CALL reorder_a(nrow(nm1),icok(1,nke2),nm)
6070 ENDDO
6071 ENDDO
6072 nke=inloc(ni)
6073 DO n1=1,nrow(ni)
6074 nj=icok(n1,nke)
6075 IF (inloc(nj)>0.AND.
6076 . (.NOT.intab(nnod,lrbe3(iad+1),nj))) THEN
6077 lnss3=lnss3+1
6078 nke2=inloc(nj)
6079 DO m=1,nnod
6080 nm=lrbe3(iad+m)
6081 nke1=inloc(nm)
6082 CALL reorder_a(nrow(nm),icok(1,nke1),nj)
6083 CALL reorder_a(nrow(nj),icok(1,nke2),nm)
6084 ENDDO
6085 ENDIF
6086 ENDDO
6087 ENDIF
6088 ENDDO
6089C-----active rigid body main nodes------
6090 lnss= 0
6091 DO j=1,nrbyac
6092 ia(j)=0
6093 n=irbyac(j)
6094 m =npby(1,n)
6095C
6096 k=irbyac(j+nrbykin)
6097 nsn =npby(2,n)
6098 IF (inloc(m)>0) ia(j)=1
6099 DO i=1,nsn
6100 id = i+k
6101 ni=lpby(id)
6102 IF (inloc(ni)>0) THEN
6103 ia(j)=1
6104 nke=inloc(ni)
6105 DO n1=1,nrow(ni)
6106 nj=icok(n1,nke)
6107 IF (inloc(nj)>0) nrow1(nj)=nrow1(nj)+1
6108 lnss= lnss+1
6109 ENDDO
6110 ENDIF
6111 ENDDO
6112 ENDDO
6113C---- Main node treatment spect .------
6114 DO j=1,nrbyac
6115 IF (ia(j)==1) THEN
6116 n=irbyac(j)
6117 m =npby(1,n)
6118 IF (inloc(m)>0) THEN
6119 nkine=nkine-1
6120 DO i=1,numnod
6121 IF (inloc(i)>inloc(m)) inloc(i)=inloc(i)-1
6122 ENDDO
6123 ENDIF
6124 ENDIF
6125 ENDDO
6126C
6127 DO i=1,numnod
6128 nrow(i) = nrow(i)+nrow1(i)
6129 ENDDO
6130C
6131 n_impm=nkine
6132 DO j=1,nrbyac
6133 n=irbyac(j)
6134 k=irbyac(j+nrbykin)
6135 m =npby(1,n)
6136 nsn =npby(2,n)
6137 IF (ia(j)==1) THEN
6138 ndofi(m)=ndof(m)
6139 nkine=nkine+1
6140 inloc(m)=nkine
6141 DO i=1,nsn
6142 id = i+k
6143 ni=lpby(id)
6144 IF (inloc(ni)>0) THEN
6145 nrow(m)=nrow(m)+nrow(ni)
6146 ENDIF
6147 ENDDO
6148 ENDIF
6149 ENDDO
6150 n_impm=nkine-n_impm
6151 IF (nkine0>0) DEALLOCATE(icok)
6152C----6---------------------------------------------------------------7---------8
6153 RETURN
6154 END
6155!||====================================================================
6156!|| ind_kine_i ../engine/source/implicit/ind_glob_k.F
6157!||--- called by ------------------------------------------------------
6158!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
6159!||--- calls -----------------------------------------------------
6160!|| intab ../engine/source/implicit/ind_glob_k.f
6161!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6162!||--- uses -----------------------------------------------------
6163!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
6164!||====================================================================
6165 SUBROUTINE ind_kine_i(
6166 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
6167 2 NSS ,ISS ,NINT2 ,IINT2 ,IPARI ,
6168 3 INTBUF_TAB,NSS2 ,ISS2 ,NNMAX ,INLOC ,
6169 4 NKMAX ,NROWK ,ICOK ,ICOKM ,INK ,
6170 5 NDOF ,NDOF1 ,IAINT2 ,IRBE3 ,LRBE3 ,
6171 6 NSS3 ,ISS3 ,IRBE2 ,LRBE2 ,NSB2 ,
6172 7 ISB2 )
6173C-----------------------------------------------
6174C M o d u l e s
6175C-----------------------------------------------
6176 USE intbufdef_mod
6177C----6---------------------------------------------------------------7---------8
6178C I m p l i c i t T y p e s
6179C-----------------------------------------------
6180#include "implicit_f.inc"
6181C-----------------------------------------------
6182C C o m m o n B l o c k s
6183C-----------------------------------------------
6184#include "com04_c.inc"
6185#include "param_c.inc"
6186C-----------------------------------------------
6187C D u m m y A r g u m e n t s
6188C-----------------------------------------------
6189 INTEGER NNMAX,NKMAX,LRB ,LI2
6190 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
6191 . nss(*),iss(*),nint2,iint2(*),
6192 . nss2(*),iss2(*),ipari(npari,*),ndof(*),ndof1(*),
6193 . icok(nnmax,*),icokm(nkmax,*),nrowk(*)
6194 INTEGER
6195 . inloc(*),ink,iaint2(*)
6196 INTEGER IRBE3(NRBE3L,*),LRBE3(*),NSS3(*),ISS3(*),
6197 . irbe2(nrbe2l,*),lrbe2(*),nsb2(*),isb2(*)
6198
6199 TYPE(intbuf_struct_) INTBUF_TAB(*)
6200C-----------------------------------------------
6201C External function
6202C-----------------------------------------------
6203 LOGICAL INTAB
6204 EXTERNAL intab
6205C REAL
6206C-----------------------------------------------
6207C L o c a l V a r i a b l e s
6208C-----------------------------------------------
6209C------ICOK,ICOKM use the same NROWK------
6210 INTEGER NKE,NKE1,NKE2,IK,NKM1,IAD
6211 INTEGER
6212 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,k1,m1,
6213 . ji,k10,k11,k12,k13,k14,kfi,ns,nnod,nm,l1,nl1,nm1,ic
6214c----------------------
6215 k=0
6216 ns= 0
6217 DO j=1,nint2
6218 IF(iaint2(j)==1) THEN
6219 n=iint2(j)
6220 nsn = ipari(5,n)
6221 ji=ipari(1,n)
6222 k10=ji-1
6223 k11=k10+4*ipari(3,n)
6224C------IRECT(4,NSN)-----
6225 k12=k11+4*ipari(4,n)
6226C------NSV(NSN)--node number---
6227 k13=k12+nsn
6228C------MSR(NMN)-----
6229 k14=k13+ipari(6,n)
6230C------IRTL(NSN)--main el number---
6231 kfi=k14+nsn
6232 DO i=1,nsn
6233 id = i+k
6234 nss2(id)=0
6235 ni=intbuf_tab(n)%NSV(i)
6236 IF (inloc(ni)>0) THEN
6237 l=intbuf_tab(n)%IRTLM(i)
6238 nl=4*(l-1)
6239 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
6240 nnod=3
6241 ELSE
6242 nnod=4
6243 ENDIF
6244 DO m=1,nnod
6245 nm=intbuf_tab(n)%IRECTM(nl+m)
6246 nke1=inloc(nm)
6247 ndof1(nke1)=ndof(nm)
6248 DO m1=m+1,nnod
6249 nm1=intbuf_tab(n)%IRECTM(nl+m1)
6250 nkm1=inloc(nm1)
6251 CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
6252 CALL reorder_a(nrowk(nkm1),icok(1,nkm1),nm)
6253 ENDDO
6254 ENDDO
6255 nke=inloc(ni)
6256 DO n1=1,nrowk(nke)
6257 nj=icok(n1,nke)
6258 IF (inloc(nj)>0.AND.
6259 . (.NOT.intab(nsn,intbuf_tab(n)%NSV(1),nj)).
6260 . and.(.NOT.intab(nnod,intbuf_tab(n)%IRECTM(nl+1),nj))) THEN
6261 j1=ns+nss2(id)+1
6262 iss2(j1)=nj
6263 nss2(id)=nss2(id)+1
6264 nke2=inloc(nj)
6265 DO m=1,nnod
6266 nm=intbuf_tab(n)%IRECTM(nl+m)
6267 IF (inloc(nm)>0) THEN
6268 nke1=inloc(nm)
6269 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
6270 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
6271 ENDIF
6272 ENDDO
6273 ENDIF
6274 ENDDO
6275 ns=ns+nss2(id)
6276 ENDIF
6277 ENDDO
6278 k=k+nsn
6279 ENDIF
6280 ENDDO
6281C-----RBE2------
6282 k=0
6283 DO n=1,nrbe2
6284 k1=irbe2(1,n)
6285 m =irbe2(3,n)
6286 nsn =irbe2(5,n)
6287 ic = 7*512+7*64-irbe2(4,n)
6288 IF (inloc(m)>0) THEN
6289 nke1=inloc(m)
6290 ndof1(nke1)=ndof(m)
6291 nkm1=nke1
6292 DO i=1,nsn
6293 id = i+k1
6294 ni=lrbe2(id)
6295 nsb2(id)=0
6296 IF (inloc(ni)>0) THEN
6297 nke=inloc(ni)
6298 DO n1=1,nrowk(nke)
6299 nj=icok(n1,nke)
6300 nke2=inloc(nj)
6301 IF (inloc(nj)>0.AND.nj/=ni) THEN
6302 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
6303 IF (nke2<=ink) THEN
6304 CALL reorder_a(nrowk(nke2),icok(1,nke2),m)
6305 ELSE
6306 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),m)
6307 END IF
6308 k=k+1
6309 isb2(k)=nj
6310 nsb2(id)=nsb2(id)+1
6311 END IF
6312 END DO
6313 IF (ic>0) THEN
6314 CALL reorder_a(nrowk(nke1),icok(1,nke1),ni)
6315 CALL reorder_a(nrowk(nke),icok(1,nke),m)
6316 END IF
6317 END IF
6318 END DO
6319 END IF
6320 END DO
6321c---------RBE3-------------
6322 k = 0
6323 DO n=1,nrbe3
6324 iad = irbe3(1,n)
6325 ni = irbe3(3,n)
6326 nss3(n)= 0
6327 IF (ni==0) cycle
6328 nnod = irbe3(5,n)
6329 IF (inloc(ni)>0) THEN
6330 DO m=1,nnod
6331 nm=lrbe3(iad+m)
6332 nke1=inloc(nm)
6333 ndof1(nke1)=ndof(nm)
6334 DO m1=m+1,nnod
6335 nm1=lrbe3(iad+m1)
6336 nkm1=inloc(nm1)
6337 IF (nke1<=ink) THEN
6338 CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
6339 ELSE
6340 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nm1)
6341 ENDIF
6342
6343 IF (nkm1<=ink) THEN
6344 CALL reorder_a(nrowk(nkm1),icok(1,nkm1),nm)
6345 ELSE
6346 CALL reorder_a(nrowk(nkm1),icokm(1,nkm1-ink),nm)
6347 ENDIF
6348 ENDDO
6349 ENDDO
6350 nke=inloc(ni)
6351 DO n1=1,nrowk(nke)
6352 IF (nke<=ink) THEN
6353 nj=icok(n1,nke)
6354 ELSE
6355 nj=icokm(n1,nke-ink)
6356 END IF
6357 IF (inloc(nj)>0.AND.
6358 . (.NOT.intab(nnod,lrbe3(iad+1),nj))) THEN
6359 nss3(n)= nss3(n)+1
6360 k= k+1
6361 iss3(k)=nj
6362 nke2=inloc(nj)
6363 DO m=1,nnod
6364 nm=lrbe3(iad+m)
6365 IF (inloc(nm)>0) THEN
6366 nke1=inloc(nm)
6367 IF (nke1<=ink) THEN
6368 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
6369 ELSE
6370 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nj)
6371 ENDIF
6372
6373 IF (nke2<=ink) THEN
6374 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
6375 ELSE
6376 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),nm)
6377 ENDIF
6378 ENDIF
6379 ENDDO
6380 ENDIF
6381 ENDDO
6382 ENDIF
6383 ENDDO
6384C-----active rigid body main nodes------
6385 k=0
6386 ns= 0
6387 DO j=1,nrbyac
6388 n=irbyac(j)
6389 k1=irbyac(j+nrbykin)
6390 m =npby(1,n)
6391 nsn =npby(2,n)
6392 IF (inloc(m)>0) THEN
6393 nke1=inloc(m)
6394 ndof1(nke1)=ndof(m)
6395 nkm1=nke1-ink
6396 DO i=1,nsn
6397 id = i+k
6398 ni=lpby(i+k1)
6399 nss(id)=0
6400 IF (inloc(ni)>0) THEN
6401 nke=inloc(ni)
6402 DO n1=1,nrowk(nke)
6403 nj=icok(n1,nke)
6404 nke2=inloc(nj)
6405 IF (inloc(nj)>0.AND.
6406 . (.NOT.intab(nsn,lpby(k1+1),nj))) THEN
6407 CALL reorder_a(nrowk(nke1),icokm(1,nkm1),nj)
6408 IF (nke2<=ink) THEN
6409 CALL reorder_a(nrowk(nke2),icok(1,nke2),m)
6410 j1=ns+nss(id)+1
6411 iss(j1)=nj
6412 nss(id)=nss(id)+1
6413 ELSE
6414 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),m)
6415 ENDIF
6416 ENDIF
6417 ENDDO
6418 ns=ns+nss(id)
6419 ENDIF
6420 ENDDO
6421 ENDIF
6422 k=k+nsn
6423 ENDDO
6424C----6---------------------------------------------------------------7---------8
6425 RETURN
6426 END
6427!||====================================================================
6428!|| row_int11 ../engine/source/implicit/ind_glob_k.F
6429!||--- called by ------------------------------------------------------
6430!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
6431!||====================================================================
6432 SUBROUTINE row_int11(
6433 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
6434 2 NROW ,ILOC ,NDOFI ,N_IMPN ,NSN ,
6435 3 NSREM )
6436C----6---------------------------------------------------------------7---------8
6437C I m p l i c i t T y p e s
6438C-----------------------------------------------
6439#include "implicit_f.inc"
6440C-----------------------------------------------
6441C D u m m y A r g u m e n t s
6442C-----------------------------------------------
6443 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),NROW(*),
6444 . iloc(*),ndofi,n_impn,nsn,nsrem
6445C-----------------------------------------------
6446C L o c a l V a r i a b l e s
6447C-----------------------------------------------
6448 INTEGER I,J,N,N1,N2,NE,IG,M1,M2
6449C-----------------------------------------------
6450 DO i = 1, jlt
6451C--------second node-----
6452 ig = ns_imp(i)
6453 IF (ig<=nsn) THEN
6454 n1 = irects(1,ig)
6455 n2 = irects(2,ig)
6456 IF (iloc(n1)==0) THEN
6457 n_impn=n_impn+1
6458 iloc(n1)=n_impn
6459 ENDIF
6460 nrow(n1)=nrow(n1)+2
6461 IF (iloc(n2)==0) THEN
6462 n_impn=n_impn+1
6463 iloc(n2)=n_impn
6464 ENDIF
6465 nrow(n2)=nrow(n2)+2
6466 ELSE
6467 nsrem = nsrem + 2
6468 ENDIF
6469 ne=ne_imp(i)
6470 m1 = irectm(1,ne)
6471 m2 = irectm(2,ne)
6472 IF (iloc(m1)==0) THEN
6473 n_impn=n_impn+1
6474 iloc(m1)=n_impn
6475 ENDIF
6476 nrow(m1)=nrow(m1)+2
6477 IF (iloc(m2)==0) THEN
6478 n_impn=n_impn+1
6479 iloc(m2)=n_impn
6480 ENDIF
6481 nrow(m2)=nrow(m2)+2
6482 ENDDO
6483C----6---------------------------------------------------------------7---------8
6484 RETURN
6485 END
6486!||====================================================================
6487!|| row_int111 ../engine/source/implicit/ind_glob_k.F
6488!||--- called by ------------------------------------------------------
6489!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
6490!||--- calls -----------------------------------------------------
6491!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6492!||====================================================================
6493 SUBROUTINE row_int111(
6494 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
6495 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
6496 3 NSN )
6497C----6---------------------------------------------------------------7---------8
6498C I m p l i c i t T y p e s
6499C-----------------------------------------------
6500#include "implicit_f.inc"
6501C-----------------------------------------------
6502C D u m m y A r g u m e n t s
6503C-----------------------------------------------
6504 INTEGER NNMAX
6505 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),
6506 . nrow(*),iloc(*),icol(nnmax,*),n_impn,nsn
6507C REAL
6508C-----------------------------------------------
6509C L o c a l V a r i a b l e s
6510C-----------------------------------------------
6511 INTEGER I,J,N,N1,N2,NE,IG,NI,M1,M2,NJ,MI,MJ
6512C-----------------------------------------------
6513C---------ICOL : LOCAL NODE NUMBER--------
6514 DO i = 1, jlt
6515C--------second node-----
6516 ig = ns_imp(i)
6517 IF (ig<=nsn) THEN
6518 n1 = irects(1,ig)
6519 n2 = irects(2,ig)
6520 ne=ne_imp(i)
6521 m1 = irectm(1,ne)
6522 m2 = irectm(2,ne)
6523 ni=iloc(n1)
6524 mi=iloc(m1)
6525 mj=iloc(m2)
6526 CALL reorder_a(nrow(n1),icol(1,ni),m1)
6527 CALL reorder_a(nrow(m1),icol(1,mi),n1)
6528 CALL reorder_a(nrow(n1),icol(1,ni),m2)
6529 CALL reorder_a(nrow(m2),icol(1,mj),n1)
6530 nj=iloc(n2)
6531 CALL reorder_a(nrow(n2),icol(1,nj),m1)
6532 CALL reorder_a(nrow(m1),icol(1,mi),n2)
6533 CALL reorder_a(nrow(n2),icol(1,nj),m2)
6534 CALL reorder_a(nrow(m2),icol(1,mj),n2)
6535 ENDIF
6536 ENDDO
6537C----6---------------------------------------------------------------7---------8
6538 RETURN
6539 END
6540!||====================================================================
6541!|| row_int112 ../engine/source/implicit/ind_glob_k.F
6542!||--- called by ------------------------------------------------------
6543!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
6544!||--- calls -----------------------------------------------------
6545!|| row_adds ../engine/source/implicit/ind_glob_k.F
6546!||====================================================================
6547 SUBROUTINE row_int112(
6548 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
6549 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
6550 3 ICOK ,NKMAX ,NSN )
6551C----6---------------------------------------------------------------7---------8
6552C I m p l i c i t T y p e s
6553C-----------------------------------------------
6554#include "implicit_f.inc"
6555C-----------------------------------------------
6556C D u m m y A r g u m e n t s
6557C-----------------------------------------------
6558 INTEGER NNMAX,NKMAX
6559 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),NROW(*),
6560 . iloc(*),icol(nnmax,*),icok(nkmax,*),n_impn,nsn
6561C REAL
6562C-----------------------------------------------
6563C L o c a l V a r i a b l e s
6564C-----------------------------------------------
6565 INTEGER I,J,N,N1,N2,NE,IG,NI,NM,NIM,M1,M2
6566C-----------------------------------------------
6567C---------ICOL : LOCAL NODE NUMBER--------
6568 DO i = 1, jlt
6569C--------second node-----
6570 ig = ns_imp(i)
6571 IF (ig<=nsn) THEN
6572 n1 = irects(1,ig)
6573 n2 = irects(2,ig)
6574 ne=ne_imp(i)
6575 m1 = irectm(1,ne)
6576 m2 = irectm(2,ne)
6577 CALL row_adds(n1 ,m1 ,iloc ,n_impn ,icol ,
6578 1 icok ,nrow ,nnmax ,nkmax )
6579 CALL row_adds(n1 ,m2 ,iloc ,n_impn ,icol ,
6580 1 icok ,nrow ,nnmax ,nkmax )
6581 CALL row_adds(n2 ,m1 ,iloc ,n_impn ,icol ,
6582 1 icok ,nrow ,nnmax ,nkmax )
6583 CALL row_adds(n2 ,m2 ,iloc ,n_impn ,icol ,
6584 1 icok ,nrow ,nnmax ,nkmax )
6585 END IF
6586 ENDDO
6587C----6---------------------------------------------------------------7---------8
6588 RETURN
6589 END
6590!||====================================================================
6591!|| row_adds ../engine/source/implicit/ind_glob_k.F
6592!||--- called by ------------------------------------------------------
6593!|| row_int112 ../engine/source/implicit/ind_glob_k.F
6594!||--- calls -----------------------------------------------------
6595!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6596!||====================================================================
6597 SUBROUTINE row_adds(NS ,NM ,ILOC ,ISHF ,ICOL ,
6598 1 ICOK ,NROW ,NNMAX ,NKMAX )
6599C----6---------------------------------------------------------------7---------8
6600C I m p l i c i t T y p e s
6601C-----------------------------------------------
6602#include "implicit_f.inc"
6603C-----------------------------------------------------------------
6604C D u m m y A r g u m e n t s
6605C-----------------------------------------------
6606 INTEGER NNMAX,NKMAX,NS,NM
6607 INTEGER NROW(*) ,ILOC(*) ,ISHF ,ICOL(NNMAX,*),ICOK(NKMAX,*)
6608C-----------------------------------------------
6609C L o c a l V a r i a b l e s
6610C-----------------------------------------------
6611 INTEGER N1,N2,N
6612C
6613C----6---------------------------------------------------------------7---------8
6614 n1 =iloc(ns)
6615 n2 =iloc(nm)
6616 IF (n1<=ishf) THEN
6617 CALL reorder_a(nrow(n1),icol(1,n1),nm)
6618 ELSE
6619 n=n1- ishf
6620 CALL reorder_a(nrow(n1),icok(1,n),nm)
6621 ENDIF
6622 IF (n2<=ishf) THEN
6623 CALL reorder_a(nrow(n2),icol(1,n2),ns)
6624 ELSE
6625 n=n2- ishf
6626 CALL reorder_a(nrow(n2),icok(1,n),ns)
6627 ENDIF
6628 RETURN
6629 END
6630!||====================================================================
6631!|| idel_int ../engine/source/implicit/ind_glob_k.F
6632!||--- called by ------------------------------------------------------
6633!|| imp_chkm ../engine/source/implicit/imp_solv.F
6634!|| imp_solv ../engine/source/implicit/imp_solv.F
6635!||--- calls -----------------------------------------------------
6636!|| ndof_int ../engine/source/implicit/ind_glob_k.F
6637!|| ndof_int11 ../engine/source/implicit/ind_glob_k.F
6638!|| ndof_int5 ../engine/source/implicit/ind_glob_k.F
6639!||--- uses -----------------------------------------------------
6640!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
6641!||====================================================================
6642 SUBROUTINE idel_int(
6643 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
6644 2 IND_IMP ,NDOF ,NT_IMP )
6645C-----------------------------------------------
6646C M o d u l e s
6647C-----------------------------------------------
6648 USE intbufdef_mod
6649C----6---------------------------------------------------------------7---------8
6650C I m p l i c i t T y p e s
6651C-----------------------------------------------
6652#include "implicit_f.inc"
6653C-----------------------------------------------
6654C C o m m o n B l o c k s
6655C-----------------------------------------------
6656#include "com01_c.inc"
6657#include "com04_c.inc"
6658#include "param_c.inc"
6659C-----------------------------------------------
6660C D u m m y A r g u m e n t s
6661C-----------------------------------------------
6662 INTEGER IPARI(NPARI,*),NUM_IMP(*),IND_IMP(*),
6663 . NS_IMP(*),NE_IMP(*),NDOF(*),NT_IMP
6664C REAL
6665
6666 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
6667C-----------------------------------------------
6668C L o c a l V a r i a b l e s
6669C-----------------------------------------------
6670 INTEGER NIN,NTY,NSN
6671 INTEGER I,J,K,L,NDOFI,N,IAD,N_IMP,NRTS,IDEL(NT_IMP),NEW_IAD
6672C--------ramener NDOF des seconds remotes-----------------------------------
6673 IF (NSPMD>1) THEN
6674 ENDIF
6675C
6676 iad=1
6677C MULTIMP=1
6678 n_imp=0
6679 DO nin=1,ninter
6680 nty =ipari(7,nin)
6681 nsn =ipari(5,nin)
6682C MULTIMP=MAX(MULTIMP,IPARI(23,NIN))
6683 IF(nty==3)THEN
6684 ELSEIF(nty==4)THEN
6685 ELSEIF(nty==5)THEN
6686 CALL ndof_int5(num_imp(nin),ns_imp(iad),ne_imp(iad),intbuf_tab(nin)%IRECTM,
6687 . intbuf_tab(nin)%NSV,nsn ,ndof ,idel(iad) ,
6688 . intbuf_tab(nin)%MSR)
6689 iad=iad+num_imp(nin)
6690 ENDIF
6691 ENDDO
6692 DO nin=1,ninter
6693 nty =ipari(7,nin)
6694 nsn =ipari(5,nin)
6695C MULTIMP=MAX(MULTIMP,IPARI(23,NIN))
6696 IF(nty==3)THEN
6697 ELSEIF(nty==4)THEN
6698 ELSEIF(nty==5)THEN
6699 ELSEIF(nty==6)THEN
6700
6701 ELSEIF(nty==7.OR.nty==10.OR.nty==24)THEN
6702C
6703 CALL ndof_int(num_imp(nin),ns_imp(iad),ne_imp(iad),intbuf_tab(nin)%IRECTM,
6704 . intbuf_tab(nin)%NSV,nsn ,ndof ,idel(iad) )
6705 iad=iad+num_imp(nin)
6706 ELSEIF(nty==11)THEN
6707C
6708 nrts =ipari(3,nin)
6709 CALL ndof_int11(num_imp(nin),ns_imp(iad),ne_imp(iad),
6710 . intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%IRECTM,nrts ,
6711 . ndof ,idel(iad) )
6712 iad=iad+num_imp(nin)
6713 ENDIF
6714 ENDDO
6715C-------actualise NUM_IMP,NS_IMP,NE_IMP,IND_IMP-------
6716 new_iad = 0
6717 iad=1
6718C-------int5 first------
6719 DO nin=1,ninter
6720 n_imp=0
6721 nty =ipari(7,nin)
6722 IF (nty==5) THEN
6723 DO i= 1,num_imp(nin)
6724 IF (idel(iad+i)>0) THEN
6725 new_iad = new_iad + 1
6726 ns_imp(new_iad)=ns_imp(iad+i)
6727 ne_imp(new_iad)=ne_imp(iad+i)
6728 ind_imp(new_iad)=ind_imp(iad+i)
6729 n_imp = n_imp + 1
6730 ENDIF
6731 ENDDO
6732 iad=iad+num_imp(nin)
6733 num_imp(nin) = n_imp
6734 END IF
6735 ENDDO
6736 DO nin=1,ninter
6737 n_imp=0
6738 IF (nty/=5) THEN
6739 DO i= 1,num_imp(nin)
6740 IF (idel(iad+i)>0) THEN
6741 new_iad = new_iad + 1
6742 ns_imp(new_iad)=ns_imp(iad+i)
6743 ne_imp(new_iad)=ne_imp(iad+i)
6744 ind_imp(new_iad)=ind_imp(iad+i)
6745 n_imp = n_imp + 1
6746 ENDIF
6747 ENDDO
6748 iad=iad+num_imp(nin)
6749 num_imp(nin) = n_imp
6750 END IF
6751 ENDDO
6752C----6---------------------------------------------------------------7---------8
6753 RETURN
6754 END
6755!||====================================================================
6756!|| ndof_int ../engine/source/implicit/ind_glob_k.F
6757!||--- called by ------------------------------------------------------
6758!|| idel_int ../engine/source/implicit/ind_glob_k.F
6759!||====================================================================
6760 SUBROUTINE ndof_int(
6761 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
6762 2 NSN ,NDOF ,IDEL_INT )
6763C----6---------------------------------------------------------------7---------8
6764C I m p l i c i t T y p e s
6765C-----------------------------------------------
6766#include "implicit_f.inc"
6767C-----------------------------------------------
6768C D u m m y A r g u m e n t s
6769C-----------------------------------------------
6770 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),
6771 . IDEL_INT(*),NDOF(*),NSN
6772C REAL
6773C-----------------------------------------------
6774C L o c a l V a r i a b l e s
6775C-----------------------------------------------
6776 INTEGER I,J,N,N1,N2,NE,IG
6777C-----------------------------------------------
6778 DO i = 1, jlt
6779C--------second node-----
6780 ig = ns_imp(i)
6781 IF (ig<=nsn) THEN
6782 n1 = nsv(ig)
6783 idel_int(i) = ndof(n1)
6784 ELSE
6785 ENDIF
6786 ne=ne_imp(i)
6787 DO j=1,3
6788 n=irect(j,ne)
6789 idel_int(i) = min(idel_int(i),ndof(n))
6790 ENDDO
6791 IF (irect(3,ne)/=irect(4,ne)) THEN
6792 n=irect(4,ne)
6793 idel_int(i) = min(idel_int(i),ndof(n))
6794 ENDIF
6795 ENDDO
6796C----6---------------------------------------------------------------7---------8
6797 RETURN
6798 END
6799!||====================================================================
6800!|| ndof_int11 ../engine/source/implicit/ind_glob_k.F
6801!||--- called by ------------------------------------------------------
6802!|| idel_int ../engine/source/implicit/ind_glob_k.F
6803!||====================================================================
6804 SUBROUTINE ndof_int11(
6805 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
6806 2 NSN ,NDOF ,IDEL_INT )
6807C----6---------------------------------------------------------------7---------8
6808C I m p l i c i t T y p e s
6809C-----------------------------------------------
6810#include "implicit_f.inc"
6811C-----------------------------------------------
6812C D u m m y A r g u m e n t s
6813C-----------------------------------------------
6814 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),
6815 . IDEL_INT(*),NDOF(*),NSN
6816C REAL
6817C-----------------------------------------------
6818C L o c a l V a r i a b l e s
6819C-----------------------------------------------
6820 INTEGER I,J,N,N1,N2,NE,IG,M1,M2
6821C-----------------------------------------------
6822 DO I = 1, jlt
6823C--------second node-----
6824 ig = ns_imp(i)
6825 IF (ig<=nsn) THEN
6826 n1 = irects(1,ig)
6827 idel_int(i) = ndof(n1)
6828 n2 = irects(2,ig)
6829 idel_int(i) = min(idel_int(i),ndof(n2))
6830 ELSE
6831 ENDIF
6832 ne=ne_imp(i)
6833 m1 = irectm(1,ne)
6834 m2 = irectm(2,ne)
6835 idel_int(i) = min(idel_int(i),ndof(m1))
6836 idel_int(i) = min(idel_int(i),ndof(m2))
6837 ENDDO
6838C----6---------------------------------------------------------------7---------8
6839 RETURN
6840 END
6841!||====================================================================
6842!|| ndof_int5 ../engine/source/implicit/ind_glob_k.F
6843!||--- called by ------------------------------------------------------
6844!|| idel_int ../engine/source/implicit/ind_glob_k.F
6845!||====================================================================
6846 SUBROUTINE ndof_int5(
6847 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
6848 2 NSN ,NDOF ,IDEL_INT ,MSR )
6849C----6---------------------------------------------------------------7---------8
6850C I m p l i c i t T y p e s
6851C-----------------------------------------------
6852#include "implicit_f.inc"
6853C-----------------------------------------------
6854C D u m m y A r g u m e n t s
6855C-----------------------------------------------
6856 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),
6857 . IDEL_INT(*),NDOF(*),NSN,MSR(*)
6858C REAL
6859C-----------------------------------------------
6860C L o c a l V a r i a b l e s
6861C-----------------------------------------------
6862 INTEGER I,J,N,N1,N2,NE,IG
6863C-----------------------------------------------
6864 DO i = 1, jlt
6865C--------second node-----
6866 ig = ns_imp(i)
6867 n1 = nsv(ig)
6868 idel_int(i) = ndof(n1)
6869 ne=ne_imp(i)
6870 DO j=1,3
6871 n=msr(irect(j,ne))
6872 idel_int(i) = min(idel_int(i),ndof(n))
6873 ENDDO
6874 IF (irect(3,ne)/=irect(4,ne)) THEN
6875 n=msr(irect(4,ne))
6876 idel_int(i) = min(idel_int(i),ndof(n))
6877 ENDIF
6878 ENDDO
6879C----6---------------------------------------------------------------7---------8
6880 RETURN
6881 END
6882!||====================================================================
6883!|| dim_spa2 ../engine/source/implicit/ind_glob_k.F
6884!||--- calls -----------------------------------------------------
6885!|| cp_int ../engine/source/implicit/produt_v.F
6886!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6887!||====================================================================
6888 SUBROUTINE dim_spa2(NDDL,IADK,JDIK,L_NZ)
6889C-----------------------------------------------
6890C I m p l i c i t T y p e s
6891C-----------------------------------------------
6892#include "implicit_f.inc"
6893C-----------------------------------------------
6894C D u m m y A r g u m e n t s
6895C-----------------------------------------------
6896 INTEGER NDDL,IADK(*),JDIK(*),L_NZ
6897C-----------------------------------------------
6898C L o c a l V a r i a b l e s
6899C-----------------------------------------------
6900 INTEGER I,J,K,JD,ICOL(NDDL),NRI
6901C-----------------------------------------------
6902 l_nz = 0
6903 DO i = 1,nddl
6904 nri = iadk(i+1)-iadk(i)
6905 CALL cp_int(nri,jdik(iadk(i)),icol)
6906 DO j=iadk(i),iadk(i+1)-1
6907 jd = jdik(j)
6908 DO k = iadk(jd),iadk(jd+1)-1
6909 CALL reorder_a(nri,icol,jdik(k))
6910 ENDDO
6911 ENDDO
6912 l_nz = l_nz + nri
6913 ENDDO
6914C--------------------------------------------
6915 RETURN
6916 END
6917!||====================================================================
6918!|| ind_spa2 ../engine/source/implicit/ind_glob_k.F
6919!||--- calls -----------------------------------------------------
6920!|| cp_int ../engine/source/implicit/produt_v.F
6921!|| k_band ../engine/source/implicit/imp_solv.F
6922!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6923!|| reorder_m ../engine/source/implicit/ind_glob_k.F
6924!||====================================================================
6925 SUBROUTINE ind_spa2(NDDL,IADK,JDIK,IADM,JDIM,L_MAX)
6926C-----------------------------------------------
6927C I m p l i c i t T y p e s
6928C-----------------------------------------------
6929#include "implicit_f.inc"
6930C-----------------------------------------------
6931C D u m m y A r g u m e n t s
6932C-----------------------------------------------
6933 INTEGER NDDL,IADK(*),JDIK(*),IADM(*),JDIM(*),L_MAX
6934C-----------------------------------------------
6935C L o c a l V a r i a b l e s
6936C-----------------------------------------------
6937 INTEGER I,J,K,ICOL(NDDL),L_NZ,NRI,JD
6938C---- 6 ------- OPT.Consider-Creer from nodal arrays-, IADM, JDIM+UPD_ (Each ISETK)
6939 L_NZ = 0
6940 iadm(l_nz+1) = l_nz+1
6941 DO i = 1,nddl
6942 nri = iadk(i+1)-iadk(i)
6943 CALL cp_int(nri,jdik(iadk(i)),icol)
6944 DO j=iadk(i),iadk(i+1)-1
6945 jd = jdik(j)
6946 DO k = iadk(jd),iadk(jd+1)-1
6947 CALL reorder_a(nri,icol,jdik(k))
6948 ENDDO
6949 ENDDO
6950 CALL reorder_m(nri,icol)
6951 DO j=1,nri
6952 l_nz = l_nz + 1
6953 jdim(l_nz) = icol(j)
6954 ENDDO
6955 iadm(i+1) = l_nz+1
6956 ENDDO
6957 CALL k_band(nddl,iadm,jdim,l_max)
6958C--------------------------------------------
6959 RETURN
6960 END
6961!||====================================================================
6962!|| reorder_m ../engine/source/implicit/ind_glob_k.F
6963!||--- called by ------------------------------------------------------
6964!|| dim_span ../engine/source/implicit/ind_glob_k.F
6965!|| ind_spa2 ../engine/source/implicit/ind_glob_k.F
6966!|| ind_span ../engine/source/implicit/ind_glob_k.F
6967!||====================================================================
6968 SUBROUTINE reorder_m(N,IC)
6969C----6---------------------------------------------------------------7---------8
6970C I m p l i c i t T y p e s
6971C-----------------------------------------------
6972#include "implicit_f.inc"
6973C-----------------------------------------------------------------
6974C D u m m y A r g u m e n t s
6975C-----------------------------------------------
6976 INTEGER N ,IC(*)
6977C-----------------------------------------------
6978C L o c a l V a r i a b l e s
6979C-----------------------------------------------
6980 INTEGER I,J,II,IT,IMIN
6981C
6982 IF (N==0) return
6983C----- In increasing order -----
6984 DO i =1,n
6985 imin=ic(i)
6986 ii=i
6987 DO j =i+1,n
6988 IF (ic(j)<imin) THEN
6989 imin=ic(j)
6990 ii=j
6991 ENDIF
6992 ENDDO
6993 IF (ii/=i) THEN
6994 it=ic(i)
6995 ic(i)=ic(ii)
6996 ic(ii)=it
6997 ENDIF
6998 ENDDO
6999C----6---------------------------------------------------------------7---------8
7000 RETURN
7001 END
7002!||====================================================================
7003!|| dim_span ../engine/source/implicit/ind_glob_k.F
7004!||--- called by ------------------------------------------------------
7005!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
7006!|| ini_k0h ../engine/source/implicit/imp_solv.F
7007!||--- calls -----------------------------------------------------
7008!|| cp_int ../engine/source/implicit/produt_v.F
7009!|| reorder_a ../engine/source/implicit/ind_glob_k.F
7010!|| reorder_m ../engine/source/implicit/ind_glob_k.F
7011!||--- uses -----------------------------------------------------
7012!|| imp_ppat ../engine/share/modules/impbufdef_mod.F
7013!||====================================================================
7014 SUBROUTINE dim_span(NN,NDDL,IADK,JDIK,L_NZ,NDMAX)
7015C-----------------------------------------------
7016C M o d u l e s
7017C-----------------------------------------------
7018 USE imp_ppat
7019C-----------------------------------------------
7020C I m p l i c i t T y p e s
7021C-----------------------------------------------
7022#include "implicit_f.inc"
7023C-----------------------------------------------
7024C D u m m y A r g u m e n t s
7025C-----------------------------------------------
7026 INTEGER NDDL,IADK(*),JDIK(*),L_NZ,NN,NDMAX
7027C-----------------------------------------------
7028C L o c a l V a r i a b l e s
7029C-----------------------------------------------
7030 INTEGER I,J,K,JD,ICOL(NDDL),ICRI(NDDL),NRI,NR0
7031 INTEGER, DIMENSION(:),ALLOCATABLE :: IADK0,JDIK0
7032 INTEGER, DIMENSION(:),ALLOCATABLE :: IADL,JDIL
7033C----6---d'abord---K0:matrice complete(non triang)
7034 l_nz = 2*(iadk(nddl+1)-iadk(1))
7035 ALLOCATE(iadk0(nddl+1),jdik0(l_nz))
7036 DO i = 1, nddl
7037 icol(i) = iadk(i+1) - iadk(i)
7038 DO j = iadk(i),iadk(i+1)-1
7039 jd = jdik(j)
7040 icol(jd) = icol(jd) + 1
7041 ENDDO
7042 ENDDO
7043 iadk0(1) = 1
7044 DO i = 1,nddl
7045 iadk0(i+1) = iadk0(i)+icol(i)
7046 icri(i) = pre_fpat(i)
7047 ENDDO
7048 DO i = 1,nddl
7049 nri = iadk(i+1)-iadk(i)
7050 CALL cp_int(nri,jdik(iadk(i)),jdik0(iadk0(i)))
7051 icol(i) = nri
7052 DO j=iadk(i),iadk(i+1)-1
7053 jd = jdik(j)
7054 k = iadk0(jd) + icol(jd)
7055 jdik0(k) = i
7056 icol(jd) = icol(jd) + 1
7057 ENDDO
7058 ENDDO
7059C
7060 l_nz = 0
7061 DO i = 1,nddl
7062 nri = iadk(i+1)-iadk(i)
7063 IF (icri(i)==1) THEN
7064 CALL cp_int(nri,jdik(iadk(i)),icol)
7065 DO j=iadk(i),iadk(i+1)-1
7066 jd = jdik(j)
7067 DO k = iadk0(jd),iadk0(jd+1)-1
7068 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7069 ENDDO
7070 ENDDO
7071 ENDIF
7072 l_nz = l_nz + nri
7073 ENDDO
7074C
7075 SELECT CASE(nn)
7076 CASE (2)
7077C
7078 CASE (3)
7079C-----------L->K^2----------
7080 ALLOCATE(iadl(nddl+1),jdil(l_nz))
7081 iadl(1) = 1
7082 l_nz = 0
7083 DO i = 1,nddl
7084 nri = iadk(i+1)-iadk(i)
7085 CALL cp_int(nri,jdik(iadk(i)),icol)
7086 IF (icri(i)==1) THEN
7087 nr0 = nri
7088 DO j=iadk(i),iadk(i+1)-1
7089 jd = jdik(j)
7090 DO k = iadk0(jd),iadk0(jd+1)-1
7091 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7092 ENDDO
7093 ENDDO
7094 IF (nri>nr0) CALL reorder_m(nri,icol)
7095 ENDIF
7096 DO j=1,nri
7097 l_nz = l_nz + 1
7098 jdil(l_nz) = icol(j)
7099 ENDDO
7100 iadl(i+1) = l_nz+1
7101 ENDDO
7102c print *,'nddl,L_NZ,NDMAX=',nddl,L_NZ,NDMAX
7103C---- ---------*K0------------
7104 l_nz = 0
7105 DO i = 1,nddl
7106 nri = iadl(i+1)-iadl(i)
7107 IF (icri(i)==1) THEN
7108 CALL cp_int(nri,jdil(iadl(i)),icol)
7109 DO j=iadl(i),iadl(i+1)-1
7110 jd = jdil(j)
7111 DO k = iadk0(jd),iadk0(jd+1)-1
7112 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7113 ENDDO
7114 ENDDO
7115 ENDIF
7116 l_nz = l_nz + nri
7117 ENDDO
7118 DEALLOCATE(iadl,jdil)
7119C
7120 CASE (4)
7121C-----------L->K^2----------
7122 ALLOCATE(iadl(nddl+1),jdil(l_nz))
7123 iadl(1) = 1
7124 l_nz = 0
7125 DO i = 1,nddl
7126 nri = iadk(i+1)-iadk(i)
7127 CALL cp_int(nri,jdik(iadk(i)),icol)
7128 IF (icri(i)==1) THEN
7129 nr0 = nri
7130 DO j=iadk(i),iadk(i+1)-1
7131 jd = jdik(j)
7132 DO k = iadk0(jd),iadk0(jd+1)-1
7133 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7134 ENDDO
7135 ENDDO
7136 IF (nri>nr0) CALL reorder_m(nri,icol)
7137 ENDIF
7138 DO j=1,nri
7139 l_nz = l_nz + 1
7140 jdil(l_nz) = icol(j)
7141 ENDDO
7142 iadl(i+1) = l_nz+1
7143 ENDDO
7144C-----------K0-> K^2-complete---------
7145 DEALLOCATE(jdik0)
7146 ALLOCATE(jdik0(2*l_nz))
7147 DO i = 1, nddl
7148 icol(i) = iadl(i+1) - iadl(i)
7149 DO j = iadl(i),iadl(i+1)-1
7150 jd = jdil(j)
7151 icol(jd) = icol(jd) + 1
7152 ENDDO
7153 ENDDO
7154 iadk0(1) = 1
7155 DO i = 1,nddl
7156 iadk0(i+1) = iadk0(i)+icol(i)
7157 ENDDO
7158 DO i = 1,nddl
7159 nri = iadl(i+1)-iadl(i)
7160 CALL cp_int(nri,jdil(iadl(i)),jdik0(iadk0(i)))
7161 icol(i) = nri
7162 DO j=iadl(i),iadl(i+1)-1
7163 jd = jdil(j)
7164 k = iadk0(jd) + icol(jd)
7165 jdik0(k) = i
7166 icol(jd) = icol(jd) + 1
7167 ENDDO
7168 ENDDO
7169C-----------* K^2----------
7170 l_nz = 0
7171 DO i = 1,nddl
7172 nri = iadl(i+1)-iadl(i)
7173 CALL cp_int(nri,jdil(iadl(i)),icol)
7174 IF (icri(i)==1) THEN
7175 DO j=iadl(i),iadl(i+1)-1
7176 jd = jdil(j)
7177 DO k = iadk0(jd),iadk0(jd+1)-1
7178 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7179 ENDDO
7180 ENDDO
7181 ENDIF
7182 l_nz = l_nz + nri
7183 ENDDO
7184 DEALLOCATE(iadl,jdil)
7185 END SELECT
7186 DEALLOCATE(iadk0,jdik0)
7187c print *,'DIM_NZ,nddl=',L_NZ,nddl
7188C--------------------------------------------
7189 RETURN
7190 END
7191!||====================================================================
7192!|| ind_span ../engine/source/implicit/ind_glob_k.F
7193!||--- called by ------------------------------------------------------
7194!|| lin_solvih2 ../engine/source/implicit/lin_solv.F
7195!||--- calls -----------------------------------------------------
7196!|| cp_int ../engine/source/implicit/produt_v.F
7197!|| k_band ../engine/source/implicit/imp_solv.F
7198!|| reorder_a ../engine/source/implicit/ind_glob_k.F
7199!|| reorder_m ../engine/source/implicit/ind_glob_k.F
7200!||--- uses -----------------------------------------------------
7201!|| imp_ppat ../engine/share/modules/impbufdef_mod.F
7202!||====================================================================
7203 SUBROUTINE ind_span(NN,NDF,NDDL,IADK,JDIK,IADM,JDIM,L_MAX,NDMAX)
7204C-----------------------------------------------
7205C M o d u l e s
7206C-----------------------------------------------
7207 USE imp_ppat
7208C-----------------------------------------------
7209C I m p l i c i t T y p e s
7210C-----------------------------------------------
7211#include "implicit_f.inc"
7212C-----------------------------------------------
7213C D u m m y A r g u m e n t s
7214C-----------------------------------------------
7215 INTEGER NDDL,IADK(*),JDIK(*),IADM(*),JDIM(*),L_MAX,NN,NDF,NDMAX
7216C REAL
7217C-----------------------------------------------
7218C L o c a l V a r i a b l e s
7219C-----------------------------------------------
7220 INTEGER I,J,K,ICOL(NDDL),ICRI(NDDL),L_NZ,NRI,JD,NR0
7221 INTEGER, DIMENSION(:),ALLOCATABLE :: IADK0,JDIK0
7222 INTEGER, DIMENSION(:),ALLOCATABLE :: IADL,JDIL
7223C---- 6--Opt.Consider-Creer from nodal arrays-, IADM, JDIM+UPD_ (Each ISETK)
7224 l_nz = 2*(iadk(nddl+1)-iadk(1))
7225C
7226 ALLOCATE(iadk0(nddl+1),jdik0(l_nz))
7227 DO i = 1, nddl
7228 icol(i) = iadk(i+1) - iadk(i)
7229 DO j = iadk(i),iadk(i+1)-1
7230 jd = jdik(j)
7231 icol(jd) = icol(jd) + 1
7232 ENDDO
7233 ENDDO
7234 iadk0(1) = 1
7235 DO i = 1,nddl
7236 iadk0(i+1) = iadk0(i)+icol(i)
7237 icri(i) = pre_fpat(i)
7238 ENDDO
7239 DO i = 1,nddl
7240 nri = iadk(i+1)-iadk(i)
7241 CALL cp_int(nri,jdik(iadk(i)),jdik0(iadk0(i)))
7242 icol(i) = nri
7243 DO j=iadk(i),iadk(i+1)-1
7244 jd = jdik(j)
7245 k = iadk0(jd) + icol(jd)
7246 jdik0(k) = i
7247 icol(jd) = icol(jd) + 1
7248 ENDDO
7249 ENDDO
7250C
7251 SELECT CASE(nn)
7252 CASE (2)
7253C
7254 iadm(1) = iadk(1)
7255 DO i = 1,ndf
7256 iadm(i+1) = iadk(i+1)
7257 ENDDO
7258 DO j=iadk(1),iadk(ndf+1)-1
7259 jdim(j) = jdik(j)
7260 ENDDO
7261 l_nz = iadk(ndf+1)-iadk(1)
7262C
7263 DO i = ndf+1,nddl
7264 nri = iadk(i+1)-iadk(i)
7265 CALL cp_int(nri,jdik(iadk(i)),icol)
7266 IF (icri(i)==1) THEN
7267 nr0 = nri
7268 DO j=iadk(i),iadk(i+1)-1
7269 jd = jdik(j)
7270 DO k = iadk0(jd),iadk0(jd+1)-1
7271 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7272 ENDDO
7273 ENDDO
7274 IF (nri>nr0) CALL reorder_m(nri,icol)
7275 ENDIF
7276 DO j=1,nri
7277 l_nz = l_nz + 1
7278 jdim(l_nz) = icol(j)
7279 ENDDO
7280 iadm(i+1) = l_nz+1
7281 ENDDO
7282C
7283 CASE (3)
7284C
7285 iadm(1) = iadk(1)
7286 DO i = 1,ndf
7287 iadm(i+1) = iadk(i+1)
7288 ENDDO
7289 DO j=iadk(1),iadk(ndf+1)-1
7290 jdim(j) = jdik(j)
7291 ENDDO
7292 l_nz = iadk(ndf+1)-iadk(1)
7293C
7294 DO i = ndf+1,nddl
7295 nri = iadk(i+1)-iadk(i)
7296 CALL cp_int(nri,jdik(iadk(i)),icol)
7297 IF (icri(i)==1) THEN
7298 nr0 = nri
7299 DO j=iadk(i),iadk(i+1)-1
7300 jd = jdik(j)
7301 DO k = iadk0(jd),iadk0(jd+1)-1
7302 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7303 ENDDO
7304 ENDDO
7305 IF (nri>nr0) CALL reorder_m(nri,icol)
7306 ENDIF
7307 DO j=1,nri
7308 l_nz = l_nz + 1
7309 jdim(l_nz) = icol(j)
7310 ENDDO
7311 iadm(i+1) = l_nz+1
7312 ENDDO
7313C
7314 ALLOCATE(iadl(nddl+1),jdil(l_nz))
7315 CALL cp_int(nddl+1,iadm,iadl)
7316 CALL cp_int(l_nz,jdim,jdil)
7317 l_nz = iadk(ndf+1)-iadk(1)
7318 DO i = ndf+1,nddl
7319 nri = iadl(i+1)-iadl(i)
7320 CALL cp_int(nri,jdil(iadl(i)),icol)
7321 IF (icri(i)==1) THEN
7322 nr0 = nri
7323 DO j=iadl(i),iadl(i+1)-1
7324 jd = jdil(j)
7325 DO k = iadk0(jd),iadk0(jd+1)-1
7326 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7327 ENDDO
7328 ENDDO
7329 IF (nri>nr0) CALL reorder_m(nri,icol)
7330 ENDIF
7331 DO j=1,nri
7332 l_nz = l_nz + 1
7333 jdim(l_nz) = icol(j)
7334 ENDDO
7335 iadm(i+1) = l_nz+1
7336 ENDDO
7337 DEALLOCATE(iadl,jdil)
7338 CASE (4)
7339C
7340 l_nz = 0
7341 iadm(1) = iadk(1)
7342 DO i = 1,nddl
7343 nri = iadk(i+1)-iadk(i)
7344 CALL cp_int(nri,jdik(iadk(i)),icol)
7345 IF (icri(i)==1) THEN
7346 nr0 = nri
7347 DO j=iadk(i),iadk(i+1)-1
7348 jd = jdik(j)
7349 DO k = iadk0(jd),iadk0(jd+1)-1
7350 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7351 ENDDO
7352 ENDDO
7353 IF (nri>nr0) CALL reorder_m(nri,icol)
7354 ENDIF
7355 DO j=1,nri
7356 l_nz = l_nz + 1
7357 jdim(l_nz) = icol(j)
7358 ENDDO
7359 iadm(i+1) = l_nz+1
7360 ENDDO
7361 ALLOCATE(iadl(nddl+1),jdil(l_nz))
7362 CALL cp_int(nddl+1,iadm,iadl)
7363 CALL cp_int(l_nz,jdim,jdil)
7364C-----------K0-> K^2-complete---------
7365 DEALLOCATE(jdik0)
7366 ALLOCATE(jdik0(2*l_nz))
7367 DO i = 1, nddl
7368 icol(i) = iadl(i+1) - iadl(i)
7369 DO j = iadl(i),iadl(i+1)-1
7370 jd = jdil(j)
7371 icol(jd) = icol(jd) + 1
7372 ENDDO
7373 ENDDO
7374 iadk0(1) = 1
7375 DO i = 1,nddl
7376 iadk0(i+1) = iadk0(i)+icol(i)
7377 ENDDO
7378 DO i = 1,nddl
7379 nri = iadl(i+1)-iadl(i)
7380 CALL cp_int(nri,jdil(iadl(i)),jdik0(iadk0(i)))
7381 icol(i) = nri
7382 DO j=iadl(i),iadl(i+1)-1
7383 jd = jdil(j)
7384 k = iadk0(jd) + icol(jd)
7385 jdik0(k) = i
7386 icol(jd) = icol(jd) + 1
7387 ENDDO
7388 ENDDO
7389C
7390 iadm(1) = iadk(1)
7391 DO i = 1,ndf
7392 iadm(i+1) = iadk(i+1)
7393 ENDDO
7394 DO j=iadk(1),iadk(ndf+1)-1
7395 jdim(j) = jdik(j)
7396 ENDDO
7397 l_nz = iadk(ndf+1)-iadk(1)
7398 DO i = ndf+1,nddl
7399 nri = iadl(i+1)-iadl(i)
7400 CALL cp_int(nri,jdil(iadl(i)),icol)
7401 IF (icri(i)==1) THEN
7402 nr0 = nri
7403 DO j=iadl(i),iadl(i+1)-1
7404 jd = jdil(j)
7405 DO k = iadk0(jd),iadk0(jd+1)-1
7406 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7407 ENDDO
7408 ENDDO
7409 IF (nri>nr0) CALL reorder_m(nri,icol)
7410 ENDIF
7411 DO j=1,nri
7412 l_nz = l_nz + 1
7413 jdim(l_nz) = icol(j)
7414 ENDDO
7415 iadm(i+1) = l_nz+1
7416 ENDDO
7417 DEALLOCATE(iadl,jdil)
7418 END SELECT
7419 DEALLOCATE(iadk0,jdik0)
7420 CALL k_band(nddl,iadm,jdim,l_max)
7421C--------------------------------------------
7422 RETURN
7423 END
7424!||====================================================================
7425!|| fil_span0 ../engine/source/implicit/ind_glob_k.F
7426!||--- called by ------------------------------------------------------
7427!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
7428!||--- uses -----------------------------------------------------
7429!|| imp_ppat ../engine/share/modules/impbufdef_mod.F
7430!||====================================================================
7431 SUBROUTINE fil_span0(NRBYAC,IRBYAC,NPBY,IDDL,NDOF,NDDL)
7432C-----------------------------------------------
7433C M o d u l e s
7434C-----------------------------------------------
7435 USE imp_ppat
7436C-----------------------------------------------
7437C I m p l i c i t T y p e s
7438C-----------------------------------------------
7439#include "implicit_f.inc"
7440C-----------------------------------------------
7441C C o m m o n B l o c k s
7442C-----------------------------------------------
7443#include "param_c.inc"
7444C-----------------------------------------------
7445C D u m m y A r g u m e n t s
7446C-----------------------------------------------
7447 INTEGER NDDL,NPBY(NNPBY,*),IDDL(*),NRBYAC,IRBYAC(*),NDOF(*)
7448C REAL
7449C-----------------------------------------------
7450C L o c a l V a r i a b l e s
7451C-----------------------------------------------
7452 INTEGER I,J,M,N,ID
7453C----6---------------------------------------------------
7454C
7455 ALLOCATE(pre_fpat(nddl))
7456 pre_fpat = 1
7457 DO i=1,nrbyac
7458 n=irbyac(i)
7459 m =npby(1,n)
7460 id = iddl(m)
7461 DO j=1,ndof(m)
7462 pre_fpat(id+j) = 0
7463 ENDDO
7464 ENDDO
7465C--------------------------------------------
7466 RETURN
7467 END
7468!||====================================================================
7469!|| fil_span1 ../engine/source/implicit/ind_glob_k.F
7470!||--- called by ------------------------------------------------------
7471!|| imp_solv ../engine/source/implicit/imp_solv.F
7472!||--- uses -----------------------------------------------------
7473!|| imp_ppat ../engine/share/modules/impbufdef_mod.F
7474!||====================================================================
7475 SUBROUTINE fil_span1(NRBYAC,IRBYAC,NPBY,IDDL,NDDL,IKC,NDOF,INLOC)
7476C-----------------------------------------------
7477C M o d u l e s
7478C-----------------------------------------------
7479 USE imp_ppat
7480C-----------------------------------------------
7481C I m p l i c i t T y p e s
7482C-----------------------------------------------
7483#include "implicit_f.inc"
7484C-----------------------------------------------
7485C C o m m o n B l o c k s
7486C-----------------------------------------------
7487#include "com04_c.inc"
7488#include "param_c.inc"
7489C-----------------------------------------------
7490C D u m m y A r g u m e n t s
7491C-----------------------------------------------
7492 INTEGER NDDL,NPBY(NNPBY,*),IDDL(*),NRBYAC,IRBYAC(*),
7493 + ikc(*),ndof(*),inloc(*)
7494C REAL
7495C-----------------------------------------------
7496C L o c a l V a r i a b l e s
7497C-----------------------------------------------
7498 INTEGER I,J,M,N,ID,IDDLM(NDDL),IFIX,IDM
7499C----6---------------------------------------------------
7500C
7501 DO i=1,nddl
7502 pre_fpat(i) = 1
7503 ENDDO
7504C
7505 ifix=0
7506 DO n = 1,numnod
7507 i=inloc(n)
7508 iddlm(i)=iddl(i)-ifix
7509 DO j=1,ndof(i)
7510 id = iddl(i)+j
7511 IF (ikc(id)/=0) ifix=ifix+1
7512 ENDDO
7513 ENDDO
7514 DO i=1,nrbyac
7515 n=irbyac(i)
7516 m =npby(1,n)
7517 id = iddl(m)
7518 idm = iddlm(m)
7519 ifix=0
7520 DO j=1,ndof(m)
7521 IF (ikc(id+j)==0) THEN
7522 ifix=ifix+1
7523 pre_fpat(idm+ifix) = 0
7524 ENDIF
7525 ENDDO
7526 ENDDO
7527C--------------------------------------------
7528 RETURN
7529 END
7530!||====================================================================
7531!|| dim_ktot ../engine/source/implicit/ind_glob_k.F
7532!||--- calls -----------------------------------------------------
7533!|| cp_int ../engine/source/implicit/produt_v.F
7534!|| l2g_kloc ../engine/source/implicit/ind_glob_k.F
7535!|| reorder_a ../engine/source/implicit/ind_glob_k.F
7536!||====================================================================
7537 SUBROUTINE dim_ktot(NDDL ,IADK ,JDIK ,IADI ,JDII ,
7538 1 ITOK ,NDDLI ,L_NZ ,LT_I )
7539C-----------------------------------------------
7540C I m p l i c i t T y p e s
7541C-----------------------------------------------
7542#include "implicit_f.inc"
7543C-----------------------------------------------
7544C D u m m y A r g u m e n t s
7545C-----------------------------------------------
7546 INTEGER NDDL,NDDLI,IADK(*),JDIK(*),IADI(*),JDII(*),
7547 . itok(*),l_nz
7548 my_real
7549 . lt_i(*)
7550C-----------------------------------------------
7551C L o c a l V a r i a b l e s
7552C-----------------------------------------------
7553 INTEGER I,J,K,JD,JK,K2I(NDDL),ICOL(NDDL),NRI
7554C----6---------------------------------------------------------------7---------8
7555 CALL l2g_kloc(nddli ,iadi ,jdii ,itok ,lt_i )
7556C
7557 DO i = 1,nddl
7558 k2i(i) = 0
7559 ENDDO
7560 DO i = 1,nddli
7561 j = itok(i)
7562 k2i(j) = i
7563 ENDDO
7564 l_nz = 0
7565 DO i = 1,nddl
7566 nri = iadk(i+1)-iadk(i)
7567 IF (k2i(i)>0) THEN
7568 CALL cp_int(nri,jdik(iadk(i)),icol)
7569 k = k2i(i)
7570 DO j=iadi(k),iadi(k+1)-1
7571 jd = jdii(j)
7572 jk = itok(jd)
7573 CALL reorder_a(nri,icol,jk)
7574 ENDDO
7575 ENDIF
7576 l_nz = l_nz + nri
7577 ENDDO
7578C--------------------------------------------
7579 RETURN
7580 END
7581!||====================================================================
7582!|| ind_ktot ../engine/source/implicit/ind_glob_k.F
7583!||--- calls -----------------------------------------------------
7584!|| ancmsg ../engine/source/output/message/message.F
7585!|| arret ../engine/source/system/arret.F
7586!||--- uses -----------------------------------------------------
7587!|| message_mod ../engine/share/message_module/message_mod.F
7588!||====================================================================
7589 SUBROUTINE ind_ktot(NDDL ,IADK ,JDIK ,IADI ,JDII ,
7590 1 ITOK ,NDDLI ,IADT ,JDIT ,LT_K ,
7591 2 LT_I ,LT_T ,NZL )
7592C-----------------------------------------------
7593C M o d u l e s
7594C-----------------------------------------------
7595 USE message_mod
7596C-----------------------------------------------
7597C I m p l i c i t T y p e s
7598C-----------------------------------------------
7599#include "implicit_f.inc"
7600C-----------------------------------------------
7601C D u m m y A r g u m e n t s
7602C-----------------------------------------------
7603 INTEGER NDDL,NDDLI,IADK(*),JDIK(*),IADI(*),JDII(*),
7604 . itok(*),iadt(*) ,jdit(*),nzl
7605 my_real
7606 . lt_k(*), lt_i(*), lt_t(*)
7607C-----------------------------------------------
7608C L o c a l V a r i a b l e s
7609C-----------------------------------------------
7610 INTEGER I,J,K,N,L,JD,JK,K2I(NDDL),IFT,NZ
7611C----6---------------------------------------------------------------7---------8
7612C
7613 DO I = 1,nddl
7614 k2i(i) = 0
7615 ENDDO
7616 DO i = 1,nddli
7617 j = itok(i)
7618 k2i(j) = i
7619 IF (iadi(i)==iadi(i+1)) k2i(j) = 0
7620 ENDDO
7621C
7622 nz = 0
7623 iadt(1) = nz + 1
7624 DO i = 1,nddl
7625 IF (k2i(i)==0) THEN
7626 DO j=iadk(i),iadk(i+1)-1
7627 nz = nz + 1
7628 jdit(nz) = jdik(j)
7629 lt_t(nz) = lt_k(j)
7630 ENDDO
7631 ELSE
7632 n = k2i(i)
7633C---- first for [k]----
7634 k=iadi(n)
7635 jd = jdii(k)
7636 jk = itok(jd)
7637 ift = iadk(i)
7638 DO k=iadi(n),iadi(n+1)-1
7639 jd = jdii(k)
7640 jk = itok(jd)
7641 DO j=ift,iadk(i+1)-1
7642 IF (jk==jdik(j)) THEN
7643 nz = nz + 1
7644 jdit(nz) = jdik(j)
7645 lt_t(nz) = lt_k(j)+lt_i(k)
7646 ift = j + 1
7647 GOTO 100
7648 ELSEIF (jk<jdik(j)) THEN
7649 nz = nz + 1
7650 jdit(nz) = jk
7651 lt_t(nz) = lt_i(k)
7652 GOTO 100
7653 ELSE
7654 nz = nz + 1
7655 jdit(nz) = jdik(j)
7656 lt_t(nz) = lt_k(j)
7657 ift = j + 1
7658 ENDIF
7659 ENDDO
7660C---- end of insert-----
7661 j = iadk(i+1)-1
7662 IF (jk>jdik(j)) THEN
7663 nz = nz + 1
7664 jdit(nz) = jk
7665 lt_t(nz) = lt_i(k)
7666 ENDIF
7667 100 CONTINUE
7668 IF (k==(iadi(n+1)-1)) THEN
7669 DO j=ift,iadk(i+1)-1
7670 nz = nz + 1
7671 jdit(nz) = jdik(j)
7672 lt_t(nz) = lt_k(j)
7673 ENDDO
7674 ENDIF
7675 ENDDO
7676 ENDIF
7677 iadt(i+1) = nz + 1
7678 ENDDO
7679 IF (nz/=nzl) THEN
7680 CALL ancmsg(msgid=80,anmode=aninfo,
7681 . c1='ASSEMBLY')
7682 IF (nz>nzl) CALL arret(2)
7683 ENDIF
7684C--------------------------------------------
7685 RETURN
7686 END
7687!||====================================================================
7688!|| l2g_kloc ../engine/source/implicit/ind_glob_k.F
7689!||--- called by ------------------------------------------------------
7690!|| dim_ktot ../engine/source/implicit/ind_glob_k.F
7691!||--- calls -----------------------------------------------------
7692!|| ancmsg ../engine/source/output/message/message.F
7693!|| arret ../engine/source/system/arret.F
7694!|| cp_int ../engine/source/implicit/produt_v.F
7695!|| cp_real ../engine/source/implicit/produt_v.F
7696!|| reorder_kij ../engine/source/implicit/ind_glob_k.F
7697!||--- uses -----------------------------------------------------
7698!|| message_mod ../engine/share/message_module/message_mod.F
7699!||====================================================================
7700 SUBROUTINE l2g_kloc(NDDLI ,IADI ,JDII ,ITOK ,LT_I )
7701C-----------------------------------------------
7702C M o d u l e s
7703C-----------------------------------------------
7704 USE message_mod
7705C-----------------------------------------------
7706C I m p l i c i t T y p e s
7707C-----------------------------------------------
7708#include "implicit_f.inc"
7709C-----------------------------------------------
7710C C o m m o n B l o c k s
7711C-----------------------------------------------
7712#include "impl1_c.inc"
7713C-----------------------------------------------
7714C D u m m y A r g u m e n t s
7715C-----------------------------------------------
7716 INTEGER NDDLI,IADI(*),JDII(*),ITOK(*),NZI
7717 my_real
7718 . LT_I(*)
7719C-----------------------------------------------
7720C L o c a l V a r i a b l e s
7721C-----------------------------------------------
7722 INTEGER I,J,K,ICOL(NDDLI),L_NZ,NRI,NZ,JD,GI,GJ,IFT
7723 INTEGER, DIMENSION(:),ALLOCATABLE :: IADK0,JDIK0
7724 my_real,
7725 . DIMENSION(:),ALLOCATABLE :: LT_K0
7726C----6---------------
7727 l_nz = 2*(iadi(nddli+1)-iadi(1))
7728C -------------[K0]-locale complete----------
7729 ALLOCATE(iadk0(nddli+1),jdik0(l_nz),lt_k0(l_nz))
7730 DO i = 1,nddli
7731 icol(i) = 0
7732 ENDDO
7733 DO i = 1, nddli
7734 icol(i) = icol(i) + iadi(i+1) - iadi(i)
7735 DO j = iadi(i),iadi(i+1)-1
7736 jd = jdii(j)
7737 icol(jd) = icol(jd) + 1
7738 ENDDO
7739 ENDDO
7740 iadk0(1) = 1
7741 DO i = 1,nddli
7742 iadk0(i+1) = iadk0(i)+icol(i)
7743 ENDDO
7744 nz=iadk0(nddli+1) - iadk0(1)
7745 DO i = 1,nddli
7746 nri = iadi(i+1)-iadi(i)
7747 CALL cp_int(nri,jdii(iadi(i)),jdik0(iadk0(i)))
7748 CALL cp_real(nri,lt_i(iadi(i)),lt_k0(iadk0(i)))
7749 icol(i) = nri
7750 ENDDO
7751 DO i = 1,nddli
7752 DO j=iadi(i),iadi(i+1)-1
7753 jd = jdii(j)
7754 k = iadk0(jd) + icol(jd)
7755 jdik0(k) = i
7756 lt_k0(k) = lt_i(j)
7757 icol(jd) = icol(jd) + 1
7758 ENDDO
7759 ENDDO
7760C
7761 nz = 0
7762 iadi(1) = nz + 1
7763 IF (ikpat==0 )THEN
7764C -------------trang_sup----------
7765 DO i = 1, nddli
7766 gi = itok(i)
7767 DO j = iadk0(i),iadk0(i+1)-1
7768 jd = jdik0(j)
7769 gj = itok(jd)
7770 IF (gj>gi)THEN
7771 nz = nz + 1
7772 jdii(nz) = jd
7773 lt_i(nz) = lt_k0(j)
7774 ENDIF
7775 ENDDO
7776 iadi(i+1) = nz + 1
7777 ENDDO
7778 ELSE
7779C -------------trang_inf----------
7780 DO i = 1, nddli
7781 gi = itok(i)
7782 DO j = iadk0(i),iadk0(i+1)-1
7783 jd = jdik0(j)
7784 gj = itok(jd)
7785 IF (gj<gi)THEN
7786 nz = nz + 1
7787 jdii(nz) = jd
7788 lt_i(nz) = lt_k0(j)
7789 ENDIF
7790 ENDDO
7791 iadi(i+1) = nz + 1
7792 ENDDO
7793 ENDIF
7794 DEALLOCATE(iadk0,jdik0,lt_k0)
7795 IF (nz>l_nz/2) THEN
7796 CALL ancmsg(msgid=80,anmode=aninfo,
7797 . c1='TRANSLATION')
7798 CALL arret(2)
7799 ENDIF
7800C -------------in order----------
7801 DO i = 1,nddli
7802 nz = iadi(i+1)-iadi(i)
7803 ift = iadi(i)
7804 CALL reorder_kij(nz,jdii(ift),lt_i(ift),itok)
7805 ENDDO
7806C--------------------------------------------
7807 RETURN
7808 END
7809!||====================================================================
7810!|| reorder_kij ../engine/source/implicit/ind_glob_k.F
7811!||--- called by ------------------------------------------------------
7812!|| l2g_kloc ../engine/source/implicit/ind_glob_k.F
7813!||====================================================================
7814 SUBROUTINE reorder_kij(N,IC,RC,IDDL)
7815C----6---------------------------------------------------------------7---------8
7816C I m p l i c i t T y p e s
7817C-----------------------------------------------
7818#include "implicit_f.inc"
7819C-----------------------------------------------------------------
7820C D u m m y A r g u m e n t s
7821C-----------------------------------------------
7822 INTEGER N ,IC(*),IDDL(*)
7823 my_real
7824 . rc(*)
7825C-----------------------------------------------
7826C L o c a l V a r i a b l e s
7827C-----------------------------------------------
7828 INTEGER I,J,II,IT,IIC,IMIN,IDIC(N)
7829 my_real
7830 . s
7831C
7832 DO i =1,n
7833 idic(i)=iddl(ic(i))
7834 ENDDO
7835 IF (n==0) RETURN
7836C---- In an increasing iddl order -----
7837 DO i =1,n
7838 imin=idic(i)
7839 ii=i
7840 DO j =i+1,n
7841 IF (idic(j)<imin) THEN
7842 imin=idic(j)
7843 ii=j
7844 ENDIF
7845 ENDDO
7846 IF (ii/=i) THEN
7847 it=ic(i)
7848 s =rc(i)
7849 ic(i)=ic(ii)
7850 ic(ii)=it
7851 rc(i)=rc(ii)
7852 rc(ii)=s
7853 it=idic(i)
7854 idic(i)=idic(ii)
7855 idic(ii)=it
7856 ENDIF
7857 ENDDO
7858C----6---------------------------------------------------------------7---------8
7859 RETURN
7860 END
7861!||====================================================================
7862!|| ndof_fv ../engine/source/implicit/ind_glob_k.F
7863!||--- called by ------------------------------------------------------
7864!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
7865!||--- calls -----------------------------------------------------
7866!|| ancmsg ../engine/source/output/message/message.F
7867!|| arret ../engine/source/system/arret.F
7868!||--- uses -----------------------------------------------------
7869!|| message_mod ../engine/share/message_module/message_mod.F
7870!||====================================================================
7871 SUBROUTINE ndof_fv(IBFV ,VEL ,NDOF ,IFRAME)
7872 USE message_mod
7873C-----------------------------------------------
7874C I m p l i c i t T y p e s
7875C-----------------------------------------------
7876#include "implicit_f.inc"
7877#include "mvsiz_p.inc"
7878C-----------------------------------------------
7879C C o m m o n B l o c k s
7880C-----------------------------------------------
7881#include "com04_c.inc"
7882#include "com08_c.inc"
7883#include "param_c.inc"
7884C-----------------------------------------------
7885C D u m m y A r g u m e n t s
7886C-----------------------------------------------
7887 INTEGER IBFV(NIFV,*),NDOF(*),IFRAME(LISKN,*)
7888C REAL
7889 my_real
7890 . vel(lfxvelr,*)
7891C-----------------------------------------------
7892C L o c a l V a r i a b l e s
7893C-----------------------------------------------
7894 INTEGER N, I, ISK, J, L, K1, K2, K3, ISENS,K,
7895 . ii, ic, nn, ideb, nr, nsk, nfk, ifm,index(mvsiz)
7896C REAL
7897 my_real
7898 . fac, startt, stopt, ts
7899C IBFV(7,N):1 V;2 D ;0 A ;
7900C-------------------------------
7901 ideb = 0
7902C----is there is Du in [TT,TSTOP] TT-> Tstart
7903 DO nn=1,nfxvel,nvsiz
7904 IF (ibfv(8,nn)==1) GOTO 100
7905 ic = 0
7906C IF (NSENSOR>0) : by sensor will be ignoned (if not activated)
7907 DO 20 ii = 1, min(nfxvel-ideb,nvsiz)
7908 n = ii+ideb
7909 startt = vel(2,n)
7910 stopt = vel(3,n)
7911 IF(tstop<=startt)GOTO 20
7912 IF(tt>=stopt) GOTO 20
7913 i=iabs(ibfv(1,n))
7914 ic = ic + 1
7915 index(ic) = n
7916 20 CONTINUE
7917 ideb = ideb + min(nfxvel-ideb,nvsiz)
7918C
7919 DO ii=1,ic
7920 n = index(ii)
7921 i=iabs(ibfv(1,n))
7922 isk=ibfv(2,n)/10
7923 ifm = ibfv(9,n)
7924 j=ibfv(2,n)
7925 IF (ifm<=1) j=j-10*isk
7926 IF(j<=3)THEN
7927 IF (ndof(i)==0) ndof(i)=3
7928 ELSEIF(j<=6)THEN
7929 IF (ndof(i)==0) ndof(i)=6
7930C stop erroring out
7931 IF (ndof(i) <=3) THEN
7932 CALL ancmsg(msgid=253,anmode=aninfo)
7933 CALL arret(2)
7934 ENDIF
7935 ENDIF
7936C---------Otherwise Rotation will not be transforted
7937C IF (IFM >1) THEN
7938C I = IFRAME(1,IFM)
7939C IF (NDOF(I)==0) NDOF(I)=3
7940C IF (NDOF(I)==0.AND.J>3) NDOF(I)=6
7941C END IF
7942 ENDDO
7943 100 CONTINUE
7944 ENDDO
7945C
7946 RETURN
7947 END
7948!||====================================================================
7949!|| i24msegv ../engine/source/implicit/ind_glob_k.F
7950!||--- called by ------------------------------------------------------
7951!|| row_int24 ../engine/source/implicit/ind_glob_k.F
7952!|| row_int241 ../engine/source/implicit/ind_glob_k.F
7953!|| row_int242 ../engine/source/implicit/ind_glob_k.F
7954!|| rowfr_dim24 ../engine/source/mpi/implicit/imp_fri.F
7955!|| rowfr_ind24 ../engine/source/mpi/implicit/imp_fri.F
7956!||====================================================================
7957 SUBROUTINE i24msegv(IE ,IRTLMV ,SUBTRIA,IRTLM ,NVOISIN)
7958C-----------------------------------------------
7959C I m p l i c i t T y p e s
7960C-----------------------------------------------
7961#include "implicit_f.inc"
7962C-----------------------------------------------
7963C D u m m y A r g u m e n t s
7964C-----------------------------------------------
7965 INTEGER IE,IRTLMV(4),IRTLM(4),SUBTRIA,NVOISIN(8)
7966C-----------------------------------------------
7967C L o c a l V a r i a b l e s
7968C-----------------------------------------------
7969 INTEGER IX1, IX2, IX3, IX4
7970C-----------------------------------------------
7971C 11-------10
7972C |\ 19 /|
7973C | \ / |
7974C | \ / |
7975C | 16 |
7976C |15/ \11|
7977C | / \ |
7978C |/ 7 \|
7979C12-------4-------3-------9
7980C |\ 12 /|\ /|\ 14 /|
7981C | \ / | \ 3 / | \ / |
7982C | \ / | \ /2 |6 \ /18|
7983C | 17 | 5 | 15 |
7984C |20/ \ 8| 4/ \ | / \ |
7985C | / \ | / 1 \ | / \ |
7986C |/ 16 \|/ \|/ 10 \|
7987C13-------1-------2-------8
7988C |\ 5 /|
7989C | \ / |
7990C |9 \ /13|
7991C | 14 |
7992C | / \ |
7993C | / \ |
7994C |/ 17 \|
7995C 6-------7
7996C-----------------------------------------
7997 SELECT CASE (subtria)
7998C-----------------------------------------
7999 CASE(5,9,13,17)
8000 ix1 = irtlm(2)
8001 ix2 = irtlm(1)
8002 ix3 = iabs(nvoisin(1))
8003 ix4 = iabs(nvoisin(2))
8004C-----------------------------------------
8005 CASE(6,10,14,18)
8006 ix1 = irtlm(3)
8007 ix2 = irtlm(2)
8008 ix3 = iabs(nvoisin(3))
8009 ix4 = iabs(nvoisin(4))
8010C-----------------------------------------
8011 CASE(7,11,15,19)
8012 ix1 = irtlm(4)
8013 ix2 = irtlm(3)
8014 ix3 = iabs(nvoisin(5))
8015 ix4 = iabs(nvoisin(6))
8016C-----------------------------------------
8017 CASE(8,12,16,20)
8018 ix1 = irtlm(1)
8019 ix2 = irtlm(4)
8020 ix3 = iabs(nvoisin(7))
8021 ix4 = iabs(nvoisin(8))
8022 END SELECT
8023 irtlmv(1) = ix1
8024 irtlmv(2) = ix2
8025 irtlmv(3) = ix3
8026 irtlmv(4) = ix4
8027 IF (irtlmv(2)==0) irtlmv(2)=irtlmv(1)
8028 IF (irtlmv(4)==0) irtlmv(4)=irtlmv(3)
8029C
8030 RETURN
8031 END
8032
intbuf_tab_c_ini
subroutine intbuf_tab_c_ini(intbuf_tab, intbuf_tab_c)
Definition copy_intbuf_tab.F:1071
my_real
#define my_real
Definition cppsort.cpp:32
i2_prem
subroutine i2_prem(ipari, khie, ni2, ii2, nsmax)
Definition i2_prem.F:29
kin_nrmax
subroutine kin_nrmax(nnmax, nkmax, nrowk, icok, icokm, iloc, ink, fr_elem, iad_elem)
Definition imp_fri.F:3219
zero_ikin2g
subroutine zero_ikin2g(nkine, iloc)
Definition imp_fri.F:4468
dim_fr_k
subroutine dim_fr_k(elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, ndof, nnmax, inloc, fr_elem, iad_elem, n_fr, igeo, fr_i2m, iad_i2m, elbuf_tab)
Definition imp_fri.F:3340
ind_kine_kp
subroutine ind_kine_kp(nrowk, icok, icokm, nnmax, nkmax, nkine, ink, ikpat, iddl)
Definition imp_fri.F:4506
intabfr
subroutine intabfr(nic, ic, n, intab)
Definition imp_fri.F:2140
set_ikin2g
subroutine set_ikin2g(nkine, inloc)
Definition imp_fri.F:4388
get_ikin2g
subroutine get_ikin2g(nkine, ink, iloc)
Definition imp_fri.F:4429
ind_fr_k
subroutine ind_fr_k(elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, ndof, nnmax, inloc, fr_elem, iad_elem, n_fr, igeo, elbuf_tab)
Definition imp_fri.F:3542
ind_nrfr
subroutine ind_nrfr(nft, nel, npn, npp, nnmax, nrow, icol, fr_elem, iad_elem, n_fr, icok)
Definition imp_fri.F:3635
dim_nrmax
subroutine dim_nrmax(nrow, fr_elem, iad_elem, nnmax)
Definition imp_fri.F:3114
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
spc_fr_k
subroutine spc_fr_k(iadk, jdik, ndof, iddl, fr_elem, iad_elem)
Definition imp_fri.F:10156
rowfr_ind
subroutine rowfr_ind(jlt, ns_imp, ne_imp, irect, nrow, icol, nnmax, nsn, nin)
Definition imp_fri.F:4939
kin_nrmax0
subroutine kin_nrmax0(nnmax, nkmax, nrowk, icok, icokm, iloc, ink, fr_elem, iad_elem)
Definition imp_fri.F:3162
ini_fr_k
subroutine ini_fr_k(elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, ndof, nnmax, inloc, fr_elem, iad_elem, n_fr, igeo, fr_i2m, iad_i2m, elbuf_tab, nnrmax)
Definition imp_fri.F:3901
imp_solv
subroutine imp_solv(output, timers, python, icode, iskew, iskwn, ipart, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg1, itab, itabm1, npc, ibcl, ibfv, sensor_tab, nnlink, lnlink, iparg, igrv, ipari, intbuf_tab, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, icodt, icodr, isky, adsky, iads_f, ilink, llink, weight, itask, ibvel, lbvel, fbvel, x, d, v, vr, dr, thke, damp, ms, in, pm, skews, geo, eani, bufmat, bufgeo, bufsf, tf, forc, vel, fsav, agrv, fr_wave, parts0, elbuf, rby, rivet, fr_elem, iad_elem, wa, a, ar, stifn, stifr, partsav, fsky, fskyi, iframe, xframe, w16, iactiv, fskym, igeo, ipm, wfext, nodft, nodlt, nint7, num_imp, ns_imp, ne_imp, ind_imp, it, rwbuf, lprw, fr_wall, nbintc, intlist, fopt, rwsav, fsavd, graphe, fac_k, ipiv_k, nkcond, nsensor, monvol, igrsurf, fr_mv, volmon, dirul, nodglob, mumps_par, cddlp, isendto, irecvfrom, newfront, imsch, i2msch, isizxv, ilenxv, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, kinet, num_imp1, temp, dt2prev, waint, lgrav, sh4tree, sh3tree, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, irbe3, lrbe3, frbe3, fr_i2m, iad_i2m, fr_rbe3m, iad_rbe3m, frwl6, irbe2, lrbe2, intbuf_tab_c, ikine, diag_sms, icfield, lcfield, cfield, count_remslv, count_remslve, elbuf_tab, elbuf_imp, xdp, weight_md, stack, dimfb, fbsav6, stabsen, tabsensor, drape_sh4n, drape_sh3n, h3d_data, multi_fvm, igrbric, igrsh4n, igrsh3n, igrbeam, forneqs, maxdgap, nddl0, nnzk0, it_t, impbuf_tab, cptreac, fthreac, nodreac, drapeg, interfaces, th_surf, dpl0cld, vel0cld, snpc, stf, glob_therm, wfext_md)
Definition imp_solv.F:175
imp_intbuf_ini
subroutine imp_intbuf_ini(imp_intbuf_tab, nimp)
Definition imp_solv.F:8580
k_band
subroutine k_band(nddl, iadk, jdik, ndmax)
Definition imp_solv.F:2254
spmd_ndof
subroutine spmd_ndof(ndof, fr_elem, iad_elem, tsize)
Definition imp_spmd.F:3044
spmd_i2d
subroutine spmd_i2d(ndof, fr_elem, iad_elem, tsize)
Definition imp_spmd.F:2793
spmd_max_i
subroutine spmd_max_i(n)
Definition imp_spmd.F:1362
fil_span1
subroutine fil_span1(nrbyac, irbyac, npby, iddl, nddl, ikc, ndof, inloc)
Definition ind_glob_k.F:7476
dim_elemax
subroutine dim_elemax(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iparg, elbuf, ndof, nrow, inloc, nnmax, l_max, c_max, igeo, elbuf_tab)
Definition ind_glob_k.F:1628
reorder_j
subroutine reorder_j(n, ic, ni, iddl)
Definition ind_glob_k.F:4387
row_int
subroutine row_int(jlt, ns_imp, ne_imp, irect, nsv, nrow, iloc, ndofi, n_impn, nsn, nsrem)
Definition ind_glob_k.F:5086
row_int2
subroutine row_int2(jlt, ns_imp, ne_imp, irect, nsv, nrow, n_impn, iloc, icol, nnmax, icok, nkmax, nsn)
Definition ind_glob_k.F:5201
ndof_int
subroutine ndof_int(jlt, ns_imp, ne_imp, irect, nsv, nsn, ndof, idel_int)
Definition ind_glob_k.F:6763
fil_span0
subroutine fil_span0(nrbyac, irbyac, npby, iddl, ndof, nddl)
Definition ind_glob_k.F:7432
ind_spa2
subroutine ind_spa2(nddl, iadk, jdik, iadm, jdim, l_max)
Definition ind_glob_k.F:6926
row_int112
subroutine row_int112(jlt, ns_imp, ne_imp, irects, irectm, nrow, n_impn, iloc, icol, nnmax, icok, nkmax, nsn)
Definition ind_glob_k.F:6551
dim_elems2
subroutine dim_elems2(elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, nrow, inloc, nnmax, icok, nkmax, icokm, ink, igeo, elbuf_tab)
Definition ind_glob_k.F:634
dim_elemsp
subroutine dim_elemsp(elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, nrow, inloc, nkmax, icok, igeo, elbuf_tab)
Definition ind_glob_k.F:1323
dim_ndof_d
subroutine dim_ndof_d(npby, lpby, nrbyac, irbyac, ndof, iad_rby, fr_rby)
Definition ind_glob_k.F:2043
row_adds
subroutine row_adds(ns, nm, iloc, ishf, icol, icok, nrow, nnmax, nkmax)
Definition ind_glob_k.F:6599
row_int5
subroutine row_int5(jlt, ns_imp, ne_imp, irect, nsv, msr, nrow, iloc, ndofi, n_impn, nsn, nsrem)
Definition ind_glob_k.F:5288
row_int52
subroutine row_int52(jlt, ns_imp, ne_imp, irect, nsv, msr, nrow, n_impn, iloc, icol, nnmax, icok, nkmax, nsn)
Definition ind_glob_k.F:5397
dim_kine_p
subroutine dim_kine_p(igeo, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, ndof, nsi2, nsrb, nkine, inloc, irbe3, irbe2, lrbe2, nkinm, intbuf_tab)
Definition ind_glob_k.F:1699
row_int51
subroutine row_int51(jlt, ns_imp, ne_imp, irect, nsv, msr, nrow, n_impn, iloc, icol, nnmax, nsn)
Definition ind_glob_k.F:5346
dim_kinmax
subroutine dim_kinmax(igeo, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iparg, ndof, nsi2, nsrb, elbuf, nkine, inloc, nrow, nnmax, nkmax, nss, nsij, nmij, nss2, nsij2, nmij2, fr_elem, iad_elem, sh4tree, sh3tree, irbe3, lrbe3, nss3, irbe2, lrbe2, nsb2, elbuf_tab)
Definition ind_glob_k.F:3193
ndof_int11
subroutine ndof_int11(jlt, ns_imp, ne_imp, irects, irectm, nsn, ndof, idel_int)
Definition ind_glob_k.F:6807
ndof_fv
subroutine ndof_fv(ibfv, vel, ndof, iframe)
Definition ind_glob_k.F:7872
ind_int_k
subroutine ind_int_k(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, nss, iss, nint2, iint2, nss2, iss2, nddli, nnzi, iadi, jdii, iddli, iloci, n_impn, itok, iddl, nnmax, nkmax, n_impm, ndof, iaint2, irbe3, lrbe3, nss3, iss3, irbe2, lrbe2, nsb2, isb2, ind_subt)
Definition ind_glob_k.F:4847
ind_ktot
subroutine ind_ktot(nddl, iadk, jdik, iadi, jdii, itok, nddli, iadt, jdit, lt_k, lt_i, lt_t, nzl)
Definition ind_glob_k.F:7592
i24msegv
subroutine i24msegv(ie, irtlmv, subtria, irtlm, nvoisin)
Definition ind_glob_k.F:7958
dim_ndof_ii
subroutine dim_ndof_ii(nint2, iint2, ipari, ndof, nrbe3, irbe3, lrbe3, nrbe2, irbe2, lrbe2, intbuf_tab)
Definition ind_glob_k.F:1926
reorder_l
subroutine reorder_l(n, ic, ni, iddl)
Definition ind_glob_k.F:4452
dim_elems3
subroutine dim_elems3(elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, nrow, inloc, nkmax, icok, igeo, elbuf_tab)
Definition ind_glob_k.F:336
ind_kine_k
subroutine ind_kine_k(npby, lpby, itab, nrbyac, irbyac, nsc, isij, nmc, imij, nss, iss, nint2, iint2, ipari, intbuf_tab, nsc2, isij2, nss2, iss2, ndof, nnmax, nkine, inloc, nkmax, nrowk, icok, icokm, nmc2, imij2, ink, irbe3, lrbe3, iss3, irbe2, lrbe2, isb2, nsrb2)
Definition ind_glob_k.F:2775
dim_elems1
subroutine dim_elems1(igeo, elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, ndof, nrow, elbuf_tab)
Definition ind_glob_k.F:38
row_int241
subroutine row_int241(jlt, ns_imp, ne_imp, irect, nsv, nrow, n_impn, iloc, icol, nnmax, nsn, subtria, nvoisin)
Definition ind_glob_k.F:5554
dim_span
subroutine dim_span(nn, nddl, iadk, jdik, l_nz, ndmax)
Definition ind_glob_k.F:7015
row_int1
subroutine row_int1(jlt, ns_imp, ne_imp, irect, nsv, nrow, n_impn, iloc, icol, nnmax, nsn)
Definition ind_glob_k.F:5148
dim_kine_t
subroutine dim_kine_t(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndof, nnmax, nrowi, nkine, inloc, icok, nss, nsij, nmij, nss2, nsij2, nmij2, nkmax, icokm, ink, irbe3, lrbe3, nss3, irbe2, lrbe2, nsb2)
Definition ind_glob_k.F:2420
reorder_kij
subroutine reorder_kij(n, ic, rc, iddl)
Definition ind_glob_k.F:7815
ndof_int5
subroutine ndof_int5(jlt, ns_imp, ne_imp, irect, nsv, nsn, ndof, idel_int, msr)
Definition ind_glob_k.F:6849
dim_ndof_i
subroutine dim_ndof_i(npby, lpby, itab, nrbyac, irbyac, ndof, nsrb, ipari, nint2, iint2, nsi2, nprw, irbe3, irbe2, nsrb2, fr_elem, iad_elem, intbuf_tab)
Definition ind_glob_k.F:1816
reorder_m
subroutine reorder_m(n, ic)
Definition ind_glob_k.F:6969
row_int24
subroutine row_int24(jlt, ns_imp, ne_imp, irect, nsv, nrow, iloc, ndofi, n_impn, nsn, nsrem, subtria, nvoisin)
Definition ind_glob_k.F:5483
dim_kine_i
subroutine dim_kine_i(num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, lnss, lnss2, nrow, nkine, inloc, nnmax, n_impm, ndof, ndofi, iaint2, irbe3, lrbe3, lnss3, irbe2, lrbe2, lnsb2, lnsrb2, ind_subt)
Definition ind_glob_k.F:5720
row_int242
subroutine row_int242(jlt, ns_imp, ne_imp, irect, nsv, nrow, n_impn, iloc, icol, nnmax, icok, nkmax, nsn, subtria, nvoisin)
Definition ind_glob_k.F:5614
row_int111
subroutine row_int111(jlt, ns_imp, ne_imp, irects, irectm, nrow, n_impn, iloc, icol, nnmax, nsn)
Definition ind_glob_k.F:6497
reorder_a1
subroutine reorder_a1(n, ic, id)
Definition ind_glob_k.F:4312
set_ind_k
subroutine set_ind_k(iddl, ndof, iadk, jdik, nddl, nnzk, nrow, icol, n, ikpat)
Definition ind_glob_k.F:3656
ind_span
subroutine ind_span(nn, ndf, nddl, iadk, jdik, iadm, jdim, l_max, ndmax)
Definition ind_glob_k.F:7204
dim_kine_s
subroutine dim_kine_s(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndof, nnmax, nrow, nrowi, nkine, inloc, icok, irbe3, lrbe3, irbe2, lrbe2)
Definition ind_glob_k.F:2112
ind_kine_i
subroutine ind_kine_i(npby, lpby, itab, nrbyac, irbyac, nss, iss, nint2, iint2, ipari, intbuf_tab, nss2, iss2, nnmax, inloc, nkmax, nrowk, icok, icokm, ink, ndof, ndof1, iaint2, irbe3, lrbe3, nss3, iss3, irbe2, lrbe2, nsb2, isb2)
Definition ind_glob_k.F:6173
dim_ktot
subroutine dim_ktot(nddl, iadk, jdik, iadi, jdii, itok, nddli, l_nz, lt_i)
Definition ind_glob_k.F:7539
dim_int_k
subroutine dim_int_k(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, lnss, nint2, iint2, iaint2, lnss2, nddl, nnzk, iddl, iloci, n_impn, n_impm, nnmax, nkmax, ndof, nsrem, irbe3, lrbe3, lnss3, irbe2, lrbe2, lnsb2, lnsrb2, ind_subt)
Definition ind_glob_k.F:4670
dim_int7
subroutine dim_int7(ninter, ipari, intbuf_tab, nnmax)
Definition ind_glob_k.F:4554
nddl_loc
subroutine nddl_loc(nddl, iddl, iloc, nloc, ndof)
Definition ind_glob_k.F:5042
dim_elems4
subroutine dim_elems4(elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, nrow, inloc, nnmax, icok, nkmax, icokm, ink, igeo, elbuf_tab)
Definition ind_glob_k.F:973
intab
logical function intab(nic, ic, n)
Definition ind_glob_k.F:4515
dim_spa2
subroutine dim_spa2(nddl, iadk, jdik, l_nz)
Definition ind_glob_k.F:6889
idel_int
subroutine idel_int(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, ind_imp, ndof, nt_imp)
Definition ind_glob_k.F:6645
l2g_kloc
subroutine l2g_kloc(nddli, iadi, jdii, itok, lt_i)
Definition ind_glob_k.F:7701
reorder_i
subroutine reorder_i(n, ic)
Definition ind_glob_k.F:4207
dim_glob_k
subroutine dim_glob_k(geo, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iparg, ndof, iddl, nddl, nnzk, elbuf, inloc, lsize, fr_elem, iad_elem, fr_i2m, iad_i2m, nprw, nmonv, imonv, monvol, igrsurf, fr_mv, ipm, igeo, iad_rby, fr_rby, sh4tree, sh3tree, irbe3, lrbe3, fr_rbe3m, iad_rbe3m, irbe2, lrbe2, ibfv, vel, elbuf_tab, iframe, intbuf_tab)
Definition ind_glob_k.F:3385
row_int11
subroutine row_int11(jlt, ns_imp, ne_imp, irects, irectm, nrow, iloc, ndofi, n_impn, nsn, nsrem)
Definition ind_glob_k.F:6436
reorder_a
subroutine reorder_a(n, ic, id)
Definition ind_glob_k.F:4286
ind_glob_k
subroutine ind_glob_k(npby, lpby, itab, nrbyac, irbyac, nsc, isij, nmc, imij, nss, iss, nint2, iint2, ipari, intbuf_tab, nsc2, isij2, nss2, iss2, iparg, elbuf, elbuf_tab, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iddl, ndof, iadk, jdik, nddl, nnzk, nnmax, nkine, inloc, nkmax, nrowk, icok, icokm, nmc2, imij2, irk, npn, npp, fr_elem, iad_elem, ipm, igeo, irbe3, lrbe3, iss3, fr_i2m, iad_i2m, fr_rbe3m, iad_rbe3m, irbe2, lrbe2, isb2, nsrb2)
Definition ind_glob_k.F:3748
reorder_j1
subroutine reorder_j1(n, ic, ni)
Definition ind_glob_k.F:4355
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
monv_prem
subroutine monv_prem(nmonv, imonv, monvol, igrsurf, fr_mv, itag, npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndof, iprec0, irbe3, irbe2, lrbe2)
Definition monv_imp0.F:40
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
imp_ppat
Definition impbufdef_mod.F:437
imp_ppat::pre_fpat
integer, dimension(:), allocatable pre_fpat
Definition impbufdef_mod.F:439
message_mod
Definition message_mod.F:1257
cp_real
subroutine cp_real(n, x, xc)
Definition produt_v.F:871
cp_int
subroutine cp_int(n, x, xc)
Definition produt_v.F:916
rbyac_imp
subroutine rbyac_imp(npby, itab, nrbyac, irbyac, nsmax)
Definition rbyac_imp.F:29
rmind_imp
subroutine rmind_imp(nnmax, inloc, nrowk, icok)
Definition rm_imp0.F:334
rmdim_imp
subroutine rmdim_imp(ixc, ixtg, ndof, nnmax, nkine, inloc, nrow, itab, sh4tree, sh3tree)
Definition rm_imp0.F:36
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
nl
character *2 function nl()
Definition message.F:2360
arret
subroutine arret(nn)
Definition arret.F:86