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!||====================================================================
32 SUBROUTINE dim_elems1(
33 1 IGEO ,ELBUF ,IPARG ,IXS ,IXQ ,
34 2 IXC ,IXT ,IXP ,IXR ,IXTG ,
35 3 IXTG1 ,IXS10 ,IXS20 ,IXS16 ,
36 4 NDOF ,NROW ,ELBUF_TAB )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_mod
41C----6---------------------------------------------------------------7---------8
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "param_c.inc"
50#include "com04_c.inc"
51C-----------------------------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER IPARG(NPARG,*),IGEO(NPROPGI,*)
55 INTEGER
56 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
57 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
58 . ixs16(8,*),ixtg1(4,*),ndof(*),nrow(*)
59C REAL
60 my_real
61 . elbuf(*)
62 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
67 . I,J,K,N,M,EP,L,IGTYP,NNOD,K1,IHBE,EP1,IAD0,NPT,IDRIL
68 my_real
69 . IOF
70C--------NROW(NUMNOD) : number of connected nodes (sym)
71C----6---------------------------------------------------------------7---------8
72 DO 100 ng=1,ngroup
73 IF (iparg(8,ng)/=1) THEN
74 ity=iparg(5,ng)
75 nel=iparg(2,ng)
76 nft=iparg(3,ng)
77 iad=iparg(4,ng)
78 npt=iparg(6,ng)
79 icnod=iparg(11,ng)
80 isnod=iparg(28,ng)
81 idril=iparg(41,ng)
82 iad0 = iad-1
83C----------no ndof defined for void, rigid mat add dof to pass U_D later-
84 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) THEN
85C----------------deformable
86 ELSE
87C-----------------------
88C 1. ELEMENTS SOLIDES
89C-----------------------
90 IF (ity==1) THEN
91 DO i=1,nel
92 iof = elbuf_tab(ng)%GBUF%OFF(i)
93 IF(iof>zero)THEN
94 nnod=8
95 ep=i+nft
96 IF (isnod==4) THEN
97 nnod=4
98 nc(1)=ixs(2,ep)
99 nc(2)=ixs(4,ep)
100 nc(3)=ixs(7,ep)
101 nc(4)=ixs(6,ep)
102 ELSEIF (isnod==6) THEN
103 nnod=6
104 nc(1)=ixs(2,ep)
105 nc(2)=ixs(3,ep)
106 nc(3)=ixs(4,ep)
107 nc(4)=ixs(6,ep)
108 nc(5)=ixs(7,ep)
109 nc(6)=ixs(8,ep)
110 ELSEIF (isnod==10) THEN
111 nnod=4
112 nc(1)=ixs(2,ep)
113 nc(2)=ixs(4,ep)
114 nc(3)=ixs(7,ep)
115 nc(4)=ixs(6,ep)
116 ep1=ep-numels8
117 DO j=1,6
118 IF (ixs10(j,ep1)>0) THEN
119 nnod = nnod + 1
120 nc(nnod) = ixs10(j,ep1)
121 ENDIF
122 ENDDO
123 ELSEIF (isnod==8) THEN
124 nnod=8
125 DO j=1,nnod
126 nc(j)=ixs(j+1,ep)
127 ENDDO
128 ELSEIF (isnod==20) THEN
129 nnod=20
130 DO j=1,8
131 nc(j)=ixs(j+1,ep)
132 ENDDO
133 ep1=ep-(numels8+numels10)
134 DO j=9,20
135 nc(j)=ixs20(j-8,ep1)
136 ENDDO
137
138 ELSE
139 nnod=0
140 ENDIF
141 CALL reorder_i(nnod,nc)
142 DO j=1,nnod
143 n=nc(j)
144 ndof(n)=max(3,ndof(n))
145 DO l=j+1,nnod
146 IF (n/=nc(l)) nrow(n)=nrow(n)+1
147 ENDDO
148 ENDDO
149 ENDIF
150 ENDDO
151C-----------------------
152C 2. ELEMENTS 2D
153C-----------------------
154 ELSEIF(ity==2)THEN
155 DO i=1,nel
156 iof = elbuf_tab(ng)%GBUF%OFF(i)
157 IF(iof>zero)THEN
158C
159 nnod=4
160 ep=i+nft
161C IF (ISNOD==4) THEN
162C NNOD=4
163 DO j=1,nnod
164 nc(j)=ixq(j+1,ep)
165 ENDDO
166C ELSE
167C NNOD=0
168C ENDIF
169C
170 CALL reorder_i(nnod,nc)
171 DO j=1,nnod
172 n=nc(j)
173 ndof(n)=max(3,ndof(n)) !3
174 DO l=j+1,nnod
175 IF (n/=nc(l)) nrow(n)=nrow(n)+1
176 ENDDO
177 ENDDO
178C
179 ENDIF
180 ENDDO
181C-----------------------
182C 3. ELEMENTS COQUES
183C-----------------------
184 ELSEIF(ity==3)THEN
185 DO i=1,nel
186 iof = elbuf_tab(ng)%GBUF%OFF(i)
187 IF(iof>zero)THEN
188 nnod=4
189 ep=i+nft
190 DO j=1,nnod
191 nc(j)=ixc(j+1,ep)
192 ENDDO
193 CALL reorder_i(nnod,nc)
194 DO j=1,nnod
195 n=nc(j)
196 IF (npt==1.AND.idril==0) THEN
197 ndof(n)=max(3,ndof(n))
198 ELSE
199 ndof(n)=6
200 END IF
201 DO l=j+1,nnod
202 IF (n/=nc(l)) nrow(n)=nrow(n)+1
203 ENDDO
204 ENDDO
205 ENDIF
206 ENDDO
207C-----------------------
208C 4. ELEMENTS TIGES
209C-----------------------
210 ELSEIF(ity==4)THEN
211 nnod=2
212 DO i=1,nel
213 iof=elbuf_tab(ng)%GBUF%OFF(i)
214 IF(iof>zero)THEN
215 ep=i+nft
216 nc(1)=ixt(2,ep)
217 nc(2)=ixt(3,ep)
218 CALL reorder_i(nnod,nc)
219 DO j=1,nnod
220 n=nc(j)
221 ndof(n)=max(3,ndof(n))
222 DO l=1,nnod
223 IF (n/=nc(l)) nrow(n)=nrow(n)+1
224 ENDDO
225 ENDDO
226 ENDIF
227 ENDDO
228C-----------------------
229C 5. ELEMENTS POUTRES
230C-----------------------
231 ELSEIF(ity==5)THEN
232 nnod=2
233 DO i=1,nel
234 iof=elbuf_tab(ng)%GBUF%OFF(i)
235 IF(iof>zero)THEN
236 ep=i+nft
237 nc(1)=ixp(2,ep)
238 nc(2)=ixp(3,ep)
239 CALL reorder_i(nnod,nc)
240 DO j=1,nnod
241 n=nc(j)
242 ndof(n)=6
243 DO l=j+1,nnod
244 IF (n/=nc(l)) nrow(n)=nrow(n)+1
245 ENDDO
246 ENDDO
247 ENDIF
248 ENDDO
249C-----------------------
250C 6. ELEMENTS RESSORTS
251C-----------------------
252 ELSEIF(ity==6)THEN
253 nnod=2
254 DO i=1,nel
255 iof=elbuf_tab(ng)%GBUF%OFF(i)
256 IF(iof>zero)THEN
257 ep=i+nft
258 nc(1)=ixr(2,ep)
259 nc(2)=ixr(3,ep)
260 igtyp = igeo(11,ixr(1,ep))
261 IF (igtyp==12) THEN
262 nnod=3
263 nc(3)=ixr(4,ep)
264 ENDIF
265 CALL reorder_i(nnod,nc)
266 DO j=1,nnod
267 n=nc(j)
268 DO l=j+1,nnod
269 IF (n/=nc(l)) nrow(n)=nrow(n)+1
270 ENDDO
271 ENDDO
272 IF (igtyp==8.OR.igtyp==13) THEN
273 DO j=1,nnod
274 ndof(nc(j))=6
275 ENDDO
276 ELSEIF (igtyp==4.OR.igtyp==12.OR.igtyp==32) THEN
277 DO j=1,nnod
278 ndof(nc(j))=max(3,ndof(nc(j)))
279 ENDDO
280 ENDIF
281 ENDIF
282 ENDDO
283C-----------------------
284C 7. ELEMENTS COQUES 3N
285C-----------------------
286 ELSEIF(ity==7.AND.icnod/=6)THEN
287 nnod=3
288 DO i=1,nel
289 iof = elbuf_tab(ng)%GBUF%OFF(i)
290 IF(iof>zero)THEN
291 ep=i+nft
292 DO j=1,nnod
293 nc(j)=ixtg(j+1,ep)
294 ENDDO
295 CALL reorder_i(nnod,nc)
296 DO j=1,nnod
297 n=nc(j)
298 IF (npt==1.AND.idril==0) THEN
299 ndof(n)=max(3,ndof(n))
300 ELSE
301 ndof(n)=6
302 END IF
303 DO l=j+1,nnod
304 IF (n/=nc(l)) nrow(n)=nrow(n)+1
305 ENDDO
306 ENDDO
307 ENDIF
308 ENDDO
309 ENDIF
310C
311 END IF !(IPARG(1,NG) == 0 .OR. IPARG(1,NG) == 13) THEN
312 ENDIF
313 100 CONTINUE
314 RETURN
315 END
316C------version \\-----
317!||====================================================================
318!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
319!||--- called by ------------------------------------------------------
320!|| dim_elemax ../engine/source/implicit/ind_glob_k.F
321!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
322!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
323!||--- calls -----------------------------------------------------
324!|| reorder_a ../engine/source/implicit/ind_glob_k.F
325!||--- uses -----------------------------------------------------
326!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
327!||====================================================================
328 SUBROUTINE dim_elems3(
329 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
330 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
331 3 IXS10 ,IXS20 ,IXS16 ,NROW ,
332 4 INLOC ,NKMAX ,ICOK ,IGEO ,ELBUF_TAB )
333C-----------------------------------------------
334C M o d u l e s
335C-----------------------------------------------
336 USE elbufdef_mod
337C----6---------------------------------------------------------------7---------8
338C I m p l i c i t T y p e s
339C-----------------------------------------------
340#include "implicit_f.inc"
341C-----------------------------------------------
342C C o m m o n B l o c k s
343C-----------------------------------------------
344#include "com01_c.inc"
345#include "param_c.inc"
346#include "com04_c.inc"
347C-----------------------------------------------------------------
348C D u m m y A r g u m e n t s
349C-----------------------------------------------
350 INTEGER IPARG(NPARG,*),NKMAX,IGEO(NPROPGI,*)
351 INTEGER
352 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
353 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
354 . IXS16(8,*),IXTG1(4,*),NROW(*),ICOK(NKMAX,*),INLOC(*)
355C REAL
356 my_real
357 . ELBUF(*)
358 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
359C-----------------------------------------------
360C L o c a l V a r i a b l e s
361C-----------------------------------------------
362 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
363 . I,J,K,N,M,EP,L,IGTYP,NNOD,K1,IHBE,NK,EP1,IAD0
364 my_real
365 . iof
366C--------NROW(NUMNOD) : number of connected nodes (non sym)
367C----6---------------------------------------------------------------7---------8
368 DO 100 ng=1,ngroup
369 IF (iparg(8,ng)/=1) THEN
370 ity=iparg(5,ng)
371 nel=iparg(2,ng)
372C----------void, rigid mat
373 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) cycle
374 nft=iparg(3,ng)
375 iad=iparg(4,ng)
376 icnod=iparg(11,ng)
377 isnod=iparg(28,ng)
378 iad0 = iad-1
379C-----------------------
380C 1. ELEMENTS SOLIDES
381C-----------------------
382 IF (ity==1) THEN
383 nnod=8
384 DO i=1,nel
385 iof = elbuf_tab(ng)%GBUF%OFF(i)
386 IF(iof>zero)THEN
387 ep=i+nft
388 IF (isnod==4) THEN
389 nnod=4
390 nc(1)=ixs(2,ep)
391 nc(2)=ixs(4,ep)
392 nc(3)=ixs(7,ep)
393 nc(4)=ixs(6,ep)
394 ELSEIF (isnod==6) THEN
395 nnod=6
396 nc(1)=ixs(2,ep)
397 nc(2)=ixs(3,ep)
398 nc(3)=ixs(4,ep)
399 nc(4)=ixs(6,ep)
400 nc(5)=ixs(7,ep)
401 nc(6)=ixs(8,ep)
402 ELSEIF (isnod==10) THEN
403 nnod=4
404 nc(1)=ixs(2,ep)
405 nc(2)=ixs(4,ep)
406 nc(3)=ixs(7,ep)
407 nc(4)=ixs(6,ep)
408 ep1=ep-numels8
409 DO j=1,6
410 IF (ixs10(j,ep1)>0) THEN
411 nnod = nnod + 1
412 nc(nnod) = ixs10(j,ep1)
413 ENDIF
414 ENDDO
415 ELSEIF (isnod==8) THEN
416 nnod=8
417 DO j=1,nnod
418 nc(j)=ixs(j+1,ep)
419 ENDDO
420
421C add solid element 20
422 ELSEIF (isnod==20) THEN
423 nnod=20
424 DO j=1,8
425 nc(j)=ixs(j+1,ep)
426 ENDDO
427 ep1=ep-(numels8+numels10)
428 DO j=9,20
429 nc(j)=ixs20(j-8,ep1)
430 ENDDO
431
432 ELSE
433 nnod=0
434 ENDIF
435 DO j=1,nnod
436 n=nc(j)
437 nk=inloc(n)
438 IF (nk>0) THEN
439 DO l=1,nnod
440 IF (n/=nc(l)) THEN
441 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
442 ENDIF
443 ENDDO
444 ENDIF
445 ENDDO
446 ENDIF
447 ENDDO
448C-----------------------
449C 2. ELEMENTS 2D
450C-----------------------
451 ELSEIF(ity==2)THEN
452 nnod=4
453 DO i=1,nel
454 iof = elbuf_tab(ng)%GBUF%OFF(i)
455 IF(iof>zero)THEN
456C
457 ep=i+nft
458C IF (ISNOD==4) THEN
459C NNOD=4
460 DO j=1,nnod
461 nc(j)=ixq(j+1,ep)
462 ENDDO
463C ELSE
464C NNOD=0
465C ENDIF
466C
467 DO j=1,nnod
468 n=nc(j)
469 nk=inloc(n)
470 IF (nk>0) THEN
471 DO l=1,nnod
472 IF (n/=nc(l)) THEN
473 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
474 ENDIF
475 ENDDO
476 ENDIF
477 ENDDO
478C
479 ENDIF
480 ENDDO
481C-----------------------
482C 3. ELEMENTS COQUES
483C-----------------------
484 ELSEIF(ity==3)THEN
485 nnod=4
486 DO i=1,nel
487 iof = elbuf_tab(ng)%GBUF%OFF(i)
488 IF(iof>zero)THEN
489 ep=i+nft
490 DO j=1,nnod
491 nc(j)=ixc(j+1,ep)
492 ENDDO
493 DO j=1,nnod
494 n=nc(j)
495 nk=inloc(n)
496 IF (nk>0) THEN
497 DO l=1,nnod
498 IF (n/=nc(l)) THEN
499 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
500 ENDIF
501 ENDDO
502 ENDIF
503 ENDDO
504 ENDIF
505 ENDDO
506C-----------------------
507C 4. ELEMENTS TIGES
508C-----------------------
509 ELSEIF(ity==4)THEN
510 nnod=2
511 DO i=1,nel
512 iof=elbuf_tab(ng)%GBUF%OFF(i)
513 IF(iof>zero)THEN
514 ep=i+nft
515 nc(1)=ixt(2,ep)
516 nc(2)=ixt(3,ep)
517 DO j=1,nnod
518 n=nc(j)
519 nk=inloc(n)
520 IF (nk>0) THEN
521 DO l=1,nnod
522 IF (n/=nc(l)) THEN
523 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
524 ENDIF
525 ENDDO
526 ENDIF
527 ENDDO
528 ENDIF
529 ENDDO
530C-----------------------
531C 5. ELEMENTS POUTRES
532C-----------------------
533 ELSEIF(ity==5)THEN
534 nnod=2
535 DO i=1,nel
536 iof=elbuf_tab(ng)%GBUF%OFF(i)
537 IF(iof>zero)THEN
538 ep=i+nft
539 nc(1)=ixp(2,ep)
540 nc(2)=ixp(3,ep)
541 DO j=1,nnod
542 n=nc(j)
543 nk=inloc(n)
544 IF (nk>0) THEN
545 DO l=1,nnod
546 IF (n/=nc(l)) THEN
547 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
548 ENDIF
549 ENDDO
550 ENDIF
551 ENDDO
552 ENDIF
553 ENDDO
554C-----------------------
555C 6. ELEMENTS RESSORTS
556C-----------------------
557 ELSEIF(ity==6)THEN
558 nnod=2
559 DO i=1,nel
560 iof=elbuf_tab(ng)%GBUF%OFF(i)
561 IF(iof>zero)THEN
562 ep=i+nft
563 nc(1)=ixr(2,ep)
564 nc(2)=ixr(3,ep)
565 igtyp = igeo(11,ixr(1,ep))
566 IF (igtyp==12) THEN
567 nnod=3
568 nc(3)=ixr(4,ep)
569 ENDIF
570 DO j=1,nnod
571 n=nc(j)
572 nk=inloc(n)
573 IF (nk>0) THEN
574 DO l=1,nnod
575 IF (n/=nc(l)) THEN
576 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
577 ENDIF
578 ENDDO
579 ENDIF
580 ENDDO
581 ENDIF
582 ENDDO
583C-----------------------
584C 7. ELEMENTS COQUES 3N
585C-----------------------
586 ELSEIF(ity==7.AND.icnod/=6)THEN
587 nnod=3
588 DO i=1,nel
589 iof = elbuf_tab(ng)%GBUF%OFF(i)
590 IF(iof>zero)THEN
591 ep=i+nft
592 DO j=1,nnod
593 nc(j)=ixtg(j+1,ep)
594 ENDDO
595 DO j=1,nnod
596 n=nc(j)
597 nk=inloc(n)
598 IF (nk>0) THEN
599 DO l=1,nnod
600 IF (n/=nc(l)) THEN
601 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
602 ENDIF
603 ENDDO
604 ENDIF
605 ENDDO
606 ENDIF
607 ENDDO
608 ENDIF
609C
610 ENDIF
611 100 CONTINUE
612 RETURN
613 END
614!||====================================================================
615!|| dim_elems2 ../engine/source/implicit/ind_glob_k.F
616!||--- called by ------------------------------------------------------
617!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
618!||--- calls -----------------------------------------------------
619!|| reorder_a ../engine/source/implicit/ind_glob_k.F
620!||--- uses -----------------------------------------------------
621!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
622!||====================================================================
623 SUBROUTINE dim_elems2(
624 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
625 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
626 3 IXS10 ,IXS20 ,IXS16 ,NROW ,
627 4 INLOC ,NNMAX ,ICOK ,NKMAX ,ICOKM ,
628 5 INK ,IGEO ,ELBUF_TAB )
629C-----------------------------------------------
630C M o d u l e s
631C-----------------------------------------------
632 USE elbufdef_mod
633C----6---------------------------------------------------------------7---------8
634C I m p l i c i t T y p e s
635C-----------------------------------------------
636#include "implicit_f.inc"
637C-----------------------------------------------
638C C o m m o n B l o c k s
639C-----------------------------------------------
640#include "com01_c.inc"
641#include "param_c.inc"
642#include "com04_c.inc"
643C-----------------------------------------------------------------
644C D u m m y A r g u m e n t s
645C-----------------------------------------------
646 INTEGER IPARG(NPARG,*),NNMAX,NKMAX,IGEO(NPROPGI,*)
647 INTEGER
648 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
649 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
650 . IXS16(8,*),IXTG1(4,*),
651 . NROW(*),ICOK(NNMAX,*),ICOKM(NKMAX,*),INLOC(*),INK
652C REAL
653 my_real
654 . ELBUF(*)
655 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
656C-----------------------------------------------
657C L o c a l V a r i a b l e s
658C-----------------------------------------------
659 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
660 . i,j,k,n,m,ep,l,igtyp,nnod,k1,ihbe,nk,ep1,iad0
661 my_real
662 . iof
663C----6---------------------------------------------------------------7---------8
664 DO 100 ng=1,ngroup
665 IF (iparg(8,ng)/=1) THEN
666 ity=iparg(5,ng)
667 nel=iparg(2,ng)
668C----------void, rigid mat
669 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) cycle
670 nft=iparg(3,ng)
671 iad=iparg(4,ng)
672 icnod=iparg(11,ng)
673 isnod=iparg(28,ng)
674 iad0 = iad-1
675C-----------------------
676C 1. ELEMENTS SOLIDES
677C-----------------------
678 IF (ity==1) THEN
679 nnod=8
680 DO i=1,nel
681 iof = elbuf_tab(ng)%GBUF%OFF(i)
682 IF(iof>zero)THEN
683 ep=i+nft
684 IF (isnod==4) THEN
685 nnod=4
686 nc(1)=ixs(2,ep)
687 nc(2)=ixs(4,ep)
688 nc(3)=ixs(7,ep)
689 nc(4)=ixs(6,ep)
690 ELSEIF (isnod==6) THEN
691 nnod=6
692 nc(1)=ixs(2,ep)
693 nc(2)=ixs(3,ep)
694 nc(3)=ixs(4,ep)
695 nc(4)=ixs(6,ep)
696 nc(5)=ixs(7,ep)
697 nc(6)=ixs(8,ep)
698 ELSEIF (isnod==10) THEN
699 nnod=4
700 nc(1)=ixs(2,ep)
701 nc(2)=ixs(4,ep)
702 nc(3)=ixs(7,ep)
703 nc(4)=ixs(6,ep)
704 ep1=ep-numels8
705 DO j=1,6
706 IF (ixs10(j,ep1)>0) THEN
707 nnod = nnod + 1
708 nc(nnod) = ixs10(j,ep1)
709 ENDIF
710 ENDDO
711 ELSEIF (isnod==8) THEN
712 nnod=8
713 DO j=1,nnod
714 nc(j)=ixs(j+1,ep)
715 ENDDO
716
717C add solid element 20
718 ELSEIF (isnod==20) THEN
719 nnod=20
720 DO j=1,8
721 nc(j)=ixs(j+1,ep)
722 ENDDO
723 ep1=ep-(numels8+numels10)
724 DO j=9,20
725 nc(j)=ixs20(j-8,ep1)
726 ENDDO
727
728 ENDIF
729 DO j=1,nnod
730 n=nc(j)
731 nk=inloc(n)
732 IF (nk>ink) THEN
733 DO l=1,nnod
734 IF (n/=nc(l)) THEN
735 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
736 ENDIF
737 ENDDO
738 ELSEIF (nk>0) THEN
739 DO l=1,nnod
740 IF (n/=nc(l)) THEN
741 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
742 ENDIF
743 ENDDO
744 ENDIF
745 ENDDO
746 ENDIF
747 ENDDO
748C-----------------------
749C 2. ELEMENTS 2D
750C-----------------------
751 ELSEIF(ity==2)THEN
752 nnod=4
753 DO i=1,nel
754 iof = elbuf_tab(ng)%GBUF%OFF(i)
755 IF(iof>zero)THEN
756C
757 ep=i+nft
758C IF (ISNOD==4) THEN
759C NNOD=4
760 DO j=1,nnod
761 nc(j)=ixq(j+1,ep)
762 ENDDO
763C ELSE
764C NNOD=0
765C ENDIF
766C
767 DO j=1,nnod
768 n=nc(j)
769 nk=inloc(n)
770 IF (nk>ink) THEN
771 DO l=1,nnod
772 IF (n/=nc(l)) THEN
773 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
774 ENDIF
775 ENDDO
776 ELSEIF (nk>0) THEN
777 DO l=1,nnod
778 IF (n/=nc(l)) THEN
779 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
780 ENDIF
781 ENDDO
782 ENDIF
783 ENDDO
784C
785 ENDIF
786 ENDDO
787C-----------------------
788C 3. ELEMENTS COQUES
789C-----------------------
790 ELSEIF(ity==3)THEN
791 nnod=4
792 DO i=1,nel
793 iof = elbuf_tab(ng)%GBUF%OFF(i)
794 IF(iof>zero)THEN
795 ep=i+nft
796 DO j=1,nnod
797 nc(j)=ixc(j+1,ep)
798 ENDDO
799 DO j=1,nnod
800 n=nc(j)
801 nk=inloc(n)
802 IF (nk>ink) THEN
803 DO l=1,nnod
804 IF (n/=nc(l)) THEN
805 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
806 ENDIF
807 ENDDO
808 ELSEIF (nk>0) THEN
809 DO l=1,nnod
810 IF (n/=nc(l)) THEN
811 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
812 ENDIF
813 ENDDO
814 ENDIF
815 ENDDO
816 ENDIF
817 ENDDO
818C-----------------------
819C 4. ELEMENTS TIGES
820C-----------------------
821 ELSEIF(ity==4)THEN
822 nnod=2
823 DO i=1,nel
824 iof=elbuf_tab(ng)%GBUF%OFF(i)
825 IF(iof>zero)THEN
826 ep=i+nft
827 nc(1)=ixt(2,ep)
828 nc(2)=ixt(3,ep)
829 DO j=1,nnod
830 n=nc(j)
831 nk=inloc(n)
832 IF (nk>ink) THEN
833 DO l=1,nnod
834 IF (n/=nc(l)) THEN
835 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
836 ENDIF
837 ENDDO
838 ELSEIF (nk>0) THEN
839 DO l=1,nnod
840 IF (n/=nc(l)) THEN
841 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
842 ENDIF
843 ENDDO
844 ENDIF
845 ENDDO
846 ENDIF
847 ENDDO
848C-----------------------
849C 5. ELEMENTS POUTRES
850C-----------------------
851 ELSEIF(ity==5)THEN
852 nnod=2
853 DO i=1,nel
854 iof=elbuf_tab(ng)%GBUF%OFF(i)
855 IF(iof>zero)THEN
856 ep=i+nft
857 nc(1)=ixp(2,ep)
858 nc(2)=ixp(3,ep)
859 DO j=1,nnod
860 n=nc(j)
861 nk=inloc(n)
862 IF (nk>ink) THEN
863 DO l=1,nnod
864 IF (n/=nc(l)) THEN
865 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
866 ENDIF
867 ENDDO
868 ELSEIF (nk>0) THEN
869 DO l=1,nnod
870 IF (n/=nc(l)) THEN
871 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
872 ENDIF
873 ENDDO
874 ENDIF
875 ENDDO
876 ENDIF
877 ENDDO
878C-----------------------
879C 6. ELEMENTS RESSORTS
880C-----------------------
881 ELSEIF(ity==6)THEN
882 nnod=2
883 DO i=1,nel
884 iof=elbuf_tab(ng)%GBUF%OFF(i)
885 IF(iof>zero)THEN
886 ep=i+nft
887 nc(1)=ixr(2,ep)
888 nc(2)=ixr(3,ep)
889 igtyp = igeo(11,ixr(1,ep))
890 IF (igtyp==12) THEN
891 nnod=3
892 nc(3)=ixr(4,ep)
893 ENDIF
894 DO j=1,nnod
895 n=nc(j)
896 nk=inloc(n)
897 IF (nk>ink) THEN
898 DO l=1,nnod
899 IF (n/=nc(l)) THEN
900 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
901 ENDIF
902 ENDDO
903 ELSEIF (nk>0) THEN
904 DO l=1,nnod
905 IF (n/=nc(l)) THEN
906 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
907 ENDIF
908 ENDDO
909 ENDIF
910 ENDDO
911 ENDIF
912 ENDDO
913C-----------------------
914C 7. ELEMENTS COQUES 3N
915C-----------------------
916 ELSEIF(ity==7.AND.icnod/=6)THEN
917 nnod=3
918 DO i=1,nel
919 iof = elbuf_tab(ng)%GBUF%OFF(i)
920 IF(iof>zero)THEN
921 ep=i+nft
922 DO j=1,nnod
923 nc(j)=ixtg(j+1,ep)
924 ENDDO
925 DO j=1,nnod
926 n=nc(j)
927 nk=inloc(n)
928 IF (nk>ink) THEN
929 DO l=1,nnod
930 IF (n/=nc(l)) THEN
931 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
932 ENDIF
933 ENDDO
934 ELSEIF (nk>0) THEN
935 DO l=1,nnod
936 IF (n/=nc(l)) THEN
937 CALL reorder_a(nrow(nk),icokm(1,nk),nc(l))
938 ENDIF
939 ENDDO
940 ENDIF
941 ENDDO
942 ENDIF
943 ENDDO
944 ENDIF
945C
946 ENDIF
947 100 CONTINUE
948 RETURN
949 END
950C------version \\-----
951!||====================================================================
952!|| dim_elems4 ../engine/source/implicit/ind_glob_k.F
953!||--- called by ------------------------------------------------------
954!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
955!||--- calls -----------------------------------------------------
956!|| reorder_a ../engine/source/implicit/ind_glob_k.F
957!||--- uses -----------------------------------------------------
958!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
959!||====================================================================
960 SUBROUTINE dim_elems4(
961 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
962 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
963 3 IXS10 ,IXS20 ,IXS16 ,NROW ,
964 4 INLOC ,NNMAX ,ICOK ,NKMAX ,ICOKM ,
965 5 INK ,IGEO ,ELBUF_TAB )
966C-----------------------------------------------
967C M o d u l e s
968C-----------------------------------------------
969 USE elbufdef_mod
970C----6---------------------------------------------------------------7---------8
971C I m p l i c i t T y p e s
972C-----------------------------------------------
973#include "implicit_f.inc"
974C-----------------------------------------------
975C C o m m o n B l o c k s
976C-----------------------------------------------
977#include "com01_c.inc"
978#include "param_c.inc"
979#include "com04_c.inc"
980C-----------------------------------------------------------------
981C D u m m y A r g u m e n t s
982C-----------------------------------------------
983 INTEGER IPARG(NPARG,*),NNMAX,NKMAX,IGEO(NPROPGI,*)
984 INTEGER
985 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
986 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
987 . ixs16(8,*),ixtg1(4,*),
988 . nrow(*),icok(nnmax,*),icokm(nkmax,*),inloc(*),ink
989C REAL
990 my_real
991 . elbuf(*)
992 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
993C-----------------------------------------------
994C L o c a l V a r i a b l e s
995C-----------------------------------------------
996 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
997 . I,J,K,N,M,EP,L,IGTYP,NNOD,K1,IHBE,NK,NK1,EP1,IAD0
998 my_real
999 . IOF
1000C--------NROW(NUMNOD) : number of connected nodes (non sym)
1001C----6---------------------------------------------------------------7---------8
1002 DO 100 ng=1,ngroup
1003 IF (iparg(8,ng)/=1) THEN
1004 ity=iparg(5,ng)
1005 nel=iparg(2,ng)
1006C----------void, rigid mat
1007 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) cycle
1008 nft=iparg(3,ng)
1009 iad=iparg(4,ng)
1010 icnod=iparg(11,ng)
1011 isnod=iparg(28,ng)
1012 iad0 = iad-1
1013C-----------------------
1014C 1. ELEMENTS SOLIDES
1015C-----------------------
1016 IF (ity==1) THEN
1017 nnod=8
1018 DO i=1,nel
1019 iof = elbuf_tab(ng)%GBUF%OFF(i)
1020 IF(iof>zero)THEN
1021 ep=i+nft
1022 IF (isnod==4) THEN
1023 nnod=4
1024 nc(1)=ixs(2,ep)
1025 nc(2)=ixs(4,ep)
1026 nc(3)=ixs(7,ep)
1027 nc(4)=ixs(6,ep)
1028 ELSEIF (isnod==6) THEN
1029 nnod=6
1030 nc(1)=ixs(2,ep)
1031 nc(2)=ixs(3,ep)
1032 nc(3)=ixs(4,ep)
1033 nc(4)=ixs(6,ep)
1034 nc(5)=ixs(7,ep)
1035 nc(6)=ixs(8,ep)
1036 ELSEIF (isnod==10) THEN
1037 nnod=4
1038 nc(1)=ixs(2,ep)
1039 nc(2)=ixs(4,ep)
1040 nc(3)=ixs(7,ep)
1041 nc(4)=ixs(6,ep)
1042 ep1=ep-numels8
1043 DO j=1,6
1044 IF (ixs10(j,ep1)>0) THEN
1045 nnod = nnod + 1
1046 nc(nnod) = ixs10(j,ep1)
1047 ENDIF
1048 ENDDO
1049 ELSEIF (isnod==8) THEN
1050 nnod=8
1051 DO j=1,nnod
1052 nc(j)=ixs(j+1,ep)
1053 ENDDO
1054
1055C add solid element 20
1056 ELSEIF (isnod==20) THEN
1057 nnod=20
1058 DO j=1,8
1059 nc(j)=ixs(j+1,ep)
1060 ENDDO
1061 ep1=ep-(numels8+numels10)
1062 DO j=9,20
1063 nc(j)=ixs20(j-8,ep1)
1064 ENDDO
1065
1066 ELSE
1067 nnod=0
1068 ENDIF
1069 DO j=1,nnod
1070 n=nc(j)
1071 nk=inloc(n)
1072 IF (nk>ink) THEN
1073 nk1=nk-ink
1074 DO l=1,nnod
1075 IF (n/=nc(l)) THEN
1076 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1077 ENDIF
1078 ENDDO
1079 ELSEIF (nk>0) THEN
1080 DO l=1,nnod
1081 IF (n/=nc(l)) THEN
1082 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1083 ENDIF
1084 ENDDO
1085 ENDIF
1086 ENDDO
1087 ENDIF
1088 ENDDO
1089C-----------------------
1090C 2. ELEMENTS 2D
1091C-----------------------
1092 ELSEIF(ity==2)THEN
1093 nnod=4
1094 DO i=1,nel
1095 iof = elbuf_tab(ng)%GBUF%OFF(i)
1096 IF(iof>zero)THEN
1097C
1098 ep=i+nft
1099C IF (ISNOD==4) THEN
1100C NNOD=4
1101 DO j=1,nnod
1102 nc(j)=ixq(j+1,ep)
1103 ENDDO
1104C ELSE
1105C NNOD=0
1106C ENDIF
1107C
1108 DO j=1,nnod
1109 n=nc(j)
1110 nk=inloc(n)
1111 IF (nk>ink) THEN
1112 nk1=nk-ink
1113 DO l=1,nnod
1114 IF (n/=nc(l)) THEN
1115 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1116 ENDIF
1117 ENDDO
1118 ELSEIF (nk>0) THEN
1119 DO l=1,nnod
1120 IF (n/=nc(l)) THEN
1121 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1122 ENDIF
1123 ENDDO
1124 ENDIF
1125 ENDDO
1126C
1127 ENDIF
1128 ENDDO
1129C-----------------------
1130C 3. ELEMENTS COQUES
1131C-----------------------
1132 ELSEIF(ity==3)THEN
1133 nnod=4
1134 DO i=1,nel
1135 iof = elbuf_tab(ng)%GBUF%OFF(i)
1136 IF(iof>zero)THEN
1137 ep=i+nft
1138 DO j=1,nnod
1139 nc(j)=ixc(j+1,ep)
1140 ENDDO
1141 DO j=1,nnod
1142 n=nc(j)
1143 nk=inloc(n)
1144 IF (nk>ink) THEN
1145 nk1=nk-ink
1146 DO l=1,nnod
1147 IF (n/=nc(l)) THEN
1148 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1149 ENDIF
1150 ENDDO
1151 ELSEIF (nk>0) THEN
1152 DO l=1,nnod
1153 IF (n/=nc(l)) THEN
1154 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1155 ENDIF
1156 ENDDO
1157 ENDIF
1158 ENDDO
1159 ENDIF
1160 ENDDO
1161C-----------------------
1162C 4. ELEMENTS TIGES
1163C-----------------------
1164 ELSEIF(ity==4)THEN
1165 nnod=2
1166 DO i=1,nel
1167 iof=elbuf_tab(ng)%GBUF%OFF(i)
1168 IF(iof>zero)THEN
1169 ep=i+nft
1170 nc(1)=ixt(2,ep)
1171 nc(2)=ixt(3,ep)
1172 DO j=1,nnod
1173 n=nc(j)
1174 nk=inloc(n)
1175 IF (nk>ink) THEN
1176 nk1=nk-ink
1177 DO l=1,nnod
1178 IF (n/=nc(l)) THEN
1179 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1180 ENDIF
1181 ENDDO
1182 ELSEIF (nk>0) THEN
1183 DO l=1,nnod
1184 IF (n/=nc(l)) THEN
1185 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1186 ENDIF
1187 ENDDO
1188 ENDIF
1189 ENDDO
1190 ENDIF
1191 ENDDO
1192C-----------------------
1193C 5. ELEMENTS POUTRES
1194C-----------------------
1195 ELSEIF(ity==5)THEN
1196 nnod=2
1197 DO i=1,nel
1198 iof=elbuf_tab(ng)%GBUF%OFF(i)
1199 IF(iof>zero)THEN
1200 ep=i+nft
1201 nc(1)=ixp(2,ep)
1202 nc(2)=ixp(3,ep)
1203 DO j=1,nnod
1204 n=nc(j)
1205 nk=inloc(n)
1206 IF (nk>ink) THEN
1207 nk1=nk-ink
1208 DO l=1,nnod
1209 IF (n/=nc(l)) THEN
1210 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1211 ENDIF
1212 ENDDO
1213 ELSEIF (nk>0) THEN
1214 DO l=1,nnod
1215 IF (n/=nc(l)) THEN
1216 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1217 ENDIF
1218 ENDDO
1219 ENDIF
1220 ENDDO
1221 ENDIF
1222 ENDDO
1223C-----------------------
1224C 6. ELEMENTS RESSORTS
1225C-----------------------
1226 ELSEIF(ity==6)THEN
1227 nnod=2
1228 DO i=1,nel
1229 iof=elbuf_tab(ng)%GBUF%OFF(i)
1230 IF(iof>zero)THEN
1231 ep=i+nft
1232 nc(1)=ixr(2,ep)
1233 nc(2)=ixr(3,ep)
1234 igtyp = igeo(11,ixr(1,ep))
1235 IF (igtyp==12) THEN
1236 nnod=3
1237 nc(3)=ixr(4,ep)
1238 ENDIF
1239 DO j=1,nnod
1240 n=nc(j)
1241 nk=inloc(n)
1242 IF (nk>ink) THEN
1243 nk1=nk-ink
1244 DO l=1,nnod
1245 IF (n/=nc(l)) THEN
1246 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1247 ENDIF
1248 ENDDO
1249 ELSEIF (nk>0) THEN
1250 DO l=1,nnod
1251 IF (n/=nc(l)) THEN
1252 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1253 ENDIF
1254 ENDDO
1255 ENDIF
1256 ENDDO
1257 ENDIF
1258 ENDDO
1259C-----------------------
1260C 7. ELEMENTS COQUES 3N
1261C-----------------------
1262 ELSEIF(ity==7.AND.icnod/=6)THEN
1263 nnod=3
1264 DO i=1,nel
1265 iof = elbuf_tab(ng)%GBUF%OFF(i)
1266 IF(iof>zero)THEN
1267 ep=i+nft
1268 DO j=1,nnod
1269 nc(j)=ixtg(j+1,ep)
1270 ENDDO
1271 DO j=1,nnod
1272 n=nc(j)
1273 nk=inloc(n)
1274 IF (nk>ink) THEN
1275 nk1=nk-ink
1276 DO l=1,nnod
1277 IF (n/=nc(l)) THEN
1278 CALL reorder_a(nrow(nk),icokm(1,nk1),nc(l))
1279 ENDIF
1280 ENDDO
1281 ELSEIF (nk>0) THEN
1282 DO l=1,nnod
1283 IF (n/=nc(l)) THEN
1284 CALL reorder_a(nrow(nk),icok(1,nk),nc(l))
1285 ENDIF
1286 ENDDO
1287 ENDIF
1288 ENDDO
1289 ENDIF
1290 ENDDO
1291 ENDIF
1292C
1293 ENDIF
1294 100 CONTINUE
1295 RETURN
1296 END
1297C------version \\-----
1298!||====================================================================
1299!|| dim_elemsp ../engine/source/implicit/ind_glob_k.F
1300!||--- called by ------------------------------------------------------
1301!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
1302!|| ind_fr_k ../engine/source/mpi/implicit/imp_fri.F
1303!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.F
1304!||--- calls -----------------------------------------------------
1305!|| reorder_a ../engine/source/implicit/ind_glob_k.f
1306!||--- uses -----------------------------------------------------
1307!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1308!||====================================================================
1309 SUBROUTINE dim_elemsp(
1310 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
1311 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
1312 3 IXS10 ,IXS20 ,IXS16 ,NROW ,
1313 4 INLOC ,NKMAX ,ICOK ,IGEO ,ELBUF_TAB )
1314C-----------------------------------------------
1315C M o d u l e s
1316C-----------------------------------------------
1317 USE elbufdef_mod
1318C----6---------------------------------------------------------------7---------8
1319C I m p l i c i t T y p e s
1320C-----------------------------------------------
1321#include "implicit_f.inc"
1322C-----------------------------------------------
1323C C o m m o n B l o c k s
1324C-----------------------------------------------
1325#include "com01_c.inc"
1326#include "param_c.inc"
1327#include "com04_c.inc"
1328C-----------------------------------------------------------------
1329C D u m m y A r g u m e n t s
1330C-----------------------------------------------
1331 INTEGER IPARG(NPARG,*),NKMAX,IGEO(NPROPGI,*)
1332 INTEGER
1333 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
1334 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
1335 . IXS16(8,*),IXTG1(4,*),NROW(*),ICOK(NKMAX,*),INLOC(*)
1336C REAL
1337 my_real
1338 . ELBUF(*)
1339 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
1340C-----------------------------------------------
1341C L o c a l V a r i a b l e s
1342C-----------------------------------------------
1343 INTEGER NC(20),NG,ITY,NEL,NFT,IAD,ISNOD,ICNOD,
1344 . I,J,K,N,M,EP,L,IGTYP,NNOD,K1,IHBE,NK,NJ,EP1,IAD0
1345 my_real
1346 . IOF
1347C--------NROW(NUMNOD) : number of connected nodes (non sym)
1348C----6---------------------------------------------------------------7---------8
1349 DO 100 NG=1,ngroup
1350 IF (iparg(8,ng)/=1) THEN
1351 ity=iparg(5,ng)
1352 nel=iparg(2,ng)
1353C----------void, rigid mat
1354 IF (iparg(1,ng) == 0 .OR. iparg(1,ng) == 13) cycle
1355 nft=iparg(3,ng)
1356 iad=iparg(4,ng)
1357 icnod=iparg(11,ng)
1358 isnod=iparg(28,ng)
1359 iad0 = iad-1
1360C-----------------------
1361C 1. ELEMENTS SOLIDES
1362C-----------------------
1363 IF (ity==1) THEN
1364 nnod=8
1365 DO i=1,nel
1366 iof = elbuf_tab(ng)%GBUF%OFF(i)
1367 IF(iof>zero)THEN
1368 ep=i+nft
1369 IF (isnod==4) THEN
1370 nnod=4
1371 nc(1)=ixs(2,ep)
1372 nc(2)=ixs(4,ep)
1373 nc(3)=ixs(7,ep)
1374 nc(4)=ixs(6,ep)
1375 ELSEIF (isnod==6) THEN
1376 nnod=6
1377 nc(1)=ixs(2,ep)
1378 nc(2)=ixs(3,ep)
1379 nc(3)=ixs(4,ep)
1380 nc(4)=ixs(6,ep)
1381 nc(5)=ixs(7,ep)
1382 nc(6)=ixs(8,ep)
1383 ELSEIF (isnod==10) THEN
1384 nnod=4
1385 nc(1)=ixs(2,ep)
1386 nc(2)=ixs(4,ep)
1387 nc(3)=ixs(7,ep)
1388 nc(4)=ixs(6,ep)
1389 ep1=ep-numels8
1390 DO j=1,6
1391 IF (ixs10(j,ep1)>0) THEN
1392 nnod = nnod + 1
1393 nc(nnod) = ixs10(j,ep1)
1394 ENDIF
1395 ENDDO
1396 ELSEIF (isnod==8) THEN
1397 nnod=8
1398 DO j=1,nnod
1399 nc(j)=ixs(j+1,ep)
1400 ENDDO
1401
1402C add solid element 20
1403 ELSEIF (isnod==20) THEN
1404 nnod=20
1405 DO j=1,8
1406 nc(j)=ixs(j+1,ep)
1407 ENDDO
1408 ep1=ep-(numels8+numels10)
1409 DO j=9,20
1410 nc(j)=ixs20(j-8,ep1)
1411 ENDDO
1412
1413 ELSE
1414 nnod=0
1415 ENDIF
1416 DO j=1,nnod
1417 n=nc(j)
1418 nk=inloc(n)
1419 IF (nk>0) THEN
1420 DO l=1,nnod
1421 nj=nc(l)
1422 IF (n/=nj.AND.inloc(nj)>0) THEN
1423 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1424 ENDIF
1425 ENDDO
1426 ENDIF
1427 ENDDO
1428 ENDIF
1429 ENDDO
1430C-----------------------
1431C 2. ELEMENTS 2D
1432C-----------------------
1433 ELSEIF(ity==2)THEN
1434 nnod=4
1435 DO i=1,nel
1436 iof = elbuf_tab(ng)%GBUF%OFF(i)
1437 IF(iof>zero)THEN
1438C
1439 ep=i+nft
1440C IF (ISNOD==4) THEN
1441C NNOD=4
1442 DO j=1,nnod
1443 nc(j)=ixq(j+1,ep)
1444 ENDDO
1445C ELSE
1446C NNOD=0
1447C ENDIF
1448C
1449 DO j=1,nnod
1450 n=nc(j)
1451 nk=inloc(n)
1452 IF (nk>0) THEN
1453 DO l=1,nnod
1454 nj=nc(l)
1455 IF (n/=nj.AND.inloc(nj)>0) THEN
1456 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1457 ENDIF
1458 ENDDO
1459 ENDIF
1460 ENDDO
1461C
1462 ENDIF
1463 ENDDO
1464C-----------------------
1465C 3. ELEMENTS COQUES
1466C-----------------------
1467 ELSEIF(ity==3)THEN
1468 nnod=4
1469 DO i=1,nel
1470 iof = elbuf_tab(ng)%GBUF%OFF(i)
1471 IF(iof>zero)THEN
1472 ep=i+nft
1473 DO j=1,nnod
1474 nc(j)=ixc(j+1,ep)
1475 ENDDO
1476 DO j=1,nnod
1477 n=nc(j)
1478 nk=inloc(n)
1479 IF (nk>0) THEN
1480 DO l=1,nnod
1481 nj=nc(l)
1482 IF (n/=nj.AND.inloc(nj)>0) THEN
1483 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1484 ENDIF
1485 ENDDO
1486 ENDIF
1487 ENDDO
1488 ENDIF
1489 ENDDO
1490C-----------------------
1491C 4. ELEMENTS TIGES
1492C-----------------------
1493 ELSEIF(ity==4)THEN
1494 nnod=2
1495 DO i=1,nel
1496 iof=elbuf_tab(ng)%GBUF%OFF(i)
1497 IF(iof>zero)THEN
1498 ep=i+nft
1499 nc(1)=ixt(2,ep)
1500 nc(2)=ixt(3,ep)
1501 DO j=1,nnod
1502 n=nc(j)
1503 nk=inloc(n)
1504 IF (nk>0) THEN
1505 DO l=1,nnod
1506 nj=nc(l)
1507 IF (n/=nj.AND.inloc(nj)>0) THEN
1508 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1509 ENDIF
1510 ENDDO
1511 ENDIF
1512 ENDDO
1513 ENDIF
1514 ENDDO
1515C-----------------------
1516C 5. ELEMENTS POUTRES
1517C-----------------------
1518 ELSEIF(ity==5)THEN
1519 nnod=2
1520 DO i=1,nel
1521 iof=elbuf_tab(ng)%GBUF%OFF(i)
1522 IF(iof>zero)THEN
1523 ep=i+nft
1524 nc(1)=ixp(2,ep)
1525 nc(2)=ixp(3,ep)
1526 DO j=1,nnod
1527 n=nc(j)
1528 nk=inloc(n)
1529 IF (nk>0) THEN
1530 DO l=1,nnod
1531 nj=nc(l)
1532 IF (n/=nj.AND.inloc(nj)>0) THEN
1533 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1534 ENDIF
1535 ENDDO
1536 ENDIF
1537 ENDDO
1538 ENDIF
1539 ENDDO
1540C-----------------------
1541C 6. ELEMENTS RESSORTS
1542C-----------------------
1543 ELSEIF(ity==6)THEN
1544 nnod=2
1545 DO i=1,nel
1546 iof=elbuf_tab(ng)%GBUF%OFF(i)
1547 IF(iof>zero)THEN
1548 ep=i+nft
1549 nc(1)=ixr(2,ep)
1550 nc(2)=ixr(3,ep)
1551 igtyp = igeo(11,ixr(1,ep))
1552 IF (igtyp==12) THEN
1553 nnod=3
1554 nc(3)=ixr(4,ep)
1555 ENDIF
1556 DO j=1,nnod
1557 n=nc(j)
1558 nk=inloc(n)
1559 IF (nk>0) THEN
1560 DO l=1,nnod
1561 nj=nc(l)
1562 IF (n/=nj.AND.inloc(nj)>0) THEN
1563 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1564 ENDIF
1565 ENDDO
1566 ENDIF
1567 ENDDO
1568 ENDIF
1569 ENDDO
1570C-----------------------
1571C 7. ELEMENTS COQUES 3N
1572C-----------------------
1573 ELSEIF(ity==7.AND.icnod/=6)THEN
1574 nnod=3
1575 DO i=1,nel
1576 iof = elbuf_tab(ng)%GBUF%OFF(i)
1577 IF(iof>zero)THEN
1578 ep=i+nft
1579 DO j=1,nnod
1580 nc(j)=ixtg(j+1,ep)
1581 ENDDO
1582 DO j=1,nnod
1583 n=nc(j)
1584 nk=inloc(n)
1585 IF (nk>0) THEN
1586 DO l=1,nnod
1587 nj=nc(l)
1588 IF (n/=nj.AND.inloc(nj)>0) THEN
1589 CALL reorder_a(nrow(nk),icok(1,nk),inloc(nj))
1590 ENDIF
1591 ENDDO
1592 ENDIF
1593 ENDDO
1594 ENDIF
1595 ENDDO
1596 ENDIF
1597C
1598 ENDIF
1599 100 CONTINUE
1600 RETURN
1601 END
1602!||====================================================================
1603!|| dim_elemax ../engine/source/implicit/ind_glob_k.F
1604!||--- called by ------------------------------------------------------
1605!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
1606!||--- calls -----------------------------------------------------
1607!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
1608!||--- uses -----------------------------------------------------
1609!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1610!||====================================================================
1611 SUBROUTINE dim_elemax(
1612 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
1613 2 IXR ,IXTG ,IXTG1 ,IXS10 ,IXS20 ,
1614 3 IXS16 ,IPARG ,ELBUF ,NDOF ,
1615 4 NROW ,INLOC ,NNMAX ,L_MAX ,C_MAX ,
1616 5 IGEO ,ELBUF_TAB )
1617C-----------------------------------------------
1618C M o d u l e s
1619C-----------------------------------------------
1620 USE elbufdef_mod
1621C----6---------------------------------------------------------------7---------8
1622C I m p l i c i t T y p e s
1623C-----------------------------------------------
1624#include "implicit_f.inc"
1625C-----------------------------------------------
1626C C o m m o n B l o c k s
1627C-----------------------------------------------
1628#include "com01_c.inc"
1629#include "com04_c.inc"
1630#include "param_c.inc"
1631C-----------------------------------------------------------------
1632C D u m m y A r g u m e n t s
1633C-----------------------------------------------
1634 INTEGER IPARG(NPARG,*),IGEO(NPROPGI,*)
1635 INTEGER
1636 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
1637 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),IXS20(12,*),
1638 . ixs16(8,*),ixtg1(4,*),ndof(*),nrow(*),inloc(*),
1639 . nnmax,l_max,c_max
1640C REAL
1641 my_real
1642 . elbuf(*)
1643 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
1644C-----------------------------------------------
1645C L o c a l V a r i a b l e s
1646C-----------------------------------------------
1647 INTEGER ICOL(L_MAX,C_MAX),I,J,K,N,NFT,JLT,NK
1648C-----------------------------------------------
1649 NNMAX=0
1650 do n =1,numnod
1651 nrow(n)=0
1652 inloc(n)=0
1653 ENDDO
1654 DO nft = 0 , numnod-1 ,c_max
1655 jlt = min( c_max, numnod - nft )
1656 DO nk=1,jlt
1657 n=nk+nft
1658 inloc(n)=nk
1659 ENDDO
1660 CALL dim_elems3(
1661 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
1662 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
1663 3 ixs10 ,ixs20 ,ixs16 ,nrow(nft+1) ,
1664 4 inloc ,l_max ,icol ,igeo ,elbuf_tab )
1665 DO nk=1,jlt
1666 n=nk+nft
1667 inloc(n)=0
1668 nnmax=max(nnmax,nrow(n))
1669 ENDDO
1670 ENDDO
1671C----6---------------------------------------------------------------7---------8
1672 RETURN
1673 END
1674!||====================================================================
1675!|| dim_kine_p ../engine/source/implicit/ind_glob_k.F
1676!||--- called by ------------------------------------------------------
1677!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
1678!||--- uses -----------------------------------------------------
1679!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1680!||====================================================================
1681 SUBROUTINE dim_kine_p(
1682 1 IGEO ,NPBY ,LPBY ,ITAB ,NRBYAC ,
1683 2 IRBYAC ,NINT2 ,IINT2 ,IPARI ,
1684 3 NDOF ,NSI2 ,NSRB ,NKINE ,
1685 7 INLOC ,IRBE3 ,IRBE2 ,LRBE2 ,NKINM ,
1686 8 INTBUF_TAB )
1687C-----------------------------------------------
1688C M o d u l e s
1689C-----------------------------------------------
1690 USE intbufdef_mod
1691C-----------------------------------------------
1692C----6---------------------------------------------------------------7---------8
1693C I m p l i c i t T y p e s
1694C-----------------------------------------------
1695#include "implicit_f.inc"
1696C-----------------------------------------------
1697C C o m m o n B l o c k s
1698C-----------------------------------------------
1699#include "com04_c.inc"
1700#include "param_c.inc"
1701C-----------------------------------------------
1702C D u m m y A r g u m e n t s
1703C-----------------------------------------------
1704 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
1705 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),NSI2,NSRB,
1706 . NDOF(*),NKINE,INLOC(*),IGEO(*),IRBE3(NRBE3L,*),
1707 . IRBE2(NRBE2L,*),LRBE2(*),NKINM
1708C REAL
1709 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
1710C-----------------------------------------------
1711C L o c a l V a r i a b l e s
1712C-----------------------------------------------
1713 INTEGER NSN,I,J,K,N,M,NS
1714C-----------------------------------------------
1715 NKINE=0
1716C----- main of rigid body first------
1717 do i=1,nrbyac
1718 n=irbyac(i)
1719 m=npby(1,n)
1720 IF (inloc(m)==0) THEN
1721 nkine=nkine+1
1722 inloc(m)=-nkine
1723 ENDIF
1724 ENDDO
1725C----- rbe2 main------
1726 DO i=1,nrbe2
1727 k = irbe2(1,i)
1728 m = irbe2(3,i)
1729 IF (inloc(m)==0) THEN
1730 nkine=nkine+1
1731 inloc(m)=nkine
1732 ENDIF
1733 ENDDO
1734C-----will be stored in ICOKM(NKMAX,*)
1735 nkinm=nkine
1736C-----pour IND_GLOB_K, passer NKINM par include ou module, modifier dans IND_KINE_
1737C K=0
1738C------interface 2--------------
1739 DO i=1,nint2
1740 n=iint2(i)
1741 nsn = ipari(5,n)
1742 DO j=1,nsn
1743 ns=intbuf_tab(n)%NSV(j)
1744 IF (inloc(ns)==0.AND.ndof(ns)>0) THEN
1745 nkine=nkine+1
1746 inloc(ns)=nkine
1747 ENDIF
1748 ENDDO
1749 ENDDO
1750C----- rbe3 ------
1751 DO i=1,nrbe3
1752 ns=irbe3(3,i)
1753 IF (ns==0) cycle
1754 IF (inloc(ns)==0.AND.ndof(ns)>0) THEN
1755 nkine=nkine+1
1756 inloc(ns)=nkine
1757 ENDIF
1758 ENDDO
1759C----- rbe2 ------
1760 DO i=1,nrbe2
1761 k = irbe2(1,i)
1762 m = irbe2(3,i)
1763 nsn = irbe2(5,i)
1764 DO j=1,nsn
1765 ns=lrbe2(k+j)
1766 IF (inloc(ns)==0.AND.ndof(ns)>0) THEN
1767 nkine=nkine+1
1768 inloc(ns)=nkine
1769 ENDIF
1770 ENDDO
1771 ENDDO
1772C----- rigid body ------
1773 DO i=1,nrbyac
1774 n=irbyac(i)
1775 k=irbyac(i+nrbykin)
1776 nsn =npby(2,n)
1777 DO j=1,nsn
1778 ns=lpby(k+j)
1779 IF (inloc(ns)==0.AND.ndof(ns)>0) THEN
1780 nkine=nkine+1
1781 inloc(ns)=nkine
1782 ENDIF
1783 ENDDO
1784 ENDDO
1785C----6---------------------------------------------------------------7---------8
1786 RETURN
1787 END
1788!||====================================================================
1789!|| dim_ndof_i ../engine/source/implicit/ind_glob_k.F
1790!||--- called by ------------------------------------------------------
1791!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
1792!||--- calls -----------------------------------------------------
1793!|| i2_prem ../engine/source/interfaces/interf/i2_prem.F
1794!|| intab ../engine/source/implicit/ind_glob_k.F
1795!|| rbyac_imp ../engine/source/constraints/general/rbody/rbyac_imp.F
1796!||--- uses -----------------------------------------------------
1797!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1798!||====================================================================
1799 SUBROUTINE dim_ndof_i(
1800 1 NPBY ,LPBY ,ITAB ,NRBYAC ,
1801 2 IRBYAC ,NDOF ,NSRB ,IPARI ,
1802 3 NINT2 ,IINT2 ,NSI2 ,NPRW ,IRBE3 ,
1803 4 IRBE2 ,NSRB2 ,FR_ELEM ,IAD_ELEM ,INTBUF_TAB)
1804C-----------------------------------------------
1805C M o d u l e s
1806C-----------------------------------------------
1807 USE intbufdef_mod
1808C----6---------------------------------------------------------------7---------8
1809C I m p l i c i t T y p e s
1810C-----------------------------------------------
1811#include "implicit_f.inc"
1812C-----------------------------------------------
1813C C o m m o n B l o c k s
1814C-----------------------------------------------
1815#include "param_c.inc"
1816#include "com01_c.inc"
1817#include "com09_c.inc"
1818#include "com04_c.inc"
1819#include "task_c.inc"
1820C-----------------------------------------------------------------
1821C D u m m y A r g u m e n t s
1822C-----------------------------------------------
1823 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
1824 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),NSI2
1825 INTEGER NSRB,NDOF(*),NPRW(*),IRBE3(NRBE3L,*),IRBE2(NRBE2L,*),
1826 . NSRB2,FR_ELEM(*),IAD_ELEM(2,*)
1827C REAL
1828 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1829C-----------------------------------------------
1830C External function
1831C-----------------------------------------------
1832 LOGICAL INTAB
1833 EXTERNAL INTAB
1834C-----------------------------------------------
1835C L o c a l V a r i a b l e s
1836C-----------------------------------------------
1837 INTEGER NMN,JI,K10,K11,K12,K13,K14,J,K,NDOFI,NSN
1838 INTEGER I,N,M,IC,ICT,ICR,INS(NRBE3),NP,NIN,NTY,
1839 . KD(50),KFI,JIN
1840C-----------------------------------------------
1841 NSI2=0
1842 nint2=0
1843 DO k=0,nhin2
1844 CALL i2_prem(ipari,k,nint2,iint2,nsi2)
1845 ENDDO
1846C------rigid body main-------------
1847 CALL rbyac_imp(npby,itab,nrbyac,irbyac,nsrb)
1848 DO i=1,nrbyac
1849 n=irbyac(i)
1850 m=npby(1,n)
1851 ndof(m)=6
1852 ENDDO
1853C
1854 ndofi=3
1855 IF (iroddl>0) ndofi=6
1856 DO i=1,nrwall
1857 n = i + 2*nrwall
1858 m = nprw(n)
1859 IF (m>0) ndof(m)=ndofi
1860 ENDDO
1861C--------temporarily to avoid issue w/ contact +spmd
1862 IF (nspmd > 1 .AND.ninter > 0) THEN
1863 DO i=1,nrbe3
1864 n=irbe3(3,i)
1865 ins(i)=0
1866 DO nin=1,ninter
1867 nsn =ipari(5,nin)
1868 nty =ipari(7,nin)
1869 IF (ispmd/=0.AND.(nty<7.OR.nty==8
1870 . .OR.nty==14.OR.nty==15)) cycle
1871 IF(nty==5.OR.nty==7.OR.nty==10.OR.nty==11
1872 . .OR.nty==24) THEN
1873C
1874 IF (intab(nsn,intbuf_tab(nin)%NSV(1),n)) ins(i)=1
1875 ENDIF
1876 ENDDO
1877 ENDDO !
1878 DO i=1,nrbe3
1879 n = irbe3(3,i)
1880 IF (n==0.OR.ins(i)==0) cycle
1881 ic = irbe3(4,i)
1882 ict=ic/512
1883 icr=(ic-512*ict)/64
1884 IF (icr>0) THEN
1885 ndof(n) = 6
1886 ELSE
1887 ndof(n) = 3
1888 ENDIF
1889 ENDDO
1890 END IF !(NSPMD > 1 .AND.NINTER > 0) THEN
1891C-----if m is secnd of rb
1892 nsrb2=0
1893 DO n=1,nrbe2
1894 m=irbe2(3,n)
1895 nsn =irbe2(5,n)
1896C--------case NSN=1 is treated in DIM_NDOF_II
1897 IF(ndof(m)==0.AND.nsn >1) ndof(m)=ndofi
1898 nsrb2= nsrb2+nsn
1899 ENDDO
1900C----6---------------------------------------------------------------7---------8
1901 RETURN
1902 END
1903!||====================================================================
1904!|| dim_ndof_ii ../engine/source/implicit/ind_glob_k.F
1905!||--- called by ------------------------------------------------------
1906!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
1907!||--- uses -----------------------------------------------------
1908!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1909!||====================================================================
1910 SUBROUTINE dim_ndof_ii(
1911 1 NINT2 ,IINT2 ,IPARI ,NDOF ,
1912 2 NRBE3 ,IRBE3 ,LRBE3 ,NRBE2 ,IRBE2 ,
1913 3 LRBE2 ,INTBUF_TAB)
1914C-----------------------------------------------
1915C M o d u l e s
1916C-----------------------------------------------
1917 USE intbufdef_mod
1918C----6---------------------------------------------------------------7---------8
1919C I m p l i c i t T y p e s
1920C-----------------------------------------------
1921#include "implicit_f.inc"
1922C-----------------------------------------------
1923C C o m m o n B l o c k s
1924C-----------------------------------------------
1925#include "param_c.inc"
1926C-----------------------------------------------
1927C D u m m y A r g u m e n t s
1928C-----------------------------------------------
1929 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),NDOF(*),
1930 . NRBE3 ,IRBE3(NRBE3L,*),LRBE3(*),NRBE2,IRBE2(NRBE2L,*),
1931 . lrbe2(*)
1932C REAL
1933
1934 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
1935C-----------------------------------------------
1936C L o c a l V a r i a b l e s
1937C-----------------------------------------------
1938 INTEGER NMN,J,K
1939 INTEGER I,N,M,L,NS,ID,NM,NSN,IAD,ILEV,NDOFM,IROT,IC
1940C-----------------------------------------------
1941C------interface 2---au cas surface main est deactive-----------
1942 DO i=1,nint2
1943 n=iint2(i)
1944 nsn = ipari(5,n)
1945 nmn = ipari(6,n)
1946 ilev = ipari(20,n)
1947C------IRTL(NSN)--main el number---
1948 ndofm=3
1949 IF (ilev == 0) ndofm=6
1950 DO j=1,nsn
1951 ns=intbuf_tab(n)%NSV(j)
1952 IF (ndof(ns)>0) THEN
1953 l=intbuf_tab(n)%IRTLM(j)
1954 id=4*(l-1)
1955 DO m=1,4
1956 nm=intbuf_tab(n)%IRECTM(id+m)
1957 IF (ndof(nm)<=0) ndof(nm)=min(ndof(nm),-ndofm)
1958 ENDDO
1959 ENDIF
1960 ENDDO
1961 ENDDO
1962C
1963 DO i=1,nint2
1964 n=iint2(i)
1965 nsn = ipari(5,n)
1966 nmn = ipari(6,n)
1967C------IRTL(NSN)--main el number---
1968 DO j=1,nsn
1969 ns=intbuf_tab(n)%NSV(j)
1970 IF (ndof(ns)>0) THEN
1971 l=intbuf_tab(n)%IRTLM(j)
1972 id=4*(l-1)
1973 DO m=1,4
1974 nm=intbuf_tab(n)%IRECTM(id+m)
1975 IF (ndof(nm)<0) ndof(nm)=-ndof(nm)
1976 ENDDO
1977 ENDIF
1978 ENDDO
1979 ENDDO
1980C
1981 DO i=1,nrbe3
1982 iad=irbe3(1,i)
1983 ns =irbe3(3,i)
1984 irot =irbe3(6,i)
1985 IF (ns==0.OR.ndof(ns)==0) cycle
1986 ndofm=3
1987 IF (irot > 0) ndofm=6
1988 nmn=irbe3(5,i)
1989 DO j=1,nmn
1990 nm=lrbe3(iad+j)
1991 IF (ndof(nm)<=0) ndof(nm)=min(ndof(nm),-ndofm)
1992 ENDDO
1993 ENDDO
1994C
1995 DO i=1,nrbe3
1996 iad=irbe3(1,i)
1997 ns =irbe3(3,i)
1998 IF (ns==0.OR.ndof(ns)==0) cycle
1999 nmn=irbe3(5,i)
2000 DO j=1,nmn
2001 nm=lrbe3(iad+j)
2002 IF (ndof(nm)<=0) ndof(nm)=-ndof(nm)
2003 ENDDO
2004 ENDDO
2005C
2006 DO i=1,nrbe2
2007 m=irbe2(3,i)
2008 nsn =irbe2(5,i)
2009C--------case NSN=1 -------------
2010 IF(nsn==1) THEN
2011 iad=irbe2(1,i)
2012 ns=lrbe2(iad+1)
2013 ic = irbe2(4,i)/512
2014 IF (ndof(ns)<=3) irbe2(4,i)=ic*512
2015 ndof(m)=max(ndof(m),ndof(ns))
2016 END IF
2017 ENDDO
2018C----6---------------------------------------------------------------7---------8
2019 RETURN
2020 END
2021!||====================================================================
2022!|| dim_ndof_d ../engine/source/implicit/ind_glob_k.F
2023!||--- called by ------------------------------------------------------
2024!|| dim_glob_k ../engine/source/implicit/ind_glob_k.f
2025!||--- calls -----------------------------------------------------
2026!|| spmd_i2d ../engine/source/mpi/implicit/imp_spmd.F
2027!||====================================================================
2028 SUBROUTINE dim_ndof_d(
2029 1 NPBY ,LPBY ,NRBYAC ,IRBYAC ,NDOF ,
2030 2 IAD_RBY ,FR_RBY )
2031C----6---------------------------------------------------------------7---------8
2032C I m p l i c i t T y p e s
2033C-----------------------------------------------
2034#include "implicit_f.inc"
2035C-----------------------------------------------
2036C C o m m o n B l o c k s
2037C-----------------------------------------------
2038#include "param_c.inc"
2039#include "com01_c.inc"
2040#include "com04_c.inc"
2041C-----------------------------------------------
2042C D u m m y A r g u m e n t s
2043C-----------------------------------------------
2044 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*)
2045 INTEGER NDOF(*),IAD_RBY(*),FR_RBY(*)
2046C REAL
2047C-----------------------------------------------
2048C L o c a l V a r i a b l e s
2049C-----------------------------------------------
2050 INTEGER I,J,K,N,M,NSN,NS,IE,NN
2051C-----------------------------------------------
2052 IF (nrbyac==0) RETURN
2053 DO i=1,nrbyac
2054 n=irbyac(i)
2055 k=irbyac(i+nrbykin)
2056 m=npby(1,n)
2057 nsn =npby(2,n)
2058 ie = 0
2059 DO j=1,nsn
2060 ns=lpby(k+j)
2061 IF (ndof(ns)>0) ie = 1
2062 ENDDO
2063 IF (ie==0) THEN
2064 ndof(m) = 0
2065 ENDIF
2066 ENDDO
2067 IF (nspmd>1) THEN
2068 nn=iad_rby(nspmd+1)-iad_rby(1)
2069 IF (nn>0) CALL spmd_i2d(ndof,fr_rby,iad_rby,nn)
2070 ENDIF
2071C-------actualise NRBYAC,IRBYAC-------
2072 ie = 0
2073 DO i=1,nrbyac
2074 n=irbyac(i)
2075 m=npby(1,n)
2076 IF (ndof(m)>0) THEN
2077 ie = ie + 1
2078 irbyac(ie) = irbyac(i)
2079 irbyac(ie+nrbykin) = irbyac(i+nrbykin)
2080 ENDIF
2081 ENDDO
2082 nrbyac = ie
2083C----6---------------------------------------------------------------7---------8
2084 RETURN
2085 END
2086!||====================================================================
2087!|| dim_kine_s ../engine/source/implicit/ind_glob_k.F
2088!||--- called by ------------------------------------------------------
2089!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
2090!||--- calls -----------------------------------------------------
2091!|| intab ../engine/source/implicit/ind_glob_k.F
2092!||--- uses -----------------------------------------------------
2093!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2094!||====================================================================
2095 SUBROUTINE dim_kine_s(
2096 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
2097 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,NDOF ,
2098 3 NNMAX ,NROW ,NROWI ,NKINE ,INLOC ,
2099 4 ICOK ,IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
2100C-----------------------------------------------
2101C M o d u l e s
2102C-----------------------------------------------
2103 USE intbufdef_mod
2104C----6---------------------------------------------------------------7---------8
2105C I m p l i c i t T y p e s
2106C-----------------------------------------------
2107#include "implicit_f.inc"
2108C-----------------------------------------------
2109C C o m m o n B l o c k s
2110C-----------------------------------------------
2111#include "com04_c.inc"
2112#include "param_c.inc"
2113C-----------------------------------------------
2114C D u m m y A r g u m e n t s
2115C-----------------------------------------------
2116 INTEGER NNMAX
2117 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
2118 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),
2119 . ndof(*),nkine,inloc(*),irbe3(nrbe3l,*),lrbe3(*),
2120 . irbe2(nrbe2l,*),lrbe2(*)
2121 INTEGER NROW(*),NROWI(*),ICOK(NNMAX,*)
2122
2123 TYPE(intbuf_struct_) INTBUF_TAB(*)
2124C REAL
2125C-----------------------------------------------
2126C External function
2127C-----------------------------------------------
2128 LOGICAL INTAB
2129 EXTERNAL intab
2130C-----------------------------------------------
2131C L o c a l V a r i a b l e s
2132C-----------------------------------------------
2133 INTEGER NKS,NKM
2134 INTEGER NSN,NMN,I,J,K,N,M,EP,L,NI,NJ,K12,ID,NS,NK,NM,NNOD,N1,L1,NL1,NL,J1,NM1,
2135 . JI1,L10,L11,L12,L13,L14,NNOD1,I1,NSN1,M1,NKE,IAD,IC
2136C NROW(NUMNOD) :nombre of connected nodes (non sym)
2137C NROWI(NKINE) :INDICE LOCALE <=NNMAX (NROW peut eventuellement depasse NNMAX)
2138C INLOC(NUMNOD) :indice locale des "kinematic nodes"
2139C-----------------------------------------------
2140C------interface 2--------------
2141 DO i=1,nint2
2142 n=iint2(i)
2143 nsn = ipari(5,n)
2144 nmn = ipari(6,n)
2145 DO 20 j=1,nsn
2146 ns=intbuf_tab(n)%NSV(j)
2147 IF (ndof(ns)>0) THEN
2148 l=intbuf_tab(n)%IRTLM(j)
2149 id=4*(l-1)
2150 IF (intbuf_tab(n)%IRECTM(id+3)==intbuf_tab(n)%IRECTM(id+4)) THEN
2151 nnod=3
2152 ELSE
2153 nnod=4
2154 ENDIF
2155 DO m=1,nnod
2156 nm=intbuf_tab(n)%IRECTM(id+m)
2157 IF (ndof(nm)>0)nrow(nm)=nrow(nm)+nnod-1
2158 ENDDO
2159 nks=inloc(ns)
2160 DO nk=1,nrowi(nks)
2161 nj=icok(nk,nks)
2162 IF (.NOT.intab(nsn,intbuf_tab(n)%NSV(1) ,nj)) THEN
2163 IF (inloc(nj)==0.AND.ndof(nj)>0) THEN
2164 nkine=nkine+1
2165 inloc(nj)=nkine
2166 ENDIF
2167 DO m=1,nnod
2168 nm=intbuf_tab(n)%IRECTM(id+m)
2169 nrow(nm)=nrow(nm)+1
2170 nrow(nj)=nrow(nj)+1
2171 ENDDO
2172 ENDIF
2173 ENDDO
2174C-----with Kij block-(i,j have the same M)-----
2175 DO n1=j+1,nsn
2176 nj=intbuf_tab(n)%NSV(n1)
2177 l1=intbuf_tab(n)%IRTLM(n1)
2178 IF (ndof(nj)>0.AND.l/=l1) THEN
2179 IF (intab(nrowi(nks),icok(1,nks),nj)) THEN
2180 nl1=4*(l1-1)
2181 DO m=1,nnod
2182 nm=intbuf_tab(n)%IRECTM(id+m)
2183 DO j1=1,4
2184 nm1=intbuf_tab(n)%IRECTM(nl1+j1)
2185 IF (nm/=nm1) THEN
2186 nrow(nm)=nrow(nm)+1
2187 nrow(nm1)=nrow(nm1)+1
2188 ENDIF
2189 ENDDO
2190 ENDDO
2191 ENDIF
2192 ENDIF
2193 ENDDO
2194 ENDIF
2195 20 CONTINUE
2196 DO j=1,nmn
2197 nm=intbuf_tab(n)%MSR(j)
2198 IF (inloc(nm)==0.AND.ndof(nm)>0) THEN
2199 nkine=nkine+1
2200 inloc(nm)=nkine
2201 ENDIF
2202 ENDDO
2203 ENDDO
2204C+++couplage entre int2----
2205 IF (nint2>1) THEN
2206 DO j=1,nint2
2207 n=iint2(j)
2208 nsn = ipari(5,n)
2209 DO j1=j+1,nint2
2210 n1=iint2(j1)
2211 nsn1 = ipari(5,n1)
2212 ji1=ipari(1,n1)
2213 l10=ji1-1
2214 l11=l10+4*ipari(3,n1)
2215 l12=l11+4*ipari(4,n1)
2216 l13=l12+nsn1
2217 l14=l13+ipari(6,n1)
2218 DO i=1,nsn
2219 ni=intbuf_tab(n)%NSV(i)
2220 IF (ndof(ni)>0) THEN
2221 nke=inloc(ni)
2222C------cherche-secnd pairs-entre int2---
2223 DO i1=1,nsn1
2224 nj=intbuf_tab(n1)%NSV(i1)
2225 IF (ndof(nj)>0.AND.
2226 . intab(nrowi(nke),icok(1,nke),nj)) THEN
2227 l=intbuf_tab(n)%IRTLM(i)
2228 nl=4*(l-1)
2229 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2230 nnod=3
2231 ELSE
2232 nnod=4
2233 ENDIF
2234 l1=intbuf_tab(n1)%IRTLM(i1)
2235 nl1=4*(l1-1)
2236 IF (intbuf_tab(n1)%IRECTM(nl1+3)==intbuf_tab(n1)%IRECTM(nl1+4)) THEN
2237 nnod1=3
2238 ELSE
2239 nnod1=4
2240 ENDIF
2241 DO m=1,nnod
2242 nm=intbuf_tab(n)%IRECTM(nl+m)
2243 DO m1=1,nnod1
2244 nm1=intbuf_tab(n1)%IRECTM(nl1+m1)
2245 IF (ndof(nm)>0.AND.ndof(nm1)>0) THEN
2246 nrow(nm)=nrow(nm)+1
2247 nrow(nm1)=nrow(nm1)+1
2248 ENDIF
2249 ENDDO
2250 ENDDO
2251C----------endif NDOF(NJ)>0----
2252 ENDIF
2253C----------enddo DO I1=1,NSN1----
2254 ENDDO
2255C----------endif NDOF(NI)>0----
2256 ENDIF
2257C----------enddo DO I=1,NSN----
2258 ENDDO
2259C----------enddo DO J1=----
2260 ENDDO
2261 ENDDO
2262 ENDIF
2263C----- Rbe2 ------
2264 DO i=1,nrbe2
2265 k=irbe2(1,i)
2266 m=irbe2(3,i)
2267 nsn =irbe2(5,i)
2268 ic = 7*512+7*64-irbe2(4,i)
2269 DO j=1,nsn
2270 ns=lrbe2(k+j)
2271 IF (ndof(ns)>0) THEN
2272 nks=inloc(ns)
2273 DO nk=1,nrowi(nks)
2274 nj=icok(nk,nks)
2275 IF (ndof(nj)>0) THEN
2276 nrow(m)=nrow(m)+1
2277 nrow(nj)=nrow(nj)+1+nhrbe2
2278 IF (inloc(nj)==0) THEN
2279 nkine=nkine+1
2280 inloc(nj)=nkine
2281 ENDIF
2282 ENDIF
2283 ENDDO
2284C-----Due to hierarchy----
2285 IF (nrow(ns)>nrowi(nks)) nrow(m)=nrow(m)+ nrow(ns)-nrowi(nks)
2286C+++++++Knsns -> Kmns
2287 IF (ic>0) THEN
2288 nrow(m)=nrow(m)+1
2289 nrow(ns)=nrow(ns)+1
2290 ENDIF
2291 ENDIF
2292 ENDDO
2293C+++estimation de couplage ----
2294 nrow(m)=nrow(m)+1
2295 ENDDO
2296C------RBE3--------------
2297 DO i=1,nrbe3
2298 ns = irbe3(3,i)
2299 IF (ns==0.OR.ndof(ns)==0) cycle
2300 iad = irbe3(1,i)
2301 nnod = irbe3(5,i)
2302 nks=inloc(ns)
2303 DO m=1,nnod
2304 nm=lrbe3(iad+m)
2305 IF (ndof(nm)>0)nrow(nm)=nrow(nm)+nnod-1
2306 ENDDO
2307 DO nk=1,nrowi(nks)
2308 nj=icok(nk,nks)
2309 IF (inloc(nj)==0.AND.ndof(nj)>0) THEN
2310 nkine=nkine+1
2311 inloc(nj)=nkine
2312 ENDIF
2313 DO m=1,nnod
2314 nm=lrbe3(iad+m)
2315 nrow(nm)=nrow(nm)+1
2316 nrow(nj)=nrow(nj)+1
2317 ENDDO
2318 ENDDO
2319C-----Due to hierarchy----
2320 IF (nrow(ns)>nrowi(nks)) THEN
2321 k12 = nrow(ns)-nrowi(nks)
2322 DO m=1,nnod
2323 nm=lrbe3(iad+m)
2324 nrow(nm)=nrow(nm)+ k12 + k12
2325 ENDDO
2326 END IF
2327C-----with Kij (i,j -> NSi,NSj-----
2328 DO i1=i+1,nrbe3
2329 nj=irbe3(3,i1)
2330 IF (nj==0.OR.ndof(nj)==0) cycle
2331 IF (intab(nrowi(nks),icok(1,nks),nj)) THEN
2332 m1 = irbe3(1,i1)
2333 n1 = irbe3(5,i1)
2334 DO m=1,nnod
2335 nm=lrbe3(iad+m)
2336 DO j1=1,n1
2337 nm1=lrbe3(m1+j1)
2338 IF (nm/=nm1) THEN
2339 nrow(nm)=nrow(nm)+1
2340 nrow(nm1)=nrow(nm1)+1
2341 ENDIF
2342 ENDDO
2343 ENDDO
2344 ENDIF
2345 ENDDO
2346C
2347 DO m=1,nnod
2348 nm=lrbe3(iad+m)
2349 IF (inloc(nm)==0.AND.ndof(nm)>0) THEN
2350 nkine=nkine+1
2351 inloc(nm)=nkine
2352 ENDIF
2353 ENDDO
2354 ENDDO
2355C----- rigid body ------
2356 DO i=1,nrbyac
2357 n=irbyac(i)
2358 k=irbyac(i+nrbykin)
2359 m=npby(1,n)
2360 IF (inloc(m)<0) inloc(m)=-inloc(m)
2361 nsn =npby(2,n)
2362 IF (ndof(m)>0) THEN
2363 DO j=1,nsn
2364 ns=lpby(k+j)
2365 IF (ndof(ns)>0) THEN
2366 nks=inloc(ns)
2367 DO nk=1,nrowi(nks)
2368 nj=icok(nk,nks)
2369 IF (ndof(nj)>0) THEN
2370 IF (.NOT.intab(nsn,lpby(k+1),nj)) THEN
2371 nrow(m)=nrow(m)+1
2372 nrow(nj)=nrow(nj)+1
2373 IF (inloc(nj)==0) THEN
2374 nkine=nkine+1
2375 inloc(nj)=nkine
2376 ENDIF
2377 ENDIF
2378 ENDIF
2379 ENDDO
2380 IF (nrow(ns)>nrowi(nks)) nrow(m)=nrow(m)+ nrow(ns)-nrowi(nks)
2381 END IF !IF (NDOF(NS)>0)
2382 ENDDO
2383 ENDIF
2384C+++estimation de couplage ----
2385 nrow(m)=nrow(m)+nsn
2386 ENDDO
2387C
2388C----6---------------------------------------------------------------7---------8
2389 RETURN
2390 END
2391!||====================================================================
2392!|| dim_kine_t ../engine/source/implicit/ind_glob_k.f
2393!||--- called by ------------------------------------------------------
2394!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
2395!||--- calls -----------------------------------------------------
2396!|| intab ../engine/source/implicit/ind_glob_k.F
2397!|| reorder_a ../engine/source/implicit/ind_glob_k.F
2398!||--- uses -----------------------------------------------------
2399!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2400!||====================================================================
2401 SUBROUTINE dim_kine_t(
2402 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
2403 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,NDOF ,
2404 3 NNMAX ,NROWI ,NKINE ,INLOC ,ICOK ,
2405 4 NSS ,NSIJ ,NMIJ ,NSS2 ,NSIJ2 ,
2406 5 NMIJ2 ,NKMAX ,ICOKM ,INK ,IRBE3 ,
2407 6 LRBE3 ,NSS3 ,IRBE2 ,LRBE2 ,NSB2 )
2408C-----------------------------------------------
2409C M o d u l e s
2410C-----------------------------------------------
2411 USE intbufdef_mod
2412C-----------------------------------------------
2413C I m p l i c i t T y p e s
2414C-----------------------------------------------
2415#include "implicit_f.inc"
2416C-----------------------------------------------
2417C C o m m o n B l o c k s
2418C-----------------------------------------------
2419#include "com04_c.inc"
2420#include "param_c.inc"
2421C-----------------------------------------------
2422C D u m m y A r g u m e n t s
2423C-----------------------------------------------
2424 INTEGER NNMAX
2425 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
2426 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),
2427 . ndof(*),nkine,inloc(*),nmij2,nss3
2428 INTEGER NROWI(*),ICOK(NNMAX,*),NSS ,NSIJ ,NMIJ,NSS2 ,NSIJ2
2429 INTEGER NKMAX,ICOKM(NKMAX,*),INK,IRBE3(NRBE3L,*),LRBE3(*),
2430 . irbe2(nrbe2l,*),lrbe2(*),nsb2
2431
2432 TYPE(intbuf_struct_) INTBUF_TAB(*)
2433C REAL
2434C-----------------------------------------------
2435C External function
2436C-----------------------------------------------
2437 LOGICAL INTAB
2438 EXTERNAL INTAB
2439C-----------------------------------------------
2440C L o c a l V a r i a b l e s
2441C-----------------------------------------------
2442 INTEGER NKS,NKM,NKE1,NKE2,NKM1,NKE
2443 INTEGER NSN,NMN,I,J,K,N,M,EP,L,NI,NJ,JI,K10,K11,K12,K13,
2444 . K14,KFI,ID,NS,NK,NM,NNOD,N1,L1,NL1,NL,J1,NM1,N2,
2445 . JI1,L10,L11,L12,L13,L14,NNOD1,I1,NSN1,M1,IAD,IC
2446C NROWI(NKINE) :INDICE LOCALE <=NNMAX
2447C INLOC(NUMNOD) :indice locale des "kinematic nodes"
2448C-----------------------------------------------
2449C------interface 2--------------
2450 NSS2=0
2451 nsij2=0
2452 DO i=1,nint2
2453 n=iint2(i)
2454 nsn = ipari(5,n)
2455 nmn = ipari(6,n)
2456 ji=ipari(1,n)
2457 k10=ji-1
2458 k11=k10+4*ipari(3,n)
2459C------IRECT(4,NSN)-----
2460 k12=k11+4*ipari(4,n)
2461C------NSV(NSN)--node number---
2462 k13=k12+nsn
2463C------MSR(NMN)-----
2464 k14=k13+nmn
2465C------IRTL(NSN)--main el number---
2466 kfi=k14+nsn
2467 DO 20 j=1,nsn
2468 ns=intbuf_tab(n)%NSV(j)
2469 IF (ndof(ns)>0) THEN
2470 l=intbuf_tab(n)%IRTLM(j)
2471 id=4*(l-1)
2472 IF (intbuf_tab(n)%IRECTM(id+3)==intbuf_tab(n)%IRECTM(id+4)) THEN
2473 nnod=3
2474 ELSE
2475 nnod=4
2476 ENDIF
2477 DO m=1,nnod
2478 nm=intbuf_tab(n)%IRECTM(id+m)
2479 IF (ndof(nm)>0) THEN
2480 nke1=inloc(nm)
2481 DO j1=1,nnod
2482 nm1=intbuf_tab(n)%IRECTM(id+j1)
2483 IF (nm/=nm1) CALL reorder_a(nrowi(nke1),icok(1,nke1),nm1)
2484 ENDDO
2485 ENDIF
2486 ENDDO
2487 nks=inloc(ns)
2488 DO nk=1,nrowi(nks)
2489 nj=icok(nk,nks)
2490 IF (ndof(nj)>0.AND.
2491 . (.NOT.intab(nsn,intbuf_tab(n)%NSV(1),nj))) THEN
2492 nss2=nss2+1
2493 nke2=inloc(nj)
2494 DO m=1,nnod
2495 nm=intbuf_tab(n)%IRECTM(id+m)
2496 IF (ndof(nm)>0) THEN
2497 nke1=inloc(nm)
2498 CALL reorder_a(nrowi(nke1),icok(1,nke1),nj)
2499 CALL reorder_a(nrowi(nke2),icok(1,nke2),nm)
2500 ENDIF
2501 ENDDO
2502 ENDIF
2503 ENDDO
2504C-----with Kij block-(i,j have the same M)-----
2505 DO n1=j+1,nsn
2506 nj=intbuf_tab(n)%NSV(n1)
2507 l1=intbuf_tab(n)%IRTLM(n1)
2508 IF (ndof(nj)>0.AND.
2509 . intab(nrowi(nks),icok(1,nks),nj)) THEN
2510 nsij2=nsij2+2
2511 IF (l/=l1) THEN
2512 nl1=4*(l1-1)
2513 DO m=1,nnod
2514 nm=intbuf_tab(n)%IRECTM(id+m)
2515 IF (ndof(nm)>0) THEN
2516 nke1=inloc(nm)
2517 DO j1=1,4
2518 nm1=intbuf_tab(n)%IRECTM(nl1+j1)
2519 IF (nm/=nm1.AND.ndof(nm1)>0) THEN
2520 nke2=inloc(nm1)
2521 CALL reorder_a(nrowi(nke1),icok(1,nke1),nm1)
2522 CALL reorder_a(nrowi(nke2),icok(1,nke2),nm)
2523 ENDIF
2524 ENDDO
2525 ENDIF
2526 ENDDO
2527 ENDIF
2528 ENDIF
2529 ENDDO
2530 ENDIF
2531 20 CONTINUE
2532 ENDDO
2533C------Rbe2------
2534 nsb2=0
2535 DO n=1,nrbe2
2536 k=irbe2(1,n)
2537 m=irbe2(3,n)
2538 nsn =irbe2(5,n)
2539 nke1=inloc(m)
2540 ic = 7*512+7*64-irbe2(4,n)
2541 DO j=1,nsn
2542 ns=lrbe2(k+j)
2543 IF (ndof(ns)>0) THEN
2544 nks=inloc(ns)
2545 DO nk=1,nrowi(nks)
2546 IF (nks >ink) THEN
2547 nj=icok(nk,nks)
2548 ELSE
2549 nj=icokm(nk,nks)
2550 END IF
2551 nke2=inloc(nj)
2552 IF (ndof(nj)>0.AND.nj/=ns) THEN
2553 nsb2=nsb2+1
2554 CALL reorder_a(nrowi(nke1),icokm(1,nke1),nj)
2555 IF (nke2>ink) THEN
2556 CALL reorder_a(nrowi(nke2),icok(1,nke2),m)
2557 ELSEIF (nke2>0) THEN
2558 CALL reorder_a(nrowi(nke2),icokm(1,nke2),m)
2559 ENDIF
2560 ENDIF
2561 ENDDO
2562 IF (ic>0) THEN
2563 CALL reorder_a(nrowi(nke1),icokm(1,nke1),ns)
2564 IF (nks > ink) THEN
2565 CALL reorder_a(nrowi(nks),icok(1,nks),m)
2566 ELSEIF (nks > 0) THEN
2567 CALL reorder_a(nrowi(nks),icokm(1,nks),m)
2568 END IF
2569 ENDIF
2570 ENDIF
2571 ENDDO
2572 ENDDO
2573C------RBE3--------------
2574 nss3=0
2575 DO i=1,nrbe3
2576 iad=irbe3(1,i)
2577 ns =irbe3(3,i)
2578 IF (ns==0) cycle
2579 nnod=irbe3(5,i)
2580 IF (ndof(ns)>0) THEN
2581C
2582 DO m=1,nnod
2583 nm=lrbe3(iad+m)
2584 IF (ndof(nm)>0) THEN
2585 nke1=inloc(nm)
2586 DO j1=m+1,nnod
2587 nm1=lrbe3(iad+j1)
2588 IF (nke1>ink.AND.nm/=nm1) THEN
2589 CALL reorder_a(nrowi(nke1),icok(1,nke1),nm1)
2590 ELSEIF (nke1>0.AND.nm/=nm1) THEN
2591 CALL reorder_a(nrowi(nke1),icokm(1,nke1),nm1)
2592 ENDIF
2593 nke2=inloc(nm1)
2594 IF (nke2>ink) THEN
2595 CALL reorder_a(nrowi(nke2),icok(1,nke2),nm)
2596 ELSEIF (nke2>0) THEN
2597 CALL reorder_a(nrowi(nke2),icokm(1,nke2),nm)
2598 ENDIF
2599 ENDDO
2600 ENDIF
2601 ENDDO
2602 nks=inloc(ns)
2603 DO nk=1,nrowi(nks)
2604C-----due to change of RBE2- (M used ICOKM now) --
2605 IF (nks > ink) THEN
2606 nj=icok(nk,nks)
2607 ELSE
2608 nj=icokm(nk,nks)
2609 END IF
2610 IF (ndof(nj)>0 ) THEN
2611 nss3=nss3+1
2612 nke2=inloc(nj)
2613 DO m=1,nnod
2614 nm=lrbe3(iad+m)
2615 IF (ndof(nm)>0) THEN
2616 nke1=inloc(nm)
2617
2618 IF (nke1>ink) THEN
2619 CALL reorder_a(nrowi(nke1),icok(1,nke1),nj)
2620 ELSEIF (nke1>0) THEN
2621 CALL reorder_a(nrowi(nke1),icokm(1,nke1),nj)
2622 ENDIF
2623
2624 IF (nke2>ink) THEN
2625 CALL reorder_a(nrowi(nke2),icok(1,nke2),nm)
2626 ELSEIF (nke2>0) THEN
2627 CALL reorder_a(nrowi(nke2),icokm(1,nke2),nm)
2628 ENDIF
2629
2630 ENDIF
2631 ENDDO
2632 ENDIF
2633 ENDDO
2634 ENDIF
2635 ENDDO
2636C+++couplage entre int2----
2637 nmij2=0
2638C
2639 nss=0
2640 nsij=0
2641 DO i=1,nrbyac
2642 n=irbyac(i)
2643 k=irbyac(i+nrbykin)
2644 m=npby(1,n)
2645 nsn =npby(2,n)
2646 IF (ndof(m)>0) THEN
2647 nke1=inloc(m)
2648 DO j=1,nsn
2649 ns=lpby(k+j)
2650 IF (ndof(ns)>0) THEN
2651 nks=inloc(ns)
2652 DO nk=1,nrowi(nks)
2653 IF (nks > ink) THEN
2654 nj=icok(nk,nks)
2655 ELSE
2656 nj=icokm(nk,nks)
2657 END IF
2658 nke2=inloc(nj)
2659 IF (ndof(nj)>0.AND.
2660 . (.NOT.intab(nsn,lpby(k+1),nj))) THEN
2661 nss=nss+1
2662 CALL reorder_a(nrowi(nke1),icokm(1,nke1),nj)
2663 IF (nke2>ink) THEN
2664 CALL reorder_a(nrowi(nke2),icok(1,nke2),m)
2665 ELSEIF (nke2>0) THEN
2666 CALL reorder_a(nrowi(nke2),icokm(1,nke2),m)
2667 ENDIF
2668 ENDIF
2669 ENDDO
2670C-----create rigid body secnd nodes with Kij block-(i,j have the same M)-----
2671 DO n1=j+1,nsn
2672 nj=lpby(k+n1)
2673 IF (nks > ink) THEN
2674 IF (ndof(nj)>0.AND.
2675 . (intab(nrowi(nks),icok(1,nks),nj))) THEN
2676 nsij=nsij+2
2677 ENDIF
2678 ELSE
2679 IF (ndof(nj)>0.AND.
2680 . (intab(nrowi(nks),icokm(1,nks),nj))) THEN
2681 nsij=nsij+2
2682 ENDIF
2683 END IF
2684 ENDDO
2685 ENDIF
2686 ENDDO
2687 ENDIF
2688 ENDDO
2689C+++couplage entre rigid bodies----
2690 nmij=0
2691 IF (nrbyac>1) THEN
2692 DO j=1,nrbyac
2693 n=irbyac(j)
2694 k=irbyac(j+nrbykin)
2695 m =npby(1,n)
2696 ns=npby(2,n)
2697 IF (ndof(m)>0) THEN
2698 nke1=inloc(m)
2699 DO j1=j+1,nrbyac
2700 n1=irbyac(j1)
2701 l1=irbyac(j1+nrbykin)
2702 nm =npby(1,n1)
2703 nsn =npby(2,n1)
2704 IF (intab(nrowi(nke1),icokm(1,nke1),nm)) THEN
2705 DO i=1,nsn
2706 id = i+l1
2707 ni=lpby(id)
2708 IF (ndof(ni)>0) THEN
2709 nks=inloc(ni)
2710 IF (nks > ink) THEN
2711 IF (intab(nrowi(nks),icok(1,nks),m)) THEN
2712C------cherche-secnd pairs----
2713 DO n1=1,ns
2714 n2=lpby(k+n1)
2715 IF (ndof(n2)>0.AND.
2716 . intab(nrowi(nks),icok(1,nks),n2)) THEN
2717 nmij=nmij+2
2718 ENDIF
2719 ENDDO
2720 ENDIF
2721 ELSE
2722 IF (intab(nrowi(nks),icokm(1,nks),m)) THEN
2723C------cherche-secnd pairs----
2724 DO n1=1,ns
2725 n2=lpby(k+n1)
2726 IF (ndof(n2)>0.AND.
2727 . intab(nrowi(nks),icokm(1,nks),n2)) THEN
2728 nmij=nmij+2
2729 ENDIF
2730 ENDDO
2731 ENDIF
2732 END IF
2733 ENDIF
2734 ENDDO
2735 ENDIF
2736 ENDDO
2737 ENDIF
2738 ENDDO
2739 ENDIF
2740 nsij=nsij+nmij
2741C----6---------------------------------------------------------------7---------8
2742 RETURN
2743 END
2744!||====================================================================
2745!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
2746!||--- called by ------------------------------------------------------
2747!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
2748!||--- calls -----------------------------------------------------
2749!|| intab ../engine/source/implicit/ind_glob_k.F
2750!|| reorder_a ../engine/source/implicit/ind_glob_k.F
2751!|| rmind_imp ../engine/source/model/remesh/rm_imp0.F
2752!||--- uses -----------------------------------------------------
2753!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2754!||====================================================================
2755 SUBROUTINE ind_kine_k(NPBY,LPBY,
2756 1 ITAB ,NRBYAC ,IRBYAC ,NSC ,ISIJ ,
2757 2 NMC ,IMIJ ,NSS ,ISS ,NINT2 ,
2758 3 IINT2 ,IPARI ,INTBUF_TAB,NSC2 ,ISIJ2 ,
2759 4 NSS2 ,ISS2 ,NDOF ,NNMAX ,NKINE ,
2760 5 INLOC ,NKMAX ,NROWK ,ICOK ,ICOKM ,
2761 6 NMC2 ,IMIJ2 ,INK ,IRBE3 ,LRBE3 ,
2762 7 ISS3 ,IRBE2 ,LRBE2 ,ISB2 ,NSRB2 )
2763C----6---------------------------------------------------------------7---------8
2764C-----------------------------------------------
2765C M o d u l e s
2766C-----------------------------------------------
2767 USE intbufdef_mod
2768C-----------------------------------------------
2769C I m p l i c i t T y p e s
2770C-----------------------------------------------
2771#include "implicit_f.inc"
2772C-----------------------------------------------
2773C C o m m o n B l o c k s
2774C-----------------------------------------------
2775#include "com04_c.inc"
2776#include "param_c.inc"
2777#include "remesh_c.inc"
2778C-----------------------------------------------
2779C D u m m y A r g u m e n t s
2780C-----------------------------------------------
2781 INTEGER NNMAX,NKMAX
2782 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
2783 . nsc(*),isij(*),nss(*),iss(*),nint2,iint2(*),
2784 . nsc2(*),isij2(*),nss2(*),iss2(*),ipari(npari,*),
2785 . nmc,imij(*),icok(nnmax,*),icokm(nkmax,*),nrowk(*),
2786 . nmc2,imij2(*),irbe2(nrbe2l,*),lrbe2(*),isb2(*),nsrb2(*)
2787 INTEGER
2788 . ndof(*),nkine,inloc(*),ink,irbe3(nrbe3l,*),lrbe3(*),iss3(*)
2789
2790 TYPE(intbuf_struct_) INTBUF_TAB(*)
2791C-----------------------------------------------
2792C External function
2793C-----------------------------------------------
2794 LOGICAL INTAB
2795 EXTERNAL intab
2796C REAL
2797C-----------------------------------------------
2798C L o c a l V a r i a b l e s
2799C-----------------------------------------------
2800C------ICOK,ICOKM use the same NROWK------
2801 INTEGER NKE,NKE1,NKE2,IK,NKM1,IAD
2802 INTEGER
2803 . I,J,K,N,L,NL,NJ,NI,J1,M,NSN,N1,N2,NK,ID,
2804 . JI,K10,K11,K12,K13,K14,KFI,NS,NNOD,NM,L1,NL1,NM1,
2805 . JI1,L10,L11,L12,L13,L14,NNOD1,I1,NSN1,M1,K1,IC
2806c----------------------
2807 K=0
2808 ns= 0
2809 nk=1
2810 DO j=1,nint2
2811 n=iint2(j)
2812 nsn = ipari(5,n)
2813 ji=ipari(1,n)
2814 k10=ji-1
2815 k11=k10+4*ipari(3,n)
2816C------IRECT(4,NSN)-----
2817 k12=k11+4*ipari(4,n)
2818C------NSV(NSN)--node number---
2819 k13=k12+nsn
2820C------MSR(NMN)-----
2821 k14=k13+ipari(6,n)
2822C------IRTL(NSN)--main el number---
2823 kfi=k14+nsn
2824 nsc2(j)=0
2825 DO i=1,nsn
2826 id = i+k
2827 nss2(id)=0
2828 ni=intbuf_tab(n)%NSV(i)
2829 IF (ndof(ni)>0) THEN
2830 l=intbuf_tab(n)%IRTLM(i)
2831 nl=4*(l-1)
2832 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2833 nnod=3
2834 ELSE
2835 nnod=4
2836 ENDIF
2837 DO m=1,nnod
2838 nm=intbuf_tab(n)%IRECTM(nl+m)
2839 IF (ndof(nm)>0) THEN
2840 nke1=inloc(nm)
2841 DO j1=1,nnod
2842 nm1=intbuf_tab(n)%IRECTM(nl+j1)
2843 IF (nm/=nm1) CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
2844 ENDDO
2845 ENDIF
2846 ENDDO
2847 nke=inloc(ni)
2848 DO n1=1,nrowk(nke)
2849 nj=icok(n1,nke)
2850 IF (ndof(nj)>0.AND.
2851 . (.NOT.intab(nsn,intbuf_tab(n)%NSV(1),nj))) THEN
2852 j1=ns+nss2(id)+1
2853 iss2(j1)=nj
2854 nss2(id)=nss2(id)+1
2855 nke2=inloc(nj)
2856 DO m=1,nnod
2857 nm=intbuf_tab(n)%IRECTM(nl+m)
2858 IF (ndof(nm)>0) THEN
2859 nke1=inloc(nm)
2860 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
2861 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
2862 ENDIF
2863 ENDDO
2864 ENDIF
2865 ENDDO
2866 ns=ns+nss2(id)
2867C-----with Kij block-(i,j secnd)-----
2868 DO n1=i+1,nsn
2869 nj=intbuf_tab(n)%NSV(n1)
2870 l1=intbuf_tab(n)%IRTLM(n1)
2871 IF (ndof(nj)>0.AND.
2872 . intab(nrowk(nke),icok(1,nke),nj)) THEN
2873 nsc2(j)=nsc2(j)+1
2874 id =nk+2*(nsc2(j)-1)
2875 isij2(id)=i
2876 isij2(id+1)=n1
2877 IF(l/=l1) THEN
2878 nl1=4*(l1-1)
2879 DO m=1,nnod
2880 nm=intbuf_tab(n)%IRECTM(nl+m)
2881 IF (ndof(nm)>0) THEN
2882 nke1=inloc(nm)
2883 DO j1=1,4
2884 nm1=intbuf_tab(n)%IRECTM(nl1+j1)
2885 IF (nm/=nm1.AND.ndof(nm1)>0) THEN
2886 nke2=inloc(nm1)
2887 CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
2888 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
2889 ENDIF
2890 ENDDO
2891 ENDIF
2892 ENDDO
2893 ENDIF
2894 ENDIF
2895 ENDDO
2896 ENDIF
2897 ENDDO
2898 k=k+nsn
2899 nk=nk+2*nsc2(j)
2900 ENDDO
2901C+++couplage entre int2----
2902 nmc2=0
2903C-----RBE2------
2904 k=0
2905 DO n=1,nrbe2
2906 k1=irbe2(1,n)
2907 m =irbe2(3,n)
2908 nsn=irbe2(5,n)
2909 nke1=inloc(m)
2910 ns = 0
2911 ic = 7*512+7*64-irbe2(4,n)
2912 DO i=1,nsn
2913 ni=lrbe2(i+k1)
2914 nsrb2(i+k1)=0
2915 IF (ndof(ni)>0) THEN
2916 nke=inloc(ni)
2917 DO n1=1,nrowk(nke)
2918 IF (nke <= ink) THEN
2919 nj=icok(n1,nke)
2920 ELSE
2921 nj=icokm(n1,nke-ink)
2922 END IF
2923 nke2=inloc(nj)
2924 IF (ndof(nj)>0.AND.nj/=ni) THEN
2925 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nj)
2926 IF (nke2<=ink) THEN
2927 CALL reorder_a(nrowk(nke2),icok(1,nke2),m)
2928 ELSEIF (nke2>0) THEN
2929 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),m)
2930 ENDIF
2931 k=k+1
2932 nsrb2(i+k1)=nsrb2(i+k1)+1
2933 isb2(k)=nj
2934 ns=ns+1
2935 ENDIF
2936 ENDDO
2937 IF (ic>0) THEN
2938 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),ni)
2939 IF (nke <= ink) THEN
2940 CALL reorder_a(nrowk(nke),icok(1,nke),m)
2941 ELSEIF (nke > 0) THEN
2942 CALL reorder_a(nrowk(nke),icokm(1,nke-ink),m)
2943 END IF
2944 ENDIF
2945 ENDIF
2946 ENDDO
2947 irbe2(8,n) = ns
2948 ENDDO
2949C------------RBE3-----
2950 k = 0
2951 DO i=1,nrbe3
2952 iad=irbe3(1,i)
2953 ni =irbe3(3,i)
2954 IF (ni==0) cycle
2955 nnod=irbe3(5,i)
2956 ns=0
2957 IF (ndof(ni)>0) THEN
2958 DO m=1,nnod
2959 nm=lrbe3(iad+m)
2960 IF (ndof(nm)>0) THEN
2961 nke1=inloc(nm)
2962 DO j1=1,nnod
2963 nm1=lrbe3(iad+j1)
2964 IF (nke1<=ink.AND.nm/=nm1) THEN
2965 CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
2966 ELSEIF (nm/=nm1) THEN
2967 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nm1)
2968 ENDIF
2969 ENDDO
2970 ENDIF
2971 ENDDO
2972 nke=inloc(ni)
2973 DO n1=1,nrowk(nke)
2974 IF (nke <= ink) THEN
2975 nj=icok(n1,nke)
2976 ELSE
2977 nj=icokm(n1,nke-ink)
2978 END IF
2979 IF (ndof(nj)>0.AND.ni/=nj) THEN
2980 ns=ns+1
2981 k = k + 1
2982 iss3(k)=nj
2983 nke2=inloc(nj)
2984 DO m=1,nnod
2985 nm=lrbe3(iad+m)
2986 IF (ndof(nm)>0) THEN
2987 nke1=inloc(nm)
2988
2989 IF (nke1<=ink) THEN
2990 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
2991 ELSE
2992 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nj)
2993 ENDIF
2994
2995 IF (nke2<=ink) THEN
2996 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
2997 ELSE
2998 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),nm)
2999 ENDIF
3000
3001 ENDIF
3002 ENDDO
3003 ENDIF
3004 ENDDO
3005 ENDIF
3006 irbe3(8,i) = ns
3007 ENDDO
3008C-----active rigid body main nodes------
3009 k=0
3010 ns= 0
3011 nk=1
3012 DO j=1,nrbyac
3013 n=irbyac(j)
3014 k1=irbyac(j+nrbykin)
3015 m =npby(1,n)
3016 nsn =npby(2,n)
3017 nsc(j)=0
3018 IF (ndof(m)>0) THEN
3019 nke1=inloc(m)
3020 nkm1=nke1-ink
3021 DO i=1,nsn
3022 id = i+k
3023 ni=lpby(i+k1)
3024 nss(id)=0
3025 IF (ndof(ni)>0) THEN
3026 nke=inloc(ni)
3027 DO n1=1,nrowk(nke)
3028 IF (nke <= ink) THEN
3029 nj=icok(n1,nke)
3030 ELSE
3031 nj=icokm(n1,nke-ink)
3032 END IF
3033 nke2=inloc(nj)
3034 IF (ndof(nj)>0.AND.
3035 . (.NOT.intab(nsn,lpby(k1+1),nj))) THEN
3036 CALL reorder_a(nrowk(nke1),icokm(1,nkm1),nj)
3037 IF (nke2<=ink) THEN
3038 CALL reorder_a(nrowk(nke2),icok(1,nke2),m)
3039 j1=ns+nss(id)+1
3040 iss(j1)=nj
3041 nss(id)=nss(id)+1
3042 ELSE
3043 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),m)
3044 ENDIF
3045 ENDIF
3046 ENDDO
3047 ns=ns+nss(id)
3048C-----create rigid body secnd nodes with Kij block-(i,j have the same M)-----
3049 DO n1=i+1,nsn
3050 nj=lpby(k1+n1)
3051 IF (nke <= ink) THEN
3052 IF (ndof(nj)>0.AND.
3053 . (intab(nrowk(nke),icok(1,nke),nj))) THEN
3054 nsc(j)=nsc(j)+1
3055 id =nk+2*(nsc(j)-1)
3056 isij(id)=ni
3057 isij(id+1)=nj
3058 ENDIF
3059 ELSE
3060 IF (ndof(nj)>0.AND.
3061 . (intab(nrowk(nke),icokm(1,nke-ink),nj))) THEN
3062 nsc(j)=nsc(j)+1
3063 id =nk+2*(nsc(j)-1)
3064 isij(id)=ni
3065 isij(id+1)=nj
3066 ENDIF
3067 END IF
3068 ENDDO
3069 ENDIF
3070 ENDDO
3071 ENDIF
3072 k=k+nsn
3073 nk=nk+2*nsc(j)
3074 ENDDO
3075C+++couplage entre rigid bodies----
3076 nmc=0
3077 IF (nrbyac>1) THEN
3078 DO j=1,nrbyac
3079 n=irbyac(j)
3080 k=irbyac(j+nrbykin)
3081 m =npby(1,n)
3082 ns=npby(2,n)
3083C
3084 IF (ndof(m)>0) THEN
3085 nke1=inloc(m)
3086 nkm1=nke1-ink
3087 DO j1=j+1,nrbyac
3088 n1=irbyac(j1)
3089 l1=irbyac(j1+nrbykin)
3090 nm =npby(1,n1)
3091 nsn =npby(2,n1)
3092 IF (ndof(nm)>0.AND. nkmax>0) THEN
3093 IF (intab(nrowk(nke1),icokm(1,nkm1),nm)) THEN
3094 DO i=1,nsn
3095 id = i+l1
3096 ni=lpby(id)
3097 IF (ndof(ni)>0) THEN
3098 nke=inloc(ni)
3099 IF (nke <= ink) THEN
3100 IF (intab(nrowk(nke),icok(1,nke),m)) THEN
3101 nj=0
3102C------cherche-secnd pairs----
3103 DO n1=1,ns
3104 n2=lpby(k+n1)
3105 IF (ndof(n2)>0.AND.
3106 . intab(nrowk(nke),icok(1,nke),n2)) THEN
3107 nj=n2
3108 nmc=nmc+1
3109 id =2*(nmc-1)+1
3110 imij(id)=m
3111 imij(id+1)=nm
3112 isij(nk+id)=ni
3113 isij(nk+id-1)=nj
3114 ENDIF
3115 ENDDO
3116 ENDIF
3117 ELSE
3118 IF (intab(nrowk(nke),icokm(1,nke-ink),m)) THEN
3119 nj=0
3120C------cherche-secnd pairs----
3121 DO n1=1,ns
3122 n2=lpby(k+n1)
3123 IF (ndof(n2)>0.AND.
3124 . intab(nrowk(nke),icokm(1,nke-ink),n2)) THEN
3125 nj=n2
3126 nmc=nmc+1
3127 id =2*(nmc-1)+1
3128 imij(id)=m
3129 imij(id+1)=nm
3130 isij(nk+id)=ni
3131 isij(nk+id-1)=nj
3132 ENDIF
3133 ENDDO
3134 ENDIF
3135 END IF !(NKE <= INK) THEN
3136 ENDIF
3137 ENDDO
3138 END IF !IF (INTAB(NROWK(NKE1)
3139 END IF !IF (NDOF(NM)>0.AND. NKMAX>0)
3140C
3141 ENDDO
3142 ENDIF
3143C
3144 ENDDO
3145 ENDIF
3146 IF (nadmesh > 0) CALL rmind_imp(nnmax,inloc,nrowk,icok )
3147C----6---------------------------------------------------------------7---------8
3148 RETURN
3149 END
3150C------computation for NNMAX,NKMAX------
3151!||====================================================================
3152!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
3153!||--- called by ------------------------------------------------------
3154!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
3155!||--- calls -----------------------------------------------------
3156!|| dim_elems2 ../engine/source/implicit/ind_glob_k.F
3157!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
3158!|| dim_kine_p ../engine/source/implicit/ind_glob_k.F
3159!|| dim_kine_s ../engine/source/implicit/ind_glob_k.F
3160!|| dim_kine_t ../engine/source/implicit/ind_glob_k.F
3161!|| kin_nrmax ../engine/source/mpi/implicit/imp_fri.F
3162!|| kin_nrmax0 ../engine/source/mpi/implicit/imp_fri.F
3163!|| rmdim_imp ../engine/source/model/remesh/rm_imp0.F
3164!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
3165!||--- uses -----------------------------------------------------
3166!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3167!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3168!||====================================================================
3169 SUBROUTINE dim_kinmax(
3170 1 IGEO ,NPBY ,LPBY ,ITAB ,NRBYAC ,
3171 2 IRBYAC ,NINT2 ,IINT2 ,IPARI ,
3172 3 INTBUF_TAB,IXS ,IXQ ,IXC ,IXT ,
3173 4 IXP ,IXR ,IXTG ,IXTG1 ,IXS10 ,
3174 5 IXS20 ,IXS16 ,IPARG ,NDOF ,
3175 6 NSI2 ,NSRB ,ELBUF ,NKINE ,INLOC ,
3176 7 NROW ,NNMAX ,NKMAX ,NSS ,NSIJ ,
3177 8 NMIJ ,NSS2 ,NSIJ2 ,NMIJ2 ,FR_ELEM ,
3178 9 IAD_ELEM ,SH4TREE ,SH3TREE ,IRBE3 ,LRBE3 ,
3179 A NSS3 ,IRBE2 ,LRBE2 ,NSB2 ,ELBUF_TAB )
3180C-----------------------------------------------
3181C M o d u l e s
3182C-----------------------------------------------
3183 USE elbufdef_mod
3184 USE intbufdef_mod
3185C-----------------------------------------------
3186C I m p l i c i t T y p e s
3187C-----------------------------------------------
3188#include "implicit_f.inc"
3189C-----------------------------------------------
3190C C o m m o n B l o c k s
3191C-----------------------------------------------
3192#include "com01_c.inc"
3193#include "com04_c.inc"
3194#include "param_c.inc"
3195#include "impl1_c.inc"
3196#include "remesh_c.inc"
3197C-----------------------------------------------
3198C D u m m y A r g u m e n t s
3199C-----------------------------------------------
3200 INTEGER IPARG(NPARG,*),IGEO(*),IRBE3(*),LRBE3(*)
3201 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
3202 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),NSI2,NSRB
3203 INTEGER FR_ELEM(*),IAD_ELEM(2,*),SH4TREE(*),SH3TREE(*)
3204 INTEGER
3205 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*), ixp(nixp,*),
3206 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3207 . ixs16(8,*),ixtg1(4,*),ndof(*),nrow(*),nnmax,nkine,
3208 . inloc(*),nkmax,nss,nsij,nmij,nss2,nsij2,nmij2,nss3,
3209 . irbe2(*),lrbe2(*),nsb2
3210C REAL
3211 my_real elbuf(*)
3212 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3213 TYPE(intbuf_struct_) INTBUF_TAB(*)
3214C-----------------------------------------------
3215C L o c a l V a r i a b l e s
3216C-----------------------------------------------
3217 INTEGER I,J,K,N,M,L,NKINE0,NNMAX0,NK,L1,L2,IERR,LNK
3218 INTEGER, DIMENSION(:),ALLOCATABLE :: ICOK,NROWI
3219C-----------------------------------------------
3220 DO N =1,numnod
3221 inloc(n)=0
3222 ENDDO
3223c-----2. prepare icol for secnd nodes using ikine;
3224 CALL dim_kine_p(
3225 1 igeo ,npby ,lpby ,itab ,nrbyac ,
3226 2 irbyac ,nint2 ,iint2 ,ipari ,
3227 3 ndof ,nsi2 ,nsrb ,nkine ,
3228 7 inloc ,irbe3 ,irbe2 ,lrbe2 ,lnk ,
3229 8 intbuf_tab )
3230C----- pass for IND_GLOB_K, including RBE2 main
3231 lcokm=lnk
3232 nkine0=nkine
3233 IF (nkine0>0) THEN
3234 ALLOCATE(icok(nkine*nnmax))
3235 ALLOCATE(nrowi(nkine))
3236 ENDIF
3237 DO n =1,nkine0
3238 nrowi(n)=0
3239 ENDDO
3240 CALL dim_elems3(
3241 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3242 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3243 3 ixs10 ,ixs20 ,ixs16 ,nrowi ,
3244 4 inloc ,nnmax ,icok ,igeo ,elbuf_tab )
3245 IF (nspmd>1) THEN
3246 CALL kin_nrmax(
3247 1 nnmax ,nnmax ,nrowi ,icok ,icok ,
3248 2 inloc ,numnod ,fr_elem ,iad_elem )
3249 ENDIF
3250 DO n =1,numnod
3251 nk=inloc(n)
3252 IF (nk > 0) nrow(n) = max(nrow(n),nrowi(nk))
3253 ENDDO
3254c-----3. calcul NNMAX,NKMAX and creating INLOC,NKINE;
3255 CALL dim_kine_s(
3256 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
3257 2 nint2 ,iint2 ,ipari ,intbuf_tab,ndof ,
3258 3 nnmax ,nrow ,nrowi ,nkine ,inloc ,
3259 4 icok ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
3260 IF (nkine0>0) THEN
3261 DEALLOCATE(icok)
3262 DEALLOCATE(nrowi)
3263 ENDIF
3264C
3265 nkmax=nnmax
3266 nnmax0=nnmax
3267 DO n =1,numnod
3268 nk=inloc(n)
3269 IF (nk>lnk) THEN
3270 nnmax=max(nnmax,nrow(n))
3271 ELSEIF (nk>0) THEN
3272 nkmax=max(nkmax,nrow(n))
3273 ENDIF
3274 ENDDO
3275C----for some special case (hierarchy kinematic RBE2/RBE3),NKMAX is underestimated
3276 IF (nspmd>1)CALL spmd_max_i(nnmax)
3277 nkmax=max(nkmax,nnmax)
3278 IF (nspmd>1)CALL spmd_max_i(nkmax)
3279C
3280 nkine0=nkine
3281 IF (nkine0>0) THEN
3282 nk = lnk*nkmax+nkine*nnmax
3283 ALLOCATE(icok(nk))
3284 ALLOCATE(nrowi(nkine))
3285 ENDIF
3286 DO n =1,nkine0
3287 nrowi(n)=0
3288 ENDDO
3289 l1 = 1
3290 l2 = 1 + lnk*nkmax
3291 CALL dim_elems2(
3292 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3293 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3294 3 ixs10 ,ixs20 ,ixs16 ,nrowi ,
3295 4 inloc ,nnmax ,icok(l2) ,nkmax ,icok(l1) ,
3296 5 lnk ,igeo ,elbuf_tab )
3297c
3298 IF (nspmd>1) THEN
3299 CALL kin_nrmax0(
3300 1 nnmax ,nkmax ,nrowi ,icok(l2) ,icok(l1) ,
3301 2 inloc ,lnk ,fr_elem ,iad_elem )
3302 ENDIF
3303c-----3. calcul NNMAX,NKMAX and creating INLOC,NKINE;
3304 CALL dim_kine_t(
3305 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
3306 2 nint2 ,iint2 ,ipari ,intbuf_tab,ndof ,
3307 3 nnmax ,nrowi ,nkine ,inloc ,icok(l2) ,
3308 4 nss ,nsij ,nmij ,nss2 ,nsij2 ,
3309 5 nmij2 ,nkmax ,icok(l1) ,lnk ,irbe3 ,
3310 6 lrbe3 ,nss3 ,irbe2 ,lrbe2 ,nsb2 )
3311 nkmax=0
3312 nnmax=nnmax0
3313 DO n =1,numnod
3314 nk=inloc(n)
3315 IF (nk>lnk) THEN
3316 nnmax=max(nnmax,nrowi(nk))
3317 ELSEIF (nk>0) THEN
3318 nkmax=max(nkmax,nrowi(nk))
3319 ENDIF
3320 ENDDO
3321 DO n =1,numnod
3322 nk=inloc(n)
3323 IF (nk>0)nrow(n)=nrowi(nk)
3324 ENDDO
3325 IF (nkine0>0) THEN
3326 DEALLOCATE(icok)
3327 DEALLOCATE(nrowi)
3328 ENDIF
3329 IF (nadmesh > 0) CALL rmdim_imp(ixc ,ixtg ,ndof ,nnmax,nkine,
3330 1 inloc,nrow ,itab ,sh4tree,sh3tree)
3331C----6---------------------------------------------------------------7---------8
3332 RETURN
3333 END
3334C------estimation for NNMAX,NKMAX,NNZK, prepare data for IND_GLOB_K
3335!||====================================================================
3336!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
3337!||--- called by ------------------------------------------------------
3338!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
3339!||--- calls -----------------------------------------------------
3340!|| dim_elemax ../engine/source/implicit/ind_glob_k.F
3341!|| dim_elems1 ../engine/source/implicit/ind_glob_k.F
3342!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
3343!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
3344!|| dim_ndof_d ../engine/source/implicit/ind_glob_k.F
3345!|| dim_ndof_i ../engine/source/implicit/ind_glob_k.F
3346!|| dim_ndof_ii ../engine/source/implicit/ind_glob_k.F
3347!|| dim_nrmax ../engine/source/mpi/implicit/imp_fri.F
3348!|| monv_prem ../engine/source/airbag/monv_imp0.F
3349!|| ndof_fv ../engine/source/implicit/ind_glob_k.F
3350!|| set_ikin2g ../engine/source/mpi/implicit/imp_fri.F
3351!|| spmd_ndof ../engine/source/mpi/implicit/imp_spmd.F
3352!||--- uses -----------------------------------------------------
3353!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
3354!|| groupdef_mod ../common_source/modules/groupdef_mod.F
3355!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3356!||====================================================================
3357 SUBROUTINE dim_glob_k(
3358 1 GEO ,NPBY ,LPBY ,ITAB ,NRBYAC ,
3359 2 IRBYAC ,NINT2 ,IINT2 ,IPARI ,
3360 3 IXS ,IXQ ,IXC ,IXT ,
3361 4 IXP ,IXR ,IXTG ,IXTG1 ,IXS10 ,
3362 5 IXS20 ,IXS16 ,IPARG ,NDOF ,
3363 6 IDDL ,NDDL ,NNZK ,ELBUF ,INLOC ,
3364 7 LSIZE ,FR_ELEM ,IAD_ELEM ,FR_I2M ,IAD_I2M ,
3365 8 NPRW ,NMONV ,IMONV ,MONVOL ,IGRSURF ,
3366 9 FR_MV ,IPM ,IGEO ,IAD_RBY ,
3367 A FR_RBY ,SH4TREE ,SH3TREE ,IRBE3 ,LRBE3 ,
3368 B FR_RBE3M ,IAD_RBE3M ,IRBE2 ,LRBE2 ,IBFV ,
3369 C VEL ,ELBUF_TAB ,IFRAME ,INTBUF_TAB )
3370C-----------------------------------------------
3371C M o d u l e s
3372C-----------------------------------------------
3373 USE elbufdef_mod
3374 USE intbufdef_mod
3375 USE groupdef_mod
3376C-----------------------------------------------
3377C I m p l i c i t T y p e s
3378C-----------------------------------------------
3379#include "implicit_f.inc"
3380C-----------------------------------------------
3381C C o m m o n B l o c k s
3382C-----------------------------------------------
3383#include "com01_c.inc"
3384#include "com04_c.inc"
3385#include "param_c.inc"
3386#include "impl1_c.inc"
3387#include "task_c.inc"
3388C-----------------------------------------------
3389C D u m m y A r g u m e n t s
3390C-----------------------------------------------
3391 INTEGER IPARG(NPARG,*),FR_ELEM(*) ,IAD_ELEM(2,*)
3392 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*)
3393 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),
3394 . fr_i2m(*),iad_i2m(*),fr_rby(*),iad_rby(*)
3395 INTEGER NMONV,IMONV(*),MONVOL(*),
3396 . fr_mv(nspmd+2,nvolu),nprw(*),fr_rbe3m(*),iad_rbe3m(*)
3397 INTEGER IPM(NPROPMI,*),IGEO(NPROPGI,*),IFRAME(LISKN,*)
3398 INTEGER
3399 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*), ixp(nixp,*),
3400 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3401 . ixs16(8,*),ixtg1(4,*),iddl(*),ndof(*),irbe3(*),lrbe3(*),
3402 . nddl ,nnzk,inloc(*),lsize(*),sh4tree(*), sh3tree(*),
3403 . irbe2(*),lrbe2(*),ibfv(*)
3404C REAL
3405 my_real
3406 . geo(npropg,*),elbuf(*),vel(*)
3407 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3408 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
3409 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
3410C-----------------------------------------------
3411C L o c a l V a r i a b l e s
3412C-----------------------------------------------
3413 INTEGER NKINE,NKMAX,NNMAX,NSI2,NSRB,NSS,NSIJ,NMIJ,NSS2,NSIJ2,NSS3
3414 INTEGER I,J,K,N,M,L,NDOFI,NDOFJ,NKINE0,NMIJ2,IP,NPN,NPP,IER1
3415 INTEGER IAD_M(NSPMD+1),NSB2,NSRB2
3416 INTEGER, DIMENSION(:),ALLOCATABLE :: FR_M
3417C-----------------------------------------------
3418C-----NNMAX:max number of connected nodes(excepting main nodes of rbodies)
3419C INLOC(NUMNOD) : global numnod in order of IDDL
3420C actuel order : non kinematical nodes;kinematical nodes; main nodes of rbodies
3421C ICOL(NKMAX,NRBYAC) for main nodes
3422C ICOL(NNMAX,NKINE-NRBYAC) for kine. nodes
3423C ICOL(NNMAX,NNSIZ) for other nodes
3424C NROW(NUMNOD) number of connected nodes use the mem. of iddl
3425C----pour spmd on ne distinque plus nodes kine ---------------------------------------
3426C et INLOC(NUMNOD) : local(pi) numnod in order of IDDL
3427C actuel order : nodes fontieres avec pj(j<i); nodes; nodes fontieres avec pj(j>i)
3428c-----1. calcule NNMAX,NDOF;
3429 DO N =1,numnod
3430 iddl(n)=0
3431 ndof(n)=0
3432 ENDDO
3433 CALL dim_ndof_i(
3434 1 npby ,lpby ,itab ,nrbyac ,
3435 2 irbyac ,ndof ,nsrb ,ipari ,
3436 3 nint2 ,iint2 ,nsi2 ,nprw ,irbe3 ,
3437 4 irbe2 ,nsrb2 ,fr_elem ,iad_elem ,intbuf_tab )
3438 CALL dim_elems1(
3439 1 igeo ,elbuf ,iparg ,ixs ,ixq ,
3440 2 ixc ,ixt ,ixp ,ixr ,ixtg ,
3441 3 ixtg1 ,ixs10 ,ixs20 ,ixs16 ,
3442 4 ndof ,iddl ,elbuf_tab )
3443 CALL dim_ndof_ii(
3444 1 nint2 ,iint2 ,ipari ,ndof ,
3445 2 nrbe3 ,irbe3 ,lrbe3 ,nrbe2 ,irbe2 ,
3446 3 lrbe2 ,intbuf_tab )
3447C+++ not allowing imposed rotations on solid element..---
3448 CALL ndof_fv(ibfv ,vel ,ndof ,iframe )
3449 IF (imp_rby==1) CALL dim_ndof_d(
3450 1 npby ,lpby ,nrbyac ,irbyac ,ndof ,
3451 2 iad_rby ,fr_rby )
3452 IF (nspmd>1) THEN
3453 nnmax=iad_elem(1,nspmd+1)-iad_elem(1,1)
3454 IF (nnmax>0) CALL spmd_ndof(ndof,fr_elem,iad_elem,nnmax)
3455 ENDIF
3456 CALL monv_prem(
3457 1 nmonv ,imonv ,monvol ,igrsurf ,
3458 2 fr_mv ,inloc ,npby ,lpby ,nrbyac ,
3459 3 irbyac ,nint2 ,iint2 ,ipari ,intbuf_tab,
3460 4 ndof ,iprec ,irbe3 ,irbe2 ,lrbe2 )
3461 nnmax=0
3462 DO n =1,numnod
3463 IF (ndof(n)>0) nnmax=max(nnmax,iddl(n))
3464 ENDDO
3465c-----raffine NNMAX;
3466 nkine0=2*nnmax
3467 IF (nspmd>1) THEN
3468 npp=iad_elem(1,nspmd+1)-iad_elem(1,1)
3469 m = iad_i2m(nspmd+1)-iad_i2m(1)+
3470 . iad_rbe3m(nspmd+1)-iad_rbe3m(1)
3471 ALLOCATE(fr_m(m))
3472 m = 0
3473 iad_m(1)=1
3474 DO ip =1,nspmd
3475 iad_m(ip+1)=m+1
3476 ENDDO
3477C
3478 CALL dim_fr_k(
3479 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3480 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3481 3 ixs10 ,ixs20 ,ixs16 ,ndof ,
3482 4 nkine0 ,inloc ,fr_elem ,iad_elem ,npp ,
3483 5 igeo ,fr_m ,iad_m ,elbuf_tab )
3484 DEALLOCATE(fr_m)
3485 ENDIF
3486 CALL dim_elemax(
3487 1 ixs ,ixq ,ixc ,ixt ,ixp ,
3488 2 ixr ,ixtg ,ixtg1 ,ixs10 ,ixs20 ,
3489 3 ixs16 ,iparg ,elbuf ,ndof ,
3490 4 iddl ,inloc ,nnmax ,nkine0 ,nnsiz ,
3491 5 igeo ,elbuf_tab )
3492 IF (nspmd>1) THEN
3493 CALL dim_nrmax(iddl ,fr_elem ,iad_elem ,nnmax )
3494 ENDIF
3495C
3496 CALL dim_kinmax(
3497 1 igeo ,npby ,lpby ,itab ,nrbyac ,
3498 2 irbyac ,nint2 ,iint2 ,ipari ,
3499 3 intbuf_tab,ixs ,ixq ,ixc ,ixt ,
3500 4 ixp ,ixr ,ixtg ,ixtg1 ,ixs10 ,
3501 5 ixs20 ,ixs16 ,iparg ,ndof ,
3502 6 nsi2 ,nsrb ,elbuf ,nkine ,inloc ,
3503 7 iddl ,nnmax ,nkmax ,nss ,nsij ,
3504 8 nmij ,nss2 ,nsij2 ,nmij2 ,fr_elem ,
3505 9 iad_elem ,sh4tree ,sh3tree ,irbe3 ,lrbe3 ,
3506 a nss3 ,irbe2 ,lrbe2 ,nsb2 ,elbuf_tab )
3507c-----4. calcul NNZK,;
3508 IF (iroddl==0) THEN
3509 ndofj=3
3510 ELSE
3511C-------cela sur-dimensioner kij en cas du model mix (solide +coque) mais pas trop grace
3512 ndofj=6
3513 ENDIF
3514 nnzk = 0
3515 DO n=1,numnod
3516 DO k=1,ndof(n)
3517C-------termes knn-------
3518 DO j=1,ndof(n)
3519 IF (j/=k) nnzk = nnzk+1
3520c NNZK = NNZK+NDOF(N)-1
3521 ENDDO
3522C-------termes kn,nj-------
3523 DO j=1,iddl(n)
3524 DO l=1,ndofj
3525 nnzk = nnzk+1
3526c NNZK = NNZK+NDOFJ*IDDL(N)
3527 ENDDO
3528 ENDDO
3529 ENDDO
3530 ENDDO
3531 nnzk = nnzk/2+1
3532 npn=0
3533 npp=0
3534 IF (nspmd>1) THEN
3535 CALL set_ikin2g(nkine,inloc)
3536 j=0
3537 l=0
3538 DO n =1,numnod
3539 iddl(n)=0
3540 ENDDO
3541C------d'abord frontieres avec precedent procs j<i
3542 DO ip =1,ispmd
3543 DO m=iad_elem(1,ip),iad_elem(1,ip+1)-1
3544 n=fr_elem(m)
3545 IF (iddl(n)==0) THEN
3546 j=j+1
3547 inloc(j)=n
3548 iddl(n)=j
3549 ENDIF
3550 ENDDO
3551 ENDDO
3552C------frontieres avec procs derierre a la fin j>i
3553 DO ip =ispmd+2,nspmd
3554 DO m=iad_elem(1,ip),iad_elem(1,ip+1)-1
3555 n=fr_elem(m)
3556 IF (iddl(n)==0) THEN
3557 l=l+1
3558 iddl(n)=-l
3559 ENDIF
3560 ENDDO
3561 ENDDO
3562 npn=j
3563 npp=l
3564 DO n =1,numnod
3565 IF (iddl(n)==0) THEN
3566 j=j+1
3567 inloc(j)=n
3568 ELSEIF (iddl(n)<0) THEN
3569 k=numnod-l-iddl(n)
3570 inloc(k)=n
3571 ENDIF
3572 ENDDO
3573 ELSE
3574C---------set INLOC; pour kine. nodes---
3575 DO n =1,numnod
3576 iddl(n)=inloc(n)
3577 ENDDO
3578 IF (ikpat<=1) THEN
3579 j=0
3580 DO n =1,numnod
3581 IF (iddl(n)==0) THEN
3582 j=j+1
3583 inloc(j)=n
3584 ELSE
3585 k=numnod-iddl(n)+1
3586 inloc(k)=n
3587 ENDIF
3588 ENDDO
3589 ELSE
3590 j=nkine
3591 DO n =1,numnod
3592 IF (iddl(n)==0) THEN
3593 j=j+1
3594 inloc(j)=n
3595 ELSE
3596 k=iddl(n)
3597 inloc(k)=n
3598 ENDIF
3599 ENDDO
3600 ENDIF
3601 ENDIF
3602c-----4. calcul IDDL,;
3603 nddl =0
3604 DO j=1,numnod
3605 n=inloc(j)
3606 iddl(n)=nddl
3607 ndofi = ndof(n)
3608 IF (ndofi>0) nddl = nddl + ndofi
3609 ENDDO
3610c-----dimensions divers;
3611 lsize(1)=nsrb
3612 lsize(2)=nsi2
3613 lsize(3)=nss+1
3614 lsize(4)=nsij+1
3615 lsize(5)=nmij+1
3616 lsize(6)=nss2+1
3617 lsize(7)=nsij2+1
3618 lsize(8)=nkine
3619 lsize(9)=nnmax
3620 lsize(10)=nkmax
3621 lsize(11)=nmij2
3622 lsize(12)=npn
3623 lsize(13)=npp
3624 lsize(14)=nss3
3625 lsize(15)=nsb2
3626 lsize(16)=nsrb2
3627C----6---------------------------------------------------------------7---------8
3628 RETURN
3629 END
3630C --------- stockage M.C.R.S + SYM- -----
3631!||====================================================================
3632!|| set_ind_k ../engine/source/implicit/ind_glob_k.F
3633!||--- called by ------------------------------------------------------
3634!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
3635!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
3636!||====================================================================
3637 SUBROUTINE set_ind_k(
3638 1 IDDL ,NDOF ,IADK ,JDIK ,NDDL ,
3639 2 NNZK ,NROW ,ICOL ,N ,IKPAT )
3640C-----------------------------------------------
3641C I m p l i c i t T y p e s
3642C-----------------------------------------------
3643#include "implicit_f.inc"
3644C-----------------------------------------------
3645C D u m m y A r g u m e n t s
3646C-----------------------------------------------
3647 INTEGER
3648 . iddl(*),ndof(*),iadk(*),jdik(*),
3649 . nddl ,nnzk,nrow ,icol(*),n,ikpat
3650C-----------------------------------------------
3651C L o c a l V a r i a b l e s
3652C-----------------------------------------------
3653 INTEGER I,J,K,L,NL,NJ,NDOFI
3654c----- calcul IADK,JDIK,NNZK-----
3655 ndofi = ndof(n)
3656 DO k=1,ndofi
3657C-------termes knn-------
3658 IF (ikpat==0) THEN
3659 DO j=k+1,ndofi
3660 nnzk = nnzk+1
3661 jdik(nnzk) = iddl(n)+j
3662 ENDDO
3663C-------termes kn,nj-------
3664 DO j=1,nrow
3665 nj = icol(j)
3666 DO l=1,ndof(nj)
3667 nnzk = nnzk+1
3668 jdik(nnzk) = iddl(nj)+l
3669 ENDDO
3670 ENDDO
3671 ELSE
3672C-------termes knj,n-------
3673 DO j=1,nrow
3674 nj = icol(j)
3675 DO l=1,ndof(nj)
3676 nnzk = nnzk+1
3677 jdik(nnzk) = iddl(nj)+l
3678 ENDDO
3679 ENDDO
3680 DO j=1,k-1
3681 nnzk = nnzk+1
3682 jdik(nnzk) = iddl(n)+j
3683 ENDDO
3684 ENDIF
3685 nddl = nddl +1
3686 iadk(nddl) = nnzk+1
3687 ENDDO
3688C
3689 RETURN
3690 END
3691C --------- stockage M.C.R.S + SYM- -----
3692!||====================================================================
3693!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
3694!||--- called by ------------------------------------------------------
3695!|| imp_buck ../engine/source/implicit/imp_buck.F
3696!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
3697!|| imp_solv ../engine/source/implicit/imp_solv.F
3698!||--- calls -----------------------------------------------------
3699!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
3700!|| dim_elems4 ../engine/source/implicit/ind_glob_k.F
3701!|| get_ikin2g ../engine/source/mpi/implicit/imp_fri.F
3702!|| ind_fr_k ../engine/source/mpi/implicit/imp_fri.F
3703!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
3704!|| ind_kine_kp ../engine/source/mpi/implicit/imp_fri.F
3705!|| ind_nrfr ../engine/source/mpi/implicit/imp_fri.F
3706!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.f
3707!|| kin_nrmax ../engine/source/mpi/implicit/imp_fri.F
3708!|| reorder_j ../engine/source/implicit/ind_glob_k.f
3709!|| reorder_l ../engine/source/implicit/ind_glob_k.F
3710!|| set_ind_k ../engine/source/implicit/ind_glob_k.F
3711!|| spc_fr_k ../engine/source/mpi/implicit/imp_fri.F
3712!|| zero_ikin2g ../engine/source/mpi/implicit/imp_fri.F
3713!||--- uses -----------------------------------------------------
3714!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3715!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3716!||====================================================================
3717 SUBROUTINE ind_glob_k(NPBY,LPBY,
3718 1 ITAB ,NRBYAC ,IRBYAC ,NSC ,ISIJ ,
3719 2 NMC ,IMIJ ,NSS ,ISS ,NINT2 ,
3720 3 IINT2 ,IPARI ,INTBUF_TAB,NSC2 ,ISIJ2 ,
3721 4 NSS2 ,ISS2 ,IPARG ,ELBUF ,ELBUF_TAB ,
3722 5 IXS ,IXQ ,IXC ,IXT ,IXP ,
3723 6 IXR ,IXTG ,IXTG1 ,IXS10 ,IXS20 ,
3724 7 IXS16 ,IDDL ,NDOF ,IADK ,
3725 8 JDIK ,NDDL ,NNZK ,NNMAX ,NKINE ,
3726 9 INLOC ,NKMAX ,NROWK ,ICOK ,ICOKM ,
3727 A NMC2 ,IMIJ2 ,IRK ,NPN ,NPP ,
3728 B FR_ELEM ,IAD_ELEM ,IPM ,IGEO ,IRBE3 ,
3729 C LRBE3 ,ISS3 ,FR_I2M ,IAD_I2M ,FR_RBE3M ,
3730 D IAD_RBE3M ,IRBE2 ,LRBE2 ,ISB2 ,NSRB2 )
3731C-----------------------------------------------
3732C M o d u l e s
3733C-----------------------------------------------
3734 USE elbufdef_mod
3735 USE intbufdef_mod
3736C-----------------------------------------------
3737C I m p l i c i t T y p e s
3738C-----------------------------------------------
3739#include "implicit_f.inc"
3740C-----------------------------------------------
3741C C o m m o n B l o c k s
3742C-----------------------------------------------
3743#include "com01_c.inc"
3744#include "com04_c.inc"
3745#include "param_c.inc"
3746#include "impl1_c.inc"
3747C-----------------------------------------------
3748C D u m m y A r g u m e n t s
3749C-----------------------------------------------
3750 INTEGER IPARG(NPARG,*),NNMAX,IRK,NKMAX
3751 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
3752 . NSC(*),ISIJ(*),NSS(*),ISS(*),NINT2,IINT2(*),
3753 . nsc2(*),isij2(*),nss2(*),iss2(*),ipari(npari,*),
3754 . nmc,imij(*),icok(nnmax,*),icokm(nkmax,*),nrowk(*)
3755 INTEGER IPM(NPROPMI,*),IGEO(NPROPGI,*)
3756 INTEGER
3757 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*), ixp(nixp,*),
3758 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3759 . ixs16(8,*),ixtg1(4,*),iddl(*),ndof(*),iadk(*),jdik(*),
3760 . nddl ,nnzk,nkine,inloc(*),nmc2,imij2(*),npn ,npp,
3761 . fr_elem(*),iad_elem(2,*),irbe3(*),lrbe3(*),iss3(*),
3762 . fr_i2m(*),iad_i2m(*),fr_rbe3m(*),iad_rbe3m(*),
3763 . irbe2(*),lrbe2(*),isb2(*),nsrb2(*)
3764 my_real
3765 . elbuf(*)
3766 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3767 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
3768C=======================================================================
3769C stockage M.C.R.S (Modified Compressed Row Stockage)
3770C stockage creux : diagonale + trangle en lignes: IKPAT=0:triang_sup IKPAT=1: inf
3771C [K](id,jd) -> DIAG(ND)+LT(IK)(exclue diag)
3772C id = 1..nddl : ID = IADK(ID)...IADK(ID+1)-1
3773C jd = 1..NNZK : JD = JDIK(IK)
3774C NDOF(NUMNOD) : nombre de ddl
3775C DIAG(NDDL)
3776C IADK(NDDL+1)
3777C JDIK(NNZK)
3778C-----------------------------------------------
3779C L o c a l V a r i a b l e s
3780C-----------------------------------------------
3781 INTEGER ICOL(NNMAX,NNSIZ),NROW(NNSIZ),JLT1,INK,NRMAX
3782 INTEGER I,J,K,N,L,NL,NJ,LENK,M,NK,ID,NFT,JLT,N_FR,IP
3783 INTEGER ILOC(NUMNOD)
3784 INTEGER IAD_M(NSPMD+1)
3785 INTEGER, DIMENSION(:),ALLOCATABLE :: FR_M
3786 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICOKFR
3787C m:main,s:secnd NSS(NRBYAC):nombre de j: Kjm= sum(KjsCsm)
3788C NSC(NRBYAC):nombre de "secnd line": ISIJ(2,NSC,NRBYAC)--
3789C nrowk(NKINE), icok size: NNMAX*(NKINE-NRBYAC)+NKMAX*NRBYAC:icok,icokm
3790C------eventuellment actualiser NDOF due au OFF d'element-
3791C-----1. calcul IADK,JDIK,par each NNSIZ using INLOC.
3792C-----IRK=0, calcul des tableux kinematiques est dispense-----
3793 IF (NSPMD>1) THEN
3794 DO N = 1 , numnod
3795 iloc(n)=0
3796 ENDDO
3797 n_fr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3798 m = iad_i2m(nspmd+1)-iad_i2m(1)+
3799 . iad_rbe3m(nspmd+1)-iad_rbe3m(1)
3800 ALLOCATE(fr_m(m))
3801 m = 0
3802 iad_m(1)=1
3803 DO ip =1,nspmd
3804 iad_m(ip+1)=m+1
3805 ENDDO
3806 IF (nkine>0) THEN
3807C-------cree ILOC()------
3808 ink=nkine-lcokm
3809c INK=NKINE-NRBYAC
3810 CALL get_ikin2g(nkine,ink,iloc)
3811 IF (irk == 1) THEN
3812 DO nk =1,nkine
3813 nrowk(nk)=0
3814 ENDDO
3815 CALL dim_elems4(
3816 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3817 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3818 3 ixs10 ,ixs20 ,ixs16 ,nrowk ,
3819 4 iloc ,nnmax ,icok ,nkmax ,icokm ,
3820 5 ink ,igeo ,elbuf_tab )
3821 CALL kin_nrmax(
3822 1 nnmax ,nkmax ,nrowk ,icok ,icokm ,
3823 2 iloc ,ink ,fr_elem ,iad_elem )
3824 CALL ind_kine_k(npby,lpby,
3825 1 itab ,nrbyac ,irbyac ,nsc ,isij ,
3826 2 nmc ,imij ,nss ,iss ,nint2 ,
3827 3 iint2 ,ipari ,intbuf_tab,nsc2 ,isij2 ,
3828 4 nss2 ,iss2 ,ndof ,nnmax ,nkine ,
3829 5 iloc ,nkmax ,nrowk ,icok ,icokm ,
3830 6 nmc2 ,imij2 ,ink ,irbe3 ,lrbe3 ,
3831 7 iss3 ,irbe2 ,lrbe2 ,isb2 ,nsrb2 )
3832C
3833 CALL ind_kine_kp(
3834 1 nrowk ,icok ,icokm ,nnmax ,nkmax ,
3835 2 nkine ,ink ,ikpat ,iddl )
3836C
3837 ENDIF
3838 CALL zero_ikin2g(nkine,iloc)
3839 ENDIF
3840 CALL ini_fr_k(
3841 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3842 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3843 3 ixs10 ,ixs20 ,ixs16 ,ndof ,
3844 4 nnmax ,iloc ,fr_elem ,iad_elem ,n_fr ,
3845 5 igeo ,fr_m ,iad_m ,elbuf_tab ,nrmax )
3846 DEALLOCATE(fr_m)
3847 jlt1=numnod
3848 lenk = 0
3849 nl = 1
3850 iadk(nl) = 1
3851 ALLOCATE(icokfr(nrmax,n_fr))
3852C
3853 DO nft = 0 , jlt1-1 , nnsiz
3854 jlt = min( nnsiz, jlt1 - nft )
3855 DO nk=1,jlt
3856 n=nk+nft
3857 k=inloc(n)
3858 iloc(k)=nk
3859 nrow(nk)=0
3860 ENDDO
3861 CALL dim_elems3(
3862 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3863 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3864 3 ixs10 ,ixs20 ,ixs16 ,nrow ,
3865 4 iloc ,nnmax ,icol ,igeo ,elbuf_tab )
3866 CALL ind_nrfr(
3867 1 nft ,jlt ,npn ,npp ,nnmax ,
3868 2 nrow ,icol ,fr_elem ,iad_elem ,n_fr ,
3869 3 icokfr )
3870 DO nk=1,jlt
3871 n=nk+nft
3872 k=inloc(n)
3873 iloc(k)=0
3874 ENDDO
3875 IF (nkine>0) THEN
3876 CALL get_ikin2g(nkine,ink,iloc)
3877 DO nk=1,jlt
3878 n=nk+nft
3879 j=inloc(n)
3880 IF (ndof(j)>0) THEN
3881 k=iloc(j)
3882 IF (k>ink) THEN
3883 nj=k-ink
3884 CALL set_ind_k(
3885 1 iddl ,ndof ,iadk ,jdik ,nl ,
3886 2 lenk ,nrowk(k) ,icokm(1,nj),j ,ikpat )
3887 ELSEIF (k>0) THEN
3888 CALL set_ind_k(
3889 1 iddl ,ndof ,iadk ,jdik ,nl ,
3890 2 lenk ,nrowk(k) ,icok(1,k) ,j ,ikpat )
3891 ELSE
3892 IF (ikpat==0) THEN
3893 CALL reorder_j(nrow(nk),icol(1,nk),j,iddl)
3894 ELSE
3895 CALL reorder_l(nrow(nk),icol(1,nk),j,iddl)
3896 ENDIF
3897 CALL set_ind_k(
3898 1 iddl ,ndof ,iadk ,jdik ,nl ,
3899 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3900 ENDIF
3901 ENDIF
3902 ENDDO
3903 CALL zero_ikin2g(nkine,iloc)
3904 ELSE
3905 IF (ikpat==0) THEN
3906 DO nk=1,jlt
3907 n=nk+nft
3908 j=inloc(n)
3909 CALL reorder_j(nrow(nk),icol(1,nk),j,iddl)
3910 IF (ndof(j)>0) THEN
3911 CALL set_ind_k(
3912 1 iddl ,ndof ,iadk ,jdik ,nl ,
3913 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3914 ENDIF
3915 ENDDO
3916 ELSE
3917 DO nk=1,jlt
3918 n=nk+nft
3919 j=inloc(n)
3920 CALL reorder_l(nrow(nk),icol(1,nk),j,iddl)
3921 IF (ndof(j)>0) THEN
3922 CALL set_ind_k(
3923 1 iddl ,ndof ,iadk ,jdik ,nl ,
3924 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3925 ENDIF
3926 ENDDO
3927 ENDIF
3928 ENDIF
3929 ENDDO
3930C
3931 CALL ind_fr_k(
3932 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3933 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3934 3 ixs10 ,ixs20 ,ixs16 ,ndof ,
3935 4 nnmax ,iloc ,fr_elem ,iad_elem ,n_fr ,
3936 5 igeo ,elbuf_tab )
3937 IF(iautspc>0) THEN
3938 CALL spc_fr_k(
3939 1 iadk ,jdik ,ndof ,iddl ,fr_elem ,
3940 2 iad_elem )
3941 ENDIF
3942 DEALLOCATE(icokfr)
3943C
3944 GOTO 100
3945 ENDIF
3946C----------mono-domaine-------------
3947 DO n = 1 , numnod
3948 iloc(n)=0
3949 ENDDO
3950 lenk = 0
3951 nl = 1
3952 iadk(nl) = 1
3953C
3954 IF (ikpat<=1) THEN
3955 jlt1=numnod-nkine
3956 DO nft = 0 , jlt1-1 , nnsiz
3957 jlt = min( nnsiz, jlt1 - nft )
3958 DO nk=1,jlt
3959 n=nk+nft
3960 k=inloc(n)
3961 iloc(k)=nk
3962 nrow(nk)=0
3963 ENDDO
3964 CALL dim_elems3(
3965 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3966 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3967 3 ixs10 ,ixs20 ,ixs16 ,nrow ,
3968 4 iloc ,nnmax ,icol ,igeo ,elbuf_tab )
3969 IF (ikpat==0) THEN
3970 DO nk=1,jlt
3971 n=nk+nft
3972 j=inloc(n)
3973 IF (ndof(j)>0) THEN
3974 CALL reorder_j(nrow(nk),icol(1,nk),j,iddl)
3975 CALL set_ind_k(
3976 1 iddl ,ndof ,iadk ,jdik ,nl ,
3977 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3978 ENDIF
3979 ENDDO
3980 ELSE
3981 DO nk=1,jlt
3982 n=nk+nft
3983 j=inloc(n)
3984 IF (ndof(j)>0) THEN
3985 CALL reorder_l(nrow(nk),icol(1,nk),j,iddl)
3986 CALL set_ind_k(
3987 1 iddl ,ndof ,iadk ,jdik ,nl ,
3988 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
3989 ENDIF
3990 ENDDO
3991 ENDIF
3992 DO nk=1,jlt
3993 n=nk+nft
3994 k=inloc(n)
3995 iloc(k)=0
3996 ENDDO
3997 ENDDO
3998c-----2. if irk=1 create nrow,icol for all kine. nodes using INLOC()=-INLOC()
3999c modifies nrow,icol .
4000 IF (nkine==0) GOTO 100
4001 nft=numnod-nkine
4002 jlt=nkine
4003 ink=nkine-lcokm
4004C INK=NKINE-NRBYAC
4005 DO nk =1,jlt
4006 n=nk+nft
4007 k=inloc(n)
4008 iloc(k)=nk
4009 ENDDO
4010 IF (irk == 1) THEN
4011 DO nk =1,jlt
4012 nrowk(nk)=0
4013 ENDDO
4014 CALL dim_elems4(
4015 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
4016 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
4017 3 ixs10 ,ixs20 ,ixs16 ,nrowk ,
4018 4 iloc ,nnmax ,icok ,nkmax ,icokm ,
4019 5 ink ,igeo ,elbuf_tab )
4020C
4021 CALL ind_kine_k(npby,lpby,
4022 1 itab ,nrbyac ,irbyac ,nsc ,isij ,
4023 2 nmc ,imij ,nss ,iss ,nint2 ,
4024 3 iint2 ,ipari ,intbuf_tab,nsc2 ,isij2 ,
4025 4 nss2 ,iss2 ,ndof ,nnmax ,nkine ,
4026 5 iloc ,nkmax ,nrowk ,icok ,icokm ,
4027 6 nmc2 ,imij2 ,ink ,irbe3 ,lrbe3 ,
4028 7 iss3 ,irbe2 ,lrbe2 ,isb2 ,nsrb2 )
4029C
4030 IF (ikpat==0) THEN
4031 DO nk =1,jlt
4032 n=nk+nft
4033 j=inloc(n)
4034 IF (nk>ink.AND.nkmax>0) THEN
4035 nj=nk-ink
4036 CALL reorder_j(nrowk(nk),icokm(1,nj),j,iddl)
4037 ELSE
4038 CALL reorder_j(nrowk(nk),icok(1,nk),j,iddl)
4039 ENDIF
4040 ENDDO
4041 ELSE
4042 DO nk =1,jlt
4043 n=nk+nft
4044 j=inloc(n)
4045 IF (nk>ink.AND.nkmax>0) THEN
4046 nj=nk-ink
4047 CALL reorder_l(nrowk(nk),icokm(1,nj),j,iddl)
4048 ELSEIF (nnmax>0) THEN
4049 CALL reorder_l(nrowk(nk),icok(1,nk),j,iddl)
4050 ENDIF
4051 ENDDO
4052 ENDIF
4053 ENDIF
4054C---main nodes of rbodies at last----
4055 DO nk=1,ink
4056 n=nk+nft
4057 j=inloc(n)
4058 IF (ndof(j)>0) THEN
4059 CALL set_ind_k(
4060 1 iddl ,ndof ,iadk ,jdik ,nl ,
4061 2 lenk ,nrowk(nk) ,icok(1,nk),j ,ikpat )
4062 ENDIF
4063 ENDDO
4064 DO nk=1+ink,jlt
4065 n=nk+nft
4066 j=inloc(n)
4067 IF (ndof(j)>0) THEN
4068 nj=nk-ink
4069 CALL set_ind_k(
4070 1 iddl ,ndof ,iadk ,jdik ,nl ,
4071 2 lenk ,nrowk(nk),icokm(1,nj),j ,ikpat )
4072 ENDIF
4073 ENDDO
4074C--------IKPAT=2, rigid body main first----------
4075 ELSE
4076 IF (nkine>0) THEN
4077 nft=0
4078 jlt=nkine
4079 ink=nkine-lcokm
4080C INK=NKINE-NRBYAC
4081 DO nk =1,lcokm
4082 n=nk+nft
4083 k=inloc(n)
4084 iloc(k)=nk+ink
4085 ENDDO
4086 DO nk =1+lcokm,jlt
4087 n=nk+nft
4088 k=inloc(n)
4089 iloc(k)=nk-lcokm
4090 ENDDO
4091 IF (irk == 1) THEN
4092 DO nk =1,jlt
4093 nrowk(nk)=0
4094 ENDDO
4095 CALL dim_elems4(
4096 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
4097 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
4098 3 ixs10 ,ixs20 ,ixs16 ,nrowk ,
4099 4 iloc ,nnmax ,icok ,nkmax ,icokm ,
4100 5 ink ,igeo ,elbuf_tab )
4101C
4102 CALL ind_kine_k(npby,lpby,
4103 1 itab ,nrbyac ,irbyac ,nsc ,isij ,
4104 2 nmc ,imij ,nss ,iss ,nint2 ,
4105 3 iint2 ,ipari ,intbuf_tab,nsc2 ,isij2 ,
4106 4 nss2 ,iss2 ,ndof ,nnmax ,nkine ,
4107 5 iloc ,nkmax ,nrowk ,icok ,icokm ,
4108 6 nmc2 ,imij2 ,ink ,irbe3 ,lrbe3 ,
4109 7 iss3 ,irbe2 ,lrbe2 ,isb2 ,nsrb2 )
4110 DO nk =1,jlt
4111 n=nk+nft
4112 j=inloc(n)
4113 iloc(j)=0
4114 IF (nk>lcokm) THEN
4115 nj=nk-lcokm
4116 CALL reorder_l(nrowk(nj),icok(1,nj),j,iddl)
4117 ELSEIF( nkmax>0) THEN
4118 CALL reorder_l(nrowk(nk+ink),icokm(1,nk),j,iddl)
4119 ENDIF
4120 ENDDO
4121 ENDIF
4122C---main nodes of rbodies first----
4123 DO nk=1,lcokm
4124 n=nk+nft
4125 j=inloc(n)
4126 iloc(j)=0
4127 IF (ndof(j)>0) THEN
4128 CALL set_ind_k(
4129 1 iddl ,ndof ,iadk ,jdik ,nl ,
4130 2 lenk ,nrowk(nk+ink) ,icokm(1,nk),j ,ikpat )
4131 ENDIF
4132 ENDDO
4133 DO nk=lcokm+1,jlt
4134 n=nk+nft
4135 j=inloc(n)
4136 iloc(j)=0
4137 IF (ndof(j)>0) THEN
4138 nj=nk-lcokm
4139 CALL set_ind_k(
4140 1 iddl ,ndof ,iadk ,jdik ,nl ,
4141 2 lenk ,nrowk(nj) ,icok(1,nj),j ,ikpat )
4142 ENDIF
4143 ENDDO
4144 ENDIF
4145 DO nft = nkine , numnod-1 , nnsiz
4146 jlt = min( nnsiz, numnod - nft )
4147 DO nk=1,jlt
4148 n=nk+nft
4149 k=inloc(n)
4150 iloc(k)=nk
4151 nrow(nk)=0
4152 ENDDO
4153 CALL dim_elems3(
4154 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
4155 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
4156 3 ixs10 ,ixs20 ,ixs16 ,nrow ,
4157 4 iloc ,nnmax ,icol ,igeo ,elbuf_tab )
4158 DO nk=1,jlt
4159 n=nk+nft
4160 j=inloc(n)
4161 CALL reorder_l(nrow(nk),icol(1,nk),j,iddl)
4162 IF (ndof(j)>0) THEN
4163 CALL set_ind_k(
4164 1 iddl ,ndof ,iadk ,jdik ,nl ,
4165 2 lenk ,nrow(nk) ,icol(1,nk),j ,ikpat )
4166 ENDIF
4167 ENDDO
4168 DO nk=1,jlt
4169 n=nk+nft
4170 k=inloc(n)
4171 iloc(k)=0
4172 ENDDO
4173 ENDDO
4174 ENDIF
4175 100 iadk(nddl+1) = lenk+1
4176 IF (lenk>nnzk.OR.nl/=(nddl+1))
4177 . WRITE(*,*)'--MEMERY PROBLEM 2--:',lenk,nl,nnzk,nddl+1
4178C---remet positive----
4179 nnzk = lenk
4180C----6---------------------------------------------------------------7---------8
4181 RETURN
4182 END
4183!||====================================================================
4184!|| reorder_i ../engine/source/implicit/ind_glob_k.F
4185!||--- called by ------------------------------------------------------
4186!|| dim_elems1 ../engine/source/implicit/ind_glob_k.f
4187!||====================================================================
4188 SUBROUTINE reorder_i(N,IC)
4189C----6---------------------------------------------------------------7---------8
4190C I m p l i c i t T y p e s
4191C-----------------------------------------------
4192#include "implicit_f.inc"
4193C-----------------------------------------------------------------
4194C D u m m y A r g u m e n t s
4195C-----------------------------------------------
4196 INTEGER N ,IC(*)
4197C-----------------------------------------------
4198C L o c a l V a r i a b l e s
4199C-----------------------------------------------
4200 INTEGER I,J,IMIN,IT,II
4201C
4202 IF (N<=0) return
4203 DO i =1,n
4204 imin=ic(i)
4205 ii=i
4206 DO j =i+1,n
4207 IF (ic(j)<imin) THEN
4208 imin=ic(j)
4209 ii=j
4210 ENDIF
4211 ENDDO
4212 it=ic(i)
4213 ic(i)=imin
4214 ic(ii)=it
4215 ENDDO
4216C----delete doubles----------------------------
4217 ii=1
4218 DO i =2,n
4219 IF (ic(i)/=ic(i-1)) THEN
4220 ii =ii +1
4221 ic(ii)=ic(i)
4222 ENDIF
4223 ENDDO
4224 n = ii
4225C----6---------------------------------------------------------------7---------8
4226 RETURN
4227 END
4228!||====================================================================
4229!|| reorder_a ../engine/source/implicit/ind_glob_k.F
4230!||--- called by ------------------------------------------------------
4231!|| dim_elems2 ../engine/source/implicit/ind_glob_k.F
4232!|| dim_elems3 ../engine/source/implicit/ind_glob_k.F
4233!|| dim_elems4 ../engine/source/implicit/ind_glob_k.F
4234!|| dim_elemsp ../engine/source/implicit/ind_glob_k.F
4235!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
4236!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
4237!|| dim_kine_t ../engine/source/implicit/ind_glob_k.F
4238!|| dim_ktot ../engine/source/implicit/ind_glob_k.F
4239!|| dim_spa2 ../engine/source/implicit/ind_glob_k.F
4240!|| dim_span ../engine/source/implicit/ind_glob_k.F
4241!|| ind_fr_k ../engine/source/mpi/implicit/imp_fri.F
4242!|| ind_kine_i ../engine/source/implicit/ind_glob_k.F
4243!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
4244!|| ind_kinfrk ../engine/source/mpi/implicit/imp_fri.F
4245!|| ind_nrfr ../engine/source/mpi/implicit/imp_fri.F
4246!|| ind_nrmax ../engine/source/mpi/implicit/imp_fri.F
4247!|| ind_spa2 ../engine/source/implicit/ind_glob_k.F
4248!|| ind_span ../engine/source/implicit/ind_glob_k.F
4249!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.F
4250!|| kin_nrmax ../engine/source/mpi/implicit/imp_fri.F
4251!|| kin_nrmax0 ../engine/source/mpi/implicit/imp_fri.F
4252!|| rmdim_imp ../engine/source/model/remesh/rm_imp0.F
4253!|| rmind_imp ../engine/source/model/remesh/rm_imp0.F
4254!|| row_adds ../engine/source/implicit/ind_glob_k.F
4255!|| row_int1 ../engine/source/implicit/ind_glob_k.F
4256!|| row_int111 ../engine/source/implicit/ind_glob_k.F
4257!|| row_int2 ../engine/source/implicit/ind_glob_k.F
4258!|| row_int241 ../engine/source/implicit/ind_glob_k.F
4259!|| row_int242 ../engine/source/implicit/ind_glob_k.F
4260!|| row_int51 ../engine/source/implicit/ind_glob_k.F
4261!|| row_int52 ../engine/source/implicit/ind_glob_k.F
4262!|| rowfr_ind ../engine/source/mpi/implicit/imp_fri.F
4263!|| rowfr_ind11 ../engine/source/mpi/implicit/imp_fri.F
4264!|| rowfr_ind24 ../engine/source/mpi/implicit/imp_fri.F
4265!|| spmd_icol ../engine/source/mpi/implicit/imp_spmd.F
4266!||====================================================================
4267 SUBROUTINE reorder_a(N,IC,ID)
4268C----6---------------------------------------------------------------7---------8
4269C I m p l i c i t T y p e s
4270C-----------------------------------------------
4271#include "implicit_f.inc"
4272C-----------------------------------------------------------------
4273C D u m m y A r g u m e n t s
4274C-----------------------------------------------
4275 INTEGER N ,IC(*),ID
4276C-----------------------------------------------
4277C L o c a l V a r i a b l e s
4278C-----------------------------------------------
4279 INTEGER I,IT
4280C
4281C----add ID--at end--------------------------
4282 DO I =1,n
4283 IF (ic(i)==id) RETURN
4284 ENDDO
4285 n =n+1
4286 ic(n)=id
4287C----6---------------------------------------------------------------7---------8
4288 RETURN
4289 END
4290!||====================================================================
4291!|| reorder_a1 ../engine/source/implicit/ind_glob_k.F
4292!||====================================================================
4293 SUBROUTINE reorder_a1(N,IC,ID)
4294C----6---------------------------------------------------------------7---------8
4295C I m p l i c i t T y p e s
4296C-----------------------------------------------
4297#include "implicit_f.inc"
4298C-----------------------------------------------------------------
4299C D u m m y A r g u m e n t s
4300C-----------------------------------------------
4301 INTEGER N ,IC(*),ID
4302C-----------------------------------------------
4303C L o c a l V a r i a b l e s
4304C-----------------------------------------------
4305 INTEGER I,IT
4306C
4307C----add ID--in right order--------------------------
4308 it =n+1
4309 DO i =1,n
4310 IF (ic(i)==id) THEN
4311 RETURN
4312 ELSEIF (ic(i)>id) THEN
4313 it =i
4314 GOTO 10
4315 ENDIF
4316 ENDDO
4317 10 IF (it==1) THEN
4318 DO i =n,it,-1
4319 ic(i+1)=ic(i)
4320 ENDDO
4321 ic(it)=id
4322 n = n+1
4323 ELSEIF (id/=ic(it-1)) THEN
4324 DO i =n,it,-1
4325 ic(i+1)=ic(i)
4326 ENDDO
4327 ic(it)=id
4328 n = n+1
4329 ENDIF
4330C----6---------------------------------------------------------------7---------8
4331 RETURN
4332 END
4333!||====================================================================
4334!|| reorder_j1 ../engine/source/implicit/ind_glob_k.F
4335!||====================================================================
4336 SUBROUTINE reorder_j1(N,IC,NI)
4337C----6---------------------------------------------------------------7---------8
4338C I m p l i c i t T y p e s
4339C-----------------------------------------------
4340#include "implicit_f.inc"
4341C-----------------------------------------------------------------
4342C D u m m y A r g u m e n t s
4343C-----------------------------------------------
4344 INTEGER N ,IC(*),NI
4345C-----------------------------------------------
4346C L o c a l V a r i a b l e s
4347C-----------------------------------------------
4348 INTEGER I,II
4349C
4350 II=0
4351 do i =1,n
4352 IF (ic(i)>ni) THEN
4353 ii =ii +1
4354 ic(ii)=ic(i)
4355 ENDIF
4356 ENDDO
4357 n = ii
4358C----6---------------------------------------------------------------7---------8
4359 RETURN
4360 END
4361!||====================================================================
4362!|| reorder_j ../engine/source/implicit/ind_glob_k.F
4363!||--- called by ------------------------------------------------------
4364!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
4365!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
4366!|| ind_kine_kp ../engine/source/mpi/implicit/imp_fri.F
4367!||====================================================================
4368 SUBROUTINE reorder_j(N,IC,NI,IDDL)
4369C----6---------------------------------------------------------------7---------8
4370C I m p l i c i t T y p e s
4371C-----------------------------------------------
4372#include "implicit_f.inc"
4373C-----------------------------------------------------------------
4374C D u m m y A r g u m e n t s
4375C-----------------------------------------------
4376 INTEGER N ,IC(*),NI,IDDL(*)
4377C-----------------------------------------------
4378C L o c a l V a r i a b l e s
4379C-----------------------------------------------
4380 INTEGER I,J,II,IT,IIC,IMIN,IDIC(N)
4381C
4382 ii=0
4383 it=iddl(ni)
4384 DO i =1,n
4385 iic=iddl(ic(i))
4386 IF (iic>it) THEN
4387 ii =ii +1
4388 ic(ii)=ic(i)
4389 idic(ii)=iic
4390 ENDIF
4391 ENDDO
4392 n = ii
4393 IF (n==0) RETURN
4394C-----en ordre iddl croisante-----
4395 DO i =1,n
4396 imin=idic(i)
4397 ii=i
4398 DO j =i+1,n
4399 IF (idic(j)<imin) THEN
4400 imin=idic(j)
4401 ii=j
4402 ENDIF
4403 ENDDO
4404 IF (ii/=i) THEN
4405 it=ic(i)
4406 ic(i)=ic(ii)
4407 ic(ii)=it
4408 it=idic(i)
4409 idic(i)=idic(ii)
4410 idic(ii)=it
4411 ENDIF
4412 ENDDO
4413C----delete doubles----------------------------
4414C II=1
4415C DO I =2,N
4416C IF (IC(I)/=IC(I-1)) THEN
4417C II =II +1
4418C IC(II)=IC(I)
4419C ENDIF
4420C ENDDO
4421C N = II
4422C----6---------------------------------------------------------------7---------8
4423 RETURN
4424 END
4425!||====================================================================
4426!|| reorder_l ../engine/source/implicit/ind_glob_k.F
4427!||--- called by ------------------------------------------------------
4428!|| ind_fr_k0 ../engine/source/mpi/implicit/imp_fri.F
4429!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
4430!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
4431!|| ind_kine_kp ../engine/source/mpi/implicit/imp_fri.F
4432!||====================================================================
4433 SUBROUTINE reorder_l(N,IC,NI,IDDL)
4434C----6---------------------------------------------------------------7---------8
4435C I m p l i c i t T y p e s
4436C-----------------------------------------------
4437#include "implicit_f.inc"
4438C-----------------------------------------------------------------
4439C D u m m y A r g u m e n t s
4440C-----------------------------------------------
4441 INTEGER N ,IC(*),NI,IDDL(*)
4442C-----------------------------------------------
4443C L o c a l V a r i a b l e s
4444C-----------------------------------------------
4445 INTEGER I,J,II,IT,IIC,IMIN,IDIC(N)
4446C
4447 ii=0
4448 it=iddl(ni)
4449 DO i =1,n
4450 iic=iddl(ic(i))
4451 IF (iic<it) THEN
4452 ii =ii +1
4453 ic(ii)=ic(i)
4454 idic(ii)=iic
4455 ENDIF
4456 ENDDO
4457 n = ii
4458 IF (n==0) RETURN
4459C-----en ordre iddl croisante-----
4460 DO i =1,n
4461 imin=idic(i)
4462 ii=i
4463 DO j =i+1,n
4464 IF (idic(j)<imin) THEN
4465 imin=idic(j)
4466 ii=j
4467 ENDIF
4468 ENDDO
4469 IF (ii/=i) THEN
4470 it=ic(i)
4471 ic(i)=ic(ii)
4472 ic(ii)=it
4473 it=idic(i)
4474 idic(i)=idic(ii)
4475 idic(ii)=it
4476 ENDIF
4477 ENDDO
4478C----6---------------------------------------------------------------7---------8
4479 RETURN
4480 END
4481!||====================================================================
4482!|| intab ../engine/source/implicit/ind_glob_k.F
4483!||--- called by ------------------------------------------------------
4484!|| degenes8 ../engine/source/elements/solid/solide/degenes8.F
4485!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
4486!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
4487!|| dim_kine_s ../engine/source/implicit/ind_glob_k.F
4488!|| dim_kine_t ../engine/source/implicit/ind_glob_k.F
4489!|| dim_ndof_i ../engine/source/implicit/ind_glob_k.F
4490!|| imp_icomcrit ../engine/source/implicit/imp_int_k.F
4491!|| ind_kine_i ../engine/source/implicit/ind_glob_k.F
4492!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
4493!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.F
4494!|| intabfr ../engine/source/mpi/implicit/imp_fri.F
4495!||====================================================================
4496 LOGICAL FUNCTION intab(NIC,IC,N)
4497C----6---------------------------------------------------------------7---------8
4498C I m p l i c i t T y p e s
4499C-----------------------------------------------
4500#include "implicit_f.inc"
4501C-----------------------------------------------------------------
4502C D u m m y A r g u m e n t s
4503C-----------------------------------------------
4504 INTEGER n ,nic,ic(*)
4505C-----------------------------------------------
4506C L o c a l V a r i a b l e s
4507C-----------------------------------------------
4508 INTEGER i,j
4509C----6---------------------------------------------------------------7---------8
4510 intab=.false.
4511 DO i =1,nic
4512 IF (n==ic(i)) THEN
4513 intab=.true.
4514 RETURN
4515 ENDIF
4516 ENDDO
4517C
4518 RETURN
4519 END
4520!||====================================================================
4521!|| dim_int7 ../engine/source/implicit/ind_glob_k.F
4522!||--- called by ------------------------------------------------------
4523!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
4524!||--- calls -----------------------------------------------------
4525!|| ancmsg ../engine/source/output/message/message.F
4526!|| arret ../engine/source/system/arret.F
4527!|| imp_intbuf_ini ../engine/source/implicit/imp_solv.F
4528!|| intbuf_tab_c_ini ../common_source/interf/copy_intbuf_tab.F
4529!||--- uses -----------------------------------------------------
4530!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
4531!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
4532!|| message_mod ../engine/share/message_module/message_mod.F
4533!||====================================================================
4534 SUBROUTINE dim_int7(
4535 1 NINTER ,IPARI ,INTBUF_TAB ,NNMAX)
4536C-----------------------------------------------
4537C M o d u l e s
4538C-----------------------------------------------
4539 USE imp_intbuf
4540 USE message_mod
4541 USE intbufdef_mod
4542C----6---------------------------------------------------------------7---------8
4543C I m p l i c i t T y p e s
4544C-----------------------------------------------
4545#include "implicit_f.inc"
4546C-----------------------------------------------
4547C C o m m o n B l o c k s
4548C-----------------------------------------------
4549#include "com08_c.inc"
4550#include "param_c.inc"
4551#include "task_c.inc"
4552#include "impl1_c.inc"
4553C-----------------------------------------------------------------
4554C D u m m y A r g u m e n t s
4555C-----------------------------------------------
4556 INTEGER IPARI(NPARI,*),NINTER,NNMAX
4557C REAL
4558 TYPE(intbuf_struct_) INTBUF_TAB(*)
4559C-----------------------------------------------
4560C L o c a l V a r i a b l e s
4561C-----------------------------------------------
4562 INTEGER NIN,NTY,NUM_IMP,NSN,NMN,NRTS,ILEV,NOINT
4563 INTEGER I,J,K,L,NDOFI,N,IAD,IERR,STAT,NIMP(NINTER)
4564 my_real
4565 . startt,stopt
4566C-----------------------------------------------
4567C------interface --------------
4568 nnmax=0
4569 DO nin=1,ninter
4570 nsn =ipari(5,nin)
4571 nmn =ipari(6,nin)
4572 nty =ipari(7,nin)
4573 nimp(nin) = 0
4574C----------deleted int NTY->0
4575 IF (nty ==0 ) cycle
4576 IF (nty ==2 ) THEN
4577 ilev =ipari(20,nin)
4578 noint =ipari(15,nin)
4579 IF (ilev>=10.AND.ilev<=25) THEN
4580 CALL ancmsg(msgid=241,anmode=aninfo,i1=ilev,i2=noint )
4581 CALL arret(2)
4582 END IF
4583 ELSEIF (nty/=5 .AND. nty/=7 .AND. nty/=10
4584 . .AND. nty/=11 .AND. nty/=24) THEN
4585 startt=intbuf_tab(nin)%VARIABLES(3)
4586 stopt =intbuf_tab(nin)%VARIABLES(11)
4587 IF(startt<tstop)
4588 . CALL ancmsg(msgid=232,anmode=aninfo,i1=nty )
4589 END IF
4590C-----as int5 uses only ISPMD=0 ; some values are not initialized w/ ISPMD/=0
4591 IF (ispmd/=0.AND.(nty<7.OR.nty==8
4592 . .OR.nty==14.OR.nty==15)) cycle
4593 startt=intbuf_tab(nin)%VARIABLES(3)
4594 stopt =intbuf_tab(nin)%VARIABLES(11)
4595 IF(startt<=tstop) THEN
4596 IF(nty==3)THEN
4597 ELSEIF(nty==4)THEN
4598 ELSEIF(nty==5)THEN
4599 nnmax=nnmax+nsn
4600 ELSEIF(nty==6)THEN
4601
4602 ELSEIF(nty==7.OR.nty==10.OR.nty==24)THEN
4603 num_imp = ipari(18,nin)*ipari(23,nin)
4604 nnmax=nnmax+num_imp
4605C--------exceptionaly to deactivate kg
4606 IF(nty==24.AND.iikgoff==0.AND.ikg==0)THEN
4607 iikgoff = 1
4608 END IF
4609C-------dispense i24disk---
4610 IF(nty==24) nimp(nin) = num_imp
4611C
4612 ELSEIF(nty==11)THEN
4613 num_imp = ipari(18,nin)*ipari(23,nin)
4614 nnmax=nnmax+num_imp
4615C
4616 ENDIF
4617 ENDIF
4618 ENDDO
4619C-----------Allocate INTBUF_TAB_CP for implicit
4620 ALLOCATE (intbuf_tab_cp(ninter), stat=stat)
4621 CALL intbuf_tab_c_ini(intbuf_tab, intbuf_tab_cp)
4622C-----------Allocate IMP_INTBUF_TAB for implicit
4623 ALLOCATE (intbuf_tab_imp(ninter), stat=stat)
4624 CALL imp_intbuf_ini(intbuf_tab_imp, nimp)
4625C----6---------------------------------------------------------------7---------8
4626 RETURN
4627 END
4628!||====================================================================
4629!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
4630!||--- called by ------------------------------------------------------
4631!|| imp_chkm ../engine/source/implicit/imp_solv.F
4632!|| imp_solv ../engine/source/implicit/imp_solv.F
4633!||--- calls -----------------------------------------------------
4634!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
4635!|| nddl_loc ../engine/source/implicit/ind_glob_k.F
4636!|| row_int ../engine/source/implicit/ind_glob_k.F
4637!|| row_int11 ../engine/source/implicit/ind_glob_k.F
4638!|| row_int24 ../engine/source/implicit/ind_glob_k.F
4639!|| row_int5 ../engine/source/implicit/ind_glob_k.F
4640!||--- uses -----------------------------------------------------
4641!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
4642!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
4643!||====================================================================
4644 SUBROUTINE dim_int_k(
4645 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
4646 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
4647 3 LNSS ,NINT2 ,IINT2 ,IAINT2 ,LNSS2 ,
4648 4 NDDL ,NNZK ,IDDL ,ILOCI ,N_IMPN ,
4649 5 N_IMPM ,NNMAX ,NKMAX ,NDOF ,NSREM ,
4650 6 IRBE3 ,LRBE3 ,LNSS3 ,IRBE2 ,LRBE2 ,
4651 7 LNSB2 ,LNSRB2 ,IND_SUBT )
4652C-----------------------------------------------
4653C M o d u l e s
4654C-----------------------------------------------
4655 USE intbufdef_mod
4656 USE imp_intbuf
4657C----6---------------------------------------------------------------7---------8
4658C I m p l i c i t T y p e s
4659C-----------------------------------------------
4660#include "implicit_f.inc"
4661C-----------------------------------------------
4662C C o m m o n B l o c k s
4663C-----------------------------------------------
4664#include "com04_c.inc"
4665#include "param_c.inc"
4666C-----------------------------------------------------------------
4667C D u m m y A r g u m e n t s
4668C-----------------------------------------------
4669 INTEGER IPARI(NPARI,*),NUM_IMP(*),
4670 . NS_IMP(*),NE_IMP(*),ILOCI(*),NDOF(*)
4671 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
4672 . lnss,nint2,iint2(*),iaint2(*),lnss2,nsrem
4673 INTEGER
4674 . nddl,iddl(*) ,nnzk,n_impn,n_impm,nnmax ,nkmax
4675 INTEGER IRBE3(NRBE3L,*),LRBE3(*),LNSS3,IRBE2(NRBE2L,*),LRBE2(*),
4676 . lnsb2,lnsrb2,ind_subt(*)
4677C REAL
4678
4679 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
4680C-----------------------------------------------
4681C L o c a l V a r i a b l e s
4682C-----------------------------------------------
4683 INTEGER NIN,NTY,NDOF1(NUMNOD),NSN
4684 INTEGER I,J,K,L,NDOFI,N,IAD,N_IMP,
4685 . nrts
4686C-----------------------------------------------
4687C------interface ----iddl used for nrow firstly----------
4688 nddl =0
4689 ndofi=3
4690 DO n =1,numnod
4691 iddl(n)=0
4692 iloci(n)=0
4693 ndof1(n)=ndofi
4694 ENDDO
4695C
4696 iad=1
4697 n_imp=0
4698 DO nin=1,ninter
4699 nty =ipari(7,nin)
4700 nsn =ipari(5,nin)
4701 IF(nty==3)THEN
4702 ELSEIF(nty==4)THEN
4703 ELSEIF(nty==5)THEN
4704 CALL row_int5(num_imp(nin),ns_imp(iad),ne_imp(iad),intbuf_tab(nin)%IRECTM,
4705 . intbuf_tab(nin)%NSV, intbuf_tab(nin)%MSR,iddl ,iloci ,ndofi,n_imp ,
4706 . nsn ,nsrem )
4707 iad=iad+num_imp(nin)
4708 ENDIF
4709 ENDDO
4710C IAD=1
4711 DO nin=1,ninter
4712 nty =ipari(7,nin)
4713 nsn =ipari(5,nin)
4714C MULTIMP=MAX(MULTIMP,IPARI(23,NIN))
4715 IF(nty==3)THEN
4716 ELSEIF(nty==4)THEN
4717 ELSEIF(nty==5)THEN
4718 ELSEIF(nty==6)THEN
4719
4720 ELSEIF(nty==7.OR.nty==10)THEN
4721C
4722 CALL row_int(num_imp(nin),ns_imp(iad),ne_imp(iad),intbuf_tab(nin)%IRECTM,
4723 . intbuf_tab(nin)%NSV, iddl ,iloci ,ndofi,n_imp ,
4724 . nsn ,nsrem )
4725 iad=iad+num_imp(nin)
4726 ELSEIF(nty==24)THEN
4727C
4728c CALL ROW_INT24(NUM_IMP(NIN),NS_IMP(IAD),NE_IMP(IAD),INTBUF_TAB(NIN)%IRECTM,
4729c . INTBUF_TAB(NIN)%NSV, IDDL ,ILOCI ,NDOFI,N_IMP ,
4730c . NSN ,NSREM ,IND_SUBT,INTBUF_TAB(NIN)%NVOISIN)
4731 CALL row_int24(intbuf_tab_imp(nin)%I_STOK(1),intbuf_tab_imp(nin)%CAND_N,
4732 . intbuf_tab_imp(nin)%CAND_E,intbuf_tab(nin)%IRECTM,
4733 . intbuf_tab(nin)%NSV, iddl ,iloci ,ndofi,n_imp ,
4734 . nsn ,nsrem ,intbuf_tab_imp(nin)%INDSUBT,
4735 . intbuf_tab(nin)%NVOISIN)
4736 iad=iad+num_imp(nin)
4737 ELSEIF(nty==11)THEN
4738C
4739 nrts =ipari(3,nin)
4740 CALL row_int11(num_imp(nin),ns_imp(iad),ne_imp(iad),
4741 . intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%IRECTM, iddl ,iloci,
4742 . ndofi,n_imp ,nrts ,nsrem )
4743 iad=iad+num_imp(nin)
4744 ENDIF
4745 ENDDO
4746 nnmax=0
4747 DO n =1,numnod
4748 IF (iloci(n)>0) THEN
4749 nnmax=max(nnmax,iddl(n))
4750 iddl(n)=0
4751 ENDIF
4752 ENDDO
4753C-----couplage avec cond. kine ------
4754 n_impm=n_imp
4755 CALL dim_kine_i(
4756 1 num_imp ,ns_imp ,ne_imp ,npby ,lpby ,
4757 2 itab ,nrbyac ,irbyac ,nint2 ,iint2 ,
4758 3 ipari ,intbuf_tab,lnss ,lnss2 ,iddl ,
4759 4 n_imp ,iloci ,nnmax ,n_impm ,ndof ,
4760 5 ndof1 ,iaint2 ,irbe3 ,lrbe3 ,lnss3 ,
4761 6 irbe2 ,lrbe2 ,lnsb2 ,lnsrb2 ,ind_subt )
4762c-----1. calcule NNMAX,NKMAX;
4763 n_impn=n_imp-n_impm
4764 nnmax=0
4765 nkmax=0
4766 DO n =1,numnod
4767 IF (iloci(n)>0) THEN
4768 IF (iloci(n)>n_impn) THEN
4769 nkmax=max(nkmax,iddl(n))
4770 ELSE
4771 nnmax=max(nnmax,iddl(n))
4772 ndof1(n)=max(3,ndof1(n))
4773 ENDIF
4774 ENDIF
4775 ENDDO
4776c-----2. calcule NNZK;
4777 nnzk = 0
4778 DO n =1,numnod
4779 IF (iloci(n)>0) THEN
4780 DO k=1,ndof1(n)
4781C-------termes knn-------
4782 DO j=1,ndof1(n)
4783 IF (j/=k) nnzk = nnzk+1
4784 ENDDO
4785C-------termes kn,nj-------
4786 DO j=1,iddl(n)
4787 DO l=1,ndof1(n)
4788 nnzk = nnzk+1
4789 ENDDO
4790 ENDDO
4791 ENDDO
4792 ENDIF
4793 ENDDO
4794 nnzk = nnzk/2+1
4795c write(*,*)'int NNMAX,NKMAX,N_IMP=',NNMAX,NKMAX,N_IMP
4796c-----3. calcul NDDL,IDDL;
4797 CALL nddl_loc(nddl,iddl,iloci,n_imp,ndof1)
4798C----6---------------------------------------------------------------7---------8
4799 RETURN
4800 END
4801C --------- stockage M.C.R.S + SYM- -----
4802!||====================================================================
4803!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
4804!||--- called by ------------------------------------------------------
4805!|| imp_chkm ../engine/source/implicit/imp_solv.F
4806!|| imp_solv ../engine/source/implicit/imp_solv.f
4807!||--- calls -----------------------------------------------------
4808!|| ind_kine_i ../engine/source/implicit/ind_glob_k.F
4809!|| reorder_j ../engine/source/implicit/ind_glob_k.F
4810!|| reorder_l ../engine/source/implicit/ind_glob_k.F
4811!|| row_int112 ../engine/source/implicit/ind_glob_k.F
4812!|| row_int2 ../engine/source/implicit/ind_glob_k.F
4813!|| row_int242 ../engine/source/implicit/ind_glob_k.F
4814!|| row_int52 ../engine/source/implicit/ind_glob_k.F
4815!|| set_ind_k ../engine/source/implicit/ind_glob_k.F
4816!||--- uses -----------------------------------------------------
4817!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
4818!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
4819!||====================================================================
4820 SUBROUTINE ind_int_k(
4821 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
4822 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
4823 3 NSS ,ISS ,NINT2 ,IINT2 ,NSS2 ,
4824 4 ISS2 ,NDDLI ,NNZI ,IADI ,JDII ,
4825 5 IDDLI ,ILOCI ,N_IMPN ,ITOK ,IDDL ,
4826 6 NNMAX ,NKMAX ,N_IMPM ,NDOF ,IAINT2 ,
4827 7 IRBE3 ,LRBE3 ,NSS3 ,ISS3 ,IRBE2 ,
4828 8 LRBE2 ,NSB2 ,ISB2 ,IND_SUBT )
4829C-----------------------------------------------
4830C M o d u l e s
4831C-----------------------------------------------
4832 USE intbufdef_mod
4833 USE imp_intbuf
4834C----6---------------------------------------------------------------7---------8
4835C I m p l i c i t T y p e s
4836C-----------------------------------------------
4837#include "implicit_f.inc"
4838C-----------------------------------------------
4839C C o m m o n B l o c k s
4840C-----------------------------------------------
4841#include "com04_c.inc"
4842#include "param_c.inc"
4843#include "impl1_c.inc"
4844C-----------------------------------------------------------------
4845C D u m m y A r g u m e n t s
4846C-----------------------------------------------
4847 INTEGER NUM_IMP(*),IPARI(NPARI,*),IND_SUBT(*),
4848 . ns_imp(*),ne_imp(*) ,ndof(*),iaint2(*),lrb,li2
4849 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
4850 . nss(*),iss(*),nint2,iint2(*),nss2(*),iss2(*)
4851 INTEGER
4852 . IDDL(*),IADI(*),JDII(*),IDDLI(*),ITOK(*),
4853 . ILOCI(*),NDDLI ,NNZI,NNMAX,N_IMPN,N_IMPM,NKMAX
4854 INTEGER IRBE3(NRBE3L,*),LRBE3(*),NSS3(*),ISS3(*),
4855 . irbe2(nrbe2l,*),lrbe2(*),nsb2(*),isb2(*)
4856C REAL
4857
4858 TYPE(intbuf_struct_) INTBUF_TAB(*)
4859C=======================================================================
4860C stockage M.C.R.S (Modified Compressed Row Stockage)
4861C [K] pour interfaces : diagonale + trangle sup en lignes:
4862C [K](id,jd) -> DIAG(NDDL)+LT(IK)(exclue diag)
4863C id = 1..nddl : ID = IADI(ID)...IADI(ID+1)-1
4864C jd = 1..NNZI : JD = JDII(IK)
4865C IADI(NDDLI+1)
4866C JDII(NNZK)
4867C ITOK(NDDLI) : L'indice de [K] global:NDDLI->NDDL
4868C-----------------------------------------------
4869C L o c a l V a r i a b l e s
4870C-----------------------------------------------
4871 INTEGER NROW(N_IMPN+N_IMPM),ICOL(NNMAX,N_IMPN),
4872 . NDOF1(N_IMPN+N_IMPM),ICOK(NKMAX,N_IMPM),IKP
4873 INTEGER I,J,K,L,N,KD(50), JFI, KFI,NDOFI,ND,N_IMPT,
4874 . nty,nl,nj,nin,lenk,iad,iloc(n_impn+n_impm),
4875 . nsn,nrts
4876C-----------------------------------------------
4877C------ILOCI est ILOC dans IND_GLOB_K --------------
4878C
4879 ikp=ikpat
4880 ndofi=3
4881 nd=0
4882 n_impt=n_impn+n_impm
4883 DO n =1,numnod
4884 IF (iloci(n)>0) THEN
4885 i=iloci(n)
4886 iloc(i)=n
4887 ndof1(i)=ndofi
4888 ENDIF
4889 ENDDO
4890 DO n =1,n_impt
4891 nrow(n)=0
4892 ENDDO
4893C
4894 iad=1
4895 DO nin=1,ninter
4896 nty =ipari(7,nin)
4897 nsn =ipari(5,nin)
4898 IF(nty==3)THEN
4899 ELSEIF(nty==4)THEN
4900 ELSEIF(nty==5)THEN
4901 CALL row_int52(num_imp(nin),ns_imp(iad),ne_imp(iad),
4902 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,
4903 . intbuf_tab(nin)%MSR,nrow ,
4904 . n_impn,iloci ,icol ,nnmax ,icok ,
4905 . nkmax ,nsn )
4906 iad=iad+num_imp(nin)
4907 ENDIF
4908 ENDDO
4909C IAD=1
4910 DO nin=1,ninter
4911 nty =ipari(7,nin)
4912 nsn =ipari(5,nin)
4913 IF(nty==3)THEN
4914 ELSEIF(nty==4)THEN
4915 ELSEIF(nty==5)THEN
4916 ELSEIF(nty==6)THEN
4917
4918 ELSEIF(nty==7.OR.nty==10)THEN
4919C
4920 CALL row_int2(num_imp(nin),ns_imp(iad),ne_imp(iad),
4921 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,nrow ,n_impn,
4922 . iloci ,icol ,nnmax ,icok ,nkmax ,
4923 . nsn )
4924 iad=iad+num_imp(nin)
4925 ELSEIF(nty==24)THEN
4926C
4927c CALL ROW_INT242(NUM_IMP(NIN),NS_IMP(IAD),NE_IMP(IAD),
4928c . INTBUF_TAB(NIN)%IRECTM,INTBUF_TAB(NIN)%NSV,NROW ,N_IMPN,
4929c . ILOCI ,ICOL ,NNMAX ,ICOK ,NKMAX ,
4930c . NSN ,IND_SUBT,INTBUF_TAB(NIN)%NVOISIN)
4931 CALL row_int242(intbuf_tab_imp(nin)%I_STOK(1),intbuf_tab_imp(nin)%CAND_N,
4932 . intbuf_tab_imp(nin)%CAND_E,intbuf_tab(nin)%IRECTM,
4933 . intbuf_tab(nin)%NSV,nrow ,n_impn,
4934 . iloci ,icol ,nnmax ,icok ,nkmax ,
4935 . nsn ,intbuf_tab_imp(nin)%INDSUBT,
4936 . intbuf_tab(nin)%NVOISIN)
4937 iad=iad+num_imp(nin)
4938 ELSEIF(nty==11)THEN
4939C
4940 nrts =ipari(3,nin)
4941 CALL row_int112(num_imp(nin),ns_imp(iad),ne_imp(iad),
4942 . intbuf_tab(nin)%IRECTS ,intbuf_tab(nin)%IRECTM, nrow ,n_impn,
4943 . iloci ,icol ,nnmax ,icok ,nkmax ,
4944 . nrts )
4945 iad=iad+num_imp(nin)
4946 ENDIF
4947 ENDDO
4948 CALL ind_kine_i(
4949 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
4950 2 nss ,iss ,nint2 ,iint2 ,ipari ,
4951 3 intbuf_tab,nss2 ,iss2 ,nnmax ,iloci ,
4952 4 nkmax ,nrow ,icol ,icok ,n_impn ,
4953 5 ndof ,ndof1 ,iaint2 ,irbe3 ,lrbe3 ,
4954 6 nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
4955 7 isb2 )
4956 IF (ikp==0) THEN
4957 DO i =1,n_impn
4958 n=iloc(i)
4959 CALL reorder_j(nrow(i),icol(1,i),n,iddli)
4960 ENDDO
4961 DO i =n_impn+1,n_impt
4962 n=iloc(i)
4963 nj=i-n_impn
4964 CALL reorder_j(nrow(i),icok(1,nj),n,iddli)
4965 ENDDO
4966 ELSE
4967 DO i =1,n_impn
4968 n=iloc(i)
4969 CALL reorder_l(nrow(i),icol(1,i),n,iddli)
4970 ENDDO
4971 DO i =n_impn+1,n_impt
4972 n=iloc(i)
4973 nj=i-n_impn
4974 CALL reorder_l(nrow(i),icok(1,nj),n,iddli)
4975 ENDDO
4976 ENDIF
4977C-----revinir ndof---
4978 DO i =1,n_impn
4979 ndof1(i)=max(3,ndof1(i))
4980 ENDDO
4981 DO i =1,n_impt
4982 n=iloc(i)
4983 iloci(n)=ndof1(i)
4984 ENDDO
4985 nd =0
4986 lenk = 0
4987 nl = 1
4988 iadi(nl) = 1
4989 DO i =1,n_impn
4990 n=iloc(i)
4991 DO k=1,ndof1(i)
4992 nd = nd + 1
4993 itok(nd)=iddl(n)+k
4994 ENDDO
4995 CALL set_ind_k(
4996 1 iddli ,iloci ,iadi ,jdii ,nl ,
4997 2 lenk ,nrow(i) ,icol(1,i) ,n ,ikp )
4998 ENDDO
4999 DO i =n_impn+1,n_impt
5000 n=iloc(i)
5001 nj=i-n_impn
5002 DO k=1,ndof1(i)
5003 nd = nd + 1
5004 itok(nd)=iddl(n)+k
5005 ENDDO
5006 CALL set_ind_k(
5007 1 iddli ,iloci ,iadi ,jdii ,nl ,
5008 2 lenk ,nrow(i) ,icok(1,nj) ,n ,ikp )
5009 ENDDO
5010 IF (lenk>nnzi.OR.nl/=(nddli+1))
5011 . WRITE(*,*)'--MEMERY PROBLEM 5-- :',lenk,nnzi,nl,nddli+1
5012 nnzi = lenk
5013C----6---------------------------------------------------------------7---------8
5014 RETURN
5015 END
5016C --------- ----
5017!||====================================================================
5018!|| nddl_loc ../engine/source/implicit/ind_glob_k.F
5019!||--- called by ------------------------------------------------------
5020!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5021!||====================================================================
5022 SUBROUTINE nddl_loc(
5023 1 NDDL ,IDDL ,ILOC ,NLOC ,NDOF )
5024C----6---------------------------------------------------------------7---------8
5025C I m p l i c i t T y p e s
5026C-----------------------------------------------
5027#include "implicit_f.inc"
5028C-----------------------------------------------
5029C C o m m o n B l o c k s
5030C-----------------------------------------------
5031#include "com04_c.inc"
5032C-----------------------------------------------------------------
5033C D u m m y A r g u m e n t s
5034C-----------------------------------------------
5035 INTEGER NDDL ,IDDL(*) ,ILOC(*) ,NLOC,NDOF(*)
5036C REAL
5037C-----------------------------------------------
5038C L o c a l V a r i a b l e s
5039C-----------------------------------------------
5040 INTEGER I,N,LOCI(NLOC)
5041C-----------------------------------------------
5042 NDDL=0
5043 DO n = 1, numnod
5044 IF (iloc(n)>0) THEN
5045 i=iloc(n)
5046 loci(i)=n
5047 ENDIF
5048 iddl(n)=nddl
5049 ENDDO
5050 DO i=1,nloc
5051 n=loci(i)
5052 iddl(n)=nddl
5053 nddl = nddl + ndof(n)
5054 ENDDO
5055C----6---------------------------------------------------------------7---------8
5056 RETURN
5057 END
5058C --------- ----
5059!||====================================================================
5060!|| row_int ../engine/source/implicit/ind_glob_k.F
5061!||--- called by ------------------------------------------------------
5062!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5063!||====================================================================
5064 SUBROUTINE row_int(
5065 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5066 2 NROW ,ILOC ,NDOFI ,N_IMPN ,NSN ,
5067 3 NSREM )
5068C----6---------------------------------------------------------------7---------8
5069C I m p l i c i t T y p e s
5070C-----------------------------------------------
5071#include "implicit_f.inc"
5072C-----------------------------------------------
5073C D u m m y A r g u m e n t s
5074C-----------------------------------------------
5075 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5076 . iloc(*),ndofi,n_impn,nsn,nsrem
5077C REAL
5078C-----------------------------------------------
5079C L o c a l V a r i a b l e s
5080C-----------------------------------------------
5081 INTEGER I,J,N,N1,N2,NE,IG
5082C-----------------------------------------------
5083 DO i = 1, jlt
5084C--------secnd node-----
5085 ig = ns_imp(i)
5086 IF (ig<=nsn) THEN
5087 n1 = nsv(ig)
5088 IF (iloc(n1)==0) THEN
5089 n_impn=n_impn+1
5090 iloc(n1)=n_impn
5091 ENDIF
5092 nrow(n1)=nrow(n1)+3
5093 ELSE
5094 nsrem=nsrem+1
5095 ENDIF
5096 ne=ne_imp(i)
5097 DO j=1,3
5098 n=irect(j,ne)
5099 IF (iloc(n)==0) THEN
5100 n_impn=n_impn+1
5101 iloc(n)=n_impn
5102 ENDIF
5103 nrow(n)=nrow(n)+1
5104 ENDDO
5105 IF (irect(3,ne)/=irect(4,ne)) THEN
5106 n=irect(4,ne)
5107 IF (iloc(n)==0) THEN
5108 n_impn=n_impn+1
5109 iloc(n)=n_impn
5110 ENDIF
5111 nrow(n)=nrow(n)+1
5112 IF (ig<=nsn) nrow(n1)=nrow(n1)+1
5113 ENDIF
5114 ENDDO
5115C----6---------------------------------------------------------------7---------8
5116 RETURN
5117 END
5118C --------- ----
5119!||====================================================================
5120!|| row_int1 ../engine/source/implicit/ind_glob_k.F
5121!||--- called by ------------------------------------------------------
5122!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
5123!||--- calls -----------------------------------------------------
5124!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5125!||====================================================================
5126 SUBROUTINE row_int1(
5127 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5128 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
5129 3 NSN )
5130C----6---------------------------------------------------------------7---------8
5131C I m p l i c i t T y p e s
5132C-----------------------------------------------
5133#include "implicit_f.inc"
5134C-----------------------------------------------
5135C D u m m y A r g u m e n t s
5136C-----------------------------------------------
5137 INTEGER NNMAX
5138 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5139 . ILOC(*),ICOL(NNMAX,*),N_IMPN,NSN
5140C REAL
5141C-----------------------------------------------
5142C L o c a l V a r i a b l e s
5143C-----------------------------------------------
5144 INTEGER I,J,N,N1,N2,NE,IG,NI
5145C-----------------------------------------------
5146C---------ICOL : LOCAL NODE NUMBER--------
5147 DO I = 1, jlt
5148C--------secnd node-----
5149 ig = ns_imp(i)
5150 IF (ig<=nsn) THEN
5151 n1 = nsv(ig)
5152 ne=ne_imp(i)
5153 ni=iloc(n1)
5154 DO j=1,3
5155 n=irect(j,ne)
5156 n2=iloc(n)
5157 CALL reorder_a(nrow(n1),icol(1,ni),n)
5158 CALL reorder_a(nrow(n),icol(1,n2),n1)
5159 ENDDO
5160 IF (irect(3,ne)/=irect(4,ne)) THEN
5161 n=irect(4,ne)
5162 n2 =iloc(n)
5163 CALL reorder_a(nrow(n1),icol(1,ni),n)
5164 CALL reorder_a(nrow(n),icol(1,n2),n1)
5165 ENDIF
5166 ENDIF
5167 ENDDO
5168C----6---------------------------------------------------------------7---------8
5169 RETURN
5170 END
5171C --------- ----
5172!||====================================================================
5173!|| row_int2 ../engine/source/implicit/ind_glob_k.F
5174!||--- called by ------------------------------------------------------
5175!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
5176!||--- calls -----------------------------------------------------
5177!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5178!||====================================================================
5179 SUBROUTINE row_int2(
5180 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5181 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
5182 3 ICOK ,NKMAX ,NSN )
5183C----6---------------------------------------------------------------7---------8
5184C I m p l i c i t T y p e s
5185C-----------------------------------------------
5186#include "implicit_f.inc"
5187C-----------------------------------------------
5188C D u m m y A r g u m e n t s
5189C-----------------------------------------------
5190 INTEGER NNMAX,NKMAX
5191 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5192 . ILOC(*),ICOL(NNMAX,*),ICOK(NKMAX,*),N_IMPN,NSN
5193C REAL
5194C-----------------------------------------------
5195C L o c a l V a r i a b l e s
5196C-----------------------------------------------
5197 INTEGER I,J,N,N1,N2,NE,IG,NI,NM,NIM
5198C-----------------------------------------------
5199C---------ICOL : LOCAL NODE NUMBER--------
5200 DO I = 1, jlt
5201C--------secnd node-----
5202 ig = ns_imp(i)
5203 IF (ig<=nsn) THEN
5204 n1 = nsv(ig)
5205 ne=ne_imp(i)
5206 ni=iloc(n1)
5207 IF (ni<=n_impn) THEN
5208 DO j=1,3
5209 n=irect(j,ne)
5210 n2=iloc(n)
5211 CALL reorder_a(nrow(ni),icol(1,ni),n)
5212 IF (n2<=n_impn) THEN
5213 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5214 ELSE
5215 nm=n2- n_impn
5216 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5217 ENDIF
5218 ENDDO
5219 IF (irect(3,ne)/=irect(4,ne)) THEN
5220 n=irect(4,ne)
5221 n2 =iloc(n)
5222 CALL reorder_a(nrow(ni),icol(1,ni),n)
5223 IF (n2<=n_impn) THEN
5224 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5225 ELSE
5226 nm=n2- n_impn
5227 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5228 ENDIF
5229 ENDIF
5230 ELSE
5231 nim=ni-n_impn
5232 DO j=1,3
5233 n=irect(j,ne)
5234 n2=iloc(n)
5235 CALL reorder_a(nrow(ni),icok(1,nim),n)
5236 IF (n2<=n_impn) THEN
5237 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5238 ELSE
5239 nm=n2- n_impn
5240 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5241 ENDIF
5242 ENDDO
5243 IF (irect(3,ne)/=irect(4,ne)) THEN
5244 n=irect(4,ne)
5245 n2 =iloc(n)
5246 CALL reorder_a(nrow(ni),icok(1,nim),n)
5247 IF (n2<=n_impn) THEN
5248 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5249 ELSE
5250 nm=n2- n_impn
5251 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5252 ENDIF
5253 ENDIF
5254 ENDIF
5255 END IF
5256 ENDDO
5257C----6---------------------------------------------------------------7---------8
5258 RETURN
5259 END
5260C --------- ----
5261!||====================================================================
5262!|| row_int5 ../engine/source/implicit/ind_glob_k.F
5263!||--- called by ------------------------------------------------------
5264!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5265!||====================================================================
5266 SUBROUTINE row_int5(
5267 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5268 2 MSR ,NROW ,ILOC ,NDOFI ,N_IMPN ,
5269 3 NSN ,NSREM )
5270C----6---------------------------------------------------------------7---------8
5271C I m p l i c i t T y p e s
5272C-----------------------------------------------
5273#include "implicit_f.inc"
5274C-----------------------------------------------
5275C D u m m y A r g u m e n t s
5276C-----------------------------------------------
5277 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5278 . msr(*),iloc(*),ndofi,n_impn,nsn,nsrem
5279C REAL
5280C-----------------------------------------------
5281C L o c a l V a r i a b l e s
5282C-----------------------------------------------
5283 INTEGER I,J,N,N1,N2,NE,IG
5284C-----------------------------------------------
5285 DO i = 1, jlt
5286C--------secnd node-----
5287 ig = ns_imp(i)
5288 n1 = nsv(ig)
5289 IF (iloc(n1)==0) THEN
5290 n_impn=n_impn+1
5291 iloc(n1)=n_impn
5292 ENDIF
5293 nrow(n1)=nrow(n1)+3
5294 ne=ne_imp(i)
5295 DO j=1,3
5296 n=msr(irect(j,ne))
5297 IF (iloc(n)==0) THEN
5298 n_impn=n_impn+1
5299 iloc(n)=n_impn
5300 ENDIF
5301 nrow(n)=nrow(n)+1
5302 ENDDO
5303 IF (irect(3,ne)/=irect(4,ne)) THEN
5304 n=msr(irect(4,ne))
5305 IF (iloc(n)==0) THEN
5306 n_impn=n_impn+1
5307 iloc(n)=n_impn
5308 ENDIF
5309 nrow(n)=nrow(n)+1
5310 IF (ig<=nsn) nrow(n1)=nrow(n1)+1
5311 ENDIF
5312 ENDDO
5313C----6---------------------------------------------------------------7---------8
5314 RETURN
5315 END
5316C --------- ----
5317!||====================================================================
5318!|| row_int51 ../engine/source/implicit/ind_glob_k.F
5319!||--- called by ------------------------------------------------------
5320!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
5321!||--- calls -----------------------------------------------------
5322!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5323!||====================================================================
5324 SUBROUTINE row_int51(
5325 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5326 2 MSR ,NROW ,N_IMPN ,ILOC ,ICOL ,
5327 3 NNMAX ,NSN )
5328C----6---------------------------------------------------------------7---------8
5329C I m p l i c i t T y p e s
5330C-----------------------------------------------
5331#include "implicit_f.inc"
5332C-----------------------------------------------
5333C D u m m y A r g u m e n t s
5334C-----------------------------------------------
5335 INTEGER NNMAX
5336 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5337 . iloc(*),icol(nnmax,*),n_impn,nsn,msr(*)
5338C REAL
5339C-----------------------------------------------
5340C L o c a l V a r i a b l e s
5341C-----------------------------------------------
5342 INTEGER I,J,N,N1,N2,NE,IG,NI
5343C-----------------------------------------------
5344C---------ICOL : LOCAL NODE NUMBER--------
5345 DO i = 1, jlt
5346C--------secnd node-----
5347 ig = ns_imp(i)
5348 n1 = nsv(ig)
5349 ne=ne_imp(i)
5350 ni=iloc(n1)
5351 DO j=1,3
5352 n=msr(irect(j,ne))
5353 n2=iloc(n)
5354 CALL reorder_a(nrow(n1),icol(1,ni),n)
5355 CALL reorder_a(nrow(n),icol(1,n2),n1)
5356 ENDDO
5357 IF (irect(3,ne)/=irect(4,ne)) THEN
5358 n=msr(irect(4,ne))
5359 n2 =iloc(n)
5360 CALL reorder_a(nrow(n1),icol(1,ni),n)
5361 CALL reorder_a(nrow(n),icol(1,n2),n1)
5362 ENDIF
5363 ENDDO
5364C----6---------------------------------------------------------------7---------8
5365 RETURN
5366 END
5367C --------- ----
5368!||====================================================================
5369!|| row_int52 ../engine/source/implicit/ind_glob_k.F
5370!||--- called by ------------------------------------------------------
5371!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
5372!||--- calls -----------------------------------------------------
5373!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5374!||====================================================================
5375 SUBROUTINE row_int52(
5376 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5377 2 MSR ,NROW ,N_IMPN ,ILOC ,ICOL ,
5378 3 NNMAX ,ICOK ,NKMAX ,NSN )
5379C----6---------------------------------------------------------------7---------8
5380C I m p l i c i t T y p e s
5381C-----------------------------------------------
5382#include "implicit_f.inc"
5383C-----------------------------------------------
5384C D u m m y A r g u m e n t s
5385C-----------------------------------------------
5386 INTEGER NNMAX,NKMAX
5387 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5388 . iloc(*),icol(nnmax,*),icok(nkmax,*),n_impn,nsn,msr(*)
5389C REAL
5390C-----------------------------------------------
5391C L o c a l V a r i a b l e s
5392C-----------------------------------------------
5393 INTEGER I,J,N,N1,N2,NE,IG,NI,NM,NIM
5394C-----------------------------------------------
5395C---------ICOL : LOCAL NODE NUMBER--------
5396 DO i = 1, jlt
5397C--------secnd node-----
5398 ig = ns_imp(i)
5399 n1 = nsv(ig)
5400 ne=ne_imp(i)
5401 ni=iloc(n1)
5402 IF (ni<=n_impn) THEN
5403 DO j=1,3
5404 n=msr(irect(j,ne))
5405 n2=iloc(n)
5406 CALL reorder_a(nrow(ni),icol(1,ni),n)
5407 IF (n2<=n_impn) THEN
5408 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5409 ELSE
5410 nm=n2- n_impn
5411 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5412 ENDIF
5413 ENDDO
5414 IF (irect(3,ne)/=irect(4,ne)) THEN
5415 n=msr(irect(4,ne))
5416 n2 =iloc(n)
5417 CALL reorder_a(nrow(ni),icol(1,ni),n)
5418 IF (n2<=n_impn) THEN
5419 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5420 ELSE
5421 nm=n2- n_impn
5422 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5423 ENDIF
5424 ENDIF
5425 ELSE
5426 nim=ni-n_impn
5427 DO j=1,3
5428 n=msr(irect(j,ne))
5429 n2=iloc(n)
5430 CALL reorder_a(nrow(ni),icok(1,nim),n)
5431 IF (n2<=n_impn) THEN
5432 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5433 ELSE
5434 nm=n2- n_impn
5435 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5436 ENDIF
5437 ENDDO
5438 IF (irect(3,ne)/=irect(4,ne)) THEN
5439 n=msr(irect(4,ne))
5440 n2 =iloc(n)
5441 CALL reorder_a(nrow(ni),icok(1,nim),n)
5442 IF (n2<=n_impn) THEN
5443 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5444 ELSE
5445 nm=n2- n_impn
5446 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5447 ENDIF
5448 ENDIF
5449 ENDIF
5450 ENDDO
5451C----6---------------------------------------------------------------7---------8
5452 RETURN
5453 END
5454!||====================================================================
5455!|| row_int24 ../engine/source/implicit/ind_glob_k.F
5456!||--- called by ------------------------------------------------------
5457!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5458!||--- calls -----------------------------------------------------
5459!|| i24msegv ../engine/source/implicit/ind_glob_k.F
5460!||====================================================================
5461 SUBROUTINE row_int24(
5462 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5463 2 NROW ,ILOC ,NDOFI ,N_IMPN ,NSN ,
5464 3 NSREM ,SUBTRIA ,NVOISIN )
5465C----6---------------------------------------------------------------7---------8
5466C I m p l i c i t T y p e s
5467C-----------------------------------------------
5468#include "implicit_f.inc"
5469C-----------------------------------------------
5470C D u m m y A r g u m e n t s
5471C-----------------------------------------------
5472 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5473 . ILOC(*),NDOFI,N_IMPN,NSN,NSREM,SUBTRIA(*),NVOISIN(8,*)
5474C REAL
5475C-----------------------------------------------
5476C L o c a l V a r i a b l e s
5477C-----------------------------------------------
5478 INTEGER I,J,N,N1,N2,NE,IG,IRTLM(4),NEI
5479C-----------------------------------------------
5480 DO i = 1, jlt
5481C--------secnd node-----
5482 ig = ns_imp(i)
5483 IF (ig<=nsn) THEN
5484 n1 = nsv(ig)
5485 IF (iloc(n1)==0) THEN
5486 n_impn=n_impn+1
5487 iloc(n1)=n_impn
5488 ENDIF
5489 nrow(n1)=nrow(n1)+3
5490C
5491 ELSE
5492 nsrem=nsrem+1
5493 ENDIF
5494 ne=ne_imp(i)
5495 IF (ne<0) THEN
5496 nei=-ne
5497 CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
5498 ELSE
5499 irtlm(1:4) = irect(1:4,ne)
5500 END IF
5501 DO j=1,3
5502 n=irtlm(j)
5503 IF (iloc(n)==0) THEN
5504 n_impn=n_impn+1
5505 iloc(n)=n_impn
5506 ENDIF
5507 nrow(n)=nrow(n)+1
5508 ENDDO
5509 IF (irtlm(3)/=irtlm(4)) THEN
5510 n=irtlm(4)
5511 IF (iloc(n)==0) THEN
5512 n_impn=n_impn+1
5513 iloc(n)=n_impn
5514 ENDIF
5515 nrow(n)=nrow(n)+1
5516
5517 IF (ig<=nsn) nrow(n1)=nrow(n1)+1
5518 ENDIF
5519 ENDDO
5520C----6---------------------------------------------------------------7---------8
5521 RETURN
5522 END
5523C --------- ----
5524!||====================================================================
5525!|| row_int241 ../engine/source/implicit/ind_glob_k.F
5526!||--- called by ------------------------------------------------------
5527!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
5528!||--- calls -----------------------------------------------------
5529!|| i24msegv ../engine/source/implicit/ind_glob_k.F
5530!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5531!||====================================================================
5532 SUBROUTINE row_int241(
5533 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5534 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
5535 3 NSN ,SUBTRIA ,NVOISIN )
5536C----6---------------------------------------------------------------7---------8
5537C I m p l i c i t T y p e s
5538C-----------------------------------------------
5539#include "implicit_f.inc"
5540C-----------------------------------------------
5541C D u m m y A r g u m e n t s
5542C-----------------------------------------------
5543 INTEGER NNMAX
5544 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5545 . iloc(*),icol(nnmax,*),n_impn,nsn,subtria(*),nvoisin(8,*)
5546C REAL
5547C-----------------------------------------------
5548C L o c a l V a r i a b l e s
5549C-----------------------------------------------
5550 INTEGER I,J,N,N1,N2,NE,IG,NI,IRTLM(4),NEI
5551C-----------------------------------------------
5552C---------ICOL : LOCAL NODE NUMBER--------
5553 DO i = 1, jlt
5554C--------secnd node-----
5555 ig = ns_imp(i)
5556 IF (ig<=nsn) THEN
5557 n1 = nsv(ig)
5558 ne=ne_imp(i)
5559 IF (ne<0) THEN
5560 nei=-ne
5561 CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
5562 ELSE
5563 irtlm(1:4) = irect(1:4,ne)
5564 END IF
5565 ni=iloc(n1)
5566 DO j=1,3
5567 n=irtlm(j)
5568 n2=iloc(n)
5569 CALL reorder_a(nrow(n1),icol(1,ni),n)
5570 CALL reorder_a(nrow(n),icol(1,n2),n1)
5571 ENDDO
5572 IF (irtlm(3)/=irtlm(4)) THEN
5573 n=irtlm(4)
5574 n2 =iloc(n)
5575 CALL reorder_a(nrow(n1),icol(1,ni),n)
5576 CALL reorder_a(nrow(n),icol(1,n2),n1)
5577 ENDIF
5578 ENDIF
5579 ENDDO
5580C----6---------------------------------------------------------------7---------8
5581 RETURN
5582 END
5583C --------- ----
5584!||====================================================================
5585!|| row_int242 ../engine/source/implicit/ind_glob_k.F
5586!||--- called by ------------------------------------------------------
5587!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
5588!||--- calls -----------------------------------------------------
5589!|| i24msegv ../engine/source/implicit/ind_glob_k.F
5590!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5591!||====================================================================
5592 SUBROUTINE row_int242(
5593 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
5594 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
5595 3 ICOK ,NKMAX ,NSN ,SUBTRIA ,NVOISIN )
5596C----6---------------------------------------------------------------7---------8
5597C I m p l i c i t T y p e s
5598C-----------------------------------------------
5599#include "implicit_f.inc"
5600C-----------------------------------------------
5601C D u m m y A r g u m e n t s
5602C-----------------------------------------------
5603 INTEGER NNMAX,NKMAX
5604 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),NROW(*),
5605 . ILOC(*),ICOL(NNMAX,*),ICOK(NKMAX,*),N_IMPN,NSN,
5606 . SUBTRIA(*),NVOISIN(8,*)
5607C REAL
5608C-----------------------------------------------
5609C L o c a l V a r i a b l e s
5610C-----------------------------------------------
5611 INTEGER I,J,N,N1,N2,NE,IG,NI,NM,NIM,IRTLM(4),NEI
5612C-----------------------------------------------
5613C---------ICOL : LOCAL NODE NUMBER--------
5614 DO I = 1, jlt
5615C--------secnd node-----
5616 ig = ns_imp(i)
5617 IF (ig<=nsn) THEN
5618 n1 = nsv(ig)
5619 ne=ne_imp(i)
5620 ni=iloc(n1)
5621 IF (ne<0) THEN
5622 nei=-ne
5623 CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
5624 ELSE
5625 irtlm(1:4) = irect(1:4,ne)
5626 END IF
5627 IF (ni<=n_impn) THEN
5628 DO j=1,3
5629 n=irtlm(j)
5630 n2=iloc(n)
5631 CALL reorder_a(nrow(ni),icol(1,ni),n)
5632 IF (n2<=n_impn) THEN
5633 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5634 ELSE
5635 nm=n2- n_impn
5636 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5637 ENDIF
5638 ENDDO
5639 IF (irtlm(3)/=irtlm(4)) THEN
5640 n=irtlm(4)
5641 n2 =iloc(n)
5642 CALL reorder_a(nrow(ni),icol(1,ni),n)
5643 IF (n2<=n_impn) THEN
5644 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5645 ELSE
5646 nm=n2- n_impn
5647 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5648 ENDIF
5649 ENDIF
5650 ELSE
5651 nim=ni-n_impn
5652 DO j=1,3
5653 n=irtlm(j)
5654 n2=iloc(n)
5655 CALL reorder_a(nrow(ni),icok(1,nim),n)
5656 IF (n2<=n_impn) THEN
5657 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5658 ELSE
5659 nm=n2- n_impn
5660 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5661 ENDIF
5662 ENDDO
5663 IF (irtlm(3)/=irtlm(4)) THEN
5664 n=irtlm(4)
5665 n2 =iloc(n)
5666 CALL reorder_a(nrow(ni),icok(1,nim),n)
5667 IF (n2<=n_impn) THEN
5668 CALL reorder_a(nrow(n2),icol(1,n2),n1)
5669 ELSE
5670 nm=n2- n_impn
5671 CALL reorder_a(nrow(n2),icok(1,nm),n1)
5672 ENDIF
5673 ENDIF
5674 ENDIF
5675 END IF
5676 ENDDO
5677C----6---------------------------------------------------------------7---------8
5678 RETURN
5679 END
5680!||====================================================================
5681!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
5682!||--- called by ------------------------------------------------------
5683!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
5684!||--- calls -----------------------------------------------------
5685!|| intab ../engine/source/implicit/ind_glob_k.F
5686!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5687!|| row_int1 ../engine/source/implicit/ind_glob_k.F
5688!|| row_int111 ../engine/source/implicit/ind_glob_k.F
5689!|| row_int241 ../engine/source/implicit/ind_glob_k.f
5690!|| row_int51 ../engine/source/implicit/ind_glob_k.F
5691!||--- uses -----------------------------------------------------
5692!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
5693!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
5694!||====================================================================
5695 SUBROUTINE dim_kine_i(
5696 1 NUM_IMP ,NS_IMP ,NE_IMP ,NPBY ,LPBY ,
5697 2 ITAB ,NRBYAC ,IRBYAC ,NINT2 ,IINT2 ,
5698 3 IPARI ,INTBUF_TAB,LNSS ,LNSS2 ,NROW ,
5699 4 NKINE ,INLOC ,NNMAX ,N_IMPM ,NDOF ,
5700 5 NDOFI ,IAINT2 ,IRBE3 ,LRBE3 ,LNSS3 ,
5701 6 IRBE2 ,LRBE2 ,LNSB2 ,LNSRB2 ,IND_SUBT )
5702C-----------------------------------------------
5703C M o d u l e s
5704C-----------------------------------------------
5705 USE intbufdef_mod
5706 USE imp_intbuf
5707C----6---------------------------------------------------------------7---------8
5708C I m p l i c i t T y p e s
5709C-----------------------------------------------
5710#include "implicit_f.inc"
5711C-----------------------------------------------
5712C C o m m o n B l o c k s
5713C-----------------------------------------------
5714#include "com04_c.inc"
5715#include "param_c.inc"
5716C-----------------------------------------------
5717C D u m m y A r g u m e n t s
5718C-----------------------------------------------
5719 INTEGER NNMAX,NKINE,N_IMPM
5720 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),
5721 . npby(nnpby,*),lpby(*),itab(*),nrbyac,irbyac(*)
5722 INTEGER NINT2,IINT2(*),IPARI(NPARI,*),IAINT2(*),
5723 . inloc(*),lnss ,lnss2,nrow(*),ndof(*),ndofi(*)
5724 INTEGER IRBE3(NRBE3L,*),LRBE3(*),LNSS3,IRBE2(NRBE2L,*),
5725 . LRBE2(*),LNSB2,LNSRB2,IND_SUBT(*)
5726
5727 TYPE(intbuf_struct_) INTBUF_TAB(*)
5728C REAL
5729C-----------------------------------------------
5730C External function
5731C-----------------------------------------------
5732 LOGICAL INTAB
5733 EXTERNAL INTAB
5734C-----------------------------------------------
5735C L o c a l V a r i a b l e s
5736C-----------------------------------------------
5737 INTEGER IAD,NTY,NIN,KD(50),NKE,NKE2
5738 INTEGER IA(NRBYAC),NROW1(NUMNOD)
5739 INTEGER
5740 . I,J,K,N,L,NL,NJ,NI,J1,M,NSN,N1,N2,NK,ID,
5741 . JI,K10,K11,K12,K13,K14,KFI,NS,NNOD,NM,L1,NL1,NM1,
5742 . NRTS,NKINE0,NMAX,NKE1,M1,IC
5743 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICOK,ICOK1
5744C-----------------------------------------------
5745 NKINE0 = nkine
5746 IF (nkine0>0) ALLOCATE(icok(nnmax,nkine0))
5747C
5748 DO i=1,numnod
5749 nrow1(i) = 0
5750 ENDDO
5751C
5752 iad=1
5753 DO nin=1,ninter
5754 nty =ipari(7,nin)
5755 nsn =ipari(5,nin)
5756 IF(nty==3)THEN
5757 ELSEIF(nty==4)THEN
5758 ELSEIF(nty==5)THEN
5759 CALL row_int51(num_imp(nin),ns_imp(iad),ne_imp(iad),
5760 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,
5761 . intbuf_tab(nin)%MSR,nrow ,
5762 . nkine ,inloc ,icok ,nnmax ,nsn )
5763 iad=iad+num_imp(nin)
5764 ENDIF
5765 ENDDO
5766 DO nin=1,ninter
5767 nty =ipari(7,nin)
5768 nsn =ipari(5,nin)
5769 IF(nty==3)THEN
5770 ELSEIF(nty==4)THEN
5771 ELSEIF(nty==5)THEN
5772 ELSEIF(nty==6)THEN
5773
5774 ELSEIF(nty==7.OR.nty==10)THEN
5775C
5776 CALL row_int1(num_imp(nin),ns_imp(iad),ne_imp(iad),
5777 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,nrow ,nkine ,
5778 . inloc ,icok ,nnmax ,nsn )
5779 iad=iad+num_imp(nin)
5780 ELSEIF(nty==24)THEN
5781C
5782c CALL ROW_INT241(NUM_IMP(NIN),NS_IMP(IAD),NE_IMP(IAD),
5783c . INTBUF_TAB(NIN)%IRECTM,INTBUF_TAB(NIN)%NSV,NROW ,NKINE ,
5784c . INLOC ,ICOK ,NNMAX ,NSN ,IND_SUBT,
5785c . INTBUF_TAB(NIN)%NVOISIN)
5786 CALL row_int241(intbuf_tab_imp(nin)%I_STOK(1),intbuf_tab_imp(nin)%CAND_N,
5787 . intbuf_tab_imp(nin)%CAND_E,intbuf_tab(nin)%IRECTM,
5788 . intbuf_tab(nin)%NSV,nrow ,nkine ,
5789 . inloc ,icok ,nnmax ,nsn ,
5790 . intbuf_tab_imp(nin)%INDSUBT,intbuf_tab(nin)%NVOISIN)
5791 iad=iad+num_imp(nin)
5792 ELSEIF(nty==11)THEN
5793C
5794 nrts =ipari(3,nin)
5795 CALL row_int111(num_imp(nin),ns_imp(iad),ne_imp(iad),
5796 . intbuf_tab(nin)%IRECTS ,intbuf_tab(nin)%IRECTM,nrow ,nkine ,
5797 . inloc ,icok ,nnmax ,nrts )
5798 iad=iad+num_imp(nin)
5799 ENDIF
5800 ENDDO
5801 k=0
5802 lnss2=0
5803 DO j=1,nint2
5804 n=iint2(j)
5805 iaint2(j)=0
5806 nsn = ipari(5,n)
5807 ji=ipari(1,n)
5808 k10=ji-1
5809 k11=k10+4*ipari(3,n)
5810C------IRECT(4,NSN)-----
5811 k12=k11+4*ipari(4,n)
5812C------NSV(NSN)--node number---
5813 k13=k12+nsn
5814C------MSR(NMN)-----
5815 k14=k13+ipari(6,n)
5816C------IRTL(NSN)--main el number---
5817 kfi=k14+nsn
5818 DO i=1,nsn
5819 id = i+k
5820 ni=intbuf_tab(n)%NSV(i)
5821 IF (inloc(ni)>0.AND.inloc(ni)<=nkine0) THEN
5822 iaint2(j)=1
5823 l=intbuf_tab(n)%IRTLM(i)
5824 nl=4*(l-1)
5825 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
5826 nnod=3
5827 ELSE
5828 nnod=4
5829 ENDIF
5830 DO m=1,nnod
5831 nm=intbuf_tab(n)%IRECTM(nl+m)
5832 ndofi(nm)=ndof(nm)
5833 IF (inloc(nm)==0) THEN
5834 nkine=nkine+1
5835 inloc(nm)=nkine
5836 nrow1(nm)=nrow1(nm)+ nnod + nnod
5837 ENDIF
5838 ENDDO
5839 nke=inloc(ni)
5840 DO n1=1,nrow(ni)
5841 nj=icok(n1,nke)
5842 IF (inloc(nj)>0 ) THEN
5843 lnss2=lnss2+1
5844 nke2=inloc(nj)
5845 DO m=1,nnod
5846 nm=intbuf_tab(n)%IRECTM(nl+m)
5847 IF (inloc(nm)>0) THEN
5848 nrow1(nm)=nrow1(nm)+1
5849 IF (nke2>0) nrow1(nj)=nrow1(nj)+1
5850 ELSE
5851 nkine=nkine+1
5852 inloc(nm)=nkine
5853 nrow1(nm)=1
5854 ENDIF
5855 ENDDO
5856 ENDIF
5857 ENDDO
5858 ENDIF
5859 ENDDO
5860 k=k+nsn
5861 ENDDO
5862C-----RBE2------
5863 lnsb2= 0
5864 lnsrb2= 0
5865 DO j=1,nrbe2
5866 k=irbe2(1,j)
5867 m =irbe2(3,j)
5868 nsn =irbe2(5,j)
5869 lnsrb2= lnsrb2+nsn
5870 ic = 7*512+7*64-irbe2(4,j)
5871 DO i=1,nsn
5872 ni=lrbe2(i+k)
5873 IF (inloc(ni)>0) THEN
5874 nke=inloc(ni)
5875 DO n1=1,nrow(ni)
5876 nj=icok(n1,nke)
5877 IF (inloc(nj)>0.AND.nj/=ni) nrow1(nj)=nrow1(nj)+1+nhrbe2
5878 lnsb2= lnsb2+1
5879 ENDDO
5880 IF (inloc(m)==0) THEN
5881 nkine=nkine+1
5882 inloc(m)=nkine
5883 ENDIF
5884 nrow1(m)=nrow1(m)+nrow(ni)+nrow1(ni)
5885 IF (ic>0) THEN
5886 nrow1(m)=nrow1(m)+1
5887 nrow1(ni)=nrow1(ni)+1
5888 END IF
5889 ENDIF
5890C---------for the case with main node--------
5891 lnsb2= lnsb2+1
5892 ENDDO
5893 IF (inloc(m)>0) ndofi(m)=ndof(m)
5894 ENDDO
5895C------------RBE3-------------
5896 DO n=1,nrbe3
5897 iad = irbe3(1,n)
5898 ni = irbe3(3,n)
5899 IF (ni==0.OR.ndofi(ni)==0) cycle
5900 nnod = irbe3(5,n)
5901 IF (inloc(ni)>0) THEN
5902 DO m=1,nnod
5903 nm=lrbe3(iad+m)
5904 ndofi(nm)=ndof(nm)
5905 IF (inloc(nm)==0) THEN
5906 nkine=nkine+1
5907 inloc(nm)=nkine
5908 nrow1(nm)=nrow1(nm)+ nnod
5909 ENDIF
5910 ENDDO
5911 nke=inloc(ni)
5912 DO n1=1,nrow(ni)
5913 nj=icok(n1,nke)
5914 IF (inloc(nj)>0.AND.
5915 . (.NOT.intab(nnod,lrbe3(iad+1),nj))) THEN
5916 nke2=inloc(nj)
5917 DO m=1,nnod
5918 nm=lrbe3(iad+m)
5919 nrow1(nm)=nrow1(nm)+1
5920 IF (nke2>0) nrow1(nj)=nrow1(nj)+1
5921 ENDDO
5922 ENDIF
5923 ENDDO
5924 ENDIF
5925 ENDDO
5926C--------------------
5927 IF (nkine>nkine0) THEN
5928 nmax = nnmax
5929 ALLOCATE(icok1(nnmax,nkine0))
5930 DO i=1,numnod
5931 IF (inloc(i)>0) THEN
5932 nmax=max(nmax,(nrow1(i)+nrow(i)))
5933 nke = inloc(i)
5934 DO j =1,nrow(i)
5935 icok1(j,nke) = icok(j,nke)
5936 ENDDO
5937 ENDIF
5938 nrow1(i) = 0
5939 ENDDO
5940 DEALLOCATE(icok)
5941 ALLOCATE(icok(nmax,nkine))
5942 DO i=1,numnod
5943 IF (inloc(i)>0.AND.nrow(i)>0) THEN
5944 nke = inloc(i)
5945 DO j =1,nrow(i)
5946 icok(j,nke) = icok1(j,nke)
5947 ENDDO
5948 ENDIF
5949 ENDDO
5950 DEALLOCATE(icok1)
5951 lnss2=0
5952 DO j=1,nint2
5953 IF(iaint2(j)==1) THEN
5954 n=iint2(j)
5955 nsn = ipari(5,n)
5956 ji=ipari(1,n)
5957 k10=ji-1
5958 k11=k10+4*ipari(3,n)
5959C------IRECT(4,NSN)-----
5960 k12=k11+4*ipari(4,n)
5961C------NSV(NSN)--node number---
5962 k13=k12+nsn
5963C------MSR(NMN)-----
5964 k14=k13+ipari(6,n)
5965C------IRTL(NSN)--main el number---
5966 kfi=k14+nsn
5967 DO i=1,nsn
5968 ni=intbuf_tab(n)%NSV(i)
5969 IF (inloc(ni)>0) THEN
5970 l=intbuf_tab(n)%IRTLM(i)
5971 nl=4*(l-1)
5972 IF(intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))THEN
5973 nnod=3
5974 ELSE
5975 nnod=4
5976 ENDIF
5977 DO m=1,nnod
5978 nm=intbuf_tab(n)%IRECTM(nl+m)
5979 nke1=inloc(nm)
5980 DO m1=m+1,nnod
5981 nm1=intbuf_tab(n)%IRECTM(nl+m1)
5982 nke2=inloc(nm1)
5983 CALL reorder_a(nrow(nm),icok(1,nke1),nm1)
5984 CALL reorder_a(nrow(nm1),icok(1,nke2),nm)
5985 ENDDO
5986 ENDDO
5987 nke=inloc(ni)
5988 DO n1=1,nrow(ni)
5989 nj=icok(n1,nke)
5990 IF (inloc(nj)>0) THEN
5991 lnss2=lnss2+1
5992 nke2=inloc(nj)
5993 DO m=1,nnod
5994 nm=intbuf_tab(n)%IRECTM(nl+m)
5995 IF (inloc(nm)>0) THEN
5996 nke1=inloc(nm)
5997 CALL reorder_a(nrow(nm),icok(1,nke1),nj)
5998 CALL reorder_a(nrow(nj),icok(1,nke2),nm)
5999 ENDIF
6000 ENDDO
6001 ENDIF
6002 ENDDO
6003 ENDIF
6004 ENDDO
6005 ENDIF
6006 ENDDO
6007 ENDIF
6008C-----RBE2------
6009 DO j=1,nrbe2
6010 k=irbe2(1,j)
6011 m =irbe2(3,j)
6012 IF (inloc(m)==0) cycle
6013 nsn =irbe2(5,j)
6014 ic = 7*512+7*64-irbe2(4,j)
6015 nke1=inloc(m)
6016 DO i=1,nsn
6017 ni=lrbe2(i+k)
6018 IF (inloc(ni)>0) THEN
6019 nke=inloc(ni)
6020 DO n1=1,nrow(ni)
6021 nj=icok(n1,nke)
6022 nke2=inloc(nj)
6023C------------case hierarchy w/ RBE3----
6024 IF (nke2>0.AND.nj/=ni) THEN
6025 CALL reorder_a(nrow(m),icok(1,nke1),nj)
6026 CALL reorder_a(nrow(nj),icok(1,nke2),m)
6027 END IF
6028 ENDDO
6029 IF (ic>0) THEN
6030 CALL reorder_a(nrow(m),icok(1,nke1),ni)
6031 CALL reorder_a(nrow(ni),icok(1,nke),m)
6032 END IF
6033 ENDIF
6034 ENDDO
6035 ENDDO
6036C------------RBE3-------------
6037 lnss3=0
6038 DO n=1,nrbe3
6039 iad = irbe3(1,n)
6040 ni = irbe3(3,n)
6041 IF (ni==0.OR.ndofi(ni)==0) cycle
6042 nnod = irbe3(5,n)
6043 IF (inloc(ni)>0) THEN
6044 nke1=inloc(nm)
6045 DO m=1,nnod
6046 nm=lrbe3(iad+m)
6047 DO m1=m+1,nnod
6048 nm1=lrbe3(iad+m1)
6049 nke2=inloc(nm1)
6050 CALL reorder_a(nrow(nm),icok(1,nke1),nm1)
6051 CALL reorder_a(nrow(nm1),icok(1,nke2),nm)
6052 ENDDO
6053 ENDDO
6054 nke=inloc(ni)
6055 DO n1=1,nrow(ni)
6056 nj=icok(n1,nke)
6057 IF (inloc(nj)>0.AND.
6058 . (.NOT.intab(nnod,lrbe3(iad+1),nj))) THEN
6059 lnss3=lnss3+1
6060 nke2=inloc(nj)
6061 DO m=1,nnod
6062 nm=lrbe3(iad+m)
6063 nke1=inloc(nm)
6064 CALL reorder_a(nrow(nm),icok(1,nke1),nj)
6065 CALL reorder_a(nrow(nj),icok(1,nke2),nm)
6066 ENDDO
6067 ENDIF
6068 ENDDO
6069 ENDIF
6070 ENDDO
6071C-----active rigid body main nodes------
6072 lnss= 0
6073 DO j=1,nrbyac
6074 ia(j)=0
6075 n=irbyac(j)
6076 m =npby(1,n)
6077C
6078 k=irbyac(j+nrbykin)
6079 nsn =npby(2,n)
6080 IF (inloc(m)>0) ia(j)=1
6081 DO i=1,nsn
6082 id = i+k
6083 ni=lpby(id)
6084 IF (inloc(ni)>0) THEN
6085 ia(j)=1
6086 nke=inloc(ni)
6087 DO n1=1,nrow(ni)
6088 nj=icok(n1,nke)
6089 IF (inloc(nj)>0) nrow1(nj)=nrow1(nj)+1
6090 lnss= lnss+1
6091 ENDDO
6092 ENDIF
6093 ENDDO
6094 ENDDO
6095C-----main nodes traitement spec.------
6096 DO j=1,nrbyac
6097 IF (ia(j)==1) THEN
6098 n=irbyac(j)
6099 m =npby(1,n)
6100 IF (inloc(m)>0) THEN
6101 nkine=nkine-1
6102 DO i=1,numnod
6103 IF (inloc(i)>inloc(m)) inloc(i)=inloc(i)-1
6104 ENDDO
6105 ENDIF
6106 ENDIF
6107 ENDDO
6108C
6109 DO i=1,numnod
6110 nrow(i) = nrow(i)+nrow1(i)
6111 ENDDO
6112C
6113 n_impm=nkine
6114 DO j=1,nrbyac
6115 n=irbyac(j)
6116 k=irbyac(j+nrbykin)
6117 m =npby(1,n)
6118 nsn =npby(2,n)
6119 IF (ia(j)==1) THEN
6120 ndofi(m)=ndof(m)
6121 nkine=nkine+1
6122 inloc(m)=nkine
6123 DO i=1,nsn
6124 id = i+k
6125 ni=lpby(id)
6126 IF (inloc(ni)>0) THEN
6127 nrow(m)=nrow(m)+nrow(ni)
6128 ENDIF
6129 ENDDO
6130 ENDIF
6131 ENDDO
6132 n_impm=nkine-n_impm
6133 IF (nkine0>0) DEALLOCATE(icok)
6134C----6---------------------------------------------------------------7---------8
6135 RETURN
6136 END
6137!||====================================================================
6138!|| ind_kine_i ../engine/source/implicit/ind_glob_k.F
6139!||--- called by ------------------------------------------------------
6140!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
6141!||--- calls -----------------------------------------------------
6142!|| intab ../engine/source/implicit/ind_glob_k.F
6143!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6144!||--- uses -----------------------------------------------------
6145!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
6146!||====================================================================
6147 SUBROUTINE ind_kine_i(
6148 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
6149 2 NSS ,ISS ,NINT2 ,IINT2 ,IPARI ,
6150 3 INTBUF_TAB,NSS2 ,ISS2 ,NNMAX ,INLOC ,
6151 4 NKMAX ,NROWK ,ICOK ,ICOKM ,INK ,
6152 5 NDOF ,NDOF1 ,IAINT2 ,IRBE3 ,LRBE3 ,
6153 6 NSS3 ,ISS3 ,IRBE2 ,LRBE2 ,NSB2 ,
6154 7 ISB2 )
6155C-----------------------------------------------
6156C M o d u l e s
6157C-----------------------------------------------
6158 USE intbufdef_mod
6159C----6---------------------------------------------------------------7---------8
6160C I m p l i c i t T y p e s
6161C-----------------------------------------------
6162#include "implicit_f.inc"
6163C-----------------------------------------------
6164C C o m m o n B l o c k s
6165C-----------------------------------------------
6166#include "com04_c.inc"
6167#include "param_c.inc"
6168C-----------------------------------------------
6169C D u m m y A r g u m e n t s
6170C-----------------------------------------------
6171 INTEGER NNMAX,NKMAX,LRB ,LI2
6172 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
6173 . nss(*),iss(*),nint2,iint2(*),
6174 . nss2(*),iss2(*),ipari(npari,*),ndof(*),ndof1(*),
6175 . icok(nnmax,*),icokm(nkmax,*),nrowk(*)
6176 INTEGER
6177 . inloc(*),ink,iaint2(*)
6178 INTEGER IRBE3(NRBE3L,*),LRBE3(*),NSS3(*),ISS3(*),
6179 . irbe2(nrbe2l,*),lrbe2(*),nsb2(*),isb2(*)
6180
6181 TYPE(intbuf_struct_) INTBUF_TAB(*)
6182C-----------------------------------------------
6183C External function
6184C-----------------------------------------------
6185 LOGICAL INTAB
6186 EXTERNAL intab
6187C REAL
6188C-----------------------------------------------
6189C L o c a l V a r i a b l e s
6190C-----------------------------------------------
6191C------ICOK,ICOKM use the same NROWK------
6192 INTEGER NKE,NKE1,NKE2,IK,NKM1,IAD
6193 INTEGER
6194 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,k1,m1,
6195 . ji,k10,k11,k12,k13,k14,kfi,ns,nnod,nm,l1,nl1,nm1,ic
6196c----------------------
6197 k=0
6198 ns= 0
6199 DO j=1,nint2
6200 IF(iaint2(j)==1) THEN
6201 n=iint2(j)
6202 nsn = ipari(5,n)
6203 ji=ipari(1,n)
6204 k10=ji-1
6205 k11=k10+4*ipari(3,n)
6206C------IRECT(4,NSN)-----
6207 k12=k11+4*ipari(4,n)
6208C------NSV(NSN)--node number---
6209 k13=k12+nsn
6210C------MSR(NMN)-----
6211 k14=k13+ipari(6,n)
6212C------IRTL(NSN)--main el number---
6213 kfi=k14+nsn
6214 DO i=1,nsn
6215 id = i+k
6216 nss2(id)=0
6217 ni=intbuf_tab(n)%NSV(i)
6218 IF (inloc(ni)>0) THEN
6219 l=intbuf_tab(n)%IRTLM(i)
6220 nl=4*(l-1)
6221 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
6222 nnod=3
6223 ELSE
6224 nnod=4
6225 ENDIF
6226 DO m=1,nnod
6227 nm=intbuf_tab(n)%IRECTM(nl+m)
6228 nke1=inloc(nm)
6229 ndof1(nke1)=ndof(nm)
6230 DO m1=m+1,nnod
6231 nm1=intbuf_tab(n)%IRECTM(nl+m1)
6232 nkm1=inloc(nm1)
6233 CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
6234 CALL reorder_a(nrowk(nkm1),icok(1,nkm1),nm)
6235 ENDDO
6236 ENDDO
6237 nke=inloc(ni)
6238 DO n1=1,nrowk(nke)
6239 nj=icok(n1,nke)
6240 IF (inloc(nj)>0.AND.
6241 . (.NOT.intab(nsn,intbuf_tab(n)%NSV(1),nj)).
6242 . and.(.NOT.intab(nnod,intbuf_tab(n)%IRECTM(nl+1),nj))) THEN
6243 j1=ns+nss2(id)+1
6244 iss2(j1)=nj
6245 nss2(id)=nss2(id)+1
6246 nke2=inloc(nj)
6247 DO m=1,nnod
6248 nm=intbuf_tab(n)%IRECTM(nl+m)
6249 IF (inloc(nm)>0) THEN
6250 nke1=inloc(nm)
6251 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
6252 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
6253 ENDIF
6254 ENDDO
6255 ENDIF
6256 ENDDO
6257 ns=ns+nss2(id)
6258 ENDIF
6259 ENDDO
6260 k=k+nsn
6261 ENDIF
6262 ENDDO
6263C-----RBE2------
6264 k=0
6265 DO n=1,nrbe2
6266 k1=irbe2(1,n)
6267 m =irbe2(3,n)
6268 nsn =irbe2(5,n)
6269 ic = 7*512+7*64-irbe2(4,n)
6270 IF (inloc(m)>0) THEN
6271 nke1=inloc(m)
6272 ndof1(nke1)=ndof(m)
6273 nkm1=nke1
6274 DO i=1,nsn
6275 id = i+k1
6276 ni=lrbe2(id)
6277 nsb2(id)=0
6278 IF (inloc(ni)>0) THEN
6279 nke=inloc(ni)
6280 DO n1=1,nrowk(nke)
6281 nj=icok(n1,nke)
6282 nke2=inloc(nj)
6283 IF (inloc(nj)>0.AND.nj/=ni) THEN
6284 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
6285 IF (nke2<=ink) THEN
6286 CALL reorder_a(nrowk(nke2),icok(1,nke2),m)
6287 ELSE
6288 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),m)
6289 END IF
6290 k=k+1
6291 isb2(k)=nj
6292 nsb2(id)=nsb2(id)+1
6293 END IF
6294 END DO
6295 IF (ic>0) THEN
6296 CALL reorder_a(nrowk(nke1),icok(1,nke1),ni)
6297 CALL reorder_a(nrowk(nke),icok(1,nke),m)
6298 END IF
6299 END IF
6300 END DO
6301 END IF
6302 END DO
6303c---------RBE3-------------
6304 k = 0
6305 DO n=1,nrbe3
6306 iad = irbe3(1,n)
6307 ni = irbe3(3,n)
6308 nss3(n)= 0
6309 IF (ni==0) cycle
6310 nnod = irbe3(5,n)
6311 IF (inloc(ni)>0) THEN
6312 DO m=1,nnod
6313 nm=lrbe3(iad+m)
6314 nke1=inloc(nm)
6315 ndof1(nke1)=ndof(nm)
6316 DO m1=m+1,nnod
6317 nm1=lrbe3(iad+m1)
6318 nkm1=inloc(nm1)
6319 IF (nke1<=ink) THEN
6320 CALL reorder_a(nrowk(nke1),icok(1,nke1),nm1)
6321 ELSE
6322 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nm1)
6323 ENDIF
6324
6325 IF (nkm1<=ink) THEN
6326 CALL reorder_a(nrowk(nkm1),icok(1,nkm1),nm)
6327 ELSE
6328 CALL reorder_a(nrowk(nkm1),icokm(1,nkm1-ink),nm)
6329 ENDIF
6330 ENDDO
6331 ENDDO
6332 nke=inloc(ni)
6333 DO n1=1,nrowk(nke)
6334 IF (nke<=ink) THEN
6335 nj=icok(n1,nke)
6336 ELSE
6337 nj=icokm(n1,nke-ink)
6338 END IF
6339 IF (inloc(nj)>0.AND.
6340 . (.NOT.intab(nnod,lrbe3(iad+1),nj))) THEN
6341 nss3(n)= nss3(n)+1
6342 k= k+1
6343 iss3(k)=nj
6344 nke2=inloc(nj)
6345 DO m=1,nnod
6346 nm=lrbe3(iad+m)
6347 IF (inloc(nm)>0) THEN
6348 nke1=inloc(nm)
6349 IF (nke1<=ink) THEN
6350 CALL reorder_a(nrowk(nke1),icok(1,nke1),nj)
6351 ELSE
6352 CALL reorder_a(nrowk(nke1),icokm(1,nke1-ink),nj)
6353 ENDIF
6354
6355 IF (nke2<=ink) THEN
6356 CALL reorder_a(nrowk(nke2),icok(1,nke2),nm)
6357 ELSE
6358 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),nm)
6359 ENDIF
6360 ENDIF
6361 ENDDO
6362 ENDIF
6363 ENDDO
6364 ENDIF
6365 ENDDO
6366C-----active rigid body main nodes------
6367 k=0
6368 ns= 0
6369 DO j=1,nrbyac
6370 n=irbyac(j)
6371 k1=irbyac(j+nrbykin)
6372 m =npby(1,n)
6373 nsn =npby(2,n)
6374 IF (inloc(m)>0) THEN
6375 nke1=inloc(m)
6376 ndof1(nke1)=ndof(m)
6377 nkm1=nke1-ink
6378 DO i=1,nsn
6379 id = i+k
6380 ni=lpby(i+k1)
6381 nss(id)=0
6382 IF (inloc(ni)>0) THEN
6383 nke=inloc(ni)
6384 DO n1=1,nrowk(nke)
6385 nj=icok(n1,nke)
6386 nke2=inloc(nj)
6387 IF (inloc(nj)>0.AND.
6388 . (.NOT.intab(nsn,lpby(k1+1),nj))) THEN
6389 CALL reorder_a(nrowk(nke1),icokm(1,nkm1),nj)
6390 IF (nke2<=ink) THEN
6391 CALL reorder_a(nrowk(nke2),icok(1,nke2),m)
6392 j1=ns+nss(id)+1
6393 iss(j1)=nj
6394 nss(id)=nss(id)+1
6395 ELSE
6396 CALL reorder_a(nrowk(nke2),icokm(1,nke2-ink),m)
6397 ENDIF
6398 ENDIF
6399 ENDDO
6400 ns=ns+nss(id)
6401 ENDIF
6402 ENDDO
6403 ENDIF
6404 k=k+nsn
6405 ENDDO
6406C----6---------------------------------------------------------------7---------8
6407 RETURN
6408 END
6409!||====================================================================
6410!|| row_int11 ../engine/source/implicit/ind_glob_k.F
6411!||--- called by ------------------------------------------------------
6412!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
6413!||====================================================================
6414 SUBROUTINE row_int11(
6415 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
6416 2 NROW ,ILOC ,NDOFI ,N_IMPN ,NSN ,
6417 3 NSREM )
6418C----6---------------------------------------------------------------7---------8
6419C I m p l i c i t T y p e s
6420C-----------------------------------------------
6421#include "implicit_f.inc"
6422C-----------------------------------------------
6423C D u m m y A r g u m e n t s
6424C-----------------------------------------------
6425 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),NROW(*),
6426 . iloc(*),ndofi,n_impn,nsn,nsrem
6427C-----------------------------------------------
6428C L o c a l V a r i a b l e s
6429C-----------------------------------------------
6430 INTEGER I,J,N,N1,N2,NE,IG,M1,M2
6431C-----------------------------------------------
6432 DO i = 1, jlt
6433C--------secnd node-----
6434 ig = ns_imp(i)
6435 IF (ig<=nsn) THEN
6436 n1 = irects(1,ig)
6437 n2 = irects(2,ig)
6438 IF (iloc(n1)==0) THEN
6439 n_impn=n_impn+1
6440 iloc(n1)=n_impn
6441 ENDIF
6442 nrow(n1)=nrow(n1)+2
6443 IF (iloc(n2)==0) THEN
6444 n_impn=n_impn+1
6445 iloc(n2)=n_impn
6446 ENDIF
6447 nrow(n2)=nrow(n2)+2
6448 ELSE
6449 nsrem = nsrem + 2
6450 ENDIF
6451 ne=ne_imp(i)
6452 m1 = irectm(1,ne)
6453 m2 = irectm(2,ne)
6454 IF (iloc(m1)==0) THEN
6455 n_impn=n_impn+1
6456 iloc(m1)=n_impn
6457 ENDIF
6458 nrow(m1)=nrow(m1)+2
6459 IF (iloc(m2)==0) THEN
6460 n_impn=n_impn+1
6461 iloc(m2)=n_impn
6462 ENDIF
6463 nrow(m2)=nrow(m2)+2
6464 ENDDO
6465C----6---------------------------------------------------------------7---------8
6466 RETURN
6467 END
6468!||====================================================================
6469!|| row_int111 ../engine/source/implicit/ind_glob_k.F
6470!||--- called by ------------------------------------------------------
6471!|| dim_kine_i ../engine/source/implicit/ind_glob_k.F
6472!||--- calls -----------------------------------------------------
6473!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6474!||====================================================================
6475 SUBROUTINE row_int111(
6476 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
6477 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
6478 3 NSN )
6479C----6---------------------------------------------------------------7---------8
6480C I m p l i c i t T y p e s
6481C-----------------------------------------------
6482#include "implicit_f.inc"
6483C-----------------------------------------------
6484C D u m m y A r g u m e n t s
6485C-----------------------------------------------
6486 INTEGER NNMAX
6487 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),
6488 . nrow(*),iloc(*),icol(nnmax,*),n_impn,nsn
6489C REAL
6490C-----------------------------------------------
6491C L o c a l V a r i a b l e s
6492C-----------------------------------------------
6493 INTEGER I,J,N,N1,N2,NE,IG,NI,M1,M2,NJ,MI,MJ
6494C-----------------------------------------------
6495C---------ICOL : LOCAL NODE NUMBER--------
6496 DO i = 1, jlt
6497C--------secnd node-----
6498 ig = ns_imp(i)
6499 IF (ig<=nsn) THEN
6500 n1 = irects(1,ig)
6501 n2 = irects(2,ig)
6502 ne=ne_imp(i)
6503 m1 = irectm(1,ne)
6504 m2 = irectm(2,ne)
6505 ni=iloc(n1)
6506 mi=iloc(m1)
6507 mj=iloc(m2)
6508 CALL reorder_a(nrow(n1),icol(1,ni),m1)
6509 CALL reorder_a(nrow(m1),icol(1,mi),n1)
6510 CALL reorder_a(nrow(n1),icol(1,ni),m2)
6511 CALL reorder_a(nrow(m2),icol(1,mj),n1)
6512 nj=iloc(n2)
6513 CALL reorder_a(nrow(n2),icol(1,nj),m1)
6514 CALL reorder_a(nrow(m1),icol(1,mi),n2)
6515 CALL reorder_a(nrow(n2),icol(1,nj),m2)
6516 CALL reorder_a(nrow(m2),icol(1,mj),n2)
6517 ENDIF
6518 ENDDO
6519C----6---------------------------------------------------------------7---------8
6520 RETURN
6521 END
6522!||====================================================================
6523!|| row_int112 ../engine/source/implicit/ind_glob_k.F
6524!||--- called by ------------------------------------------------------
6525!|| ind_int_k ../engine/source/implicit/ind_glob_k.f
6526!||--- calls -----------------------------------------------------
6527!|| row_adds ../engine/source/implicit/ind_glob_k.F
6528!||====================================================================
6529 SUBROUTINE row_int112(
6530 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
6531 2 NROW ,N_IMPN ,ILOC ,ICOL ,NNMAX ,
6532 3 ICOK ,NKMAX ,NSN )
6533C----6---------------------------------------------------------------7---------8
6534C I m p l i c i t T y p e s
6535C-----------------------------------------------
6536#include "implicit_f.inc"
6537C-----------------------------------------------
6538C D u m m y A r g u m e n t s
6539C-----------------------------------------------
6540 INTEGER NNMAX,NKMAX
6541 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),NROW(*),
6542 . iloc(*),icol(nnmax,*),icok(nkmax,*),n_impn,nsn
6543C REAL
6544C-----------------------------------------------
6545C L o c a l V a r i a b l e s
6546C-----------------------------------------------
6547 INTEGER I,J,N,N1,N2,NE,IG,NI,NM,NIM,M1,M2
6548C-----------------------------------------------
6549C---------ICOL : LOCAL NODE NUMBER--------
6550 DO i = 1, jlt
6551C--------secnd node-----
6552 ig = ns_imp(i)
6553 IF (ig<=nsn) THEN
6554 n1 = irects(1,ig)
6555 n2 = irects(2,ig)
6556 ne=ne_imp(i)
6557 m1 = irectm(1,ne)
6558 m2 = irectm(2,ne)
6559 CALL row_adds(n1 ,m1 ,iloc ,n_impn ,icol ,
6560 1 icok ,nrow ,nnmax ,nkmax )
6561 CALL row_adds(n1 ,m2 ,iloc ,n_impn ,icol ,
6562 1 icok ,nrow ,nnmax ,nkmax )
6563 CALL row_adds(n2 ,m1 ,iloc ,n_impn ,icol ,
6564 1 icok ,nrow ,nnmax ,nkmax )
6565 CALL row_adds(n2 ,m2 ,iloc ,n_impn ,icol ,
6566 1 icok ,nrow ,nnmax ,nkmax )
6567 END IF
6568 ENDDO
6569C----6---------------------------------------------------------------7---------8
6570 RETURN
6571 END
6572!||====================================================================
6573!|| row_adds ../engine/source/implicit/ind_glob_k.F
6574!||--- called by ------------------------------------------------------
6575!|| row_int112 ../engine/source/implicit/ind_glob_k.F
6576!||--- calls -----------------------------------------------------
6577!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6578!||====================================================================
6579 SUBROUTINE row_adds(NS ,NM ,ILOC ,ISHF ,ICOL ,
6580 1 ICOK ,NROW ,NNMAX ,NKMAX )
6581C----6---------------------------------------------------------------7---------8
6582C I m p l i c i t T y p e s
6583C-----------------------------------------------
6584#include "implicit_f.inc"
6585C-----------------------------------------------------------------
6586C D u m m y A r g u m e n t s
6587C-----------------------------------------------
6588 INTEGER NNMAX,NKMAX,NS,NM
6589 INTEGER NROW(*) ,ILOC(*) ,ISHF ,ICOL(NNMAX,*),ICOK(NKMAX,*)
6590C-----------------------------------------------
6591C L o c a l V a r i a b l e s
6592C-----------------------------------------------
6593 INTEGER N1,N2,N
6594C
6595C----6---------------------------------------------------------------7---------8
6596 n1 =iloc(ns)
6597 n2 =iloc(nm)
6598 IF (n1<=ishf) THEN
6599 CALL reorder_a(nrow(n1),icol(1,n1),nm)
6600 ELSE
6601 n=n1- ishf
6602 CALL reorder_a(nrow(n1),icok(1,n),nm)
6603 ENDIF
6604 IF (n2<=ishf) THEN
6605 CALL reorder_a(nrow(n2),icol(1,n2),ns)
6606 ELSE
6607 n=n2- ishf
6608 CALL reorder_a(nrow(n2),icok(1,n),ns)
6609 ENDIF
6610 RETURN
6611 END
6612!||====================================================================
6613!|| idel_int ../engine/source/implicit/ind_glob_k.F
6614!||--- called by ------------------------------------------------------
6615!|| imp_chkm ../engine/source/implicit/imp_solv.F
6616!|| imp_solv ../engine/source/implicit/imp_solv.F
6617!||--- calls -----------------------------------------------------
6618!|| ndof_int ../engine/source/implicit/ind_glob_k.F
6619!|| ndof_int11 ../engine/source/implicit/ind_glob_k.F
6620!|| ndof_int5 ../engine/source/implicit/ind_glob_k.F
6621!||--- uses -----------------------------------------------------
6622!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
6623!||====================================================================
6624 SUBROUTINE idel_int(
6625 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
6626 2 IND_IMP ,NDOF ,NT_IMP )
6627C-----------------------------------------------
6628C M o d u l e s
6629C-----------------------------------------------
6630 USE intbufdef_mod
6631C----6---------------------------------------------------------------7---------8
6632C I m p l i c i t T y p e s
6633C-----------------------------------------------
6634#include "implicit_f.inc"
6635C-----------------------------------------------
6636C C o m m o n B l o c k s
6637C-----------------------------------------------
6638#include "com01_c.inc"
6639#include "com04_c.inc"
6640#include "param_c.inc"
6641C-----------------------------------------------
6642C D u m m y A r g u m e n t s
6643C-----------------------------------------------
6644 INTEGER IPARI(NPARI,*),NUM_IMP(*),IND_IMP(*),
6645 . NS_IMP(*),NE_IMP(*),NDOF(*),NT_IMP
6646C REAL
6647
6648 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
6649C-----------------------------------------------
6650C L o c a l V a r i a b l e s
6651C-----------------------------------------------
6652 INTEGER NIN,NTY,NSN
6653 INTEGER I,J,K,L,NDOFI,N,IAD,N_IMP,NRTS,IDEL(NT_IMP),NEW_IAD
6654C--------ramener NDOF des secnds remotes-----------------------------------
6655 IF (NSPMD>1) THEN
6656 ENDIF
6657C
6658 iad=1
6659C MULTIMP=1
6660 n_imp=0
6661 DO nin=1,ninter
6662 nty =ipari(7,nin)
6663 nsn =ipari(5,nin)
6664C MULTIMP=MAX(MULTIMP,IPARI(23,NIN))
6665 IF(nty==3)THEN
6666 ELSEIF(nty==4)THEN
6667 ELSEIF(nty==5)THEN
6668 CALL ndof_int5(num_imp(nin),ns_imp(iad),ne_imp(iad),intbuf_tab(nin)%IRECTM,
6669 . intbuf_tab(nin)%NSV,nsn ,ndof ,idel(iad) ,
6670 . intbuf_tab(nin)%MSR)
6671 iad=iad+num_imp(nin)
6672 ENDIF
6673 ENDDO
6674 DO nin=1,ninter
6675 nty =ipari(7,nin)
6676 nsn =ipari(5,nin)
6677C MULTIMP=MAX(MULTIMP,IPARI(23,NIN))
6678 IF(nty==3)THEN
6679 ELSEIF(nty==4)THEN
6680 ELSEIF(nty==5)THEN
6681 ELSEIF(nty==6)THEN
6682
6683 ELSEIF(nty==7.OR.nty==10.OR.nty==24)THEN
6684C
6685 CALL ndof_int(num_imp(nin),ns_imp(iad),ne_imp(iad),intbuf_tab(nin)%IRECTM,
6686 . intbuf_tab(nin)%NSV,nsn ,ndof ,idel(iad) )
6687 iad=iad+num_imp(nin)
6688 ELSEIF(nty==11)THEN
6689C
6690 nrts =ipari(3,nin)
6691 CALL ndof_int11(num_imp(nin),ns_imp(iad),ne_imp(iad),
6692 . intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%IRECTM,nrts ,
6693 . ndof ,idel(iad) )
6694 iad=iad+num_imp(nin)
6695 ENDIF
6696 ENDDO
6697C-------actualise NUM_IMP,NS_IMP,NE_IMP,IND_IMP-------
6698 new_iad = 0
6699 iad=1
6700C-------int5 first------
6701 DO nin=1,ninter
6702 n_imp=0
6703 nty =ipari(7,nin)
6704 IF (nty==5) THEN
6705 DO i= 1,num_imp(nin)
6706 IF (idel(iad+i)>0) THEN
6707 new_iad = new_iad + 1
6708 ns_imp(new_iad)=ns_imp(iad+i)
6709 ne_imp(new_iad)=ne_imp(iad+i)
6710 ind_imp(new_iad)=ind_imp(iad+i)
6711 n_imp = n_imp + 1
6712 ENDIF
6713 ENDDO
6714 iad=iad+num_imp(nin)
6715 num_imp(nin) = n_imp
6716 END IF
6717 ENDDO
6718 DO nin=1,ninter
6719 n_imp=0
6720 IF (nty/=5) THEN
6721 DO i= 1,num_imp(nin)
6722 IF (idel(iad+i)>0) THEN
6723 new_iad = new_iad + 1
6724 ns_imp(new_iad)=ns_imp(iad+i)
6725 ne_imp(new_iad)=ne_imp(iad+i)
6726 ind_imp(new_iad)=ind_imp(iad+i)
6727 n_imp = n_imp + 1
6728 ENDIF
6729 ENDDO
6730 iad=iad+num_imp(nin)
6731 num_imp(nin) = n_imp
6732 END IF
6733 ENDDO
6734C----6---------------------------------------------------------------7---------8
6735 RETURN
6736 END
6737!||====================================================================
6738!|| ndof_int ../engine/source/implicit/ind_glob_k.F
6739!||--- called by ------------------------------------------------------
6740!|| idel_int ../engine/source/implicit/ind_glob_k.F
6741!||====================================================================
6742 SUBROUTINE ndof_int(
6743 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
6744 2 NSN ,NDOF ,IDEL_INT )
6745C----6---------------------------------------------------------------7---------8
6746C I m p l i c i t T y p e s
6747C-----------------------------------------------
6748#include "implicit_f.inc"
6749C-----------------------------------------------
6750C D u m m y A r g u m e n t s
6751C-----------------------------------------------
6752 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),
6753 . IDEL_INT(*),NDOF(*),NSN
6754C REAL
6755C-----------------------------------------------
6756C L o c a l V a r i a b l e s
6757C-----------------------------------------------
6758 INTEGER I,J,N,N1,N2,NE,IG
6759C-----------------------------------------------
6760 DO i = 1, jlt
6761C--------secnd node-----
6762 ig = ns_imp(i)
6763 IF (ig<=nsn) THEN
6764 n1 = nsv(ig)
6765 idel_int(i) = ndof(n1)
6766 ELSE
6767 ENDIF
6768 ne=ne_imp(i)
6769 DO j=1,3
6770 n=irect(j,ne)
6771 idel_int(i) = min(idel_int(i),ndof(n))
6772 ENDDO
6773 IF (irect(3,ne)/=irect(4,ne)) THEN
6774 n=irect(4,ne)
6775 idel_int(i) = min(idel_int(i),ndof(n))
6776 ENDIF
6777 ENDDO
6778C----6---------------------------------------------------------------7---------8
6779 RETURN
6780 END
6781!||====================================================================
6782!|| ndof_int11 ../engine/source/implicit/ind_glob_k.F
6783!||--- called by ------------------------------------------------------
6784!|| idel_int ../engine/source/implicit/ind_glob_k.F
6785!||====================================================================
6786 SUBROUTINE ndof_int11(
6787 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
6788 2 NSN ,NDOF ,IDEL_INT )
6789C----6---------------------------------------------------------------7---------8
6790C I m p l i c i t T y p e s
6791C-----------------------------------------------
6792#include "implicit_f.inc"
6793C-----------------------------------------------
6794C D u m m y A r g u m e n t s
6795C-----------------------------------------------
6796 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),
6797 . IDEL_INT(*),NDOF(*),NSN
6798C REAL
6799C-----------------------------------------------
6800C L o c a l V a r i a b l e s
6801C-----------------------------------------------
6802 INTEGER I,J,N,N1,N2,NE,IG,M1,M2
6803C-----------------------------------------------
6804 DO I = 1, jlt
6805C--------secnd node-----
6806 ig = ns_imp(i)
6807 IF (ig<=nsn) THEN
6808 n1 = irects(1,ig)
6809 idel_int(i) = ndof(n1)
6810 n2 = irects(2,ig)
6811 idel_int(i) = min(idel_int(i),ndof(n2))
6812 ELSE
6813 ENDIF
6814 ne=ne_imp(i)
6815 m1 = irectm(1,ne)
6816 m2 = irectm(2,ne)
6817 idel_int(i) = min(idel_int(i),ndof(m1))
6818 idel_int(i) = min(idel_int(i),ndof(m2))
6819 ENDDO
6820C----6---------------------------------------------------------------7---------8
6821 RETURN
6822 END
6823!||====================================================================
6824!|| ndof_int5 ../engine/source/implicit/ind_glob_k.F
6825!||--- called by ------------------------------------------------------
6826!|| idel_int ../engine/source/implicit/ind_glob_k.F
6827!||====================================================================
6828 SUBROUTINE ndof_int5(
6829 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
6830 2 NSN ,NDOF ,IDEL_INT ,MSR )
6831C----6---------------------------------------------------------------7---------8
6832C I m p l i c i t T y p e s
6833C-----------------------------------------------
6834#include "implicit_f.inc"
6835C-----------------------------------------------
6836C D u m m y A r g u m e n t s
6837C-----------------------------------------------
6838 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),
6839 . IDEL_INT(*),NDOF(*),NSN,MSR(*)
6840C REAL
6841C-----------------------------------------------
6842C L o c a l V a r i a b l e s
6843C-----------------------------------------------
6844 INTEGER I,J,N,N1,N2,NE,IG
6845C-----------------------------------------------
6846 DO i = 1, jlt
6847C--------secnd node-----
6848 ig = ns_imp(i)
6849 n1 = nsv(ig)
6850 idel_int(i) = ndof(n1)
6851 ne=ne_imp(i)
6852 DO j=1,3
6853 n=msr(irect(j,ne))
6854 idel_int(i) = min(idel_int(i),ndof(n))
6855 ENDDO
6856 IF (irect(3,ne)/=irect(4,ne)) THEN
6857 n=msr(irect(4,ne))
6858 idel_int(i) = min(idel_int(i),ndof(n))
6859 ENDIF
6860 ENDDO
6861C----6---------------------------------------------------------------7---------8
6862 RETURN
6863 END
6864!||====================================================================
6865!|| dim_spa2 ../engine/source/implicit/ind_glob_k.F
6866!||--- calls -----------------------------------------------------
6867!|| cp_int ../engine/source/implicit/produt_v.F
6868!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6869!||====================================================================
6870 SUBROUTINE dim_spa2(NDDL,IADK,JDIK,L_NZ)
6871C-----------------------------------------------
6872C I m p l i c i t T y p e s
6873C-----------------------------------------------
6874#include "implicit_f.inc"
6875C-----------------------------------------------
6876C D u m m y A r g u m e n t s
6877C-----------------------------------------------
6878 INTEGER NDDL,IADK(*),JDIK(*),L_NZ
6879C-----------------------------------------------
6880C L o c a l V a r i a b l e s
6881C-----------------------------------------------
6882 INTEGER I,J,K,JD,ICOL(NDDL),NRI
6883C-----------------------------------------------
6884 l_nz = 0
6885 DO i = 1,nddl
6886 nri = iadk(i+1)-iadk(i)
6887 CALL cp_int(nri,jdik(iadk(i)),icol)
6888 DO j=iadk(i),iadk(i+1)-1
6889 jd = jdik(j)
6890 DO k = iadk(jd),iadk(jd+1)-1
6891 CALL reorder_a(nri,icol,jdik(k))
6892 ENDDO
6893 ENDDO
6894 l_nz = l_nz + nri
6895 ENDDO
6896C--------------------------------------------
6897 RETURN
6898 END
6899!||====================================================================
6900!|| ind_spa2 ../engine/source/implicit/ind_glob_k.f
6901!||--- calls -----------------------------------------------------
6902!|| cp_int ../engine/source/implicit/produt_v.F
6903!|| k_band ../engine/source/implicit/imp_solv.F
6904!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6905!|| reorder_m ../engine/source/implicit/ind_glob_k.F
6906!||====================================================================
6907 SUBROUTINE ind_spa2(NDDL,IADK,JDIK,IADM,JDIM,L_MAX)
6908C-----------------------------------------------
6909C I m p l i c i t T y p e s
6910C-----------------------------------------------
6911#include "implicit_f.inc"
6912C-----------------------------------------------
6913C D u m m y A r g u m e n t s
6914C-----------------------------------------------
6915 INTEGER NDDL,IADK(*),JDIK(*),IADM(*),JDIM(*),L_MAX
6916C-----------------------------------------------
6917C L o c a l V a r i a b l e s
6918C-----------------------------------------------
6919 INTEGER I,J,K,ICOL(NDDL),L_NZ,NRI,JD
6920C----6--------opt. envisager-creer a partir de tableux nodales--,iadm,jdim+upd_(chaque isetk)
6921 L_NZ = 0
6922 iadm(l_nz+1) = l_nz+1
6923 DO i = 1,nddl
6924 nri = iadk(i+1)-iadk(i)
6925 CALL cp_int(nri,jdik(iadk(i)),icol)
6926 DO j=iadk(i),iadk(i+1)-1
6927 jd = jdik(j)
6928 DO k = iadk(jd),iadk(jd+1)-1
6929 CALL reorder_a(nri,icol,jdik(k))
6930 ENDDO
6931 ENDDO
6932 CALL reorder_m(nri,icol)
6933 DO j=1,nri
6934 l_nz = l_nz + 1
6935 jdim(l_nz) = icol(j)
6936 ENDDO
6937 iadm(i+1) = l_nz+1
6938 ENDDO
6939 CALL k_band(nddl,iadm,jdim,l_max)
6940C--------------------------------------------
6941 RETURN
6942 END
6943!||====================================================================
6944!|| reorder_m ../engine/source/implicit/ind_glob_k.F
6945!||--- called by ------------------------------------------------------
6946!|| dim_span ../engine/source/implicit/ind_glob_k.F
6947!|| ind_spa2 ../engine/source/implicit/ind_glob_k.F
6948!|| ind_span ../engine/source/implicit/ind_glob_k.F
6949!||====================================================================
6950 SUBROUTINE reorder_m(N,IC)
6951C----6---------------------------------------------------------------7---------8
6952C I m p l i c i t T y p e s
6953C-----------------------------------------------
6954#include "implicit_f.inc"
6955C-----------------------------------------------------------------
6956C D u m m y A r g u m e n t s
6957C-----------------------------------------------
6958 INTEGER N ,IC(*)
6959C-----------------------------------------------
6960C L o c a l V a r i a b l e s
6961C-----------------------------------------------
6962 INTEGER I,J,II,IT,IMIN
6963C
6964 IF (N==0) return
6965C-----en ordre croisante-----
6966 DO i =1,n
6967 imin=ic(i)
6968 ii=i
6969 DO j =i+1,n
6970 IF (ic(j)<imin) THEN
6971 imin=ic(j)
6972 ii=j
6973 ENDIF
6974 ENDDO
6975 IF (ii/=i) THEN
6976 it=ic(i)
6977 ic(i)=ic(ii)
6978 ic(ii)=it
6979 ENDIF
6980 ENDDO
6981C----6---------------------------------------------------------------7---------8
6982 RETURN
6983 END
6984!||====================================================================
6985!|| dim_span ../engine/source/implicit/ind_glob_k.F
6986!||--- called by ------------------------------------------------------
6987!|| imp_sol_init ../engine/source/implicit/imp_sol_init.f
6988!|| ini_k0h ../engine/source/implicit/imp_solv.F
6989!||--- calls -----------------------------------------------------
6990!|| cp_int ../engine/source/implicit/produt_v.F
6991!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6992!|| reorder_m ../engine/source/implicit/ind_glob_k.F
6993!||--- uses -----------------------------------------------------
6994!|| imp_ppat ../engine/share/modules/impbufdef_mod.F
6995!||====================================================================
6996 SUBROUTINE dim_span(NN,NDDL,IADK,JDIK,L_NZ,NDMAX)
6997C-----------------------------------------------
6998C M o d u l e s
6999C-----------------------------------------------
7000 USE imp_ppat
7001C-----------------------------------------------
7002C I m p l i c i t T y p e s
7003C-----------------------------------------------
7004#include "implicit_f.inc"
7005C-----------------------------------------------
7006C D u m m y A r g u m e n t s
7007C-----------------------------------------------
7008 INTEGER NDDL,IADK(*),JDIK(*),L_NZ,NN,NDMAX
7009C-----------------------------------------------
7010C L o c a l V a r i a b l e s
7011C-----------------------------------------------
7012 INTEGER I,J,K,JD,ICOL(NDDL),ICRI(NDDL),NRI,NR0
7013 INTEGER, DIMENSION(:),ALLOCATABLE :: IADK0,JDIK0
7014 INTEGER, DIMENSION(:),ALLOCATABLE :: IADL,JDIL
7015C----6---d'abord---K0:matrice complete(non triang)
7016 l_nz = 2*(iadk(nddl+1)-iadk(1))
7017 ALLOCATE(iadk0(nddl+1),jdik0(l_nz))
7018 DO i = 1, nddl
7019 icol(i) = iadk(i+1) - iadk(i)
7020 DO j = iadk(i),iadk(i+1)-1
7021 jd = jdik(j)
7022 icol(jd) = icol(jd) + 1
7023 ENDDO
7024 ENDDO
7025 iadk0(1) = 1
7026 DO i = 1,nddl
7027 iadk0(i+1) = iadk0(i)+icol(i)
7028 icri(i) = pre_fpat(i)
7029 ENDDO
7030 DO i = 1,nddl
7031 nri = iadk(i+1)-iadk(i)
7032 CALL cp_int(nri,jdik(iadk(i)),jdik0(iadk0(i)))
7033 icol(i) = nri
7034 DO j=iadk(i),iadk(i+1)-1
7035 jd = jdik(j)
7036 k = iadk0(jd) + icol(jd)
7037 jdik0(k) = i
7038 icol(jd) = icol(jd) + 1
7039 ENDDO
7040 ENDDO
7041C
7042 l_nz = 0
7043 DO i = 1,nddl
7044 nri = iadk(i+1)-iadk(i)
7045 IF (icri(i)==1) THEN
7046 CALL cp_int(nri,jdik(iadk(i)),icol)
7047 DO j=iadk(i),iadk(i+1)-1
7048 jd = jdik(j)
7049 DO k = iadk0(jd),iadk0(jd+1)-1
7050 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7051 ENDDO
7052 ENDDO
7053 ENDIF
7054 l_nz = l_nz + nri
7055 ENDDO
7056C
7057 SELECT CASE(nn)
7058 CASE (2)
7059C
7060 CASE (3)
7061C-----------L->K^2----------
7062 ALLOCATE(iadl(nddl+1),jdil(l_nz))
7063 iadl(1) = 1
7064 l_nz = 0
7065 DO i = 1,nddl
7066 nri = iadk(i+1)-iadk(i)
7067 CALL cp_int(nri,jdik(iadk(i)),icol)
7068 IF (icri(i)==1) THEN
7069 nr0 = nri
7070 DO j=iadk(i),iadk(i+1)-1
7071 jd = jdik(j)
7072 DO k = iadk0(jd),iadk0(jd+1)-1
7073 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7074 ENDDO
7075 ENDDO
7076 IF (nri>nr0) CALL reorder_m(nri,icol)
7077 ENDIF
7078 DO j=1,nri
7079 l_nz = l_nz + 1
7080 jdil(l_nz) = icol(j)
7081 ENDDO
7082 iadl(i+1) = l_nz+1
7083 ENDDO
7084c print *,'nddl,L_NZ,NDMAX=',nddl,L_NZ,NDMAX
7085C---- ---------*K0------------
7086 l_nz = 0
7087 DO i = 1,nddl
7088 nri = iadl(i+1)-iadl(i)
7089 IF (icri(i)==1) THEN
7090 CALL cp_int(nri,jdil(iadl(i)),icol)
7091 DO j=iadl(i),iadl(i+1)-1
7092 jd = jdil(j)
7093 DO k = iadk0(jd),iadk0(jd+1)-1
7094 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7095 ENDDO
7096 ENDDO
7097 ENDIF
7098 l_nz = l_nz + nri
7099 ENDDO
7100 DEALLOCATE(iadl,jdil)
7101C
7102 CASE (4)
7103C-----------L->K^2----------
7104 ALLOCATE(iadl(nddl+1),jdil(l_nz))
7105 iadl(1) = 1
7106 l_nz = 0
7107 DO i = 1,nddl
7108 nri = iadk(i+1)-iadk(i)
7109 CALL cp_int(nri,jdik(iadk(i)),icol)
7110 IF (icri(i)==1) THEN
7111 nr0 = nri
7112 DO j=iadk(i),iadk(i+1)-1
7113 jd = jdik(j)
7114 DO k = iadk0(jd),iadk0(jd+1)-1
7115 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7116 ENDDO
7117 ENDDO
7118 IF (nri>nr0) CALL reorder_m(nri,icol)
7119 ENDIF
7120 DO j=1,nri
7121 l_nz = l_nz + 1
7122 jdil(l_nz) = icol(j)
7123 ENDDO
7124 iadl(i+1) = l_nz+1
7125 ENDDO
7126C-----------K0-> K^2-complet---------
7127 DEALLOCATE(jdik0)
7128 ALLOCATE(jdik0(2*l_nz))
7129 DO i = 1, nddl
7130 icol(i) = iadl(i+1) - iadl(i)
7131 DO j = iadl(i),iadl(i+1)-1
7132 jd = jdil(j)
7133 icol(jd) = icol(jd) + 1
7134 ENDDO
7135 ENDDO
7136 iadk0(1) = 1
7137 DO i = 1,nddl
7138 iadk0(i+1) = iadk0(i)+icol(i)
7139 ENDDO
7140 DO i = 1,nddl
7141 nri = iadl(i+1)-iadl(i)
7142 CALL cp_int(nri,jdil(iadl(i)),jdik0(iadk0(i)))
7143 icol(i) = nri
7144 DO j=iadl(i),iadl(i+1)-1
7145 jd = jdil(j)
7146 k = iadk0(jd) + icol(jd)
7147 jdik0(k) = i
7148 icol(jd) = icol(jd) + 1
7149 ENDDO
7150 ENDDO
7151C-----------* K^2----------
7152 l_nz = 0
7153 DO i = 1,nddl
7154 nri = iadl(i+1)-iadl(i)
7155 CALL cp_int(nri,jdil(iadl(i)),icol)
7156 IF (icri(i)==1) THEN
7157 DO j=iadl(i),iadl(i+1)-1
7158 jd = jdil(j)
7159 DO k = iadk0(jd),iadk0(jd+1)-1
7160 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7161 ENDDO
7162 ENDDO
7163 ENDIF
7164 l_nz = l_nz + nri
7165 ENDDO
7166 DEALLOCATE(iadl,jdil)
7167 END SELECT
7168 DEALLOCATE(iadk0,jdik0)
7169c print *,'DIM_NZ,nddl=',L_NZ,nddl
7170C--------------------------------------------
7171 RETURN
7172 END
7173!||====================================================================
7174!|| ind_span ../engine/source/implicit/ind_glob_k.F
7175!||--- called by ------------------------------------------------------
7176!|| lin_solvih2 ../engine/source/implicit/lin_solv.F
7177!||--- calls -----------------------------------------------------
7178!|| cp_int ../engine/source/implicit/produt_v.F
7179!|| k_band ../engine/source/implicit/imp_solv.F
7180!|| reorder_a ../engine/source/implicit/ind_glob_k.F
7181!|| reorder_m ../engine/source/implicit/ind_glob_k.F
7182!||--- uses -----------------------------------------------------
7183!|| imp_ppat ../engine/share/modules/impbufdef_mod.F
7184!||====================================================================
7185 SUBROUTINE ind_span(NN,NDF,NDDL,IADK,JDIK,IADM,JDIM,L_MAX,NDMAX)
7186C-----------------------------------------------
7187C M o d u l e s
7188C-----------------------------------------------
7189 USE imp_ppat
7190C-----------------------------------------------
7191C I m p l i c i t T y p e s
7192C-----------------------------------------------
7193#include "implicit_f.inc"
7194C-----------------------------------------------
7195C D u m m y A r g u m e n t s
7196C-----------------------------------------------
7197 INTEGER NDDL,IADK(*),JDIK(*),IADM(*),JDIM(*),L_MAX,NN,NDF,NDMAX
7198C REAL
7199C-----------------------------------------------
7200C L o c a l V a r i a b l e s
7201C-----------------------------------------------
7202 INTEGER I,J,K,ICOL(NDDL),ICRI(NDDL),L_NZ,NRI,JD,NR0
7203 INTEGER, DIMENSION(:),ALLOCATABLE :: IADK0,JDIK0
7204 INTEGER, DIMENSION(:),ALLOCATABLE :: IADL,JDIL
7205C----6--opt. envisager-creer a partir de tableux nodales--,iadm,jdim+upd_(chaque isetk)
7206 l_nz = 2*(iadk(nddl+1)-iadk(1))
7207C
7208 ALLOCATE(iadk0(nddl+1),jdik0(l_nz))
7209 DO i = 1, nddl
7210 icol(i) = iadk(i+1) - iadk(i)
7211 DO j = iadk(i),iadk(i+1)-1
7212 jd = jdik(j)
7213 icol(jd) = icol(jd) + 1
7214 ENDDO
7215 ENDDO
7216 iadk0(1) = 1
7217 DO i = 1,nddl
7218 iadk0(i+1) = iadk0(i)+icol(i)
7219 icri(i) = pre_fpat(i)
7220 ENDDO
7221 DO i = 1,nddl
7222 nri = iadk(i+1)-iadk(i)
7223 CALL cp_int(nri,jdik(iadk(i)),jdik0(iadk0(i)))
7224 icol(i) = nri
7225 DO j=iadk(i),iadk(i+1)-1
7226 jd = jdik(j)
7227 k = iadk0(jd) + icol(jd)
7228 jdik0(k) = i
7229 icol(jd) = icol(jd) + 1
7230 ENDDO
7231 ENDDO
7232C
7233 SELECT CASE(nn)
7234 CASE (2)
7235C
7236 iadm(1) = iadk(1)
7237 DO i = 1,ndf
7238 iadm(i+1) = iadk(i+1)
7239 ENDDO
7240 DO j=iadk(1),iadk(ndf+1)-1
7241 jdim(j) = jdik(j)
7242 ENDDO
7243 l_nz = iadk(ndf+1)-iadk(1)
7244C
7245 DO i = ndf+1,nddl
7246 nri = iadk(i+1)-iadk(i)
7247 CALL cp_int(nri,jdik(iadk(i)),icol)
7248 IF (icri(i)==1) THEN
7249 nr0 = nri
7250 DO j=iadk(i),iadk(i+1)-1
7251 jd = jdik(j)
7252 DO k = iadk0(jd),iadk0(jd+1)-1
7253 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7254 ENDDO
7255 ENDDO
7256 IF (nri>nr0) CALL reorder_m(nri,icol)
7257 ENDIF
7258 DO j=1,nri
7259 l_nz = l_nz + 1
7260 jdim(l_nz) = icol(j)
7261 ENDDO
7262 iadm(i+1) = l_nz+1
7263 ENDDO
7264C
7265 CASE (3)
7266C
7267 iadm(1) = iadk(1)
7268 DO i = 1,ndf
7269 iadm(i+1) = iadk(i+1)
7270 ENDDO
7271 DO j=iadk(1),iadk(ndf+1)-1
7272 jdim(j) = jdik(j)
7273 ENDDO
7274 l_nz = iadk(ndf+1)-iadk(1)
7275C
7276 DO i = ndf+1,nddl
7277 nri = iadk(i+1)-iadk(i)
7278 CALL cp_int(nri,jdik(iadk(i)),icol)
7279 IF (icri(i)==1) THEN
7280 nr0 = nri
7281 DO j=iadk(i),iadk(i+1)-1
7282 jd = jdik(j)
7283 DO k = iadk0(jd),iadk0(jd+1)-1
7284 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7285 ENDDO
7286 ENDDO
7287 IF (nri>nr0) CALL reorder_m(nri,icol)
7288 ENDIF
7289 DO j=1,nri
7290 l_nz = l_nz + 1
7291 jdim(l_nz) = icol(j)
7292 ENDDO
7293 iadm(i+1) = l_nz+1
7294 ENDDO
7295C
7296 ALLOCATE(iadl(nddl+1),jdil(l_nz))
7297 CALL cp_int(nddl+1,iadm,iadl)
7298 CALL cp_int(l_nz,jdim,jdil)
7299 l_nz = iadk(ndf+1)-iadk(1)
7300 DO i = ndf+1,nddl
7301 nri = iadl(i+1)-iadl(i)
7302 CALL cp_int(nri,jdil(iadl(i)),icol)
7303 IF (icri(i)==1) THEN
7304 nr0 = nri
7305 DO j=iadl(i),iadl(i+1)-1
7306 jd = jdil(j)
7307 DO k = iadk0(jd),iadk0(jd+1)-1
7308 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7309 ENDDO
7310 ENDDO
7311 IF (nri>nr0) CALL reorder_m(nri,icol)
7312 ENDIF
7313 DO j=1,nri
7314 l_nz = l_nz + 1
7315 jdim(l_nz) = icol(j)
7316 ENDDO
7317 iadm(i+1) = l_nz+1
7318 ENDDO
7319 DEALLOCATE(iadl,jdil)
7320 CASE (4)
7321C
7322 l_nz = 0
7323 iadm(1) = iadk(1)
7324 DO i = 1,nddl
7325 nri = iadk(i+1)-iadk(i)
7326 CALL cp_int(nri,jdik(iadk(i)),icol)
7327 IF (icri(i)==1) THEN
7328 nr0 = nri
7329 DO j=iadk(i),iadk(i+1)-1
7330 jd = jdik(j)
7331 DO k = iadk0(jd),iadk0(jd+1)-1
7332 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7333 ENDDO
7334 ENDDO
7335 IF (nri>nr0) CALL reorder_m(nri,icol)
7336 ENDIF
7337 DO j=1,nri
7338 l_nz = l_nz + 1
7339 jdim(l_nz) = icol(j)
7340 ENDDO
7341 iadm(i+1) = l_nz+1
7342 ENDDO
7343 ALLOCATE(iadl(nddl+1),jdil(l_nz))
7344 CALL cp_int(nddl+1,iadm,iadl)
7345 CALL cp_int(l_nz,jdim,jdil)
7346C-----------K0-> K^2-complet---------
7347 DEALLOCATE(jdik0)
7348 ALLOCATE(jdik0(2*l_nz))
7349 DO i = 1, nddl
7350 icol(i) = iadl(i+1) - iadl(i)
7351 DO j = iadl(i),iadl(i+1)-1
7352 jd = jdil(j)
7353 icol(jd) = icol(jd) + 1
7354 ENDDO
7355 ENDDO
7356 iadk0(1) = 1
7357 DO i = 1,nddl
7358 iadk0(i+1) = iadk0(i)+icol(i)
7359 ENDDO
7360 DO i = 1,nddl
7361 nri = iadl(i+1)-iadl(i)
7362 CALL cp_int(nri,jdil(iadl(i)),jdik0(iadk0(i)))
7363 icol(i) = nri
7364 DO j=iadl(i),iadl(i+1)-1
7365 jd = jdil(j)
7366 k = iadk0(jd) + icol(jd)
7367 jdik0(k) = i
7368 icol(jd) = icol(jd) + 1
7369 ENDDO
7370 ENDDO
7371C
7372 iadm(1) = iadk(1)
7373 DO i = 1,ndf
7374 iadm(i+1) = iadk(i+1)
7375 ENDDO
7376 DO j=iadk(1),iadk(ndf+1)-1
7377 jdim(j) = jdik(j)
7378 ENDDO
7379 l_nz = iadk(ndf+1)-iadk(1)
7380 DO i = ndf+1,nddl
7381 nri = iadl(i+1)-iadl(i)
7382 CALL cp_int(nri,jdil(iadl(i)),icol)
7383 IF (icri(i)==1) THEN
7384 nr0 = nri
7385 DO j=iadl(i),iadl(i+1)-1
7386 jd = jdil(j)
7387 DO k = iadk0(jd),iadk0(jd+1)-1
7388 IF (jdik0(k)<i) CALL reorder_a(nri,icol,jdik0(k))
7389 ENDDO
7390 ENDDO
7391 IF (nri>nr0) CALL reorder_m(nri,icol)
7392 ENDIF
7393 DO j=1,nri
7394 l_nz = l_nz + 1
7395 jdim(l_nz) = icol(j)
7396 ENDDO
7397 iadm(i+1) = l_nz+1
7398 ENDDO
7399 DEALLOCATE(iadl,jdil)
7400 END SELECT
7401 DEALLOCATE(iadk0,jdik0)
7402 CALL k_band(nddl,iadm,jdim,l_max)
7403C--------------------------------------------
7404 RETURN
7405 END
7406!||====================================================================
7407!|| fil_span0 ../engine/source/implicit/ind_glob_k.f
7408!||--- called by ------------------------------------------------------
7409!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
7410!||--- uses -----------------------------------------------------
7411!|| imp_ppat ../engine/share/modules/impbufdef_mod.F
7412!||====================================================================
7413 SUBROUTINE fil_span0(NRBYAC,IRBYAC,NPBY,IDDL,NDOF,NDDL)
7414C-----------------------------------------------
7415C M o d u l e s
7416C-----------------------------------------------
7417 USE imp_ppat
7418C-----------------------------------------------
7419C I m p l i c i t T y p e s
7420C-----------------------------------------------
7421#include "implicit_f.inc"
7422C-----------------------------------------------
7423C C o m m o n B l o c k s
7424C-----------------------------------------------
7425#include "param_c.inc"
7426C-----------------------------------------------
7427C D u m m y A r g u m e n t s
7428C-----------------------------------------------
7429 INTEGER NDDL,NPBY(NNPBY,*),IDDL(*),NRBYAC,IRBYAC(*),NDOF(*)
7430C REAL
7431C-----------------------------------------------
7432C L o c a l V a r i a b l e s
7433C-----------------------------------------------
7434 INTEGER I,J,M,N,ID
7435C----6---------------------------------------------------
7436C
7437 ALLOCATE(pre_fpat(nddl))
7438 pre_fpat = 1
7439 DO i=1,nrbyac
7440 n=irbyac(i)
7441 m =npby(1,n)
7442 id = iddl(m)
7443 DO j=1,ndof(m)
7444 pre_fpat(id+j) = 0
7445 ENDDO
7446 ENDDO
7447C--------------------------------------------
7448 RETURN
7449 END
7450!||====================================================================
7451!|| fil_span1 ../engine/source/implicit/ind_glob_k.F
7452!||--- called by ------------------------------------------------------
7453!|| imp_solv ../engine/source/implicit/imp_solv.F
7454!||--- uses -----------------------------------------------------
7455!|| imp_ppat ../engine/share/modules/impbufdef_mod.F
7456!||====================================================================
7457 SUBROUTINE fil_span1(NRBYAC,IRBYAC,NPBY,IDDL,NDDL,IKC,NDOF,INLOC)
7458C-----------------------------------------------
7459C M o d u l e s
7460C-----------------------------------------------
7461 USE imp_ppat
7462C-----------------------------------------------
7463C I m p l i c i t T y p e s
7464C-----------------------------------------------
7465#include "implicit_f.inc"
7466C-----------------------------------------------
7467C C o m m o n B l o c k s
7468C-----------------------------------------------
7469#include "com04_c.inc"
7470#include "param_c.inc"
7471C-----------------------------------------------
7472C D u m m y A r g u m e n t s
7473C-----------------------------------------------
7474 INTEGER NDDL,NPBY(NNPBY,*),IDDL(*),NRBYAC,IRBYAC(*),
7475 + ikc(*),ndof(*),inloc(*)
7476C REAL
7477C-----------------------------------------------
7478C L o c a l V a r i a b l e s
7479C-----------------------------------------------
7480 INTEGER I,J,M,N,ID,IDDLM(NDDL),IFIX,IDM
7481C----6---------------------------------------------------
7482C
7483 DO i=1,nddl
7484 pre_fpat(i) = 1
7485 ENDDO
7486C
7487 ifix=0
7488 DO n = 1,numnod
7489 i=inloc(n)
7490 iddlm(i)=iddl(i)-ifix
7491 DO j=1,ndof(i)
7492 id = iddl(i)+j
7493 IF (ikc(id)/=0) ifix=ifix+1
7494 ENDDO
7495 ENDDO
7496 DO i=1,nrbyac
7497 n=irbyac(i)
7498 m =npby(1,n)
7499 id = iddl(m)
7500 idm = iddlm(m)
7501 ifix=0
7502 DO j=1,ndof(m)
7503 IF (ikc(id+j)==0) THEN
7504 ifix=ifix+1
7505 pre_fpat(idm+ifix) = 0
7506 ENDIF
7507 ENDDO
7508 ENDDO
7509C--------------------------------------------
7510 RETURN
7511 END
7512!||====================================================================
7513!|| dim_ktot ../engine/source/implicit/ind_glob_k.F
7514!||--- calls -----------------------------------------------------
7515!|| cp_int ../engine/source/implicit/produt_v.f
7516!|| l2g_kloc ../engine/source/implicit/ind_glob_k.F
7517!|| reorder_a ../engine/source/implicit/ind_glob_k.F
7518!||====================================================================
7519 SUBROUTINE dim_ktot(NDDL ,IADK ,JDIK ,IADI ,JDII ,
7520 1 ITOK ,NDDLI ,L_NZ ,LT_I )
7521C-----------------------------------------------
7522C I m p l i c i t T y p e s
7523C-----------------------------------------------
7524#include "implicit_f.inc"
7525C-----------------------------------------------
7526C D u m m y A r g u m e n t s
7527C-----------------------------------------------
7528 INTEGER NDDL,NDDLI,IADK(*),JDIK(*),IADI(*),JDII(*),
7529 . itok(*),l_nz
7530 my_real
7531 . lt_i(*)
7532C-----------------------------------------------
7533C L o c a l V a r i a b l e s
7534C-----------------------------------------------
7535 INTEGER I,J,K,JD,JK,K2I(NDDL),ICOL(NDDL),NRI
7536C----6---------------------------------------------------------------7---------8
7537 CALL l2g_kloc(nddli ,iadi ,jdii ,itok ,lt_i )
7538C
7539 DO i = 1,nddl
7540 k2i(i) = 0
7541 ENDDO
7542 DO i = 1,nddli
7543 j = itok(i)
7544 k2i(j) = i
7545 ENDDO
7546 l_nz = 0
7547 DO i = 1,nddl
7548 nri = iadk(i+1)-iadk(i)
7549 IF (k2i(i)>0) THEN
7550 CALL cp_int(nri,jdik(iadk(i)),icol)
7551 k = k2i(i)
7552 DO j=iadi(k),iadi(k+1)-1
7553 jd = jdii(j)
7554 jk = itok(jd)
7555 CALL reorder_a(nri,icol,jk)
7556 ENDDO
7557 ENDIF
7558 l_nz = l_nz + nri
7559 ENDDO
7560C--------------------------------------------
7561 RETURN
7562 END
7563!||====================================================================
7564!|| ind_ktot ../engine/source/implicit/ind_glob_k.F
7565!||--- calls -----------------------------------------------------
7566!|| ancmsg ../engine/source/output/message/message.F
7567!|| arret ../engine/source/system/arret.F
7568!||--- uses -----------------------------------------------------
7569!|| message_mod ../engine/share/message_module/message_mod.F
7570!||====================================================================
7571 SUBROUTINE ind_ktot(NDDL ,IADK ,JDIK ,IADI ,JDII ,
7572 1 ITOK ,NDDLI ,IADT ,JDIT ,LT_K ,
7573 2 LT_I ,LT_T ,NZL )
7574C-----------------------------------------------
7575C M o d u l e s
7576C-----------------------------------------------
7577 USE message_mod
7578C-----------------------------------------------
7579C I m p l i c i t T y p e s
7580C-----------------------------------------------
7581#include "implicit_f.inc"
7582C-----------------------------------------------
7583C D u m m y A r g u m e n t s
7584C-----------------------------------------------
7585 INTEGER NDDL,NDDLI,IADK(*),JDIK(*),IADI(*),JDII(*),
7586 . itok(*),iadt(*) ,jdit(*),nzl
7587 my_real
7588 . lt_k(*), lt_i(*), lt_t(*)
7589C-----------------------------------------------
7590C L o c a l V a r i a b l e s
7591C-----------------------------------------------
7592 INTEGER I,J,K,N,L,JD,JK,K2I(NDDL),IFT,NZ
7593C----6---------------------------------------------------------------7---------8
7594C
7595 DO I = 1,nddl
7596 k2i(i) = 0
7597 ENDDO
7598 DO i = 1,nddli
7599 j = itok(i)
7600 k2i(j) = i
7601 IF (iadi(i)==iadi(i+1)) k2i(j) = 0
7602 ENDDO
7603C
7604 nz = 0
7605 iadt(1) = nz + 1
7606 DO i = 1,nddl
7607 IF (k2i(i)==0) THEN
7608 DO j=iadk(i),iadk(i+1)-1
7609 nz = nz + 1
7610 jdit(nz) = jdik(j)
7611 lt_t(nz) = lt_k(j)
7612 ENDDO
7613 ELSE
7614 n = k2i(i)
7615C---- first for [k]----
7616 k=iadi(n)
7617 jd = jdii(k)
7618 jk = itok(jd)
7619 ift = iadk(i)
7620 DO k=iadi(n),iadi(n+1)-1
7621 jd = jdii(k)
7622 jk = itok(jd)
7623 DO j=ift,iadk(i+1)-1
7624 IF (jk==jdik(j)) THEN
7625 nz = nz + 1
7626 jdit(nz) = jdik(j)
7627 lt_t(nz) = lt_k(j)+lt_i(k)
7628 ift = j + 1
7629 GOTO 100
7630 ELSEIF (jk<jdik(j)) THEN
7631 nz = nz + 1
7632 jdit(nz) = jk
7633 lt_t(nz) = lt_i(k)
7634 GOTO 100
7635 ELSE
7636 nz = nz + 1
7637 jdit(nz) = jdik(j)
7638 lt_t(nz) = lt_k(j)
7639 ift = j + 1
7640 ENDIF
7641 ENDDO
7642C---- end of insert-----
7643 j = iadk(i+1)-1
7644 IF (jk>jdik(j)) THEN
7645 nz = nz + 1
7646 jdit(nz) = jk
7647 lt_t(nz) = lt_i(k)
7648 ENDIF
7649 100 CONTINUE
7650 IF (k==(iadi(n+1)-1)) THEN
7651 DO j=ift,iadk(i+1)-1
7652 nz = nz + 1
7653 jdit(nz) = jdik(j)
7654 lt_t(nz) = lt_k(j)
7655 ENDDO
7656 ENDIF
7657 ENDDO
7658 ENDIF
7659 iadt(i+1) = nz + 1
7660 ENDDO
7661 IF (nz/=nzl) THEN
7662 CALL ancmsg(msgid=80,anmode=aninfo,
7663 . c1='ASSEMBLY')
7664 IF (nz>nzl) CALL arret(2)
7665 ENDIF
7666C--------------------------------------------
7667 RETURN
7668 END
7669!||====================================================================
7670!|| l2g_kloc ../engine/source/implicit/ind_glob_k.F
7671!||--- called by ------------------------------------------------------
7672!|| dim_ktot ../engine/source/implicit/ind_glob_k.F
7673!||--- calls -----------------------------------------------------
7674!|| ancmsg ../engine/source/output/message/message.F
7675!|| arret ../engine/source/system/arret.F
7676!|| cp_int ../engine/source/implicit/produt_v.F
7677!|| cp_real ../engine/source/implicit/produt_v.F
7678!|| reorder_kij ../engine/source/implicit/ind_glob_k.F
7679!||--- uses -----------------------------------------------------
7680!|| message_mod ../engine/share/message_module/message_mod.F
7681!||====================================================================
7682 SUBROUTINE l2g_kloc(NDDLI ,IADI ,JDII ,ITOK ,LT_I )
7683C-----------------------------------------------
7684C M o d u l e s
7685C-----------------------------------------------
7686 USE message_mod
7687C-----------------------------------------------
7688C I m p l i c i t T y p e s
7689C-----------------------------------------------
7690#include "implicit_f.inc"
7691C-----------------------------------------------
7692C C o m m o n B l o c k s
7693C-----------------------------------------------
7694#include "impl1_c.inc"
7695C-----------------------------------------------
7696C D u m m y A r g u m e n t s
7697C-----------------------------------------------
7698 INTEGER NDDLI,IADI(*),JDII(*),ITOK(*),NZI
7699 my_real
7700 . LT_I(*)
7701C-----------------------------------------------
7702C L o c a l V a r i a b l e s
7703C-----------------------------------------------
7704 INTEGER I,J,K,ICOL(NDDLI),L_NZ,NRI,NZ,JD,GI,GJ,IFT
7705 INTEGER, DIMENSION(:),ALLOCATABLE :: IADK0,JDIK0
7706 my_real,
7707 . DIMENSION(:),ALLOCATABLE :: LT_K0
7708C----6---------------
7709 l_nz = 2*(iadi(nddli+1)-iadi(1))
7710C -------------[K0]-locale complete----------
7711 ALLOCATE(iadk0(nddli+1),jdik0(l_nz),lt_k0(l_nz))
7712 DO i = 1,nddli
7713 icol(i) = 0
7714 ENDDO
7715 DO i = 1, nddli
7716 icol(i) = icol(i) + iadi(i+1) - iadi(i)
7717 DO j = iadi(i),iadi(i+1)-1
7718 jd = jdii(j)
7719 icol(jd) = icol(jd) + 1
7720 ENDDO
7721 ENDDO
7722 iadk0(1) = 1
7723 DO i = 1,nddli
7724 iadk0(i+1) = iadk0(i)+icol(i)
7725 ENDDO
7726 nz=iadk0(nddli+1) - iadk0(1)
7727 DO i = 1,nddli
7728 nri = iadi(i+1)-iadi(i)
7729 CALL cp_int(nri,jdii(iadi(i)),jdik0(iadk0(i)))
7730 CALL cp_real(nri,lt_i(iadi(i)),lt_k0(iadk0(i)))
7731 icol(i) = nri
7732 ENDDO
7733 DO i = 1,nddli
7734 DO j=iadi(i),iadi(i+1)-1
7735 jd = jdii(j)
7736 k = iadk0(jd) + icol(jd)
7737 jdik0(k) = i
7738 lt_k0(k) = lt_i(j)
7739 icol(jd) = icol(jd) + 1
7740 ENDDO
7741 ENDDO
7742C
7743 nz = 0
7744 iadi(1) = nz + 1
7745 IF (ikpat==0 )THEN
7746C -------------trang_sup----------
7747 DO i = 1, nddli
7748 gi = itok(i)
7749 DO j = iadk0(i),iadk0(i+1)-1
7750 jd = jdik0(j)
7751 gj = itok(jd)
7752 IF (gj>gi)THEN
7753 nz = nz + 1
7754 jdii(nz) = jd
7755 lt_i(nz) = lt_k0(j)
7756 ENDIF
7757 ENDDO
7758 iadi(i+1) = nz + 1
7759 ENDDO
7760 ELSE
7761C -------------trang_inf----------
7762 DO i = 1, nddli
7763 gi = itok(i)
7764 DO j = iadk0(i),iadk0(i+1)-1
7765 jd = jdik0(j)
7766 gj = itok(jd)
7767 IF (gj<gi)THEN
7768 nz = nz + 1
7769 jdii(nz) = jd
7770 lt_i(nz) = lt_k0(j)
7771 ENDIF
7772 ENDDO
7773 iadi(i+1) = nz + 1
7774 ENDDO
7775 ENDIF
7776 DEALLOCATE(iadk0,jdik0,lt_k0)
7777 IF (nz>l_nz/2) THEN
7778 CALL ancmsg(msgid=80,anmode=aninfo,
7779 . c1='TRANSLATION')
7780 CALL arret(2)
7781 ENDIF
7782C -------------in order----------
7783 DO i = 1,nddli
7784 nz = iadi(i+1)-iadi(i)
7785 ift = iadi(i)
7786 CALL reorder_kij(nz,jdii(ift),lt_i(ift),itok)
7787 ENDDO
7788C--------------------------------------------
7789 RETURN
7790 END
7791!||====================================================================
7792!|| reorder_kij ../engine/source/implicit/ind_glob_k.F
7793!||--- called by ------------------------------------------------------
7794!|| l2g_kloc ../engine/source/implicit/ind_glob_k.F
7795!||====================================================================
7796 SUBROUTINE reorder_kij(N,IC,RC,IDDL)
7797C----6---------------------------------------------------------------7---------8
7798C I m p l i c i t T y p e s
7799C-----------------------------------------------
7800#include "implicit_f.inc"
7801C-----------------------------------------------------------------
7802C D u m m y A r g u m e n t s
7803C-----------------------------------------------
7804 INTEGER N ,IC(*),IDDL(*)
7805 my_real
7806 . rc(*)
7807C-----------------------------------------------
7808C L o c a l V a r i a b l e s
7809C-----------------------------------------------
7810 INTEGER I,J,II,IT,IIC,IMIN,IDIC(N)
7811 my_real
7812 . s
7813C
7814 DO i =1,n
7815 idic(i)=iddl(ic(i))
7816 ENDDO
7817 IF (n==0) RETURN
7818C-----en ordre iddl croisante-----
7819 DO i =1,n
7820 imin=idic(i)
7821 ii=i
7822 DO j =i+1,n
7823 IF (idic(j)<imin) THEN
7824 imin=idic(j)
7825 ii=j
7826 ENDIF
7827 ENDDO
7828 IF (ii/=i) THEN
7829 it=ic(i)
7830 s =rc(i)
7831 ic(i)=ic(ii)
7832 ic(ii)=it
7833 rc(i)=rc(ii)
7834 rc(ii)=s
7835 it=idic(i)
7836 idic(i)=idic(ii)
7837 idic(ii)=it
7838 ENDIF
7839 ENDDO
7840C----6---------------------------------------------------------------7---------8
7841 RETURN
7842 END
7843!||====================================================================
7844!|| ndof_fv ../engine/source/implicit/ind_glob_k.F
7845!||--- called by ------------------------------------------------------
7846!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
7847!||--- calls -----------------------------------------------------
7848!|| ancmsg ../engine/source/output/message/message.F
7849!|| arret ../engine/source/system/arret.F
7850!||--- uses -----------------------------------------------------
7851!|| message_mod ../engine/share/message_module/message_mod.F
7852!||====================================================================
7853 SUBROUTINE ndof_fv(IBFV ,VEL ,NDOF ,IFRAME)
7854 USE message_mod
7855C-----------------------------------------------
7856C I m p l i c i t T y p e s
7857C-----------------------------------------------
7858#include "implicit_f.inc"
7859#include "mvsiz_p.inc"
7860C-----------------------------------------------
7861C C o m m o n B l o c k s
7862C-----------------------------------------------
7863#include "com04_c.inc"
7864#include "com08_c.inc"
7865#include "param_c.inc"
7866C-----------------------------------------------
7867C D u m m y A r g u m e n t s
7868C-----------------------------------------------
7869 INTEGER IBFV(NIFV,*),NDOF(*),IFRAME(LISKN,*)
7870C REAL
7871 my_real
7872 . vel(lfxvelr,*)
7873C-----------------------------------------------
7874C L o c a l V a r i a b l e s
7875C-----------------------------------------------
7876 INTEGER N, I, ISK, J, L, K1, K2, K3, ISENS,K,
7877 . ii, ic, nn, ideb, nr, nsk, nfk, ifm,index(mvsiz)
7878C REAL
7879 my_real
7880 . fac, startt, stopt, ts
7881C IBFV(7,N):1 V;2 D ;0 A ;
7882C-------------------------------
7883 ideb = 0
7884C----is there is Du in [TT,TSTOP] TT-> Tstart
7885 DO nn=1,nfxvel,nvsiz
7886 IF (ibfv(8,nn)==1) GOTO 100
7887 ic = 0
7888C IF (NSENSOR>0) : by sensor will be ignoned (if not activated)
7889 DO 20 ii = 1, min(nfxvel-ideb,nvsiz)
7890 n = ii+ideb
7891 startt = vel(2,n)
7892 stopt = vel(3,n)
7893 IF(tstop<=startt)GOTO 20
7894 IF(tt>=stopt) GOTO 20
7895 i=iabs(ibfv(1,n))
7896 ic = ic + 1
7897 index(ic) = n
7898 20 CONTINUE
7899 ideb = ideb + min(nfxvel-ideb,nvsiz)
7900C
7901 DO ii=1,ic
7902 n = index(ii)
7903 i=iabs(ibfv(1,n))
7904 isk=ibfv(2,n)/10
7905 ifm = ibfv(9,n)
7906 j=ibfv(2,n)
7907 IF (ifm<=1) j=j-10*isk
7908 IF(j<=3)THEN
7909 IF (ndof(i)==0) ndof(i)=3
7910 ELSEIF(j<=6)THEN
7911 IF (ndof(i)==0) ndof(i)=6
7912C stop erroring out
7913 IF (ndof(i) <=3) THEN
7914 CALL ancmsg(msgid=253,anmode=aninfo)
7915 CALL arret(2)
7916 ENDIF
7917 ENDIF
7918C---------Otherwise Rotation will not be transforted
7919C IF (IFM >1) THEN
7920C I = IFRAME(1,IFM)
7921C IF (NDOF(I)==0) NDOF(I)=3
7922C IF (NDOF(I)==0.AND.J>3) NDOF(I)=6
7923C END IF
7924 ENDDO
7925 100 CONTINUE
7926 ENDDO
7927C
7928 RETURN
7929 END
7930!||====================================================================
7931!|| i24msegv ../engine/source/implicit/ind_glob_k.F
7932!||--- called by ------------------------------------------------------
7933!|| row_int24 ../engine/source/implicit/ind_glob_k.F
7934!|| row_int241 ../engine/source/implicit/ind_glob_k.F
7935!|| row_int242 ../engine/source/implicit/ind_glob_k.F
7936!|| rowfr_dim24 ../engine/source/mpi/implicit/imp_fri.F
7937!|| rowfr_ind24 ../engine/source/mpi/implicit/imp_fri.F
7938!||====================================================================
7939 SUBROUTINE i24msegv(IE ,IRTLMV ,SUBTRIA,IRTLM ,NVOISIN)
7940C-----------------------------------------------
7941C I m p l i c i t T y p e s
7942C-----------------------------------------------
7943#include "implicit_f.inc"
7944C-----------------------------------------------
7945C D u m m y A r g u m e n t s
7946C-----------------------------------------------
7947 INTEGER IE,IRTLMV(4),IRTLM(4),SUBTRIA,NVOISIN(8)
7948C-----------------------------------------------
7949C L o c a l V a r i a b l e s
7950C-----------------------------------------------
7951 INTEGER IX1, IX2, IX3, IX4
7952C-----------------------------------------------
7953C 11-------10
7954C |\ 19 /|
7955C | \ / |
7956C | \ / |
7957C | 16 |
7958C |15/ \11|
7959C | / \ |
7960C |/ 7 \|
7961C12-------4-------3-------9
7962C |\ 12 /|\ /|\ 14 /|
7963C | \ / | \ 3 / | \ / |
7964C | \ / | \ /2 |6 \ /18|
7965C | 17 | 5 | 15 |
7966C |20/ \ 8| 4/ \ | / \ |
7967C | / \ | / 1 \ | / \ |
7968C |/ 16 \|/ \|/ 10 \|
7969C13-------1-------2-------8
7970C |\ 5 /|
7971C | \ / |
7972C |9 \ /13|
7973C | 14 |
7974C | / \ |
7975C | / \ |
7976C |/ 17 \|
7977C 6-------7
7978C-----------------------------------------
7979 SELECT CASE (subtria)
7980C-----------------------------------------
7981 CASE(5,9,13,17)
7982 ix1 = irtlm(2)
7983 ix2 = irtlm(1)
7984 ix3 = iabs(nvoisin(1))
7985 ix4 = iabs(nvoisin(2))
7986C-----------------------------------------
7987 CASE(6,10,14,18)
7988 ix1 = irtlm(3)
7989 ix2 = irtlm(2)
7990 ix3 = iabs(nvoisin(3))
7991 ix4 = iabs(nvoisin(4))
7992C-----------------------------------------
7993 CASE(7,11,15,19)
7994 ix1 = irtlm(4)
7995 ix2 = irtlm(3)
7996 ix3 = iabs(nvoisin(5))
7997 ix4 = iabs(nvoisin(6))
7998C-----------------------------------------
7999 CASE(8,12,16,20)
8000 ix1 = irtlm(1)
8001 ix2 = irtlm(4)
8002 ix3 = iabs(nvoisin(7))
8003 ix4 = iabs(nvoisin(8))
8004 END SELECT
8005 irtlmv(1) = ix1
8006 irtlmv(2) = ix2
8007 irtlmv(3) = ix3
8008 irtlmv(4) = ix4
8009 IF (irtlmv(2)==0) irtlmv(2)=irtlmv(1)
8010 IF (irtlmv(4)==0) irtlmv(4)=irtlmv(3)
8011C
8012 RETURN
8013 END
8014
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:4462
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:3339
ind_kine_kp
subroutine ind_kine_kp(nrowk, icok, icokm, nnmax, nkmax, nkine, ink, ikpat, iddl)
Definition imp_fri.F:4500
set_ikin2g
subroutine set_ikin2g(nkine, inloc)
Definition imp_fri.F:4382
get_ikin2g
subroutine get_ikin2g(nkine, ink, iloc)
Definition imp_fri.F:4423
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:3539
ind_nrfr
subroutine ind_nrfr(nft, nel, npn, npp, nnmax, nrow, icol, fr_elem, iad_elem, n_fr, icok)
Definition imp_fri.F:3631
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:10150
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:3896
imp_sol_init
subroutine imp_sol_init(geo, npby, lpby, itab, ipari, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iparg, elbuf, nint7, nbintc, x, dmcp, fr_elem, iad_elem, fr_i2m, iad_i2m, nprw, num_imp1, num_impl, 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, nddl0, nnzk0, impbuf_tab)
Definition imp_sol_init.F:62
imp_solv
subroutine imp_solv(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:173
imp_intbuf_ini
subroutine imp_intbuf_ini(imp_intbuf_tab, nimp)
Definition imp_solv.F:8551
k_band
subroutine k_band(nddl, iadk, jdik, ndmax)
Definition imp_solv.F:2249
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:7458
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:1617
reorder_j
subroutine reorder_j(n, ic, ni, iddl)
Definition ind_glob_k.F:4369
row_int
subroutine row_int(jlt, ns_imp, ne_imp, irect, nsv, nrow, iloc, ndofi, n_impn, nsn, nsrem)
Definition ind_glob_k.F:5068
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:5183
ndof_int
subroutine ndof_int(jlt, ns_imp, ne_imp, irect, nsv, nsn, ndof, idel_int)
Definition ind_glob_k.F:6745
fil_span0
subroutine fil_span0(nrbyac, irbyac, npby, iddl, ndof, nddl)
Definition ind_glob_k.F:7414
ind_spa2
subroutine ind_spa2(nddl, iadk, jdik, iadm, jdim, l_max)
Definition ind_glob_k.F:6908
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:6533
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:629
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:1314
dim_ndof_d
subroutine dim_ndof_d(npby, lpby, nrbyac, irbyac, ndof, iad_rby, fr_rby)
Definition ind_glob_k.F:2031
row_adds
subroutine row_adds(ns, nm, iloc, ishf, icol, icok, nrow, nnmax, nkmax)
Definition ind_glob_k.F:6581
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:5270
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:5379
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:1687
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:5328
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:3180
ndof_int11
subroutine ndof_int11(jlt, ns_imp, ne_imp, irects, irectm, nsn, ndof, idel_int)
Definition ind_glob_k.F:6789
ndof_fv
subroutine ndof_fv(ibfv, vel, ndof, iframe)
Definition ind_glob_k.F:7854
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:4829
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:7574
i24msegv
subroutine i24msegv(ie, irtlmv, subtria, irtlm, nvoisin)
Definition ind_glob_k.F:7940
dim_ndof_ii
subroutine dim_ndof_ii(nint2, iint2, ipari, ndof, nrbe3, irbe3, lrbe3, nrbe2, irbe2, lrbe2, intbuf_tab)
Definition ind_glob_k.F:1914
reorder_l
subroutine reorder_l(n, ic, ni, iddl)
Definition ind_glob_k.F:4434
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:333
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:2763
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:37
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:5536
dim_span
subroutine dim_span(nn, nddl, iadk, jdik, l_nz, ndmax)
Definition ind_glob_k.F:6997
row_int1
subroutine row_int1(jlt, ns_imp, ne_imp, irect, nsv, nrow, n_impn, iloc, icol, nnmax, nsn)
Definition ind_glob_k.F:5130
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:2408
reorder_kij
subroutine reorder_kij(n, ic, rc, iddl)
Definition ind_glob_k.F:7797
ndof_int5
subroutine ndof_int5(jlt, ns_imp, ne_imp, irect, nsv, nsn, ndof, idel_int, msr)
Definition ind_glob_k.F:6831
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:1804
reorder_m
subroutine reorder_m(n, ic)
Definition ind_glob_k.F:6951
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:5465
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:5702
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:5596
row_int111
subroutine row_int111(jlt, ns_imp, ne_imp, irects, irectm, nrow, n_impn, iloc, icol, nnmax, nsn)
Definition ind_glob_k.F:6479
reorder_a1
subroutine reorder_a1(n, ic, id)
Definition ind_glob_k.F:4294
set_ind_k
subroutine set_ind_k(iddl, ndof, iadk, jdik, nddl, nnzk, nrow, icol, n, ikpat)
Definition ind_glob_k.F:3640
ind_span
subroutine ind_span(nn, ndf, nddl, iadk, jdik, iadm, jdim, l_max, ndmax)
Definition ind_glob_k.F:7186
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:2100
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:6155
dim_ktot
subroutine dim_ktot(nddl, iadk, jdik, iadi, jdii, itok, nddli, l_nz, lt_i)
Definition ind_glob_k.F:7521
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:4652
dim_int7
subroutine dim_int7(ninter, ipari, intbuf_tab, nnmax)
Definition ind_glob_k.F:4536
nddl_loc
subroutine nddl_loc(nddl, iddl, iloc, nloc, ndof)
Definition ind_glob_k.F:5024
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:966
intab
logical function intab(nic, ic, n)
Definition ind_glob_k.F:4497
dim_spa2
subroutine dim_spa2(nddl, iadk, jdik, l_nz)
Definition ind_glob_k.F:6871
idel_int
subroutine idel_int(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, ind_imp, ndof, nt_imp)
Definition ind_glob_k.F:6627
l2g_kloc
subroutine l2g_kloc(nddli, iadi, jdii, itok, lt_i)
Definition ind_glob_k.F:7683
reorder_i
subroutine reorder_i(n, ic)
Definition ind_glob_k.F:4189
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:3370
row_int11
subroutine row_int11(jlt, ns_imp, ne_imp, irects, irectm, nrow, iloc, ndofi, n_impn, nsn, nsrem)
Definition ind_glob_k.F:6418
reorder_a
subroutine reorder_a(n, ic, id)
Definition ind_glob_k.F:4268
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:3731
reorder_j1
subroutine reorder_j1(n, ic, ni)
Definition ind_glob_k.F:4337
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:662
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:1249
cp_real
subroutine cp_real(n, x, xc)
Definition produt_v.F:871
produt_v
subroutine produt_v(nddl, x, y, r)
Definition produt_v.F:33
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:332
rmdim_imp
subroutine rmdim_imp(ixc, ixtg, ndof, nnmax, nkine, inloc, nrow, itab, sh4tree, sh3tree)
Definition rm_imp0.F:35
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:889
nl
character *2 function nl()
Definition message.F:2354
arret
subroutine arret(nn)
Definition arret.F:87