OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
imp_fri.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!|| imp_fri ../engine/source/mpi/implicit/imp_fri.F
25!||--- called by ------------------------------------------------------
26!|| imp_chkm ../engine/source/implicit/imp_solv.F
27!|| imp_intfr ../engine/source/implicit/imp_solv.f
28!||--- calls -----------------------------------------------------
29!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
30!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
31!|| imp_frsl ../engine/source/mpi/implicit/imp_fri.F
32!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.F
33!||--- uses -----------------------------------------------------
34!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
35!||====================================================================
36 SUBROUTINE imp_fri(
37 1 NUM_IMP ,NS_IMP ,NE_IMP ,IPARI ,INTBUF_TAB,
38 2 NPBY ,LPBY ,ITAB ,NRBYAC ,
39 3 IRBYAC ,NINT2 ,IINT2 ,IDDL ,IKC ,
40 4 NDOF ,INLOC ,NSREM ,NSL ,NBINTC ,
41 5 INTLIST ,X ,IBFV ,LJ ,SKEW ,
42 6 XFRAME ,ISKEW ,ICODT ,A ,UD ,
43 7 LB ,IFDIS ,NDDL ,URD ,IDDLI ,
44 8 IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,LRBE2 )
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE intbufdef_mod
49C----6---------------------------------------------------------------7---------8
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "param_c.inc"
57#include "impl1_c.inc"
58C-----------------------------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
62 . NE_IMP(*),NSREM ,NSL,NBINTC,INTLIST(*),
63 . IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
64 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
65 . NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
66 . IBFV(*),LJ(*),ISKEW(*),ICODT(*),IFDIS,NDDL,IDDLI(*)
67C REAL
68 my_real
69 . x(3,*),skew(*) ,xframe(*),
70 . a(3,*),ud(3,*),lb(*),urd(3,*),frbe3(*)
71
72 TYPE(intbuf_struct_) INTBUF_TAB(*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I,IKPAT0
77 my_real,
78 . DIMENSION(:),ALLOCATABLE :: LB0
79C-----------------------------------------------
80 CALL imp_frsl(nbintc,nsrem ,nsl )
81C-----------------------------------------------
82 IF (intp_c>0) THEN
83 ALLOCATE(lb0(nddl))
84 lb0=zero
85 ENDIF
86 IF ((nsrem+nsl)>0) THEN
87 IF (intp_c<=0) THEN
88 CALL imp_frki(
89 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
90 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
91 3 nint2 ,iint2 ,iddl ,ikc ,ndof ,
92 4 inloc ,nsrem ,nsl ,nbintc ,intlist ,
93 5 x ,ibfv ,lj ,skew ,
94 6 xframe ,iskew ,icodt ,irbe3 ,lrbe3 ,
95 7 frbe3 ,irbe2 ,lrbe2 )
96 ELSE
97 ikpat0 = ikpat
98 ikpat = 1
99 CALL imp_frkd(
100 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
101 2 ipari ,intbuf_tab,nint2 ,iint2 ,iddl ,
102 3 ikc ,ndof ,inloc ,nsrem ,nsl ,
103 4 nbintc ,intlist ,x ,ibfv ,
104 5 lj ,skew ,xframe ,iskew ,icodt ,
105 6 a ,ud ,lb0 ,ifdis ,urd ,
106 7 iddli ,irbe3 ,lrbe3 ,frbe3 ,irbe2 ,
107 8 lrbe2 )
108 ikpat = ikpat0
109 ENDIF
110 ENDIF
111 IF (intp_c>0) THEN
112 CALL spmd_sumf_v(lb0)
113 DO i=1,nddl
114 lb(i) = lb(i)+lb0(i)
115 ENDDO
116 DEALLOCATE(lb0)
117 ENDIF
118C----6---------------------------------------------------------------7---------8
119 RETURN
120 END
121!||====================================================================
122!|| imp_frfv ../engine/source/mpi/implicit/imp_fri.F
123!||--- called by ------------------------------------------------------
124!|| imp_chkm ../engine/source/implicit/imp_solv.F
125!|| imp_intfr ../engine/source/implicit/imp_solv.F
126!||--- calls -----------------------------------------------------
127!|| fr_matv ../engine/source/mpi/implicit/imp_fri.F
128!|| ini_dd0 ../engine/source/mpi/implicit/imp_fri.F
129!|| ini_ddfv ../engine/source/mpi/implicit/imp_fri.F
130!|| produt_vmhp ../engine/source/implicit/produt_v.F
131!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.F
132!||--- uses -----------------------------------------------------
133!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
134!||====================================================================
135 SUBROUTINE imp_frfv(
136 1 NUM_IMP ,NS_IMP ,NE_IMP ,IPARI ,INTBUF_TAB,
137 2 IDDL ,IKC ,NDOF ,NSREM ,
138 3 NSL ,D_IMP ,DD ,DR_IMP ,DDR ,
139 4 A ,AR ,MS ,V ,X ,
140 5 LB ,NDDL ,IBFV ,SKEW ,XFRAME ,
141 6 IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 ,DE ,
142 7 NDDL0 ,W_DDL )
143C-----------------------------------------------
144C M o d u l e s
145C-----------------------------------------------
146 USE intbufdef_mod
147C----6---------------------------------------------------------------7---------8
148C I m p l i c i t T y p e s
149C-----------------------------------------------
150#include "implicit_f.inc"
151C-----------------------------------------------
152C C o m m o n B l o c k s
153C-----------------------------------------------
154#include "com01_c.inc"
155#include "com04_c.inc"
156#include "param_c.inc"
157#include "impl1_c.inc"
158C-----------------------------------------------------------------
159C D u m m y A r g u m e n t s
160C-----------------------------------------------
161 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
162 . NE_IMP(*),NSREM ,NSL,NDDL,IRBE3(*),LRBE3(*)
163 INTEGER IDDL(*),IKC(*),NDOF(*),IBFV(*),IRBE2(*),LRBE2(*),
164 . NDDL0 ,W_DDL(*)
165C REAL
166 my_real
167 . D_IMP(3,*) ,DD(3,*),DR_IMP(3,*) ,DDR(3,*),LB(*),
168 . A(3,*) ,AR(3,*),MS(*) ,V(3,*),X(3,*),
169 . SKEW(*),XFRAME(*),DE
170 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
171C-----------------------------------------------
172C L o c a l V a r i a b l e s
173C-----------------------------------------------
174 INTEGER I,J,K,L
175 my_real
176 . lx(nddl)
177 my_real,
178 . DIMENSION(:),ALLOCATABLE :: dd_tmp,ddr_tmp
179C-----------------------------------------------
180 IF (iline>0) THEN
181 DO i =1,nddl
182 lx(i)=zero
183 ENDDO
184 CALL fr_matv( a ,v ,d_imp ,ms ,x ,
185 1 dr_imp,ar ,ipari ,intbuf_tab ,
186 2 ndof ,num_imp,ns_imp,ne_imp,lx ,
187 3 nsrem ,nsl ,ibfv ,skew ,xframe ,
188 4 lx ,irbe3 ,lrbe3,irbe2 ,lrbe2 )
189 CALL spmd_sumf_v(lx)
190 DO i =1,nddl
191 lb(i) = lb(i)-lx(i)
192 ENDDO
193 IF ((nsrem+nsl)>0)
194 . CALL ini_dd0(iddl ,ikc ,ndof ,ipari ,intbuf_tab,
195 . d_imp,dr_imp,nsl ,irbe3,lrbe3 ,
196 . irbe2,lrbe2 )
197 ELSE
198 l=3*numnod
199 ALLOCATE(dd_tmp(l))
200 dd_tmp=zero
201 IF (iroddl/=0) THEN
202 ALLOCATE(ddr_tmp(l))
203 ddr_tmp=zero
204 END IF
205 IF ((nsrem+nsl)>0)
206 . CALL ini_ddfv(iddl ,ikc ,ndof ,ipari ,intbuf_tab,
207 . d_imp,dr_imp,dd_tmp,ddr_tmp,nsl ,
208 . irbe3,lrbe3 ,irbe2 ,lrbe2 )
209 DO i =1,nddl
210 lx(i)=zero
211 ENDDO
212 CALL fr_matv( a ,v ,dd_tmp ,ms ,x ,
213 1 ddr_tmp ,ar ,ipari ,intbuf_tab ,
214 2 ndof ,num_imp,ns_imp,ne_imp,lx ,
215 3 nsrem ,nsl ,ibfv ,skew ,xframe ,
216 4 lx ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
217 DEALLOCATE(dd_tmp)
218 IF (iroddl/=0) DEALLOCATE(ddr_tmp)
219 CALL spmd_sumf_v(lx)
220 DO i =1,nddl
221 lb(i) = lb(i)-lx(i)
222 ENDDO
223C------calculate DE for L_search as DD,DDR will be updated
224 CALL produt_vmhp(nddl0 ,nddl ,iddl ,ndof ,ikc ,
225 . dd ,ddr ,lb ,de ,w_ddl )
226 IF ((nsrem+nsl)>0)
227 . CALL ini_dd0(iddl ,ikc ,ndof ,ipari ,intbuf_tab ,
228 . dd ,ddr ,nsl ,irbe3,lrbe3 ,
229 . irbe2 ,lrbe2)
230 ENDIF !(ILINE>0) THEN
231C----6---------------------------------------------------------------7---------8
232 RETURN
233 END
234!||====================================================================
235!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
236!||--- called by ------------------------------------------------------
237!|| imp_fri ../engine/source/mpi/implicit/imp_fri.f
238!||--- calls -----------------------------------------------------
239!|| diag_int ../engine/source/mpi/implicit/imp_fri.F
240!|| dim_kinefr ../engine/source/mpi/implicit/imp_fri.F
241!|| iddl_int ../engine/source/mpi/implicit/imp_fri.F
242!|| imp_frsn ../engine/source/mpi/implicit/imp_fri.F
243!|| ind_kinefr ../engine/source/mpi/implicit/imp_fri.f
244!|| ini_intm ../engine/source/mpi/implicit/imp_fri.F
245!|| spmd_ifc1 ../engine/source/mpi/implicit/imp_spmd.F
246!|| tag_intm ../engine/source/mpi/implicit/imp_fri.F
247!|| tag_intm11 ../engine/source/mpi/implicit/imp_fri.F
248!|| tag_ints ../engine/source/mpi/implicit/imp_fri.F
249!||--- uses -----------------------------------------------------
250!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
251!||====================================================================
252 SUBROUTINE imp_frki(
253 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
254 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
255 3 NINT2 ,IINT2 ,IDDL ,IKC ,NDOF ,
256 4 INLOC ,NSREM ,NSL ,NBINTC ,INTLIST ,
257 5 X ,IBFV ,LJ ,SKEW ,
258 6 XFRAME ,ISKEW ,ICODT ,IRBE3 ,LRBE3 ,
259 7 FRBE3 ,IRBE2 ,LRBE2 )
260C-----------------------------------------------
261C M o d u l e s
262C-----------------------------------------------
263 USE intbufdef_mod
264C----6---------------------------------------------------------------7---------8
265C I m p l i c i t T y p e s
266C-----------------------------------------------
267#include "implicit_f.inc"
268C-----------------------------------------------
269C C o m m o n B l o c k s
270C-----------------------------------------------
271#include "com04_c.inc"
272#include "param_c.inc"
273C-----------------------------------------------------------------
274C D u m m y A r g u m e n t s
275C-----------------------------------------------
276 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
277 . NE_IMP(*),NSREM ,NSL,NBINTC,INTLIST(*)
278 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
279 . NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
280 . IBFV(*),LJ(*),ISKEW(*),ICODT(*),IRBE3(*),LRBE3(*),
281 . IRBE2(*),LRBE2(*)
282C REAL
283 my_real
284 . X(3,*),SKEW(*),XFRAME(*),FRBE3(*)
285 TYPE(intbuf_struct_) INTBUF_TAB(*)
286C-----------------------------------------------
287C L o c a l V a r i a b l e s
288C-----------------------------------------------
289 INTEGER NIN,NTY,ILOCP(NUMNOD),IDDLM(NUMNOD),LNS,LNS2,N_KINE
290 INTEGER I,J,K,L,NDOFI,N,IAD,NRTS,
291 . NSN,NKC,J1,ND,N_KINE_M,LNSS ,LNSS2,LNS3,LNSS3,
292 . LRS2,LRSS2
293 my_real
294 . KSS(6,NSL)
295C------comm. table of remote secondary nodes (to origin proc) and diag_ss
296 CALL SPMD_IFC1(NSREM ,NSL ,KSS )
297 IF (NSL>0) CALL IMP_FRSN(IPARI ,INTBUF_TAB ,NBINTC,INTLIST)
298C IF ((NSREM+NSL)==0) RETURN
299 DO n =1,numnod
300 ilocp(n)=0
301 ENDDO
302C--------tag additional nodes possibly dependent----
303 n_kine=0
304C
305 CALL tag_ints(nsl ,ilocp ,n_kine)
306 n_kine_m=n_kine
307 IF (nsrem>0) THEN
308 iad=1
309 DO nin=1,ninter
310 nty =ipari(7,nin)
311 IF(nty==5) iad=iad+num_imp(nin)
312 ENDDO
313 DO nin=1,ninter
314 nsn =ipari(5,nin)
315 nty =ipari(7,nin)
316 IF(nty==3)THEN
317 ELSEIF(nty==4)THEN
318 ELSEIF(nty==5)THEN
319 ELSEIF(nty==6)THEN
320 ELSEIF(nty==7.OR.nty==10.OR.nty==24)THEN
321C
322 CALL tag_intm(num_imp(nin),ns_imp(iad),ne_imp(iad),
323 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV , ilocp ,
324 . n_kine ,nsn )
325 iad=iad+num_imp(nin)
326C
327 ELSEIF(nty==11)THEN
328 nrts =ipari(3,nin)
329 CALL tag_intm11(num_imp(nin),ns_imp(iad),ne_imp(iad),
330 . intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%IRECTM, ilocp ,
331 . n_kine ,nrts )
332 iad=iad+num_imp(nin)
333C
334 ENDIF
335 ENDDO
336 ENDIF
337C-------init iml--isl ----
338 CALL ini_intm(ilocp ,n_kine_m, n_kine )
339C-------iddlm-----------------
340 nkc=0
341 DO n =1,numnod
342 i=inloc(n)
343 iddlm(i)=iddl(i)-nkc
344 DO j=1,ndof(i)
345 nd = iddl(i)+j
346 IF (ikc(nd)/=0) nkc = nkc + 1
347 ENDDO
348 ENDDO
349C-----coupling with kinematic constraints ------
350 CALL dim_kinefr(
351 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
352 2 nint2 ,iint2 ,ipari ,intbuf_tab,ilocp,
353 3 lns ,lns2 ,lnss ,lnss2 ,n_kine_m ,
354 4 irbe3 ,lns3 ,lnss3 ,irbe2 ,lrbe2 ,
355 5 lrs2 ,lrss2 )
356 CALL ind_kinefr(
357 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
358 2 nint2 ,iint2 ,ipari ,intbuf_tab,ilocp,
359 3 lns ,lns2 ,lnss ,lnss2 ,n_kine_m ,
360 4 ibfv ,lj ,iskew ,icodt ,irbe3 ,
361 5 lns3 ,lnss3 ,irbe2 ,lrbe2 ,lrs2 ,
362 6 lrss2 )
363 CALL iddl_int(nsl ,iddl ,ikc ,ndof ,iddlm ,
364 . ipari ,intbuf_tab ,irbe3 ,lrbe3 ,frbe3 ,
365 . x ,skew ,irbe2 ,lrbe2 )
366 IF (nsl>0)
367 . CALL diag_int(nsl ,ndof ,ipari ,intbuf_tab,
368 . kss ,x ,ibfv ,skew ,xframe ,
369 . irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
370C----6---------------------------------------------------------------7---------8
371 RETURN
372 END
373C ------retrieve ISL in global num (by each proc)---
374!||====================================================================
375!|| imp_frsn ../engine/source/mpi/implicit/imp_fri.F
376!||--- called by ------------------------------------------------------
377!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
378!|| imp_frki ../engine/source/mpi/implicit/imp_fri.f
379!||--- uses -----------------------------------------------------
380!|| imp_intm ../engine/share/modules/imp_intm.F
381!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
382!||====================================================================
383 SUBROUTINE imp_frsn(IPARI ,INTBUF_TAB ,NBINTC,INTLIST)
384C-----------------------------------------------
385C M o d u l e s
386C-----------------------------------------------
387 USE imp_intm
388 USE intbufdef_mod
389C-----------------------------------------------
390C I m p l i c i t T y p e s
391C-----------------------------------------------
392#include "implicit_f.inc"
393C-----------------------------------------------
394C C o m m o n B l o c k s
395C-----------------------------------------------
396#include "param_c.inc"
397#include "com01_c.inc"
398C-----------------------------------------------
399C D u m m y A r g u m e n t s
400C-----------------------------------------------
401 INTEGER IPARI(NPARI,*), NBINTC,INTLIST(*)
402 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
403C-----------------------------------------------
404C L o c a l V a r i a b l e s
405C-----------------------------------------------
406 INTEGER I,J,K,L,N,NN,IAD,NSN,NIN,NUM,NTY,II,NB
407 INTEGER N0,N1,N2
408C-----------------------------------------------
409C S o u r c e L i n e s
410C-----------------------------------------------
411C
412 l = 0
413C -----sort by proc---independent interface structure------
414 DO i = 1, nspmd
415 IF(iad_sl(i+1)>iad_sl(i))THEN
416 DO ii = 1, nbintc
417 nin = intlist(ii)
418 nb = inbsl(ii,i)
419 IF(nb>0)THEN
420 nty = ipari(7,nin)
421 IF(nty==7.OR.nty==10.OR.nty==24) THEN
422 DO j = 1, nb
423 l = l + 1
424 n0 = isl(l)
425 n = intbuf_tab(nin)%NSV(n0)
426 isl(l) = n
427 ENDDO
428C
429 ELSEIF(nty==11) THEN
430 DO j = 1, nb/2
431 l = l + 1
432 n0 = isl(l)
433 n1 = intbuf_tab(nin)%IRECTS(2*(n0-1)+1)
434 n2 = intbuf_tab(nin)%IRECTS(2*(n0-1)+2)
435 isl(l) = n1
436 l = l + 1
437 isl(l) = n2
438 ENDDO
439C
440 END IF
441 END IF
442 ENDDO
443 ENDIF
444 ENDDO
445C
446 RETURN
447 END
448!||====================================================================
449!|| imp_frii ../engine/source/mpi/implicit/imp_fri.F
450!||--- called by ------------------------------------------------------
451!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
452!||--- uses -----------------------------------------------------
453!|| imp_intm ../engine/share/modules/imp_intm.F
454!||====================================================================
455 SUBROUTINE imp_frii(NINTER)
456C-----------------------------------------------
457C M o d u l e s
458C-----------------------------------------------
459 USE imp_intm
460C-----------------------------------------------
461C I m p l i c i t T y p e s
462C-----------------------------------------------
463#include "implicit_f.inc"
464C-----------------------------------------------
465C C o m m o n B l o c k s
466C-----------------------------------------------
467#include "impl1_c.inc"
468C-----------------------------------------------
469C D u m m y A r g u m e n t s
470C-----------------------------------------------
471 INTEGER NINTER
472C-----------------------------------------------
473C L o c a l V a r i a b l e s
474C-----------------------------------------------
475 INTEGER I
476C-----------------------------------------------
477C S o u r c e L i n e s
478C-----------------------------------------------
479C
480 ALLOCATE(ind_int(ninter))
481 DO i=1,ninter
482 NULLIFY(ind_int(i)%p)
483 ENDDO
484 ALLOCATE(shf_int(ninter))
485C
486 intp_d = max(0,intp_c)
487 nddl_si = 0
488 nddl_sl = 0
489 nz_si = 0
490 nz_sl = 0
491C
492 RETURN
493 END
494!||====================================================================
495!|| imp_fr7i ../engine/source/mpi/implicit/imp_fri.F
496!||--- called by ------------------------------------------------------
497!|| imp_chkm ../engine/source/implicit/imp_solv.F
498!|| imp_solv ../engine/source/implicit/imp_solv.F
499!||--- uses -----------------------------------------------------
500!|| imp_intm ../engine/share/modules/imp_intm.F
501!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
502!|| tri7box ../engine/share/modules/tri7box.F
503!||====================================================================
504 SUBROUTINE imp_fr7i(IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NSREM ,
505 1 NBINTC,INTLIST)
506C-----------------------------------------------
507C M o d u l e s
508C-----------------------------------------------
509 USE tri7box
510 USE imp_intm
511 USE intbufdef_mod
512C-----------------------------------------------
513C I m p l i c i t T y p e s
514C-----------------------------------------------
515#include "implicit_f.inc"
516C-----------------------------------------------
517C C o m m o n B l o c k s
518C-----------------------------------------------
519#include "param_c.inc"
520#include "com01_c.inc"
521#include "com04_c.inc"
522#include "task_c.inc"
523C-----------------------------------------------
524C D u m m y A r g u m e n t s
525C-----------------------------------------------
526 INTEGER NUM_IMP(*),NS_IMP(*),IPARI(NPARI,*),
527 . nsrem,nbintc,intlist(*)
528 TYPE(intbuf_struct_) INTBUF_TAB(*)
529C-----------------------------------------------
530C L o c a l V a r i a b l e s
531C-----------------------------------------------
532 INTEGER I,J,K,L,N,NN,IAD,NSN,NIN,NUM,NTY,II,NB
533 INTEGER IERROR1,IERROR2,NRTS,NSREM11,NCONT,
534 . ierror3,ierror4,ierror5,ierror6,ierror7
535 INTEGER DEBUT(NINTER),DEBUTI(NINTER),L1,
536 . IERROR8,IERROR9,IDEB,IDEBI,LOC_PROC
537C-----------------------------------------------
538C S o u r c e L i n e s
539C-----------------------------------------------
540 LOC_PROC = ispmd + 1
541C----init
542 DO ii = 1, nbintc
543 nin = intlist(ii)
544 debuti(nin) = 0
545 ENDDO
546 DO i = 1, nspmd
547 IF(i/=loc_proc)THEN
548 DO ii = 1, nbintc
549 nin = intlist(ii)
550 nb = nsnfi(nin)%P(i)
551 nty = ipari(7,nin)
552 IF(nty==7.OR.nty==10.OR.nty==11.OR.nty==24) THEN
553 IF(nb>0) THEN
554 debuti(nin) = debuti(nin) + nb
555 END IF
556 END IF
557 ENDDO
558 ENDIF
559 ENDDO
560C
561C
562 nsrem11 = 0
563 iad=0
564 l = 0
565 DO nin=1,ninter
566 nty =ipari(7,nin)
567 IF(nty==5) iad=iad+num_imp(nin)
568 ENDDO
569 DO nin=1,ninter
570 num=0
571 nty =ipari(7,nin)
572 nsn =ipari(5,nin)
573 shf_int(nin) = l
574 IF(nty==7.OR.nty==10.OR.nty==24) THEN
575 DO i=1,num_imp(nin)
576 IF (ns_imp(i+iad)>nsn) THEN
577 nn=ns_imp(i+iad)-nsn
578C -------tag impact nodes-------
579 nsvfi(nin)%P(nn)=-abs(nsvfi(nin)%P(nn))
580 num=num+1
581 ENDIF
582 ENDDO
583 iad=iad+num_imp(nin)
584 ELSEIF(nty==11)THEN
585C
586 nrts =ipari(3,nin)
587 DO i=1,num_imp(nin)
588 IF (ns_imp(i+iad)>nrts) THEN
589 nn=ns_imp(i+iad)-nrts
590C -------tag impact nodes-------
591 nsvfi(nin)%P(nn)=-abs(nsvfi(nin)%P(nn))
592 num=num+1
593 nsrem11 = nsrem11 + 1
594 ENDIF
595 ENDDO
596 iad=iad+num_imp(nin)
597C
598 ELSE
599 ENDIF
600 l = l + num
601 IF(ASSOCIATED(ind_int(nin)%P)) DEALLOCATE(ind_int(nin)%P)
602 l1=debuti(nin)
603 IF (l1>0) ALLOCATE(ind_int(nin)%P(l1),stat=ierror1)
604 ENDDO
605C---------
606C
607C Allocation of boundary interface arrays for implicit
608C
609C
610 ncont = nsrem-nsrem11
611 IF (intp_d==0) THEN
612 IF(ALLOCATED(stifs)) DEALLOCATE(stifs)
613 ALLOCATE(stifs(ncont),stat=ierror3)
614 IF(ALLOCATED(h_e)) DEALLOCATE(h_e)
615 ALLOCATE(h_e(4,ncont),stat=ierror4)
616 IF(ALLOCATED(n_e)) DEALLOCATE(n_e)
617 ALLOCATE(n_e(3,ncont),stat=ierror5)
618C
619 ENDIF
620C
621 IF(ALLOCATED(fr_srem)) DEALLOCATE(fr_srem)
622 ALLOCATE(fr_srem(nsrem),stat=ierror2)
623 IF(ALLOCATED(dfi)) DEALLOCATE(dfi)
624 ALLOCATE(dfi(3,nsrem),stat=ierror6)
625 IF(ALLOCATED(ffi)) DEALLOCATE(ffi)
626 ALLOCATE(ffi(3,nsrem),stat=ierror7)
627C
628 IF(ALLOCATED(iad_srem)) DEALLOCATE(iad_srem)
629 ALLOCATE(iad_srem(nspmd+1),stat=ierror8)
630 IF(ALLOCATED(inbsl)) DEALLOCATE(inbsl)
631 ALLOCATE(inbsl(nbintc,nspmd),stat=ierror9)
632C -----sort by proc---independent interface structure------
633 DO ii = 1, nbintc
634 nin = intlist(ii)
635 debut(nin) = 0
636 debuti(nin) = 0
637 ENDDO
638 l = 1
639C
640 iad_srem(1) = l
641 DO i = 1, nspmd
642 IF(i/=loc_proc)THEN
643 DO ii = 1, nbintc
644 nin = intlist(ii)
645 ideb = debut(nin)
646 idebi = debuti(nin)
647 nb = nsnfi(nin)%P(i)
648 nty = ipari(7,nin)
649 nsn = ipari(5,nin)
650 l1 = l
651 IF(nty==7.OR.nty==10.OR.nty==11.OR.nty==24) THEN
652 IF(nb>0) THEN
653 IF(nty==7.OR.nty==10.OR.nty==24) THEN
654 DO n = 1, nb
655 IF(nsvfi(nin)%P(ideb+n)<0)THEN
656 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
657 fr_srem(l) = nsvfi(nin)%P(ideb+n)
658 ind_int(nin)%P(idebi+n)=l
659 l = l + 1
660 ENDIF
661 ENDDO
662 debuti(nin) = debuti(nin) + nb
663C
664 ELSEIF(nty==11) THEN
665 DO n = 1, nb
666 IF(nsvfi(nin)%P(ideb+n)<0)THEN
667 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
668 fr_srem(l) = nsvfi(nin)%P(ideb+n)
669 ind_int(nin)%P(idebi+n)=l
670 l = l + 1
671 fr_srem(l) = 0
672 l = l + 1
673 ENDIF
674 ENDDO
675 debuti(nin) = debuti(nin) + nb
676C
677 ENDIF
678 debut(nin) = debut(nin) + nb
679 END IF
680 END IF
681 inbsl(ii,i)= l - l1
682 ENDDO
683 ENDIF
684 iad_srem(i+1)=l
685 ENDDO
686 IF(iad_srem(nspmd+1)>1)nsrem=iad_srem(nspmd+1)-1
687C
688 RETURN
689 END
690!||====================================================================
691!|| imp_frsl ../engine/source/mpi/implicit/imp_fri.F
692!||--- called by ------------------------------------------------------
693!|| imp_fri ../engine/source/mpi/implicit/imp_fri.F
694!||--- calls -----------------------------------------------------
695!|| spmd_inis ../engine/source/mpi/implicit/imp_spmd.F
696!|| spmd_inisl ../engine/source/mpi/implicit/imp_spmd.F
697!||--- uses -----------------------------------------------------
698!|| imp_intm ../engine/share/modules/imp_intm.F
699!||====================================================================
700 SUBROUTINE imp_frsl(NBINTC,NSREM ,NSL )
701C-----------------------------------------------
702C M o d u l e s
703C-----------------------------------------------
704 USE imp_intm
705C-----------------------------------------------
706C I m p l i c i t T y p e s
707C-----------------------------------------------
708#include "implicit_f.inc"
709C-----------------------------------------------
710C C o m m o n B l o c k s
711C-----------------------------------------------
712#include "com01_c.inc"
713C-----------------------------------------------
714C D u m m y A r g u m e n t s
715C-----------------------------------------------
716 INTEGER NBINTC,NSL,NSREM
717C-----------------------------------------------
718C L o c a l V a r i a b l e s
719C-----------------------------------------------
720 INTEGER I,IERROR1,IERROR2,IERROR3,IERROR4,IERROR5,
721 . II,IAD
722C-----------------------------------------------
723C S o u r c e L i n e s
724C-----------------------------------------------
725C
726 IF(ALLOCATED(iad_sl)) DEALLOCATE(iad_sl)
727 ALLOCATE(iad_sl(nspmd+1),stat=ierror1)
728 IF (nsrem==0) THEN
729 IF(ALLOCATED(iad_srem)) DEALLOCATE(iad_srem)
730 ALLOCATE(iad_srem(nspmd+1),stat=ierror2)
731 DO i = 1, nspmd+1
732 iad_srem(i)=1
733 ENDDO
734 ENDIF
735C
736 CALL spmd_inis(iad_srem,iad_sl)
737 nsl=iad_sl(nspmd+1)-1
738 IF (nsrem==0) THEN
739 IF(ALLOCATED(inbsl)) DEALLOCATE(inbsl)
740 ALLOCATE(inbsl(nbintc,nspmd),stat=ierror5)
741 DO i = 1, nspmd
742 DO ii = 1, nbintc
743 inbsl(ii,i)=0
744 ENDDO
745 ENDDO
746 ENDIF
747 CALL spmd_inisl(nbintc,inbsl)
748 IF (nsl>0) THEN
749 IF(ALLOCATED(isl)) DEALLOCATE(isl)
750 ALLOCATE(isl(nsl),stat=ierror3)
751C
752 IF (intp_d==0) THEN
753 IF(ALLOCATED(diag_s)) DEALLOCATE(diag_s)
754 ALLOCATE(diag_s(3,nsl),stat=ierror4)
755 IF(ALLOCATED(islm)) DEALLOCATE(islm)
756 ALLOCATE(islm(nsl),stat=ierror5)
757C
758 ENDIF
759 ENDIF
760
761C
762 RETURN
763 END
764C --------- ----
765!||====================================================================
766!|| tag_intm ../engine/source/mpi/implicit/imp_fri.F
767!||--- called by ------------------------------------------------------
768!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
769!||====================================================================
770 SUBROUTINE tag_intm(
771 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NSV ,
772 2 ILOC ,N_IMPN ,NSN )
773C----6---------------------------------------------------------------7---------8
774C I m p l i c i t T y p e s
775C-----------------------------------------------
776#include "implicit_f.inc"
777C-----------------------------------------------
778C C o m m o n B l o c k s
779C-----------------------------------------------
780C-----------------------------------------------------------------
781C D u m m y A r g u m e n t s
782C-----------------------------------------------
783 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),
784 . iloc(*),n_impn,nsn
785C REAL
786C-----------------------------------------------
787C L o c a l V a r i a b l e s
788C-----------------------------------------------
789 INTEGER I,J,N,N1,N2,NE,IG
790C-----------------------------------------------
791 DO I = 1, jlt
792C--------secnd node-----
793 ig = ns_imp(i)
794 IF (ig>nsn) THEN
795 ne=ne_imp(i)
796 DO j=1,3
797 n=irect(j,ne)
798 IF (iloc(n)==0) THEN
799 n_impn=n_impn+1
800 iloc(n)=n_impn
801 ENDIF
802 ENDDO
803 IF (irect(3,ne)/=irect(4,ne)) THEN
804 n=irect(4,ne)
805 IF (iloc(n)==0) THEN
806 n_impn=n_impn+1
807 iloc(n)=n_impn
808 ENDIF
809 ENDIF
810 ENDIF
811 ENDDO
812C----6---------------------------------------------------------------7---------8
813 RETURN
814 END
815C --------- ----
816!||====================================================================
817!|| tag_ints ../engine/source/mpi/implicit/imp_fri.F
818!||--- called by ------------------------------------------------------
819!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
820!|| kin_ksl ../engine/source/mpi/implicit/imp_fri.F
821!||--- uses -----------------------------------------------------
822!|| imp_intm ../engine/share/modules/imp_intm.F
823!||====================================================================
824 SUBROUTINE tag_ints(NSL ,ILOC ,N_IMPN )
825C-----------------------------------------------
826C M o d u l e s
827C-----------------------------------------------
828 USE imp_intm
829C----6---------------------------------------------------------------7---------8
830C I m p l i c i t T y p e s
831C-----------------------------------------------
832#include "implicit_f.inc"
833C-----------------------------------------------------------------
834C D u m m y A r g u m e n t s
835C-----------------------------------------------
836 INTEGER NSL,ILOC(*),N_IMPN
837C REAL
838C-----------------------------------------------
839C L o c a l V a r i a b l e s
840C-----------------------------------------------
841 INTEGER I,J,N,N1,N2,NE,IG
842C-----------------------------------------------
843 IF (INTP_D>0) THEN
844 DO I = 1, nsl
845C--------secnd node--------------
846 n = isl(i)
847 IF (iloc(n)==0) iloc(n)=i
848 ENDDO
849 ELSE
850
851 DO i = 1, nsl
852C--------secnd node-----
853 n = isl(i)
854 IF (iloc(n)==0) THEN
855 n_impn=n_impn+1
856 iloc(n)=n_impn
857C
858 islm(i) = n
859 ELSE
860 islm(i) = 0
861C
862 ENDIF
863 ENDDO
864C
865 ENDIF
866C----6---------------------------------------------------------------7---------8
867 RETURN
868 END
869!||====================================================================
870!|| ini_ddfv ../engine/source/mpi/implicit/imp_fri.F
871!||--- called by ------------------------------------------------------
872!|| imp_frfv ../engine/source/mpi/implicit/imp_fri.F
873!||--- uses -----------------------------------------------------
874!|| imp_intm ../engine/share/modules/imp_intm.F
875!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
876!||====================================================================
877 SUBROUTINE ini_ddfv(IDDL ,IKC ,NDOF ,IPARI ,INTBUF_TAB ,
878 . D ,DR ,DD ,DDR ,NSL ,
879 . IRBE3,LRBE3,IRBE2 ,LRBE2 )
880C-----------------------------------------------
881C M o d u l e s
882C-----------------------------------------------
883 USE intbufdef_mod
884C-----------------------------------------------
885C M o d u l e s
886C-----------------------------------------------
887 USE imp_intm
888C----6---------------------------------------------------------------7---------8
889C I m p l i c i t T y p e s
890C-----------------------------------------------
891#include "implicit_f.inc"
892C-----------------------------------------------
893C C o m m o n B l o c k s
894C-----------------------------------------------
895#include "param_c.inc"
896C-----------------------------------------------------------------
897C D u m m y A r g u m e n t s
898C-----------------------------------------------
899 INTEGER IDDL(*),IKC(*),NDOF(*),NSL
900 INTEGER IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*) ,
901 . IRBE2(NRBE2L,*),LRBE2(*)
902C REAL
903 my_real
904 . d(3,*),dr(3,*),dd(3,*),ddr(3,*)
905 TYPE(intbuf_struct_) INTBUF_TAB(*)
906C-----------------------------------------------
907C L o c a l V a r i a b l e s
908C-----------------------------------------------
909 INTEGER I,ND,N,J,IAD
910 INTEGER M,NSN,JI,L,NNOD,NJ,NL,NI
911C-----------------------------------------------
912 DO I = 1, nsl
913C--------local secnd node-----
914 n = isl(i)
915 DO j = 1, min(3,ndof(n))
916 nd = iddl(n)+j
917 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
918 dd(j,n)=d(j,n)
919 ENDIF
920 ENDDO
921 DO j = 3, ndof(n)
922 nd = iddl(n)+j
923 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
924 ddr(j-3,n)=dr(j-3,n)
925 ENDIF
926 ENDDO
927 ENDDO
928C
929 DO i = 1, nml
930C--------local main node-----
931 n = iml(i)
932 DO j = 1, min(3,ndof(n))
933 nd = iddl(n)+j
934 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
935 dd(j,n)=d(j,n)
936 ENDIF
937 ENDDO
938 DO j = 3, ndof(n)
939 nd = iddl(n)+j
940 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
941 ddr(j-3,n)=dr(j-3,n)
942 ENDIF
943 ENDDO
944 ENDDO
945C------Rigid bodies-----
946 DO i=1,nrb_fr
947 m=ifrsr(1,i)
948 DO j=1,min(3,ndof(m))
949 nd = iddl(m)+j
950 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
951 dd(j,m)=d(j,m)
952 ENDIF
953 ENDDO
954 DO j=3,ndof(m)
955 nd = iddl(m)+j
956 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
957 ddr(j-3,m)=dr(j-3,m)
958 ENDIF
959 ENDDO
960 ENDDO
961C------int2-------
962 DO i=1,ni2_fr
963 n=ifrs2(1,i)
964 ni=ifrs2(2,i)
965 ji=ipari(1,n)
966 nsn=ipari(5,n)
967 l=intbuf_tab(n)%IRTLM(ni)
968 nl=4*(l-1)
969 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
970 nnod=3
971 ELSE
972 nnod=4
973 ENDIF
974C-------if main node is also dependent-----
975 DO m=1,nnod
976 nj=intbuf_tab(n)%IRECTM(nl+m)
977 DO j = 1 , min(3,ndof(nj))
978 nd = iddl(nj) + j
979 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
980 dd(j,nj)=d(j,nj)
981 ENDIF
982 ENDDO
983 DO j = 3 , ndof(nj)
984 nd = iddl(nj) + j
985 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
986 ddr(j-3,nj)=dr(j-3,nj)
987 ENDIF
988 ENDDO
989 ENDDO
990 ENDDO
991C------RBE3-------
992 DO i=1,nrbe3_fr
993 n=ifrs3(i)
994 nnod=irbe3(5,n)
995 iad=irbe3(1,n)
996C-------if main node is also dependent-----
997 DO m=1,nnod
998 nj=lrbe3(iad+m)
999 DO j = 1 , min(3,ndof(nj))
1000 nd = iddl(nj) + j
1001 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1002 dd(j,nj)=d(j,nj)
1003 ENDIF
1004 ENDDO
1005 DO j = 3 , ndof(nj)
1006 nd = iddl(nj) + j
1007 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1008 ddr(j-3,nj)=dr(j-3,nj)
1009 ENDIF
1010 ENDDO
1011 ENDDO
1012 ENDDO
1013C------RBE2-------
1014 DO i=1,nrbe2_fr
1015 n=ifrs4(1,i)
1016 m=irbe2(3,n)
1017 DO j=1,min(3,ndof(m))
1018 nd = iddl(m)+j
1019 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1020 dd(j,m)=d(j,m)
1021 ENDIF
1022 ENDDO
1023 DO j=3,ndof(m)
1024 nd = iddl(m)+j
1025 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1026 ddr(j-3,m)=dr(j-3,m)
1027 ENDIF
1028 ENDDO
1029 ENDDO
1030C----6---------------------------------------------------------------7---------8
1031 RETURN
1032 END
1033!||====================================================================
1034!|| ini_dd0 ../engine/source/mpi/implicit/imp_fri.F
1035!||--- called by ------------------------------------------------------
1036!|| imp_frfv ../engine/source/mpi/implicit/imp_fri.F
1037!||--- uses -----------------------------------------------------
1038!|| imp_intm ../engine/share/modules/imp_intm.F
1039!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1040!||====================================================================
1041 SUBROUTINE ini_dd0(IDDL ,IKC ,NDOF ,IPARI ,INTBUF_TAB ,
1042 . DD ,DDR ,NSL ,IRBE3 ,LRBE3 ,
1043 . IRBE2,LRBE2 )
1044C-----------------------------------------------
1045C M o d u l e s
1046C-----------------------------------------------
1047 USE imp_intm
1048 USE intbufdef_mod
1049C----6---------------------------------------------------------------7---------8
1050C I m p l i c i t T y p e s
1051C-----------------------------------------------
1052#include "implicit_f.inc"
1053C-----------------------------------------------
1054C C o m m o n B l o c k s
1055C-----------------------------------------------
1056#include "param_c.inc"
1057C-----------------------------------------------------------------
1058C D u m m y A r g u m e n t s
1059C-----------------------------------------------
1060 INTEGER IDDL(*),IKC(*),NDOF(*),NSL
1061 INTEGER IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
1062 . IRBE2(NRBE2L,*),LRBE2(*)
1063C REAL
1064 my_real
1065 . DD(3,*),DDR(3,*)
1066 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1067C-----------------------------------------------
1068C L o c a l V a r i a b l e s
1069C-----------------------------------------------
1070 INTEGER I,ND,N,J,IAD,JI
1071 INTEGER M,NSN,L,NNOD,NJ,NL,NI
1072C-----------------------------------------------
1073 DO I = 1, nsl
1074C--------local secnd node-----
1075 n = isl(i)
1076 DO j = 1, min(3,ndof(n))
1077 nd = iddl(n)+j
1078 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1079 dd(j,n)=zero
1080 ENDIF
1081 ENDDO
1082 DO j = 3, ndof(n)
1083 nd = iddl(n)+j
1084 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1085 ddr(j-3,n)=zero
1086 ENDIF
1087 ENDDO
1088 ENDDO
1089C
1090 DO i = 1, nml
1091C--------local main node-----
1092 n = iml(i)
1093 DO j = 1, min(3,ndof(n))
1094 nd = iddl(n)+j
1095 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1096 dd(j,n)=zero
1097 ENDIF
1098 ENDDO
1099 DO j = 3, ndof(n)
1100 nd = iddl(n)+j
1101 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1102 ddr(j-3,n)=zero
1103 ENDIF
1104 ENDDO
1105 ENDDO
1106C------Rigid bodies-------
1107 DO i=1,nrb_fr
1108 m=ifrsr(1,i)
1109 DO j=1,min(3,ndof(m))
1110 nd = iddl(m)+j
1111 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1112 dd(j,m)=zero
1113 ENDIF
1114 ENDDO
1115 DO j = 3, ndof(m)
1116 nd = iddl(m)+j
1117 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1118 ddr(j-3,m)=zero
1119 ENDIF
1120 ENDDO
1121 ENDDO
1122C------int2-------
1123 DO i=1,ni2_fr
1124 n=ifrs2(1,i)
1125 ni=ifrs2(2,i)
1126 ji=ipari(1,n)
1127 nsn=ipari(5,n)
1128 l=intbuf_tab(n)%IRTLM(ni)
1129 nl=4*(l-1)
1130 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
1131 nnod=3
1132 ELSE
1133 nnod=4
1134 ENDIF
1135C-------if main node is also dependent-----
1136 DO m=1,nnod
1137 nj=intbuf_tab(n)%IRECTM(nl+m)
1138 DO j = 1 , min(3,ndof(nj))
1139 nd = iddl(nj) + j
1140 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1141 dd(j,nj)=zero
1142 ENDIF
1143 ENDDO
1144 DO j = 3 , ndof(nj)
1145 nd = iddl(nj) + j
1146 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1147 ddr(j-3,nj)=zero
1148 ENDIF
1149 ENDDO
1150 ENDDO
1151 ENDDO
1152C------RBE3-------
1153 DO i=1,nrbe3_fr
1154 n=ifrs3(i)
1155 nnod=irbe3(5,n)
1156 iad=irbe3(1,n)
1157C-------if main node is also dependent-----
1158 DO m=1,nnod
1159 nj=lrbe3(iad+m)
1160 DO j = 1 , min(3,ndof(nj))
1161 nd = iddl(nj) + j
1162 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1163 dd(j,nj)=zero
1164 ENDIF
1165 ENDDO
1166 DO j = 3 , ndof(nj)
1167 nd = iddl(nj) + j
1168 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1169 ddr(j-3,nj)=zero
1170 ENDIF
1171 ENDDO
1172 ENDDO
1173 ENDDO
1174C------RBE2-------
1175 DO i=1,nrbe2_fr
1176 n=ifrs4(1,i)
1177 m=irbe2(3,n)
1178 DO j=1,min(3,ndof(m))
1179 nd = iddl(m)+j
1180 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1181 dd(j,m)=zero
1182 ENDIF
1183 ENDDO
1184 DO j = 3, ndof(m)
1185 nd = iddl(m)+j
1186 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
1187 ddr(j-3,m)=zero
1188 ENDIF
1189 ENDDO
1190 ENDDO
1191C----6---------------------------------------------------------------7---------8
1192 RETURN
1193 END
1194C --------- ----
1195!||====================================================================
1196!|| ini_intm ../engine/source/mpi/implicit/imp_fri.F
1197!||--- called by ------------------------------------------------------
1198!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
1199!||--- uses -----------------------------------------------------
1200!|| imp_intm ../engine/share/modules/imp_intm.F
1201!||====================================================================
1202 SUBROUTINE ini_intm(ILOC ,N_IMPS,N_IMPN )
1203C-----------------------------------------------
1204C M o d u l e s
1205C-----------------------------------------------
1206 USE imp_intm
1207C----6---------------------------------------------------------------7---------8
1208C I m p l i c i t T y p e s
1209C-----------------------------------------------
1210#include "implicit_f.inc"
1211C-----------------------------------------------
1212C C o m m o n B l o c k s
1213C-----------------------------------------------
1214#include "com04_c.inc"
1215C-----------------------------------------------------------------
1216C D u m m y A r g u m e n t s
1217C-----------------------------------------------
1218 INTEGER ILOC(*),N_IMPN,N_IMPS
1219C REAL
1220C-----------------------------------------------
1221C L o c a l V a r i a b l e s
1222C-----------------------------------------------
1223 INTEGER I,J,N,IERROR1
1224C-----------------------------------------------
1225C
1226 NML=n_impn-n_imps
1227 IF (nml>0) THEN
1228 IF(ALLOCATED(iml)) DEALLOCATE(iml)
1229 ALLOCATE(iml(nml),stat=ierror1)
1230 DO n = 1, numnod
1231 IF (iloc(n)>n_imps) THEN
1232 i=iloc(n)-n_imps
1233 iml(i)=n
1234 ENDIF
1235 ENDDO
1236 ENDIF
1237C----6---------------------------------------------------------------7---------8
1238 RETURN
1239 END
1240!||====================================================================
1241!|| dim_kinefr ../engine/source/mpi/implicit/imp_fri.F
1242!||--- called by ------------------------------------------------------
1243!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
1244!||--- uses -----------------------------------------------------
1245!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1246!||====================================================================
1247 SUBROUTINE dim_kinefr(
1248 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
1249 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,INLOC ,
1250 3 LNS ,LNS2 ,LNSS ,LNSS2 ,NK_M ,
1251 4 IRBE3 ,LNS3 ,LNSS3 ,IRBE2 ,LRBE2 ,
1252 5 LNR2 ,LNRS2 )
1253C-----------------------------------------------
1254C M o d u l e s
1255C-----------------------------------------------
1256 USE intbufdef_mod
1257C----6---------------------------------------------------------------7---------8
1258C I m p l i c i t T y p e s
1259C-----------------------------------------------
1260#include "implicit_f.inc"
1261C-----------------------------------------------
1262C C o m m o n B l o c k s
1263C-----------------------------------------------
1264#include "com04_c.inc"
1265#include "param_c.inc"
1266C-----------------------------------------------------------------
1267C D u m m y A r g u m e n t s
1268C-----------------------------------------------
1269C INTEGER NNMAX,NKMAX
1270 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
1271 . NINT2,IINT2(*),IPARI(NPARI,*)
1272 integer
1273 . inloc(*),lns ,lns2,lnss ,lnss2,nk_m,
1274 . irbe3(nrbe3l,*),lns3 ,lnss3 ,irbe2(nrbe2l,*),lrbe2(*),
1275 . lnr2 ,lnrs2
1276C REAL
1277 TYPE(intbuf_struct_) INTBUF_TAB(*)
1278C-----------------------------------------------
1279C L o c a l V a r i a b l e s
1280C-----------------------------------------------
1281 integer
1282 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,
1283 . ji,kfi,ns,iad
1284C----------------------------
1285 lns2=0
1286 lnss2=0
1287 DO j=1,nint2
1288 n=iint2(j)
1289 nsn = ipari(5,n)
1290 ji=ipari(1,n)
1291 DO i=1,nsn
1292 ni=intbuf_tab(n)%NSV(i)
1293 IF (inloc(ni)>0) THEN
1294 lns2=lns2+1
1295 IF (inloc(ni)<=nk_m) lnss2=lnss2+1
1296 ENDIF
1297 ENDDO
1298 ENDDO
1299C--------RBE3--------------------
1300 lns3=0
1301 lnss3=0
1302 DO n=1,nrbe3
1303 ni = irbe3(3,n)
1304 IF (ni==0) cycle
1305 IF (inloc(ni)>0) THEN
1306 lns3=lns3+1
1307 IF (inloc(ni)<=nk_m) lnss3=lnss3+1
1308 ENDIF
1309 ENDDO
1310CC-----active rigid body main nodes------
1311 lns=0
1312 lnss=0
1313 DO j=1,nrbyac
1314 n=irbyac(j)
1315 k=irbyac(j+nrbykin)
1316 m =npby(1,n)
1317 nsn =npby(2,n)
1318 DO i=1,nsn
1319 id = i+k
1320 ni=lpby(id)
1321 IF (inloc(ni)>0) THEN
1322 lns=lns+1
1323 IF (inloc(ni)<=nk_m) lnss=lnss+1
1324 IF (inloc(m)==0) inloc(m) = 1
1325 ENDIF
1326 ENDDO
1327 ENDDO
1328C--------RBE2--------------------
1329 lnr2=0
1330 lnrs2=0
1331 DO n=1,nrbe2
1332 iad = irbe2(1,n)
1333 m = irbe2(3,n)
1334 nsn =irbe2(5,n)
1335 DO i=1,nsn
1336 id = iad+i
1337 ni=lrbe2(id)
1338 IF (inloc(ni)>0) THEN
1339 lnr2=lnr2+1
1340 IF (inloc(ni)<=nk_m) lnrs2=lnrs2+1
1341 IF (inloc(m)==0) inloc(m) = 2
1342 ENDIF
1343 ENDDO
1344 ENDDO
1345C----6---------------------------------------------------------------7---------8
1346 RETURN
1347 END
1348!||====================================================================
1349!|| ind_kinefr ../engine/source/mpi/implicit/imp_fri.F
1350!||--- called by ------------------------------------------------------
1351!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
1352!||--- uses -----------------------------------------------------
1353!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
1354!|| imp_intm ../engine/share/modules/imp_intm.F
1355!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
1356!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1357!||====================================================================
1358 SUBROUTINE ind_kinefr(
1359 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
1360 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,INLOC ,
1361 3 NSS ,NSS2 ,NSS_S ,NSS2_S ,KN_M ,
1362 4 IBFV ,LJ ,ISKEW ,ICODT ,IRBE3 ,
1363 5 NSS3 ,NSS3_S ,IRBE2 ,LRBE2 ,NSR2 ,
1364 6 NRS2_S )
1365C-----------------------------------------------
1366C M o d u l e s
1367C-----------------------------------------------
1368 USE imp_intm
1369 USE imp_rwl
1370 USE imp_aspc
1371 USE intbufdef_mod
1372C----6---------------------------------------------------------------7---------8
1373C I m p l i c i t T y p e s
1374C-----------------------------------------------
1375#include "implicit_f.inc"
1376C-----------------------------------------------
1377C C o m m o n B l o c k s
1378C-----------------------------------------------
1379#include "com04_c.inc"
1380#include "param_c.inc"
1381C-----------------------------------------------------------------
1382C D u m m y A r g u m e n t s
1383C-----------------------------------------------
1384C INTEGER NNMAX,NKMAX
1385 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
1386 . nint2,iint2(*),ipari(npari,*),iskew(*),icodt(*)
1387 integer
1388 . inloc(*),nss,nss2,nss_s ,nss2_s,kn_m,ibfv(nifv,*),lj(*),
1389 . irbe3(nrbe3l,*),nss3 ,nss3_s ,irbe2(nrbe2l,*),lrbe2(*),
1390 . nsr2 ,nrs2_s
1391C REAL
1392 TYPE(intbuf_struct_) INTBUF_TAB(*)
1393C-----------------------------------------------
1394C L o c a l V a r i a b l e s
1395C-----------------------------------------------
1396 INTEGER
1397 . I,J,K,N,L,NL,NJ,NI,J1,M,NSN,N1,N2,NK,ID,IAD,JI,
1398 . ierror1,ierror2,ierror3,ierror4,ierror5,ierror6,ierror7
1399c----------------------
1400 ni2_fr=0
1401 ni2_frs=0
1402 IF (nss2>0) THEN
1403 IF(ALLOCATED(ifrs2)) DEALLOCATE(ifrs2)
1404 ALLOCATE(ifrs2(2,nss2),stat=ierror1)
1405 IF (nss2_s>0) THEN
1406 IF(ALLOCATED(ifrs2_s)) DEALLOCATE(ifrs2_s)
1407 ALLOCATE(ifrs2_s(nss2_s),stat=ierror3)
1408 ENDIF
1409 DO j=1,nint2
1410 n=iint2(j)
1411 nsn = ipari(5,n)
1412 ji=ipari(1,n)
1413 DO i=1,nsn
1414 ni=intbuf_tab(n)%NSV(i)
1415 IF (inloc(ni)>0) THEN
1416 ni2_fr=ni2_fr+1
1417 ifrs2(1,ni2_fr)=n
1418 ifrs2(2,ni2_fr)=i
1419 IF (inloc(ni)<=kn_m)THEN
1420 ni2_frs=ni2_frs+1
1421 ifrs2_s(ni2_frs)=ni2_fr
1422 ENDIF
1423 ENDIF
1424 ENDDO
1425 ENDDO
1426 IF (ni2_fr/=nss2.OR.ni2_frs/=nss2_s)
1427 . WRITE(*,*)'pb cal NI2_FR'
1428 ENDIF
1429c-------RBE3---------------
1430 nrbe3_fr=0
1431 nrbe3_frs=0
1432 IF (nss3>0) THEN
1433 IF(ALLOCATED(ifrs3)) DEALLOCATE(ifrs3)
1434 ALLOCATE(ifrs3(nss3),stat=ierror1)
1435 IF (nss3_s>0) THEN
1436 IF(ALLOCATED(ifrs3_s)) DEALLOCATE(ifrs3_s)
1437 ALLOCATE(ifrs3_s(nss3_s),stat=ierror3)
1438 ENDIF
1439 DO n=1,nrbe3
1440 ni=irbe3(3,n)
1441 IF (ni==0) cycle
1442 IF (inloc(ni)>0) THEN
1443 nrbe3_fr=nrbe3_fr+1
1444 ifrs3(nrbe3_fr)=n
1445 IF (inloc(ni)<=kn_m)THEN
1446 nrbe3_frs=nrbe3_frs+1
1447 ifrs3_s(nrbe3_frs)=nrbe3_fr
1448 ENDIF
1449 ENDIF
1450 ENDDO
1451 IF (nrbe3_fr/=nss3.OR.nrbe3_frs/=nss3_s)
1452 . WRITE(*,*)'pb cal NRBE3_FR'
1453 ENDIF
1454C-----active rigid body main nodes------
1455 nrb_fr=0
1456 nrb_frs=0
1457 IF (nss>0) THEN
1458 IF(ALLOCATED(ifrsr)) DEALLOCATE(ifrsr)
1459 ALLOCATE(ifrsr(2,nss),stat=ierror2)
1460 IF (nss_s>0) THEN
1461 IF(ALLOCATED(ifrsr_s)) DEALLOCATE(ifrsr_s)
1462 ALLOCATE(ifrsr_s(nss_s),stat=ierror4)
1463 ENDIF
1464 DO j=1,nrbyac
1465 n=irbyac(j)
1466 k=irbyac(j+nrbykin)
1467 m =npby(1,n)
1468 IF (inloc(m)>0) THEN
1469 nsn =npby(2,n)
1470 DO i=1,nsn
1471 id = i+k
1472 ni=lpby(id)
1473 IF (inloc(ni)>0) THEN
1474 nrb_fr=nrb_fr+1
1475 ifrsr(1,nrb_fr)=m
1476 ifrsr(2,nrb_fr)=ni
1477 IF (inloc(ni)<=kn_m) THEN
1478 nrb_frs=nrb_frs+1
1479 ifrsr_s(nrb_frs)=nrb_fr
1480 ENDIF
1481 ENDIF
1482 ENDDO
1483 ENDIF
1484 ENDDO
1485 ENDIF
1486C
1487 nbc_fr = 0
1488 DO n=1,numnod
1489 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
1490 IF (inloc(n)>0.AND.inloc(n)<=kn_m)nbc_fr = nbc_fr + 1
1491 ENDIF
1492 ENDDO
1493 IF (nbc_fr>0) THEN
1494 IF(ALLOCATED(ibc_fr)) DEALLOCATE(ibc_fr)
1495 ALLOCATE(ibc_fr(3,nbc_fr),stat=ierror5)
1496 nbc_fr = 0
1497 DO n=1,numnod
1498 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
1499 IF (inloc(n)>0.AND.inloc(n)<=kn_m) THEN
1500 nbc_fr = nbc_fr + 1
1501 ibc_fr(1,nbc_fr) = n
1502 ibc_fr(2,nbc_fr) = iskew(n)
1503 ibc_fr(3,nbc_fr) = icodt(n)
1504 ENDIF
1505 ENDIF
1506 ENDDO
1507 ENDIF
1508C-------AUTOSPC
1509 nspc_fr = 0
1510 DO i=1,nspcl
1511 n = in_spc(i)
1512 IF (inloc(n)>0.AND.inloc(n)<=kn_m.AND.ic_spc(i)<=3)
1513 . nspc_fr = nspc_fr + 1
1514 ENDDO
1515 IF (nspc_fr>0) THEN
1516 IF(ALLOCATED(ispc_fr)) DEALLOCATE(ispc_fr)
1517 ALLOCATE(ispc_fr(nspc_fr),stat=ierror5)
1518 nspc_fr = 0
1519 DO i=1,nspcl
1520 n = in_spc(i)
1521 IF (inloc(n)>0.AND.inloc(n)<=kn_m.AND.ic_spc(i)<=3) THEN
1522 nspc_fr = nspc_fr + 1
1523 ispc_fr(nspc_fr)=i
1524 ENDIF
1525 ENDDO
1526 ENDIF
1527C---
1528 nfx_fr = 0
1529 DO j=1,nfxvel
1530 IF (lj(j)>0.AND.lj(j)<=3) THEN
1531 n=iabs(ibfv(1,j))
1532 IF (inloc(n)>0.AND.inloc(n)<=kn_m)nfx_fr = nfx_fr + 1
1533 ENDIF
1534 ENDDO
1535 IF (nfx_fr>0) THEN
1536 IF(ALLOCATED(ifx_fr)) DEALLOCATE(ifx_fr)
1537 ALLOCATE(ifx_fr(2,nfx_fr),stat=ierror6)
1538 nfx_fr = 0
1539 DO j=1,nfxvel
1540 IF (lj(j)>0.AND.lj(j)<=3) THEN
1541 n=iabs(ibfv(1,j))
1542 IF (inloc(n)>0.AND.inloc(n)<=kn_m) THEN
1543 nfx_fr = nfx_fr + 1
1544 ifx_fr(1,nfx_fr) = j
1545 ifx_fr(2,nfx_fr) = lj(j)
1546 ENDIF
1547 ENDIF
1548 ENDDO
1549 ENDIF
1550C
1551 nrw_fr = 0
1552 DO j=1,n_rwl
1553 n=in_rwl(j)
1554 IF (inloc(n)>0) nrw_fr = nrw_fr + 1
1555 ENDDO
1556 IF (nrw_fr>0) THEN
1557 IF(ALLOCATED(irw_fr)) DEALLOCATE(irw_fr)
1558 ALLOCATE(irw_fr(nrw_fr),stat=ierror7)
1559 nrw_fr = 0
1560 DO j=1,n_rwl
1561 n=in_rwl(j)
1562 IF (inloc(n)>0) THEN
1563 nrw_fr = nrw_fr + 1
1564 irw_fr(nrw_fr) = j
1565 ENDIF
1566 ENDDO
1567 ENDIF
1568C
1569C-----RBE2------
1570 nrbe2_fr=0
1571 nrbe2_frs=0
1572 IF (nsr2>0) THEN
1573 IF(ALLOCATED(ifrs4)) DEALLOCATE(ifrs4)
1574 ALLOCATE(ifrs4(2,nsr2),stat=ierror2)
1575 IF (nrs2_s>0) THEN
1576 IF(ALLOCATED(ifrs4_s)) DEALLOCATE(ifrs4_s)
1577 ALLOCATE(ifrs4_s(nrs2_s),stat=ierror4)
1578 ENDIF
1579 DO n=1,nrbe2
1580 m =irbe2(3,n)
1581 IF (inloc(m)>0) THEN
1582 iad = irbe2(1,n)
1583 nsn =irbe2(5,n)
1584 DO i=1,nsn
1585 id = iad+i
1586 ni=lrbe2(id)
1587 IF (inloc(ni)>0) THEN
1588 nrbe2_fr=nrbe2_fr+1
1589 ifrs4(1,nrbe2_fr)=n
1590 ifrs4(2,nrbe2_fr)=ni
1591 IF (inloc(ni)<=kn_m) THEN
1592 nrbe2_frs=nrbe2_frs+1
1593 ifrs4_s(nrbe2_frs)=nrbe2_fr
1594 ENDIF
1595 ENDIF
1596 ENDDO
1597 ENDIF
1598 ENDDO
1599 ENDIF
1600C----6---------------------------------------------------------------7---------8
1601 RETURN
1602 END
1603!||====================================================================
1604!|| iddl_int ../engine/source/mpi/implicit/imp_fri.F
1605!||--- called by ------------------------------------------------------
1606!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
1607!||--- calls -----------------------------------------------------
1608!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
1609!||--- uses -----------------------------------------------------
1610!|| imp_intm ../engine/share/modules/imp_intm.F
1611!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1612!||====================================================================
1613 SUBROUTINE iddl_int(NSL ,IDDL ,IKC ,NDOF ,IDDLM ,
1614 . IPARI ,INTBUF_TAB,IRBE3 ,LRBE3 ,FRBE3 ,
1615 . X ,SKEW ,IRBE2 ,LRBE2 )
1616C-----------------------------------------------
1617C M o d u l e s
1618C-----------------------------------------------
1619 USE imp_intm
1620 USE intbufdef_mod
1621C-----------------------------------------------
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 "param_c.inc"
1629#include "tabsiz_c.inc"
1630C-----------------------------------------------
1631C D u m m y A r g u m e n t s
1632C-----------------------------------------------
1633 INTEGER NSL,IDDL(*) ,IKC(*) ,NDOF(*) ,IDDLM(*)
1634 INTEGER IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
1635 . irbe2(nrbe2l,*),lrbe2(*)
1636 my_real
1637 . frbe3(*),x(*),skew(*)
1638 TYPE(intbuf_struct_) INTBUF_TAB(*)
1639C-----------------------------------------------
1640C L o c a l V a r i a b l e s
1641C-----------------------------------------------
1642 INTEGER I,ID,N,J,NDD,I1,IAD,NMT,IROTG,IADS
1643 INTEGER M,NSN,L,NNOD,NJ,NL,NI,JI
1644 INTEGER IERROR1,IERROR2,IERROR3,IERROR4,IERROR5
1645C-----------------------------------------------
1646C S o u r c e L i n e s
1647C-----------------------------------------------
1648C
1649 IF (NML>0) THEN
1650 IF(ALLOCATED(IDDML)) DEALLOCATE(IDDML)
1651 ALLOCATE(IDDML(3,NML),STAT=ierror1)
1652C--------initialization for ndof=0---
1653 iddml = -7
1654 DO i = 1, nml
1655 n = iml(i)
1656 ndd = 0
1657 DO j = 1 , min(3,ndof(n))
1658 id = iddl(n) + j
1659 IF (ikc(id)<1) THEN
1660 ndd = ndd + 1
1661 iddml(j,i) = iddlm(n) + ndd
1662 ELSE
1663 iddml(j,i) = -ikc(id)
1664 ENDIF
1665 ENDDO
1666 ENDDO
1667 ENDIF
1668C
1669 IF (nsl>0) THEN
1670 IF(ALLOCATED(iddsl)) DEALLOCATE(iddsl)
1671 ALLOCATE(iddsl(3,nsl),stat=ierror2)
1672 iddsl = -7
1673 DO i = 1, nsl
1674 n = isl(i)
1675 ndd = 0
1676 DO j = 1 , min(3,ndof(n))
1677 id = iddl(n) + j
1678 IF (ikc(id)<1) THEN
1679 ndd = ndd + 1
1680 iddsl(j,i) = iddlm(n) + ndd
1681 ELSE
1682 iddsl(j,i) = -ikc(id)
1683 ENDIF
1684 ENDDO
1685 ENDDO
1686 ENDIF
1687C
1688 IF (nrb_fr>0) THEN
1689 IF(ALLOCATED(iddmr)) DEALLOCATE(iddmr)
1690 ALLOCATE(iddmr(6,nrb_fr),stat=ierror3)
1691 DO i = 1, nrb_fr
1692 n = ifrsr(1,i)
1693 ndd = 0
1694 DO j = 1 , ndof(n)
1695 id = iddl(n) + j
1696 IF (ikc(id)<1) THEN
1697 ndd = ndd + 1
1698 iddmr(j,i) = iddlm(n) + ndd
1699 ELSE
1700 iddmr(j,i) = -ikc(id)
1701 ENDIF
1702 ENDDO
1703 ENDDO
1704 ENDIF
1705C
1706 IF (ni2_fr>0) THEN
1707 IF(ALLOCATED(iddmi2)) DEALLOCATE(iddmi2)
1708 ALLOCATE(iddmi2(6,4,ni2_fr),stat=ierror4)
1709 DO i=1,ni2_fr
1710 n=ifrs2(1,i)
1711 ni=ifrs2(2,i)
1712 ji=ipari(1,n)
1713 nsn=ipari(5,n)
1714 l=intbuf_tab(n)%IRTLM(ni)
1715 nl=4*(l-1)
1716 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
1717 nnod=3
1718 ELSE
1719 nnod=4
1720 ENDIF
1721C-------if main node is also dependent-----
1722 DO m=1,nnod
1723 nj=intbuf_tab(n)%IRECTM(nl+m)
1724 ndd = 0
1725 DO j = 1 , ndof(nj)
1726 id = iddl(nj) + j
1727 IF (ikc(id)<1) THEN
1728 ndd = ndd + 1
1729 iddmi2(j,m,i) = iddlm(nj) + ndd
1730 ELSE
1731 iddmi2(j,m,i) = -ikc(id)
1732 ENDIF
1733 ENDDO
1734 ENDDO
1735 ENDDO
1736 ENDIF
1737C-------RBE3-----------
1738 IF (nrbe3_fr>0) THEN
1739 IF(ALLOCATED(iddmi3)) DEALLOCATE(iddmi3)
1740 ndd = 0
1741 DO i=1,nrbe3_fr
1742 n=ifrs3(i)
1743 ndd = max(ndd ,irbe3(5,n))
1744 ENDDO
1745 ALLOCATE(iddmi3(6,ndd,nrbe3_fr),stat=ierror5)
1746 irotg=0
1747 nmt = 0
1748 DO i=1,nrbe3_fr
1749 n=ifrs3(i)
1750 ni=irbe3(3,n)
1751 nnod=irbe3(5,n)
1752 iad=irbe3(1,n)
1753 irotg =max(irotg,irbe3(6,n))
1754C-------
1755 DO m=1,nnod
1756 nj=lrbe3(iad+m)
1757 ndd = 0
1758 DO j = 1 , ndof(nj)
1759 id = iddl(nj) + j
1760 IF (ikc(id)<1) THEN
1761 ndd = ndd + 1
1762 iddmi3(j,m,i) = iddlm(nj) + ndd
1763 ELSE
1764 iddmi3(j,m,i) = -ikc(id)
1765 ENDIF
1766 ENDDO
1767 ENDDO
1768 nmt = nmt + nnod
1769 ENDDO
1770 IF(ALLOCATED(frcdi)) DEALLOCATE(frcdi)
1771 ALLOCATE(frcdi(18*nmt))
1772 IF (irotg>0) THEN
1773 IF(ALLOCATED(mrcdi)) DEALLOCATE(mrcdi)
1774 ALLOCATE(mrcdi(18*nmt))
1775 ENDIF
1776C------- init FRCDI,MRCDI
1777 nmt = slrbe3/2
1778 iads =1
1779 DO i=1,nrbe3_fr
1780 n=ifrs3(i)
1781 ni=irbe3(3,n)
1782 nnod=irbe3(5,n)
1783 iad=irbe3(1,n)
1784 irotg =irbe3(6,n)
1785 CALL rbe3cl(lrbe3(iad+1),lrbe3(nmt+iad+1),ni ,x ,
1786 . frbe3(6*iad+1),skew ,nnod ,irotg ,frcdi(iads),
1787 . mrcdi(iads) ,irbe3(2,n))
1788C-------
1789 iads = iads + nnod
1790 ENDDO
1791 ENDIF
1792C-----------Rbe2-------------------
1793 IF (nrbe2_fr>0) THEN
1794 IF(ALLOCATED(iddmr2)) DEALLOCATE(iddmr2)
1795 ALLOCATE(iddmr2(6,nrbe2_fr),stat=ierror3)
1796 DO i = 1, nrbe2_fr
1797 n = ifrs4(1,i)
1798 m = irbe2(3,n)
1799 ndd = 0
1800 DO j = 1 , ndof(m)
1801 id = iddl(m) + j
1802 IF (ikc(id)<1) THEN
1803 ndd = ndd + 1
1804 iddmr2(j,i) = iddlm(m) + ndd
1805 ELSE
1806 iddmr2(j,i) = -ikc(id)
1807 ENDIF
1808 ENDDO
1809 ENDDO
1810 ENDIF
1811C
1812 RETURN
1813 END
1814!||====================================================================
1815!|| diag_int ../engine/source/mpi/implicit/imp_fri.F
1816!||--- called by ------------------------------------------------------
1817!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
1818!||--- calls -----------------------------------------------------
1819!|| bcl_impkd ../engine/source/constraints/general/bcs/bc_imp0.F
1820!|| fv_updkd ../engine/source/constraints/general/impvel/fv_imp0.F
1821!|| fv_updkd2 ../engine/source/constraints/general/bcs/bc_imp0.F
1822!|| i2_frup0 ../engine/source/interfaces/interf/i2_imp1.F
1823!|| i2_frup1 ../engine/source/interfaces/interf/i2_imp1.F
1824!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.f
1825!|| prerbe2fr ../engine/source/constraints/general/rbe2/rbe2f.F
1826!|| prerbe3fr ../engine/source/constraints/general/rbe3/rbe3f.F
1827!|| rbe2_impkd ../engine/source/constraints/general/rbe2/rbe2_imp0.F
1828!|| rbe3_frupd ../engine/source/constraints/general/rbe3/rbe3_imp0.F
1829!|| updfr_rb ../engine/source/constraints/general/rbody/rby_imp0.f
1830!||--- uses -----------------------------------------------------
1831!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
1832!|| imp_intm ../engine/share/modules/imp_intm.F
1833!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
1834!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1835!||====================================================================
1836 SUBROUTINE diag_int(NSL ,NDOF ,IPARI ,INTBUF_TAB,
1837 . KSS ,X ,IBFV ,SKEW ,XFRAME,
1838 . IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
1839C-----------------------------------------------
1840C M o d u l e s
1841C-----------------------------------------------
1842 USE imp_intm
1843 USE imp_rwl
1844 USE imp_aspc
1845 USE intbufdef_mod
1846C-----------------------------------------------
1847C I m p l i c i t T y p e s
1848C-----------------------------------------------
1849#include "implicit_f.inc"
1850C-----------------------------------------------
1851C C o m m o n B l o c k s
1852C-----------------------------------------------
1853#include "param_c.inc"
1854C-----------------------------------------------
1855C D u m m y A r g u m e n t s
1856C-----------------------------------------------
1857 INTEGER NSL , NDOF(*) ,IBFV(NIFV,*)
1858 INTEGER IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
1859 . IRBE2(NRBE2L,*),LRBE2(*)
1860 my_real
1861 . KSS(6,*),X(3,*),SKEW(LSKEW,*),XFRAME(NXFRAME,*)
1862 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1863C-----------------------------------------------
1864C L o c a l V a r i a b l e s
1865C-----------------------------------------------
1866 INTEGER I,ID,N,J,NDD,I1,IS,NS,ILEV,JT(3),JR(3)
1867 INTEGER M,NSN,JI,L,NNOD,NJ,NL,NI,IROT,IRAD
1868 INTEGER IERROR1,IERROR2,J1,ISK,IFM,K1,K2,K3,ICT,NN,IAD,IADS,K
1869 my_real
1870 . XS,YS,ZS,KII(3,3),KJJ(6),EJ(3),S,KDD(6,6),KMM(6)
1871C-----------------------------------------------
1872C S o u r c e L i n e s
1873C-----------------------------------------------
1874C
1875 IF (NRB_FRS>0) THEN
1876 IF(ALLOCATED(DIAG_MR)) DEALLOCATE(DIAG_MR)
1877 ALLOCATE(DIAG_MR(6,NRB_FRS),STAT=ierror1)
1878 DO i1 = 1, nrb_frs
1879 DO j = 1, 6
1880 diag_mr(j,i1)=zero
1881 ENDDO
1882 ENDDO
1883 ENDIF
1884 IF (ni2_frs>0) THEN
1885 IF(ALLOCATED(diag_m2)) DEALLOCATE(diag_m2)
1886 ALLOCATE(diag_m2(6,4,ni2_frs),stat=ierror2)
1887 DO i1=1,ni2_frs
1888 DO j = 1, 6
1889 DO m = 1, 4
1890 diag_m2(j,m,i1)=zero
1891 ENDDO
1892 ENDDO
1893 ENDDO
1894 ENDIF
1895 IF (nrbe3_frs>0) THEN
1896C------RBE3---
1897 iads=0
1898 DO i1=1,nrbe3_frs
1899 i = ifrs3_s(i1)
1900 n=ifrs3(i)
1901 iads=max(iads,irbe3(5,n))
1902 ENDDO
1903 IF(ALLOCATED(diag_m3)) DEALLOCATE(diag_m3)
1904 ALLOCATE(diag_m3(6,iads,nrbe3_frs),stat=ierror1)
1905 diag_m3=zero
1906 ENDIF
1907C-------------RBE2----------------------
1908 IF (nrbe2_frs>0) THEN
1909 IF(ALLOCATED(diag_mr2)) DEALLOCATE(diag_mr2)
1910 ALLOCATE(diag_mr2(6,nrbe2_frs),stat=ierror1)
1911 diag_mr2=zero
1912 ENDIF
1913C--------local secondary node-, first independent----
1914 DO i = 1, nsl
1915 n = isl(i)
1916 DO j = 1, min(3,ndof(n))
1917 id = iddsl(j,i)
1918 IF (id>0) diag_s(j,i)=kss(j,i)
1919 ENDDO
1920 ENDDO
1921C
1922 DO i1=1,ni2_frs
1923 i = ifrs2_s(i1)
1924 n=ifrs2(1,i)
1925 ni=ifrs2(2,i)
1926 ji=ipari(1,n)
1927 nsn=ipari(5,n)
1928 ns=intbuf_tab(n)%NSV(ni)
1929 DO is = 1, nsl
1930 IF (isl(is)==ns) THEN
1931 ilev =ipari(20,n)
1932 IF (ilev==1) THEN
1933 CALL i2_frup1(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA ,intbuf_tab(n)%NSV ,
1934 1 intbuf_tab(n)%IRTLM ,ns ,kss(1,is),diag_m2(1,1,i1))
1935 ELSE
1936 CALL i2_frup0(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,intbuf_tab(n)%NSV ,
1937 1 intbuf_tab(n)%IRTLM,ns,ndof,kss(1,is),diag_m2(1,1,i1))
1938 ENDIF
1939 ENDIF
1940 ENDDO
1941 ENDDO
1942C------------RBE2--------------
1943 DO i1 = 1, nrbe2_frs
1944 i = ifrs4_s(i1)
1945 n = ifrs4(1,i)
1946 m = irbe2(3,n)
1947 ns = ifrs4(2,i)
1948 ict = irbe2(4,n)
1949 isk = irbe2(7,n)
1950 irad =irbe2(11,n)
1951C--------remove ICR---
1952 ict =(ict/512)*512
1953 CALL prerbe2fr(ict ,jt ,jr )
1954 DO k=1,6
1955 DO j=1,6
1956 kdd(k,j) = zero
1957 ENDDO
1958 kmm(k)= zero
1959 ENDDO
1960 DO is = 1, nsl
1961 IF (isl(is)==ns) THEN
1962 DO j=1,3
1963 kdd(j,j) = kss(j,is)
1964 ENDDO
1965 kdd(1,2)=kss(4,is)
1966 kdd(1,3)=kss(5,is)
1967 kdd(2,3)=kss(6,is)
1968 kdd(2,1)=kdd(1,2)
1969 kdd(3,1)=kdd(1,3)
1970 kdd(3,2)=kdd(2,3)
1971 CALL rbe2_impkd(m ,ns ,x ,isk ,jt ,
1972 2 jr ,ndof ,skew(1,isk),kdd ,kmm ,
1973 3 diag_s(1,is),irad )
1974 DO j = 1 , ndof(m)
1975 diag_mr2(j,i1) = diag_mr2(j,i1) + kmm(j)
1976 END DO
1977 END IF
1978 END DO
1979 END DO
1980C------RBE3---
1981 iads=1
1982 DO i1=1,nrbe3_frs
1983 i = ifrs3_s(i1)
1984 n=ifrs3(i)
1985 ni=irbe3(3,n)
1986 nnod=irbe3(5,n)
1987 irot=irbe3(6,n)
1988 iad=irbe3(1,n)
1989 DO is = 1, nsl
1990 IF (isl(is)==ni) THEN
1991C-------
1992 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
1993 CALL rbe3_frupd(nnod ,lrbe3(iad+1) ,frcdi(iads),
1994 1 mrcdi(iads),ndof ,jt ,irot ,
1995 2 kss(1,is),diag_m3(1,1,i1))
1996 ENDIF
1997 ENDDO
1998 iads=iads+nnod
1999 ENDDO
2000C------RBODY---
2001 DO i1 = 1, nrb_frs
2002 i = ifrsr_s(i1)
2003 m = ifrsr(1,i)
2004 n = ifrsr(2,i)
2005 DO is = 1, nsl
2006 IF (isl(is)==n) THEN
2007 xs=x(1,n)-x(1,m)
2008 ys=x(2,n)-x(2,m)
2009 zs=x(3,n)-x(3,m)
2010 CALL updfr_rb(xs,ys,zs,kss(1,is),diag_mr(1,i1))
2011 ENDIF
2012 ENDDO
2013 ENDDO
2014 DO i1 = 1,nbc_fr
2015 n = ibc_fr(1,i1)
2016 isk= ibc_fr(2,i1)
2017 ict= ibc_fr(3,i1)
2018 DO is = 1, nsl
2019 IF (isl(is)==n) THEN
2020 kii(1,1)=kss(1,is)
2021 kii(2,2)=kss(2,is)
2022 kii(3,3)=kss(3,is)
2023 kii(1,2)=kss(4,is)
2024 kii(1,3)=kss(5,is)
2025 kii(2,3)=kss(6,is)
2026 kii(2,1)=kii(1,2)
2027 kii(3,1)=kii(1,3)
2028 kii(3,2)=kii(2,3)
2029 CALL bcl_impkd(ict ,isk ,skew ,kii ,diag_s(1,is))
2030 ENDIF
2031 ENDDO
2032 ENDDO
2033C-------AUTOSPC
2034 DO i1=1,nspc_fr
2035 n = ispc_fr(i1)
2036 i = in_spc(n)
2037 iad = 6*(n-1)+1
2038 nn = ic_spc(n)
2039 DO is = 1, nsl
2040 IF (isl(is)==i) THEN
2041 kii(1,1)=kss(1,is)
2042 kii(2,2)=kss(2,is)
2043 kii(3,3)=kss(3,is)
2044 kii(1,2)=kss(4,is)
2045 kii(1,3)=kss(5,is)
2046 kii(2,3)=kss(6,is)
2047 kii(2,1)=kii(1,2)
2048 kii(3,1)=kii(1,3)
2049 kii(3,2)=kii(2,3)
2050 IF (nn==1) THEN
2051 ej(1)=skew_spc(iad)
2052 ej(2)=skew_spc(iad+1)
2053 ej(3)=skew_spc(iad+2)
2054 CALL l_dir(ej,j)
2055 CALL fv_updkd(ej ,j ,kii ,diag_s(1,is))
2056 ELSEIF (nn==2) THEN
2057 CALL fv_updkd2(skew_spc(iad),skew_spc(iad+3),kii,
2058 . diag_s(1,is))
2059 END IF
2060 ENDIF
2061 ENDDO
2062 ENDDO
2063 DO i1 = 1,nfx_fr
2064 n = ifx_fr(1,i1)
2065 j1= ifx_fr(2,i1)
2066 i=iabs(ibfv(1,n))
2067 isk=ibfv(2,n)/10
2068 ifm = ibfv(9,n)
2069 j=ibfv(2,n)
2070 IF (ifm<=1) j=j-10*isk
2071 k1=3*j-2
2072 k2=3*j-1
2073 k3=3*j
2074 IF (isk>1) THEN
2075 ej(1)=skew(k1,isk)
2076 ej(2)=skew(k2,isk)
2077 ej(3)=skew(k3,isk)
2078 ELSE
2079 ej(1)=xframe(k1,ifm)
2080 ej(2)=xframe(k2,ifm)
2081 ej(3)=xframe(k3,ifm)
2082 ENDIF
2083 DO is = 1, nsl
2084 IF (isl(is)==i) THEN
2085 kii(1,1)=kss(1,is)
2086 kii(2,2)=kss(2,is)
2087 kii(3,3)=kss(3,is)
2088 kii(1,2)=kss(4,is)
2089 kii(1,3)=kss(5,is)
2090 kii(2,3)=kss(6,is)
2091 kii(2,1)=kii(1,2)
2092 kii(3,1)=kii(1,3)
2093 kii(3,2)=kii(2,3)
2094 s = one/ej(j1)
2095 DO nn =1,3
2096 ej(nn) = ej(nn)*s
2097 ENDDO
2098 CALL fv_updkd(ej ,j1 ,kii ,diag_s(1,is))
2099 ENDIF
2100 ENDDO
2101 ENDDO
2102 DO i1 = 1,nrw_fr
2103 i = irw_fr(i1)
2104 n = in_rwl(i)
2105 DO is = 1, nsl
2106 IF (isl(is)==n) THEN
2107 kii(1,1)=kss(1,is)
2108 kii(2,2)=kss(2,is)
2109 kii(3,3)=kss(3,is)
2110 kii(1,2)=kss(4,is)
2111 kii(1,3)=kss(5,is)
2112 kii(2,3)=kss(6,is)
2113 kii(2,1)=kii(1,2)
2114 kii(3,1)=kii(1,3)
2115 kii(3,2)=kii(2,3)
2116 ej(1)=nor_rwl(1,i)
2117 ej(2)=nor_rwl(2,i)
2118 ej(3)=nor_rwl(3,i)
2119 CALL l_dir(ej,j1)
2120 CALL fv_updkd(ej ,j1 ,kii ,diag_s(1,is))
2121 ENDIF
2122 ENDDO
2123 ENDDO
2124C
2125 RETURN
2126 END
2127!||====================================================================
2128!|| intabfr ../engine/source/mpi/implicit/imp_fri.F
2129!||--- called by ------------------------------------------------------
2130!|| get_iad ../engine/source/mpi/implicit/imp_fri.F
2131!|| imp_fvkm ../engine/source/mpi/implicit/imp_fri.F
2132!|| imp_fvkss ../engine/source/mpi/implicit/imp_fri.F
2133!|| ini_frud ../engine/source/mpi/implicit/imp_fri.F
2134!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
2135!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.F
2136!||--- calls -----------------------------------------------------
2137!|| intab ../engine/source/implicit/ind_glob_k.F
2138!||====================================================================
2139 SUBROUTINE intabfr(NIC,IC,N,INTAB)
2140C----6---------------------------------------------------------------7---------8
2141C I m p l i c i t T y p e s
2142C-----------------------------------------------
2143#include "implicit_f.inc"
2144C-----------------------------------------------------------------
2145C D u m m y A r g u m e n t s
2146C-----------------------------------------------
2147 INTEGER N ,NIC,IC(*),INTAB
2148C-----------------------------------------------
2149C L o c a l V a r i a b l e s
2150C-----------------------------------------------
2151 INTEGER I
2152C----6-----IC est deja en ordre croissante---------------------------7---------8
2153 intab=0
2154 DO i =1,nic
2155 IF (n==ic(i)) THEN
2156 intab=i
2157 RETURN
2158 ENDIF
2159 ENDDO
2160C
2161 RETURN
2162 END
2163C --------- ----
2164!||====================================================================
2165!|| imp_diags ../engine/source/mpi/implicit/imp_fri.F
2166!||--- called by ------------------------------------------------------
2167!|| lin_solvh1 ../engine/source/implicit/lin_solv.F
2168!|| lin_solvih2 ../engine/source/implicit/lin_solv.F
2169!||--- uses -----------------------------------------------------
2170!|| imp_intm ../engine/share/modules/imp_intm.f
2171!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
2172!||====================================================================
2173 SUBROUTINE imp_diags(DIAG_K,NDOF,NSL,IPARI,INTBUF_TAB,IRBE3,LRBE3,
2174 . IRBE2 )
2175C-----------------------------------------------
2176C M o d u l e s
2177C-----------------------------------------------
2178 USE imp_intm
2179 USE intbufdef_mod
2180C----6---------------------------------------------------------------7---------8
2181C I m p l i c i t T y p e s
2182C-----------------------------------------------
2183#include "implicit_f.inc"
2184C-----------------------------------------------
2185C C o m m o n B l o c k s
2186C-----------------------------------------------
2187#include "param_c.inc"
2188C-----------------------------------------------------------------
2189C D u m m y A r g u m e n t s
2190C-----------------------------------------------
2191 INTEGER NDOF(*),NSL
2192 INTEGER IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
2193 . IRBE2(NRBE2L,*)
2194C REAL
2195 my_real
2196 . diag_k(*)
2197 TYPE(intbuf_struct_) INTBUF_TAB(*)
2198C-----------------------------------------------
2199C L o c a l V a r i a b l e s
2200C-----------------------------------------------
2201 INTEGER I,J,N,ID,I1,IAD
2202 INTEGER M,NSN,L,NNOD,NJ,NL,NI,JI
2203C-----------------------------------------------
2204 IF (intp_d>0) THEN
2205 DO i = 1, nddl_sl
2206 id = iddl_sl(i)
2207 diag_k(id)=diag_k(id)+diag_sl(i)
2208 ENDDO
2209 ELSE
2210 DO i = 1, nsl
2211C--------local secondary node-----
2212 n = isl(i)
2213 DO j = 1, min(3,ndof(n))
2214 id = iddsl(j,i)
2215 IF (id>0) diag_k(id)=diag_k(id)+diag_s(j,i)
2216 ENDDO
2217 ENDDO
2218C--------if there are independent nodes-----
2219 DO i1=1,ni2_frs
2220 i=ifrs2_s(i1)
2221 n=ifrs2(1,i)
2222 ni=ifrs2(2,i)
2223 ji=ipari(1,n)
2224 nsn=ipari(5,n)
2225 l=intbuf_tab(n)%IRTLM(ni)
2226 nl=4*(l-1)
2227 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2228 nnod=3
2229 ELSE
2230 nnod=4
2231 ENDIF
2232 DO m=1,nnod
2233 nj=intbuf_tab(n)%IRECTM(nl+m)
2234 DO j = 1 , ndof(nj)
2235 id = iddmi2(j,m,i)
2236 IF (id>0) diag_k(id)=diag_k(id)+diag_m2(j,m,i1)
2237 ENDDO
2238 ENDDO
2239 ENDDO
2240C--------RBE3-----
2241 DO i1=1,nrbe3_frs
2242 i=ifrs3_s(i1)
2243 n=ifrs3(i)
2244 iad=irbe3(1,n)
2245 nnod=irbe3(5,n)
2246 DO m=1,nnod
2247 nj=lrbe3(iad+m)
2248 DO j = 1 , ndof(nj)
2249 id = iddmi3(j,m,i)
2250 IF (id>0) diag_k(id)=diag_k(id)+diag_m3(j,m,i1)
2251 ENDDO
2252 ENDDO
2253 ENDDO
2254 DO i1 = 1, nrb_frs
2255 i=ifrsr_s(i1)
2256 n = ifrsr(1,i)
2257 DO j = 1 , ndof(n)
2258 id = iddmr(j,i)
2259 IF (id>0) diag_k(id)=diag_k(id)+diag_mr(j,i1)
2260 ENDDO
2261 ENDDO
2262C--------RBE2-----
2263 DO i1 = 1, nrbe2_frs
2264 i=ifrs4_s(i1)
2265 n = ifrs4(1,i)
2266 m = irbe2(3,n)
2267 DO j = 1 , ndof(m)
2268 id = iddmr2(j,i)
2269 IF (id>0) diag_k(id)=diag_k(id)+diag_mr2(j,i1)
2270 ENDDO
2271 ENDDO
2272C
2273 ENDIF
2274C----6---------------------------------------------------------------7---------8
2275 RETURN
2276 END
2277C --------- ----
2278!||====================================================================
2279!|| imp_diagsn ../engine/source/mpi/implicit/imp_fri.F
2280!||--- called by ------------------------------------------------------
2281!|| lin_solvh1 ../engine/source/implicit/lin_solv.F
2282!|| lin_solvih2 ../engine/source/implicit/lin_solv.F
2283!||--- uses -----------------------------------------------------
2284!|| imp_intm ../engine/share/modules/imp_intm.F
2285!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2286!||====================================================================
2287 SUBROUTINE imp_diagsn(DIAG_K,NDOF,NSL,IPARI,INTBUF_TAB,IRBE3,LRBE3,
2288 . IRBE2 )
2289C-----------------------------------------------
2290C M o d u l e s
2291C-----------------------------------------------
2292 USE imp_intm
2293 USE intbufdef_mod
2294C----6---------------------------------------------------------------7---------8
2295C I m p l i c i t T y p e s
2296C-----------------------------------------------
2297#include "implicit_f.inc"
2298C-----------------------------------------------
2299C C o m m o n B l o c k s
2300C-----------------------------------------------
2301#include "param_c.inc"
2302C-----------------------------------------------------------------
2303C D u m m y A r g u m e n t s
2304C-----------------------------------------------
2305 INTEGER NDOF(*),NSL
2306 INTEGER IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
2307 . irbe2(nrbe2l,*)
2308C REAL
2309 my_real
2310 . diag_k(*)
2311 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2312C-----------------------------------------------
2313C L o c a l V a r i a b l e s
2314C-----------------------------------------------
2315 INTEGER I,J,N,ID,I1,IAD
2316 INTEGER M,NSN,L,NNOD,NJ,NL,NI,JI
2317C-----------------------------------------------
2318 IF (intp_d>0) THEN
2319 DO i = 1, nddl_sl
2320 id = iddl_sl(i)
2321 diag_k(id)=diag_k(id)-diag_sl(i)
2322 ENDDO
2323 ELSE
2324 DO i = 1, nsl
2325C--------local secondary node-----
2326 n = isl(i)
2327 DO j = 1, min(3,ndof(n))
2328 id = iddsl(j,i)
2329 IF (id>0) diag_k(id)=diag_k(id)-diag_s(j,i)
2330 ENDDO
2331 ENDDO
2332C--------if there are independent nodes-----
2333 DO i1=1,ni2_frs
2334 i=ifrs2_s(i1)
2335 n=ifrs2(1,i)
2336 ni=ifrs2(2,i)
2337 ji=ipari(1,n)
2338 nsn=ipari(5,n)
2339 l=intbuf_tab(n)%IRTLM(ni)
2340 nl=4*(l-1)
2341 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2342 nnod=3
2343 ELSE
2344 nnod=4
2345 ENDIF
2346 DO m=1,nnod
2347 nj=intbuf_tab(n)%IRECTM(nl+m)
2348 DO j = 1 , ndof(nj)
2349 id = iddmi2(j,m,i)
2350 IF (id>0) diag_k(id)=diag_k(id)-diag_m2(j,m,i1)
2351 ENDDO
2352 ENDDO
2353 ENDDO
2354C--------RBE3-----
2355 DO i1=1,nrbe3_frs
2356 i=ifrs3_s(i1)
2357 n=ifrs3(i)
2358 iad=irbe3(1,n)
2359 nnod=irbe3(5,n)
2360 DO m=1,nnod
2361 nj=lrbe3(iad+m)
2362 DO j = 1 , ndof(nj)
2363 id = iddmi3(j,m,i)
2364 IF (id>0) diag_k(id)=diag_k(id)-diag_m3(j,m,i1)
2365 ENDDO
2366 ENDDO
2367 ENDDO
2368 DO i1 = 1, nrb_frs
2369 i=ifrsr_s(i1)
2370 n = ifrsr(1,i)
2371 DO j = 1 , ndof(n)
2372 id = iddmr(j,i)
2373 IF (id>0) diag_k(id)=diag_k(id)-diag_mr(j,i1)
2374 ENDDO
2375 ENDDO
2376C--------RBE2-----
2377 DO i1 = 1, nrbe2_frs
2378 i=ifrs4_s(i1)
2379 n = ifrs4(1,i)
2380 m = irbe2(3,n)
2381 DO j = 1 , ndof(m)
2382 id = iddmr2(j,i)
2383 IF (id>0) diag_k(id)=diag_k(id)-diag_mr2(j,i1)
2384 ENDDO
2385 ENDDO
2386C
2387 ENDIF
2388C----6---------------------------------------------------------------7---------8
2389 RETURN
2390 END
2391!||====================================================================
2392!|| fr_matv ../engine/source/mpi/implicit/imp_fri.F
2393!||--- called by ------------------------------------------------------
2394!|| imp_frfv ../engine/source/mpi/implicit/imp_fri.F
2395!|| mav_lth ../engine/source/implicit/produt_v.F
2396!|| mav_lth0 ../engine/source/implicit/produt_v.F
2397!|| mav_ltp ../engine/source/implicit/produt_v.F
2398!||--- calls -----------------------------------------------------
2399!|| fr_a2b ../engine/source/mpi/implicit/imp_fri.F
2400!|| fr_a2bd ../engine/source/mpi/implicit/imp_fri.F
2401!|| fr_u2d ../engine/source/mpi/implicit/imp_fri.F
2402!|| fr_u2dd ../engine/source/mpi/implicit/imp_fri.F
2403!|| i7mainfr ../engine/source/interfaces/int07/i7ke3.F
2404!|| mav_ltfr ../engine/source/mpi/implicit/imp_fri.F
2405!|| spmd_ifcd ../engine/source/mpi/implicit/imp_spmd.F
2406!|| spmd_ifcf ../engine/source/mpi/implicit/imp_spmd.F
2407!|| spmd_ifrf ../engine/source/mpi/implicit/imp_spmd.F
2408!|| spmd_ifru ../engine/source/mpi/implicit/imp_spmd.F
2409!|| upd_fr ../engine/source/mpi/implicit/imp_fri.F
2410!||--- uses -----------------------------------------------------
2411!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2412!||====================================================================
2413 SUBROUTINE fr_matv( A ,V ,D ,MS ,X ,
2414 1 DR ,AR ,IPARI ,INTBUF_TAB ,
2415 2 NDOF ,NUM_IMP,NS_IMP,NE_IMP,LX ,
2416 3 NSREM ,NSL ,IBFV ,SKEW ,XFRAME ,
2417 4 F ,IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
2418C-----------------------------------------------
2419C M o d u l e s
2420C-----------------------------------------------
2421 USE intbufdef_mod
2422C-----------------------------------------------
2423C I m p l i c i t T y p e s
2424C-----------------------------------------------
2425#include "implicit_f.inc"
2426C-----------------------------------------------
2427C C o m m o n B l o c k s
2428C-----------------------------------------------
2429#include "param_c.inc"
2430#include "impl1_c.inc"
2431C-----------------------------------------------
2432C D u m m y A r g u m e n t s
2433C-----------------------------------------------
2434 INTEGER IPARI(NPARI,*), NDOF(*),IBFV(*) ,
2435 . num_imp(*),ns_imp(*),ne_imp(*),nsrem,nsl,
2436 . irbe3(*) ,lrbe3(*),irbe2(*),lrbe2(*)
2437 my_real
2438 . a(3,*),ar(3,*),v(3,*),d(3,*),dr(3,*),x(3,*) ,
2439 . ms(*),skew(*) ,xframe(*)
2440 my_real
2441 . lx(*),f(*)
2442 TYPE(intbuf_struct_) INTBUF_TAB(*)
2443C-----------------------------------------------
2444C L o c a l V a r i a b l e s
2445C-----------------------------------------------
2446 INTEGER I,IDF
2447C-----------------------------------------------
2448 IF ((NSREM+NSL)==0) return
2449C
2450 IF (intp_c>0) THEN
2451C-----send U(NDDL_SL) and receive U(NDDL_SI)-----
2452 CALL spmd_ifru(lx )
2453 CALL mav_ltfr(lx ,f )
2454C-----send F (NDDL_SI) and receive F (NDDL_SL)-----
2455 CALL spmd_ifrf(f )
2456 ELSE
2457C
2458C-----initialize D,A independent nodes first-----
2459 CALL fr_u2d(ndof ,lx ,d ,a ,nsrem, nsl )
2460C-----kinematic nodes -----
2461 CALL fr_u2dd(d ,dr ,x ,ipari ,intbuf_tab,
2462 1 ndof ,a ,ar ,lx ,
2463 2 ibfv ,skew ,xframe,irbe3,lrbe3 ,
2464 3 irbe2,lrbe2 )
2465C-----send D (NSL) and receive DFI (NSREM)-----
2466 CALL spmd_ifcd(d ,nsl, nsrem)
2467C-----compute contact force ->A ,FFI-----
2468 IF (nsrem>0)
2469 . CALL i7mainfr(a ,v ,d ,x ,ms ,
2470 1 ipari ,intbuf_tab ,num_imp,ns_imp,
2471 2 ne_imp)
2472C-----send FFI (NSREM) and receive A (NSL)-----
2473 CALL spmd_ifcf(a, nsrem ,nsl)
2474C-----Compute A with dependent nodes---------
2475 CALL upd_fr(a ,ar ,x ,ipari ,intbuf_tab,
2476 1 ndof ,ibfv ,skew ,xframe ,
2477 2 irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
2478C
2479 CALL fr_a2b(ndof ,f ,a ,nsl )
2480 CALL fr_a2bd(ndof ,ipari ,intbuf_tab,f ,a ,
2481 . ar ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
2482 END IF !(INTP_C>0) THEN
2483C
2484 RETURN
2485 END
2486!||====================================================================
2487!|| fr_matv_gpu ../engine/source/mpi/implicit/imp_fri.F
2488!||--- calls -----------------------------------------------------
2489!|| mav_ltfr_gpu ../engine/source/mpi/implicit/imp_fri.F
2490!|| spmd_ifrf_gpu ../engine/source/mpi/implicit/imp_spmd.F
2491!|| spmd_ifru_gpu ../engine/source/mpi/implicit/imp_spmd.F
2492!||====================================================================
2493 SUBROUTINE fr_matv_gpu(NSREM, NSL, LX ,F ,NINDEX)
2494C-----------------------------------------------
2495C I m p l i c i t T y p e s
2496C-----------------------------------------------
2497#include "implicit_f.inc"
2498C-----------------------------------------------
2499C C o m m o n B l o c k s
2500C-----------------------------------------------
2501#include "impl1_c.inc"
2502C-----------------------------------------------
2503C D u m m y A r g u m e n t s
2504C-----------------------------------------------
2505 INTEGER NSREM, NSL, NINDEX(*)
2506 my_real
2507 . lx(*), f(*)
2508C-----------------------------------------------
2509C L o c a l V a r i a b l e s
2510C-----------------------------------------------
2511 INTEGER I
2512C-----------------------------------------------
2513 IF ((NSREM+NSL)==0) return
2514C
2515 IF (intp_c>0) THEN
2516C-----send U(NDDL_SL) and receive U(NDDL_SI)-----
2517 CALL spmd_ifru_gpu(lx,nindex)
2518 CALL mav_ltfr_gpu(lx ,f, nindex)
2519C-----send F (NDDL_SI) and receive F (NDDL_SL)-----
2520 CALL spmd_ifrf_gpu(f,nindex)
2521 ELSE
2522 print*,'**ERROR OPTION NOT COMPATIBLE WITH GPU'
2523 stop 1234
2524 END IF
2525C
2526 RETURN
2527 END
2528!||====================================================================
2529!|| fr_u2d ../engine/source/mpi/implicit/imp_fri.F
2530!||--- called by ------------------------------------------------------
2531!|| fr_matv ../engine/source/mpi/implicit/imp_fri.F
2532!||--- uses -----------------------------------------------------
2533!|| imp_intm ../engine/share/modules/imp_intm.F
2534!||====================================================================
2535 SUBROUTINE fr_u2d(NDOF ,LX ,D ,A ,NSREM ,NSL )
2536C-----------------------------------------------
2537C M o d u l e s
2538C-----------------------------------------------
2539 USE imp_intm
2540C-----------------------------------------------
2541C I m p l i c i t T y p e s
2542C-----------------------------------------------
2543#include "implicit_f.inc"
2544C-----------------------------------------------
2545C D u m m y A r g u m e n t s
2546C-----------------------------------------------
2547 INTEGER NDOF(*),NSL,NSREM
2548 my_real
2549 . D(3,*),A(3,*),LX(*)
2550C----------------------------------------------
2551C L o c a l V a r i a b l e s
2552C-----------------------------------------------
2553 INTEGER I,J,K,ID,ND,M,N
2554C----independent nodes first-----
2555 DO i = 1,nsrem
2556 ffi(1,i)=zero
2557 ffi(2,i)=zero
2558 ffi(3,i)=zero
2559 ENDDO
2560 DO i = 1,nsl
2561 n=isl(i)
2562 DO j=1,min(3,ndof(n))
2563 nd = iddsl(j,i)
2564 IF (nd>0) d(j,n)=lx(nd)
2565C--------pour com avec FFI----
2566 a(j,n)=zero
2567 ENDDO
2568 ENDDO
2569 DO i = 1,nml
2570 n=iml(i)
2571 DO j=1,min(3,ndof(n))
2572 nd = iddml(j,i)
2573 IF (nd>0) d(j,n)=lx(nd)
2574 a(j,n)=zero
2575 ENDDO
2576 ENDDO
2577C
2578 RETURN
2579 END
2580!||====================================================================
2581!|| fr_u2dd ../engine/source/mpi/implicit/imp_fri.F
2582!||--- called by ------------------------------------------------------
2583!|| fr_matv ../engine/source/mpi/implicit/imp_fri.F
2584!||--- calls -----------------------------------------------------
2585!|| bc_upd2d ../engine/source/constraints/general/bcs/bc_imp0.F
2586!|| bc_updd ../engine/source/constraints/general/bcs/bc_imp0.F
2587!|| bcl_impd ../engine/source/constraints/general/bcs/bc_imp0.F
2588!|| fv_impd ../engine/source/constraints/general/impvel/fv_imp0.F
2589!|| i2_frrd0 ../engine/source/interfaces/interf/i2_imp2.F
2590!|| i2_frrd1 ../engine/source/interfaces/interf/i2_imp2.F
2591!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.f
2592!|| prerbe2fr ../engine/source/constraints/general/rbe2/rbe2f.F
2593!|| prerbe3fr ../engine/source/constraints/general/rbe3/rbe3f.F
2594!|| rbe2_frd ../engine/source/constraints/general/rbe2/rbe2v.F
2595!|| rbe3_frd ../engine/source/constraints/general/rbe3/rbe3v.F
2596!|| rby_imp3 ../engine/source/constraints/general/rbody/rby_impd.F
2597!||--- uses -----------------------------------------------------
2598!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
2599!|| imp_intm ../engine/share/modules/imp_intm.F
2600!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
2601!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2602!||====================================================================
2603 SUBROUTINE fr_u2dd( D ,DR ,X ,IPARI ,INTBUF_TAB,
2604 . NDOF ,A ,AR ,LX ,
2605 . IBFV ,SKEW ,XFRAME,IRBE3 ,LRBE3 ,
2606 . IRBE2 ,LRBE2 )
2607C-----------------------------------------------
2608C M o d u l e s
2609C-----------------------------------------------
2610 USE imp_intm
2611 USE imp_rwl
2612 USE imp_aspc
2613 USE intbufdef_mod
2614C-----------------------------------------------
2615C I m p l i c i t T y p e s
2616C-----------------------------------------------
2617#include "implicit_f.inc"
2618C-----------------------------------------------
2619C C o m m o n B l o c k s
2620C-----------------------------------------------
2621#include "com04_c.inc"
2622#include "param_c.inc"
2623C-----------------------------------------------
2624C D u m m y A r g u m e n t s
2625C-----------------------------------------------
2626 INTEGER IRBE3(NRBE3L,*),LRBE3(*),IRBE2(NRBE2L,*),LRBE2(*),
2627 . ipari(npari,*), ndof(*),ibfv(nifv,*)
2628 my_real
2629 . d(3,*),dr(3,*),a(3,*),ar(3,*),x(3,*) ,lx(*),
2630 . skew(lskew,*) ,xframe(*)
2631 TYPE(intbuf_struct_) INTBUF_TAB(*)
2632C-----------------------------------------------
2633C L o c a l V a r i a b l e s
2634C-----------------------------------------------
2635 INTEGER I,J,N,M,NS,NI,NSN,ILEV,IADS,IROT,IAD,JI,
2636 . L,NNOD,NJ,ND,NL,ISK,IFM,LJFR(NFXVEL),
2637 . JT(3),JR(3),IRAD,NN,IC
2638 my_real
2639 . EJ(3)
2640 DO L=nbc_fr,1,-1
2641 i = ibc_fr(1,l)
2642 isk =ibc_fr(2,l)
2643 ifm =ibc_fr(3,l)
2644 CALL bcl_impd(ifm ,isk ,skew ,i ,d )
2645 a(1,i)=zero
2646 a(2,i)=zero
2647 a(3,i)=zero
2648 ENDDO
2649 DO l=nspc_fr,1,-1
2650 n = ispc_fr(l)
2651 i = in_spc(n)
2652 iad = 6*(n-1)+1
2653 nn = ic_spc(n)
2654 IF (nn==1) THEN
2655 ej(1)=skew_spc(iad)
2656 ej(2)=skew_spc(iad+1)
2657 ej(3)=skew_spc(iad+2)
2658 CALL l_dir(ej,j)
2659 d(j,i) = zero
2660 CALL bc_updd(i ,ej ,j ,d )
2661 ELSEIF (nn==2) THEN
2662 CALL bc_upd2d(i ,skew_spc(iad),skew_spc(iad+3),d )
2663 END IF
2664 a(1,i)=zero
2665 a(2,i)=zero
2666 a(3,i)=zero
2667 ENDDO
2668C
2669 IF (nfx_fr>0) THEN
2670 DO n=1,nfxvel
2671 ljfr(n)=0
2672 ENDDO
2673 DO l=1,nfx_fr
2674 i = ifx_fr(1,l)
2675 ljfr(i) = ifx_fr(2,l)
2676 ENDDO
2677 CALL fv_impd(ibfv ,ljfr ,skew ,xframe,d ,
2678 1 dr )
2679 DO l=nfx_fr,1,-1
2680 j = ifx_fr(2,l)
2681 a(j,n)=zero
2682 ENDDO
2683 ENDIF
2684C
2685 DO l = 1,nrw_fr
2686 i = irw_fr(l)
2687 n=in_rwl(i)
2688 ej(1)=nor_rwl(1,i)
2689 ej(2)=nor_rwl(2,i)
2690 ej(3)=nor_rwl(3,i)
2691 CALL l_dir(ej,j)
2692 CALL bc_updd(n ,ej ,j ,d )
2693 a(j,n)=zero
2694 ENDDO
2695C
2696C------Rigid bodies-------
2697 DO i=nrb_fr,1,-1
2698 m=ifrsr(1,i)
2699 DO j = 1 , ndof(m)
2700 nd = iddmr(j,i)
2701 IF (j<=3.AND.nd>0) THEN
2702 d(j,m)=lx(nd)
2703 ELSEIF (nd>0) THEN
2704 dr(j-3,m)=lx(nd)
2705 ENDIF
2706 ENDDO
2707 ns=ifrsr(2,i)
2708 CALL rby_imp3(x ,m ,ns ,d ,dr ,
2709 . a ,ar )
2710 ENDDO
2711C--------RBE3-----
2712 iads=1
2713 DO i=1,nrbe3_fr
2714 n=ifrs3(i)
2715 iad=irbe3(1,n)
2716 ns=irbe3(3,n)
2717 nnod=irbe3(5,n)
2718 irot=irbe3(6,n)
2719 DO m=1,nnod
2720 nj=lrbe3(iad+m)
2721 DO j=1,ndof(nj)
2722 nd = iddmi3(j,m,i)
2723 IF (j<=3.AND.nd>0) THEN
2724 d(j,nj)=lx(nd)
2725 a(j,nj)=zero
2726 ELSEIF(nd>0) THEN
2727 dr(j-3,nj)=lx(nd)
2728 ar(j-3,nj)=zero
2729 ENDIF
2730 ENDDO
2731 ENDDO
2732 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
2733 CALL rbe3_frd(nnod ,lrbe3(iad+1),ns ,d ,dr ,
2734 1 frcdi(iads),mrcdi(iads),jt ,jr ,irot )
2735 iads=iads+nnod
2736 ENDDO
2737C------Rbe2------
2738 DO i=nrbe2_fr,1,-1
2739 n=ifrs4(1,i)
2740 m=irbe2(3,n)
2741 DO j = 1 , ndof(m)
2742 nd = iddmr2(j,i)
2743 IF (j<=3.AND.nd>0) THEN
2744 d(j,m)=lx(nd)
2745 a(j,m)=zero
2746 ELSEIF (nd>0) THEN
2747 dr(j-3,m)=lx(nd)
2748 ar(j-3,m)=zero
2749 ENDIF
2750 ENDDO
2751 ns=ifrs4(2,i)
2752 isk = irbe2(7,n)
2753 irad =irbe2(11,n)
2754 ic = irbe2(4,n)
2755C--------remove ICR---
2756 ic =(ic/512)*512
2757 CALL prerbe2fr(ic ,jt ,jr )
2758 CALL rbe2_frd(ns ,m ,x ,d ,dr ,
2759 1 jt ,jr ,skew(1,isk),isk ,irad )
2760 a(1,ns)=zero
2761 a(2,ns)=zero
2762 a(3,ns)=zero
2763 ENDDO
2764C------int2-------
2765 DO i=ni2_fr,1,-1
2766 n=ifrs2(1,i)
2767 ni=ifrs2(2,i)
2768 ji=ipari(1,n)
2769 nsn=ipari(5,n)
2770 l=intbuf_tab(n)%IRTLM(ni)
2771 nl=4*(l-1)
2772 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2773 nnod=3
2774 ELSE
2775 nnod=4
2776 ENDIF
2777C-------if main node is also dependent-----
2778 DO m=1,nnod
2779 nj=intbuf_tab(n)%IRECTM(nl+m)
2780 DO j=1,ndof(nj)
2781 nd = iddmi2(j,m,i)
2782 IF (j<=3.AND.nd>0) THEN
2783 d(j,nj)=lx(nd)
2784 a(j,nj)=zero
2785 ELSEIF(nd>0) THEN
2786 dr(j-3,nj)=lx(nd)
2787 ar(j-3,nj)=zero
2788 ENDIF
2789 ENDDO
2790 ENDDO
2791 ilev =ipari(20,n)
2792 IF (ilev==1) THEN
2793 CALL i2_frrd1(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA ,intbuf_tab(n)%NSV ,
2794 1 intbuf_tab(n)%IRTLM ,d ,ni )
2795 ELSE
2796 CALL i2_frrd0(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,intbuf_tab(n)%NSV ,
2797 1 intbuf_tab(n)%IRTLM ,d ,dr ,ni ,ndof )
2798 ENDIF
2799 ENDDO
2800C
2801 RETURN
2802 END
2803!||====================================================================
2804!|| upd_fr ../engine/source/mpi/implicit/imp_fri.F
2805!||--- called by ------------------------------------------------------
2806!|| fr_matv ../engine/source/mpi/implicit/imp_fri.F
2807!||--- calls -----------------------------------------------------
2808!|| bc_fi ../engine/source/constraints/general/bcs/bc_imp0.F
2809!|| bc_fi2 ../engine/source/constraints/general/bcs/bc_imp0.F
2810!|| bc_updf ../engine/source/constraints/general/bcs/bc_imp0.F
2811!|| fv_updf ../engine/source/constraints/general/impvel/fv_imp0.F
2812!|| i2_frfm0 ../engine/source/interfaces/interf/i2_imp1.F
2813!|| i2_frfm1 ../engine/source/interfaces/interf/i2_imp1.F
2814!|| kin_updf ../engine/source/constraints/general/impvel/fv_imp0.F
2815!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.F
2816!|| prerbe2fr ../engine/source/constraints/general/rbe2/rbe2f.F
2817!|| prerbe3fr ../engine/source/constraints/general/rbe3/rbe3f.F
2818!|| rbe2frf ../engine/source/constraints/general/rbe2/rbe2f.F
2819!|| rbe3frf ../engine/source/constraints/general/rbe3/rbe3f.F
2820!|| rby_impf ../engine/source/constraints/general/rbody/rby_imp0.F
2821!||--- uses -----------------------------------------------------
2822!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
2823!|| imp_intm ../engine/share/modules/imp_intm.F
2824!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
2825!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2826!||====================================================================
2827 SUBROUTINE upd_fr( A ,AR ,X ,IPARI ,INTBUF_TAB,
2828 1 NDOF ,IBFV ,SKEW ,XFRAME ,
2829 2 IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
2830C-----------------------------------------------
2831C M o d u l e s
2832C-----------------------------------------------
2833 USE imp_intm
2834 USE imp_rwl
2835 USE imp_aspc
2836 USE intbufdef_mod
2837C-----------------------------------------------
2838C I m p l i c i t T y p e s
2839C-----------------------------------------------
2840#include "implicit_f.inc"
2841C-----------------------------------------------
2842C C o m m o n B l o c k s
2843C-----------------------------------------------
2844#include "param_c.inc"
2845C-----------------------------------------------
2846C D u m m y A r g u m e n t s
2847C-----------------------------------------------
2848 INTEGER IRBE3(NRBE3L,*),LRBE3(*),IRBE2(NRBE2L,*),LRBE2(*),
2849 . IPARI(NPARI,*), NDOF(*),IBFV(NIFV,*)
2850 my_real
2851 . a(3,*),ar(3,*),x(3,*) ,skew(lskew,*),xframe(nxframe,*)
2852 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2853C-----------------------------------------------
2854C L o c a l V a r i a b l e s
2855C-----------------------------------------------
2856 INTEGER I,J,N,M,NS,NI,NSN,ILEV,I1,IADS,IROT,IAD,NNOD,ISK,IRAD,
2857 . ji,jt(3),jr(3),nn,ic
2858 my_real
2859 . ej(3)
2860C------int2-------
2861 DO i=1,ni2_fr
2862 n=ifrs2(1,i)
2863 ji=ipari(1,n)
2864 nsn=ipari(5,n)
2865 ni=ifrs2(2,i)
2866 ilev =ipari(20,n)
2867 IF (ilev==1) THEN
2868 CALL i2_frfm1(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA ,intbuf_tab(n)%NSV ,
2869 1 intbuf_tab(n)%IRTLM ,a ,ni )
2870 ELSE
2871 CALL i2_frfm0(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,intbuf_tab(n)%NSV ,
2872 1 intbuf_tab(n)%IRTLM ,a ,ar ,ni ,ndof )
2873 ENDIF
2874 ENDDO
2875C------RBE2-------
2876 DO i=1,nrbe2_fr
2877 n=ifrs4(1,i)
2878 m=irbe2(3,n)
2879 ns=ifrs4(2,i)
2880 isk = irbe2(7,n)
2881 irad =irbe2(11,n)
2882 ic = irbe2(4,n)
2883C--------remove ICR---
2884 ic =(ic/512)*512
2885 CALL prerbe2fr(ic ,jt ,jr )
2886 CALL rbe2frf(ns ,m ,a ,ar ,jt ,
2887 1 jr ,x ,isk ,skew(1,isk),irad )
2888 ENDDO
2889C--------RBE3-----
2890 iads=1
2891 DO i=1,nrbe3_fr
2892 n=ifrs3(i)
2893 iad=irbe3(1,n)
2894 ns=irbe3(3,n)
2895 nnod=irbe3(5,n)
2896 irot=irbe3(6,n)
2897 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
2898 CALL rbe3frf(nnod ,lrbe3(iad+1),ns ,a ,ar ,
2899 1 frcdi(iads),mrcdi(iads),jt ,jr ,irot )
2900 iads=iads+nnod
2901 ENDDO
2902C------Rigid bodies-------
2903 DO i=1,nrb_fr
2904 m=ifrsr(1,i)
2905 ns=ifrsr(2,i)
2906 CALL rby_impf(x ,m ,ns ,ndof ,a ,
2907 . ar )
2908 ENDDO
2909 IF (nbc_fr>0) THEN
2910 CALL bc_updf(nbc_fr ,ibc_fr ,skew ,a )
2911 ENDIF
2912 DO i1=1,nspc_fr
2913 n = ispc_fr(i1)
2914 i = in_spc(n)
2915 iad = 6*(n-1)+1
2916 nn = ic_spc(n)
2917 IF (nn==1) THEN
2918 ej(1)=skew_spc(iad)
2919 ej(2)=skew_spc(iad+1)
2920 ej(3)=skew_spc(iad+2)
2921 CALL l_dir(ej,j)
2922 CALL bc_fi(i ,skew_spc(iad),j ,a )
2923 ELSEIF (nn==2) THEN
2924 CALL bc_fi2(i ,skew_spc(iad),skew_spc(iad+3),a )
2925 END IF
2926 ENDDO
2927C
2928 IF (nfx_fr>0) THEN
2929 CALL fv_updf(nfx_fr ,ifx_fr ,ibfv ,skew ,xframe,
2930 1 a )
2931 ENDIF
2932 DO i1 = 1,nrw_fr
2933 i = irw_fr(i1)
2934 n = in_rwl(i)
2935 ej(1)=nor_rwl(1,i)
2936 ej(2)=nor_rwl(2,i)
2937 ej(3)=nor_rwl(3,i)
2938 CALL l_dir(ej,j)
2939 CALL kin_updf(n ,ej ,j ,a )
2940 ENDDO
2941C
2942 RETURN
2943 END
2944!||====================================================================
2945!|| fr_a2b ../engine/source/mpi/implicit/imp_fri.F
2946!||--- called by ------------------------------------------------------
2947!|| fr_matv ../engine/source/mpi/implicit/imp_fri.F
2948!||--- uses -----------------------------------------------------
2949!|| imp_intm ../engine/share/modules/imp_intm.F
2950!||====================================================================
2951 SUBROUTINE fr_a2b(NDOF ,LB ,A ,NSL )
2952C-----------------------------------------------
2953C M o d u l e s
2954C-----------------------------------------------
2955 USE imp_intm
2956C-----------------------------------------------
2957C I m p l i c i t T y p e s
2958C-----------------------------------------------
2959#include "implicit_f.inc"
2960C-----------------------------------------------
2961C D u m m y A r g u m e n t s
2962C-----------------------------------------------
2963 INTEGER NDOF(*),NSL
2964 my_real
2965 . a(3,*),lb(*)
2966C----------------------------------------------
2967C L o c a l V a r i a b l e s
2968C-----------------------------------------------
2969 INTEGER I,J,K,ID,ND,M,N
2970C---------
2971 DO i = 1,nsl
2972 n=islm(i)
2973 IF (n>0) THEN
2974 DO j=1,min(3,ndof(n))
2975 nd = iddsl(j,i)
2976 IF (nd>0) lb(nd)=lb(nd)+a(j,n)
2977 ENDDO
2978 ENDIF
2979 ENDDO
2980 DO i = 1,nml
2981 n=iml(i)
2982 DO j=1,min(3,ndof(n))
2983 nd = iddml(j,i)
2984 IF (nd>0) lb(nd)=lb(nd)+a(j,n)
2985 ENDDO
2986 ENDDO
2987C
2988 RETURN
2989 END
2990!||====================================================================
2991!|| fr_a2bd ../engine/source/mpi/implicit/imp_fri.F
2992!||--- called by ------------------------------------------------------
2993!|| fr_matv ../engine/source/mpi/implicit/imp_fri.F
2994!||--- uses -----------------------------------------------------
2995!|| imp_intm ../engine/share/modules/imp_intm.F
2996!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2997!||====================================================================
2998 SUBROUTINE fr_a2bd(NDOF ,IPARI ,INTBUF_TAB ,LB ,A ,
2999 . AR ,IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
3000C-----------------------------------------------
3001C M o d u l e s
3002C-----------------------------------------------
3003 USE imp_intm
3004 USE intbufdef_mod
3005C-----------------------------------------------
3006C I m p l i c i t T y p e s
3007C-----------------------------------------------
3008#include "implicit_f.inc"
3009C-----------------------------------------------
3010C C o m m o n B l o c k s
3011C-----------------------------------------------
3012#include "param_c.inc"
3013C-----------------------------------------------
3014C D u m m y A r g u m e n t s
3015C-----------------------------------------------
3016 INTEGER NDOF(*),IPARI(NPARI,*),
3017 . IRBE3(NRBE3L,*),LRBE3(*) ,IRBE2(NRBE2L,*),LRBE2(*)
3018 my_real
3019 . a(3,*),ar(3,*),lb(*)
3020 TYPE(intbuf_struct_) INTBUF_TAB(*)
3021C----------------------------------------------
3022C L o c a l V a r i a b l e s
3023C-----------------------------------------------
3024 INTEGER I,J,N,M,NS,NI,NSN,
3025 . l,nnod,nj,nd,nl,iad,ji
3026C------------------------------------
3027C------Rigid bodies-------
3028 DO i=1,nrb_fr
3029 m=ifrsr(1,i)
3030 DO j=1,ndof(m)
3031 nd = iddmr(j,i)
3032 IF (j<=3.AND.nd>0) THEN
3033 lb(nd)=lb(nd)+a(j,m)
3034 a(j,m)=zero
3035 ELSEIF(nd>0) THEN
3036 lb(nd)=lb(nd)+ar(j-3,m)
3037 ar(j-3,m)=zero
3038 ENDIF
3039 ENDDO
3040 ENDDO
3041C------int2-------
3042 DO i=1,ni2_fr
3043 n=ifrs2(1,i)
3044 ni=ifrs2(2,i)
3045 ji=ipari(1,n)
3046 nsn=ipari(5,n)
3047 l=intbuf_tab(n)%IRTLM(ni)
3048 nl=4*(l-1)
3049 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
3050 nnod=3
3051 ELSE
3052 nnod=4
3053 ENDIF
3054C-------if main node is also dependent-----
3055 DO m=1,nnod
3056 nj=intbuf_tab(n)%IRECTM(nl+m)
3057 DO j=1,ndof(nj)
3058 nd = iddmi2(j,m,i)
3059 IF (j<=3.AND.nd>0) THEN
3060 lb(nd)=lb(nd)+a(j,nj)
3061 a(j,nj)=zero
3062 ELSEIF(nd>0) THEN
3063 lb(nd)=lb(nd)+ar(j-3,nj)
3064 ar(j-3,nj)=zero
3065 ENDIF
3066 ENDDO
3067 ENDDO
3068 ENDDO
3069C--------RBE3-----
3070 DO i=1,nrbe3_fr
3071 n=ifrs3(i)
3072 iad=irbe3(1,n)
3073 nnod=irbe3(5,n)
3074 DO m=1,nnod
3075 nj=lrbe3(iad+m)
3076 DO j=1,ndof(nj)
3077 nd = iddmi3(j,m,i)
3078 IF (j<=3.AND.nd>0) THEN
3079 lb(nd)=lb(nd)+a(j,nj)
3080 a(j,nj)=zero
3081 ELSEIF(nd>0) THEN
3082 lb(nd)=lb(nd)+ar(j-3,nj)
3083 ar(j-3,nj)=zero
3084 ENDIF
3085 ENDDO
3086 ENDDO
3087 ENDDO
3088C------RBE2-------
3089 DO i=1,nrbe2_fr
3090 n=ifrs4(1,i)
3091 m=irbe2(3,n)
3092 DO j=1,ndof(m)
3093 nd = iddmr2(j,i)
3094 IF (j<=3.AND.nd>0) THEN
3095 lb(nd)=lb(nd)+a(j,m)
3096 a(j,m)=zero
3097 ELSEIF(nd>0) THEN
3098 lb(nd)=lb(nd)+ar(j-3,m)
3099 ar(j-3,m)=zero
3100 ENDIF
3101 ENDDO
3102 ENDDO
3103C
3104 RETURN
3105 END
3106!||====================================================================
3107!|| dim_nrmax ../engine/source/mpi/implicit/imp_fri.F
3108!||--- called by ------------------------------------------------------
3109!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
3110!||--- uses -----------------------------------------------------
3111!|| imp_frk ../engine/share/modules/impbufdef_mod.F
3112!||====================================================================
3113 SUBROUTINE dim_nrmax(NROW ,FR_ELEM ,IAD_ELEM,NNMAX )
3114C-----------------------------------------------
3115C M o d u l e s
3116C-----------------------------------------------
3117 USE imp_frk
3118C-----------------------------------------------
3119C I m p l i c i t T y p e s
3120C-----------------------------------------------
3121#include "implicit_f.inc"
3122C-----------------------------------------------
3123C C o m m o n B l o c k s
3124C-----------------------------------------------
3125#include "com01_c.inc"
3126C-----------------------------------------------
3127C D u m m y A r g u m e n t s
3128C-----------------------------------------------
3129 INTEGER NROW(*),IAD_ELEM(2,*),FR_ELEM(*),NNMAX
3130C----------------------------------------------
3131C L o c a l V a r i a b l e s
3132C-----------------------------------------------
3133 INTEGER I,J,N,NR
3134C------------------------------------
3135 IF (n_frnn==0) RETURN
3136C
3137 DO i =1,nspmd
3138 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
3139 nr=iad_rl(j+1)-iad_rl(j)
3140 IF (nr>0)THEN
3141 n = fr_elem(j)
3142 nrow(n)=nrow(n)+nr
3143 nnmax = max(nnmax,nrow(n))
3144 ENDIF
3145 ENDDO
3146 ENDDO
3147C
3148 RETURN
3149 END
3150!||====================================================================
3151!|| kin_nrmax0 ../engine/source/mpi/implicit/imp_fri.F
3152!||--- called by ------------------------------------------------------
3153!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
3154!||--- calls -----------------------------------------------------
3155!|| reorder_a ../engine/source/implicit/ind_glob_k.F
3156!||--- uses -----------------------------------------------------
3157!|| imp_frk ../engine/share/modules/impbufdef_mod.F
3158!||====================================================================
3159 SUBROUTINE kin_nrmax0(
3160 1 NNMAX ,NKMAX ,NROWK ,ICOK ,ICOKM ,
3161 2 ILOC ,INK ,FR_ELEM ,IAD_ELEM )
3162C-----------------------------------------------
3163C M o d u l e s
3164C-----------------------------------------------
3165 USE imp_frk
3166C-----------------------------------------------
3167C I m p l i c i t T y p e s
3168C-----------------------------------------------
3169#include "implicit_f.inc"
3170C-----------------------------------------------
3171C C o m m o n B l o c k s
3172C-----------------------------------------------
3173#include "com01_c.inc"
3174C-----------------------------------------------
3175C D u m m y A r g u m e n t s
3176C-----------------------------------------------
3177 INTEGER NNMAX,NKMAX,NROWK(*),ILOC(*),INK
3178 INTEGER ICOK(NNMAX,*),ICOKM(NKMAX,*),IAD_ELEM(2,*),FR_ELEM(*)
3179C----------------------------------------------
3180C L o c a l V a r i a b l e s
3181C-----------------------------------------------
3182 INTEGER I,J,N,NL,NR,K,NN
3183C------------------------------------
3184 IF (N_FRNN==0) return
3185C
3186 DO i =1,nspmd
3187 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
3188 n = fr_elem(j)
3189 nn = iloc(n)
3190 IF (nn>ink)THEN
3191 DO k=iad_rl(j),iad_rl(j+1)-1
3192 nl = fr_icol(k)+iad_elem(1,i)-1
3193 CALL reorder_a(nrowk(nn),icok(1,nn),fr_elem(nl))
3194 ENDDO
3195 ELSEIF (nn>0)THEN
3196 DO k=iad_rl(j),iad_rl(j+1)-1
3197 nl = fr_icol(k)+iad_elem(1,i)-1
3198 CALL reorder_a(nrowk(nn),icokm(1,nn),fr_elem(nl))
3199 ENDDO
3200 ENDIF
3201 ENDDO
3202 ENDDO
3203C
3204 RETURN
3205 END
3206!||====================================================================
3207!|| kin_nrmax ../engine/source/mpi/implicit/imp_fri.F
3208!||--- called by ------------------------------------------------------
3209!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
3210!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
3211!||--- calls -----------------------------------------------------
3212!|| reorder_a ../engine/source/implicit/ind_glob_k.F
3213!||--- uses -----------------------------------------------------
3214!|| imp_frk ../engine/share/modules/impbufdef_mod.F
3215!||====================================================================
3216 SUBROUTINE kin_nrmax(
3217 1 NNMAX ,NKMAX ,NROWK ,ICOK ,ICOKM ,
3218 2 ILOC ,INK ,FR_ELEM ,IAD_ELEM )
3219C-----------------------------------------------
3220C M o d u l e s
3221C-----------------------------------------------
3222 USE imp_frk
3223C-----------------------------------------------
3224C I m p l i c i t T y p e s
3225C-----------------------------------------------
3226#include "implicit_f.inc"
3227C-----------------------------------------------
3228C C o m m o n B l o c k s
3229C-----------------------------------------------
3230#include "com01_c.inc"
3231C-----------------------------------------------
3232C D u m m y A r g u m e n t s
3233C-----------------------------------------------
3234 INTEGER NNMAX,NKMAX,NROWK(*),ILOC(*),INK
3235 INTEGER ICOK(NNMAX,*),ICOKM(NKMAX,*),IAD_ELEM(2,*),FR_ELEM(*)
3236C----------------------------------------------
3237C L o c a l V a r i a b l e s
3238C-----------------------------------------------
3239 INTEGER I,J,N,NL,NR,K,NK,NN
3240C------------------------------------
3241 IF (N_FRNN==0) return
3242C
3243 DO i =1,nspmd
3244 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
3245 n = fr_elem(j)
3246 nn = iloc(n)
3247 IF (nn>ink)THEN
3248 nk=nn-ink
3249 DO k=iad_rl(j),iad_rl(j+1)-1
3250 nl = fr_icol(k)+iad_elem(1,i)-1
3251 CALL reorder_a(nrowk(nn),icokm(1,nk),fr_elem(nl))
3252 ENDDO
3253 ELSEIF (nn>0)THEN
3254 DO k=iad_rl(j),iad_rl(j+1)-1
3255 nl = fr_icol(k)+iad_elem(1,i)-1
3256 CALL reorder_a(nrowk(nn),icok(1,nn),fr_elem(nl))
3257 ENDDO
3258 ENDIF
3259 ENDDO
3260 ENDDO
3261C
3262 RETURN
3263 END
3264!||====================================================================
3265!|| ind_nrmax ../engine/source/mpi/implicit/imp_fri.F
3266!||--- called by ------------------------------------------------------
3267!|| ind_nrfr ../engine/source/mpi/implicit/imp_fri.F
3268!||--- calls -----------------------------------------------------
3269!|| reorder_a ../engine/source/implicit/ind_glob_k.F
3270!||====================================================================
3271 SUBROUTINE ind_nrmax(
3272 1 NFT ,NEL ,NPN ,NPPS ,NNMAX ,
3273 2 NROW ,ICOL ,IAD_RL ,FR_ICOL ,N_FRNN )
3274C-----------------------------------------------
3275C I m p l i c i t T y p e s
3276C-----------------------------------------------
3277#include "implicit_f.inc"
3278C-----------------------------------------------
3279C C o m m o n B l o c k s
3280C-----------------------------------------------
3281#include "com04_c.inc"
3282C-----------------------------------------------
3283C D u m m y A r g u m e n t s
3284C-----------------------------------------------
3285 INTEGER NNMAX,IAD_RL(*),FR_ICOL(*),N_FRNN
3286 INTEGER NFT,NEL,NPN,NPPS,NROW(*),ICOL(NNMAX,*)
3287C----------------------------------------------
3288C L o c a l V a r i a b l e s
3289C-----------------------------------------------
3290 INTEGER I,J,N,M,JLT,JLT1,NK,NFT1,ISH,L,NPP
3291C------------------------------------
3292 IF (N_FRNN==0) return
3293 jlt=nel+nft
3294 npp=numnod-npps
3295 IF (npn>nft) THEN
3296 jlt1 = min( nel, npn - nft )
3297 DO nk=1,jlt1
3298 j=nk+nft
3299 DO i=iad_rl(j),iad_rl(j+1)-1
3300 CALL reorder_a(nrow(nk),icol(1,nk),fr_icol(i))
3301 ENDDO
3302 ENDDO
3303 ENDIF
3304 IF (npp<jlt) THEN
3305 nft1 = max(nft,npp)+1
3306 ish= npp-npn
3307 DO n=nft1,jlt
3308 nk=n-nft
3309 j=n-ish
3310 DO i=iad_rl(j),iad_rl(j+1)-1
3311 CALL reorder_a(nrow(nk),icol(1,nk),fr_icol(i))
3312 ENDDO
3313 ENDDO
3314 ENDIF
3315C
3316 RETURN
3317 END
3318
3319!||====================================================================
3320!|| dim_fr_k ../engine/source/mpi/implicit/imp_fri.F
3321!||--- called by ------------------------------------------------------
3322!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
3323!||--- calls -----------------------------------------------------
3324!|| dim_elemsp ../engine/source/implicit/ind_glob_k.F
3325!|| intab ../engine/source/implicit/ind_glob_k.F
3326!|| reorder_a ../engine/source/implicit/ind_glob_k.F
3327!|| spmd_icol ../engine/source/mpi/implicit/imp_spmd.F
3328!|| spmd_nrow ../engine/source/mpi/implicit/imp_spmd.F
3329!||--- uses -----------------------------------------------------
3330!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3331!|| imp_frk ../engine/share/modules/impbufdef_mod.F
3332!||====================================================================
3333 SUBROUTINE dim_fr_k(
3334 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
3335 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
3336 3 IXS10 ,IXS20 ,IXS16 ,NDOF ,
3337 4 NNMAX ,INLOC ,FR_ELEM ,IAD_ELEM ,N_FR ,
3338 5 IGEO ,FR_I2M ,IAD_I2M ,ELBUF_TAB )
3339C-----------------------------------------------
3340C M o d u l e s
3341C-----------------------------------------------
3342 USE imp_frk
3343 USE elbufdef_mod
3344C-----------------------------------------------
3345C I m p l i c i t T y p e s
3346C-----------------------------------------------
3347#include "implicit_f.inc"
3348C-----------------------------------------------
3349C C o m m o n B l o c k s
3350C-----------------------------------------------
3351#include "com01_c.inc"
3352#include "com04_c.inc"
3353#include "param_c.inc"
3354C-----------------------------------------------
3355C D u m m y A r g u m e n t s
3356C-----------------------------------------------
3357 INTEGER IPARG(NPARG,*),NNMAX,N_FR ,NDOF(*),IGEO(*),
3358 . FR_I2M(*),IAD_I2M(*)
3359 integer
3360 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*),ixp(nixp,*),
3361 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3362 . ixs16(8,*),ixtg1(4,*),inloc(*),fr_elem(*),iad_elem(2,*)
3363C REAL
3364 my_real
3365 . elbuf(*)
3366 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3367C-----------------------------------------------
3368C External function
3369C-----------------------------------------------
3370 LOGICAL INTAB
3371 EXTERNAL intab
3372C-----------------------------------------------
3373C L o c a l V a r i a b l e s
3374C-----------------------------------------------
3375 INTEGER I,J,N,NK,ICOL(NNMAX,N_FR),NROW(N_FR),IP,JLT,NFT,
3376 . fr_nrow(n_fr),l,iad_s(nspmd+1),iad_r(nspmd+1),nf1,
3377 . ierror1,ierror2,ierror3,ls,lr,ssize,rsize,j0,nn,nr,nl,nrn
3378C ---- creer NROW,ICOL aux front.---------
3379 IF (n_fr <=0 .OR. nnmax <=0 ) THEN
3380 nddlfr=0
3381 nddlfrb=0
3382 ndfrmax=0
3383 n_frnn=0
3384c RETURN
3385 ENDIF
3386 DO n =1,numnod
3387 inloc(n)=0
3388 ENDDO
3389 DO n =1,n_fr
3390 nrow(n)=0
3391 ENDDO
3392 DO ip =1,nspmd
3393 jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
3394 nft=iad_elem(1,ip)-1
3395 nf1=min(n_fr,nft+1)
3396 DO j=1,jlt
3397 nk=j+nft
3398 n=fr_elem(nk)
3399 inloc(n) = j
3400 ENDDO
3401 CALL dim_elemsp(
3402 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3403 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3404 3 ixs10 ,ixs20 ,ixs16 ,nrow(nf1),
3405 4 inloc ,nnmax ,icol(1,nf1),igeo ,elbuf_tab )
3406 DO j=1,jlt
3407 nk=j+nft
3408 n=fr_elem(nk)
3409 inloc(n) = 0
3410 ENDDO
3411 ENDDO
3412 CALL spmd_nrow(nrow,fr_nrow,iad_elem,n_fr)
3413C------prepare comm.-----
3414 ls=1
3415 lr=1
3416 iad_s(1)=ls
3417 iad_r(1)=lr
3418 DO ip =1,nspmd
3419 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3420 ls=ls+nrow(nk)
3421 lr=lr+fr_nrow(nk)
3422 ENDDO
3423 iad_s(ip+1)=ls
3424 iad_r(ip+1)=lr
3425 ENDDO
3426 IF ((ls+lr)>2) THEN
3427 ssize=iad_s(nspmd+1)-1
3428 rsize=iad_r(nspmd+1)-1
3429C
3430 CALL spmd_icol(
3431 1 iad_s ,iad_r ,nnmax ,icol ,nrow ,
3432 2 fr_nrow ,iad_elem ,fr_elem ,ssize ,rsize )
3433 ENDIF
3434C
3435 DO ip =1,nspmd
3436 nr=iad_i2m(ip+1)-iad_i2m(ip)
3437 IF (nr>0) THEN
3438 jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
3439 nft=iad_elem(1,ip)-1
3440 DO j=1,jlt
3441 nk=j+nft
3442 n=fr_elem(nk)
3443 inloc(n) = j
3444 ENDDO
3445 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3446 n=fr_elem(nk)
3447 IF (intab(nr,fr_i2m(iad_i2m(ip)),n)) THEN
3448 DO l=iad_i2m(ip),iad_i2m(ip+1)-1
3449 nn=fr_i2m(l)
3450 nl=inloc(nn)
3451 IF (nl>0.AND.nn/=n) THEN
3452 nrn = max(nrow(nk),fr_nrow(nk))
3453 CALL reorder_a(nrn,icol(1,nk),nl)
3454 IF (nrn>max(nrow(nk),fr_nrow(nk))) fr_nrow(nk)=nrn
3455 ENDIF
3456 ENDDO
3457 ENDIF
3458 ENDDO
3459C
3460 DO j=1,jlt
3461 nk=j+nft
3462 n=fr_elem(nk)
3463 inloc(n) = 0
3464 ENDDO
3465 ENDIF !IF (NR>0)
3466 ENDDO !IP =1,NSPMD
3467 nrmax = 0
3468 IF(ALLOCATED(iad_rl)) DEALLOCATE(iad_rl)
3469 ALLOCATE(iad_rl(n_fr+1),stat=ierror3)
3470 lr=1
3471 iad_rl(1)=lr
3472 DO ip =1,nspmd
3473 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3474 IF (nrow(nk)<fr_nrow(nk)) THEN
3475 nr=fr_nrow(nk)-nrow(nk)
3476 lr=lr+nr
3477 nrmax = max(nrmax,nr)
3478 ENDIF
3479 iad_rl(nk+1)=lr
3480 ENDDO
3481 ENDDO
3482 n_frnn=lr-1
3483C-------d'abord c'est locale------------
3484 IF (n_frnn>0) THEN
3485 IF(ALLOCATED(fr_icol)) DEALLOCATE(fr_icol)
3486 ALLOCATE(fr_icol(lr),stat=ierror2)
3487 DO ip =1,nspmd
3488 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3489 j0=nrow(nk)-iad_rl(nk)+1
3490 DO l=iad_rl(nk),iad_rl(nk+1)-1
3491 j=l+j0
3492 fr_icol(l)=icol(j,nk)
3493 ENDDO
3494 ENDDO
3495 ENDDO
3496 ENDIF
3497C------definit IFRLOC (global)pour ind_glob_k---
3498 IF(ALLOCATED(ifrloc)) DEALLOCATE(ifrloc)
3499 ALLOCATE(ifrloc(n_fr),stat=ierror1)
3500 nn=0
3501 DO n =1,numnod
3502 inloc(n)=0
3503 ENDDO
3504 DO ip =1,nspmd
3505 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3506 n=fr_elem(nk)
3507 IF (inloc(n)==0) THEN
3508 nn = nn +1
3509 inloc(n)=nn
3510 ifrloc(nk)=nn
3511 icol(1,nn)=nk
3512 ELSE
3513 ifrloc(nk)=-icol(1,inloc(n))
3514 IF (nrow(nk)<fr_nrow(nk))nrmax=nrmax+fr_nrow(nk)-nrow(nk)
3515 ENDIF
3516 ENDDO
3517 ENDDO
3518C
3519 RETURN
3520 END
3521!||====================================================================
3522!|| ind_fr_k ../engine/source/mpi/implicit/imp_fri.F
3523!||--- called by ------------------------------------------------------
3524!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
3525!||--- calls -----------------------------------------------------
3526!|| dim_elemsp ../engine/source/implicit/ind_glob_k.F
3527!|| ind_fr_k0 ../engine/source/mpi/implicit/imp_fri.F
3528!|| reorder_a ../engine/source/implicit/ind_glob_k.F
3529!||--- uses -----------------------------------------------------
3530!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3531!|| imp_frk ../engine/share/modules/impbufdef_mod.F
3532!||====================================================================
3533 SUBROUTINE ind_fr_k(
3534 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
3535 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
3536 3 IXS10 ,IXS20 ,IXS16 ,NDOF ,
3537 4 NNMAX ,INLOC ,FR_ELEM ,IAD_ELEM ,N_FR ,
3538 5 IGEO ,ELBUF_TAB )
3539C-----------------------------------------------
3540C M o d u l e s
3541C-----------------------------------------------
3542 USE imp_frk
3543 USE elbufdef_mod
3544C-----------------------------------------------
3545C I m p l i c i t T y p e s
3546C-----------------------------------------------
3547#include "implicit_f.inc"
3548C-----------------------------------------------
3549C C o m m o n B l o c k s
3550C-----------------------------------------------
3551#include "com01_c.inc"
3552#include "com04_c.inc"
3553#include "param_c.inc"
3554C-----------------------------------------------
3555C D u m m y A r g u m e n t s
3556C-----------------------------------------------
3557 INTEGER IPARG(NPARG,*),NNMAX,N_FR ,NDOF(*),IGEO(*)
3558 integer
3559 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*),ixp(nixp,*),
3560 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3561 . ixs16(8,*),ixtg1(4,*),inloc(*),fr_elem(*),iad_elem(2,*)
3562C REAL
3563 my_real
3564 . elbuf(*)
3565 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3566C-----------------------------------------------
3567C L o c a l V a r i a b l e s
3568C-----------------------------------------------
3569 INTEGER I,J,N,NK,ICOL(NNMAX,N_FR),NROW(N_FR),IP,JLT,NFT,
3570 . ierror1,ierror2,ierror3,ls,lr,ssize,rsize,j0,l,nf1
3571C ---- creer NROW,ICOL aux front.---------
3572 IF (n_fr>0) THEN
3573 DO n =1,numnod
3574 inloc(n)=0
3575 ENDDO
3576 DO n =1,n_fr
3577 nrow(n)=0
3578 ENDDO
3579 DO ip =1,nspmd
3580 jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
3581 nft=iad_elem(1,ip)-1
3582 nf1=min(n_fr,nft+1)
3583 DO j=1,jlt
3584 nk=j+nft
3585 n=fr_elem(nk)
3586 inloc(n) = j
3587 ENDDO
3588 CALL dim_elemsp(
3589 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3590 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3591 3 ixs10 ,ixs20 ,ixs16 ,nrow(nf1),
3592 4 inloc ,nnmax ,icol(1,nf1),igeo ,elbuf_tab )
3593 DO j=1,jlt
3594 nk=j+nft
3595 n=fr_elem(nk)
3596 inloc(n) = 0
3597 ENDDO
3598 ENDDO
3599C--------recupere fr_nrow --
3600 IF (n_frnn>0) THEN
3601 DO ip =1,nspmd
3602 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3603 DO l=iad_rl(nk),iad_rl(nk+1)-1
3604 CALL reorder_a(nrow(nk),icol(1,nk),fr_icol(l))
3605 ENDDO
3606 ENDDO
3607 ENDDO
3608 ENDIF
3609 ENDIF ! (N_FR>0)
3610C------ind_ [k] de FR.------
3611 CALL ind_fr_k0(
3612 1 ndof ,nrow ,nnmax ,icol ,fr_elem ,
3613 2 iad_elem ,n_fr )
3614C
3615 RETURN
3616 END
3617!||====================================================================
3618!|| ind_nrfr ../engine/source/mpi/implicit/imp_fri.F
3619!||--- called by ------------------------------------------------------
3620!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
3621!||--- calls -----------------------------------------------------
3622!|| ind_nrmax ../engine/source/mpi/implicit/imp_fri.F
3623!|| reorder_a ../engine/source/implicit/ind_glob_k.F
3624!||--- uses -----------------------------------------------------
3625!|| imp_frk ../engine/share/modules/impbufdef_mod.F
3626!||====================================================================
3627 SUBROUTINE ind_nrfr(
3628 1 NFT ,NEL ,NPN ,NPP ,NNMAX ,
3629 2 NROW ,ICOL ,FR_ELEM ,IAD_ELEM ,N_FR ,
3630 3 ICOK )
3631C-----------------------------------------------
3632C M o d u l e s
3633C-----------------------------------------------
3634 USE imp_frk
3635C-----------------------------------------------
3636C I m p l i c i t T y p e s
3637C-----------------------------------------------
3638#include "implicit_f.inc"
3639C-----------------------------------------------
3640C C o m m o n B l o c k s
3641C-----------------------------------------------
3642#include "com01_c.inc"
3643C-----------------------------------------------
3644C D u m m y A r g u m e n t s
3645C-----------------------------------------------
3646 INTEGER NNMAX,NFT,NEL,NPN,NPP,NROW(*),ICOL(NNMAX,*)
3647 integer
3648 . fr_elem(*),iad_elem(2,*),n_fr,icok(nrmax,n_fr)
3649C REAL
3650C-----------------------------------------------
3651C L o c a l V a r i a b l e s
3652C-----------------------------------------------
3653 INTEGER I,J,N,NK,NROWK(N_FR),IP,
3654 . l,iad_r(n_fr+1),fr_icol1(n_frnn+1),lr,j0,nn,n_frn
3655C--------recupere fr_nrow et passe en global (par rap. a PROC) --
3656 IF (nnmax <=0 ) RETURN
3657 DO ip =1,nspmd
3658 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3659 nrowk(nk)=iad_rl(nk+1)-iad_rl(nk)
3660 j0 = iad_elem(1,ip)-1
3661 DO l=iad_rl(nk),iad_rl(nk+1)-1
3662 j=l-iad_rl(nk)+1
3663 n= fr_icol(l)+j0
3664 icok(j,nk)=fr_elem(n)
3665 ENDDO
3666 ENDDO
3667 ENDDO
3668C----accumulate in case nodes belong to multiple interfaces--
3669 DO ip =1,nspmd
3670 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3671 n = -ifrloc(nk)
3672 IF (n>0) THEN
3673 DO j=1,nrowk(nk)
3674 CALL reorder_a(nrowk(n),icok(1,n),icok(j,nk))
3675 ENDDO
3676 ENDIF
3677 ENDDO
3678 ENDDO
3679C------dim de IAD_R->NN+1--
3680 lr=1
3681 iad_r(1)=lr
3682 DO ip =1,nspmd
3683 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3684 n = ifrloc(nk)
3685 IF (n>0) THEN
3686 lr=lr+nrowk(nk)
3687 iad_r(n+1)=lr
3688 ENDIF
3689 ENDDO
3690 ENDDO
3691 n_frn=lr-1
3692 if (n_frn>n_frnn) print *,'PROBLEM IN IND_NRFR'
3693 IF (n_frn>0) THEN
3694 DO ip =1,nspmd
3695 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3696 n = ifrloc(nk)
3697 IF (n>0) THEN
3698 DO j=1,nrowk(nk)
3699 l=iad_r(n)+j-1
3700 fr_icol1(l)=icok(j,nk)
3701 ENDDO
3702 ENDIF
3703 ENDDO
3704 ENDDO
3705 ENDIF
3706C
3707 CALL ind_nrmax(
3708 1 nft ,nel ,npn ,npp ,nnmax ,
3709 2 nrow ,icol ,iad_r ,fr_icol1 ,n_frnn )
3710
3711C
3712 RETURN
3713 END
3714!||====================================================================
3715!|| ind_fr_k0 ../engine/source/mpi/implicit/imp_fri.F
3716!||--- called by ------------------------------------------------------
3717!|| ind_fr_k ../engine/source/mpi/implicit/imp_fri.F
3718!||--- calls -----------------------------------------------------
3719!|| reorder_l ../engine/source/implicit/ind_glob_k.F
3720!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
3721!||--- uses -----------------------------------------------------
3722!|| imp_frk ../engine/share/modules/impbufdef_mod.F
3723!||====================================================================
3724 SUBROUTINE ind_fr_k0(
3725 1 NDOF ,NROW ,NNMAX ,ICOL ,FR_ELEM ,
3726 2 IAD_ELEM ,N_FR )
3727C-----------------------------------------------
3728C M o d u l e s
3729C-----------------------------------------------
3730 USE imp_frk
3731C-----------------------------------------------
3732C I m p l i c i t T y p e s
3733C-----------------------------------------------
3734#include "implicit_f.inc"
3735C-----------------------------------------------
3736C C o m m o n B l o c k s
3737C-----------------------------------------------
3738#include "com01_c.inc"
3739#include "impl1_c.inc"
3740C-----------------------------------------------
3741C D u m m y A r g u m e n t s
3742C-----------------------------------------------
3743 INTEGER NNMAX,N_FR ,NDOF(*),NROW(*)
3744 integer
3745 . fr_elem(*),iad_elem(2,*),icol(nnmax,*)
3746C REAL
3747C-----------------------------------------------
3748C L o c a l V a r i a b l e s
3749C-----------------------------------------------
3750 INTEGER I,J,N,NK,IP,L,NDDL0,NZZK0,NN,IAD,NB,
3751 . nnz(nspmd),ndofj,k,nddl,nzzk,nj,nk0,njn,nl,nzz,
3752 . ierror0,ierror1,ierror2,ierror3,ierror4,ierror5
3753 INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG
3754 my_real
3755 . s1,stmp
3756C------dim [k] pour chaque FR.-----
3757 IF (iroddl==0) THEN
3758 ndofj=3
3759 ELSE
3760 ndofj=6
3761 ENDIF
3762 nddlfr=0
3763 nddlfrb=0
3764 ndfrmax=0
3765 nzzk=0
3766 IF(ALLOCATED(nd_fr)) DEALLOCATE(nd_fr)
3767 ALLOCATE(nd_fr(nspmd),stat=ierror0)
3768 DO ip =1,nspmd
3769 nd_fr(ip)=0
3770 nnz(ip)=0
3771 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3772 n=fr_elem(nk)
3773 nd_fr(ip)=nd_fr(ip)+ndof(n)
3774 DO k=1,ndof(n)
3775C-------termes knn-------
3776 DO j=1,ndof(n)
3777 IF (j/=k) nnz(ip) = nnz(ip)+1
3778 ENDDO
3779C-------termes kn,nj-------
3780 DO j=1,nrow(nk)
3781 DO l=1,ndofj
3782 nnz(ip) = nnz(ip)+1
3783 ENDDO
3784 ENDDO
3785 ENDDO
3786 ENDDO
3787 nddlfr = nddlfr + nd_fr(ip)
3788 ndfrmax=max(ndfrmax,nd_fr(ip))
3789 nzzk = nzzk + nnz(ip)
3790 ENDDO
3791 nzzk = nzzk/2+1
3792 stmp = zero
3793 IF (nddlfr>0) THEN
3794 ALLOCATE(itag(n_fr))
3795 itag = 2
3796 DO nk=1,n_fr
3797 nb=-ifrloc(nk)
3798 IF (nb>0) itag(nb) = itag(nb) + 1
3799 ENDDO
3800 DO nk=1,n_fr
3801 nb=-ifrloc(nk)
3802 IF (nb<0) nb = nk
3803 s1 = one/itag(nb)
3804 stmp = stmp + s1*ndof(fr_elem(nb))
3805 ENDDO
3806 DEALLOCATE(itag)
3807 ENDIF
3808 CALL spmd_sum_s(stmp)
3809 nddlfrb = int(stmp)
3810 IF (nddlfr==0) RETURN
3811C
3812 nddl = nddlfr + nspmd
3813 IF(ALLOCATED(iadfr)) DEALLOCATE(iadfr)
3814 ALLOCATE(iadfr(nddl),stat=ierror1)
3815 IF(ALLOCATED(jdifr)) DEALLOCATE(jdifr)
3816 ALLOCATE(jdifr(nzzk),stat=ierror2)
3817 IF(ALLOCATED(iddlfr)) DEALLOCATE(iddlfr)
3818 ALLOCATE(iddlfr(n_fr),stat=ierror3)
3819 IF(ALLOCATED(ifr2k)) DEALLOCATE(ifr2k)
3820 ALLOCATE(ifr2k(nddlfr),stat=ierror4)
3821 IF (iprec>2.OR.iautspc>0) THEN
3822 IF(ALLOCATED(jfr2k)) DEALLOCATE(jfr2k)
3823 ALLOCATE(jfr2k(nzzk),stat=ierror5)
3824 ENDIF
3825 DO ip =1,nspmd
3826 nddl0=0
3827 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3828 n=fr_elem(nk)
3829 iddlfr(nk) = nddl0
3830 nddl0=nddl0+ndof(n)
3831 ENDDO
3832 ENDDO
3833C------ind_ [k] pour chaque FR.-----
3834 nddl0 = nddl
3835 nzzk0 = nzzk
3836 nzzk=0
3837 iad=0
3838 DO ip =1,nspmd
3839 nk0=iad_elem(1,ip)-1
3840 nzz = 0
3841 nddl=1
3842 iadfr(nddl+iad)=1
3843 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3844 n=fr_elem(nk)
3845 CALL reorder_l(nrow(nk),icol(1,nk),nk-nk0,
3846 . iddlfr(iad_elem(1,ip)))
3847 IF (ndof(n)>0) THEN
3848 DO k=1,ndof(n)
3849C-------termes knj,n-------
3850 DO j=1,nrow(nk)
3851 nj = icol(j,nk)+nk0
3852 nn=fr_elem(nj)
3853 DO l=1,ndof(nn)
3854 nzz = nzz+1
3855 jdifr(nzz+nzzk) = iddlfr(nj)+l
3856 ENDDO
3857 ENDDO
3858 DO j=1,k-1
3859 nzz = nzz+1
3860 jdifr(nzz+nzzk) = iddlfr(nk)+j
3861 ENDDO
3862 nddl = nddl +1
3863 iadfr(nddl+iad) = nzz+1
3864 ENDDO
3865 ENDIF
3866 ENDDO
3867 nzzk = nzzk +nzz
3868 iad = iad + nddl
3869 ENDDO
3870 IF (nzzk>nzzk0.OR.iad/=nddl0)
3871 . WRITE(*,*)'--MEMERY PROBLEM 3--:',nzzk,nzzk0,iad,nddl0
3872 nzkfr = nzzk
3873C
3874 RETURN
3875 END
3876!||====================================================================
3877!|| ini_fr_k ../engine/source/mpi/implicit/imp_fri.F
3878!||--- called by ------------------------------------------------------
3879!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
3880!||--- calls -----------------------------------------------------
3881!|| dim_elemsp ../engine/source/implicit/ind_glob_k.F
3882!|| intab ../engine/source/implicit/ind_glob_k.F
3883!|| reorder_a ../engine/source/implicit/ind_glob_k.F
3884!|| spmd_icol ../engine/source/mpi/implicit/imp_spmd.F
3885!|| spmd_nrow ../engine/source/mpi/implicit/imp_spmd.F
3886!||--- uses -----------------------------------------------------
3887!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3888!|| imp_frk ../engine/share/modules/impbufdef_mod.F
3889!||====================================================================
3890 SUBROUTINE ini_fr_k(
3891 1 ELBUF ,IPARG ,IXS ,IXQ ,IXC ,
3892 2 IXT ,IXP ,IXR ,IXTG ,IXTG1 ,
3893 3 IXS10 ,IXS20 ,IXS16 ,NDOF ,
3894 4 NNMAX ,INLOC ,FR_ELEM ,IAD_ELEM ,N_FR ,
3895 5 IGEO ,FR_I2M ,IAD_I2M ,ELBUF_TAB ,NNRMAX )
3896C-----------------------------------------------
3897C M o d u l e s
3898C-----------------------------------------------
3899 USE imp_frk
3900 USE elbufdef_mod
3901C-----------------------------------------------
3902C I m p l i c i t T y p e s
3903C-----------------------------------------------
3904#include "implicit_f.inc"
3905C-----------------------------------------------
3906C C o m m o n B l o c k s
3907C-----------------------------------------------
3908#include "com01_c.inc"
3909#include "com04_c.inc"
3910#include "param_c.inc"
3911C-----------------------------------------------
3912C D u m m y A r g u m e n t s
3913C-----------------------------------------------
3914 INTEGER IPARG(NPARG,*),NNMAX,N_FR ,NDOF(*),IGEO(*),
3915 . FR_I2M(*),IAD_I2M(*),NNRMAX
3916 integer
3917 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*),ixp(nixp,*),
3918 . ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
3919 . ixs16(8,*),ixtg1(4,*),inloc(*),fr_elem(*),iad_elem(2,*)
3920C REAL
3921 my_real
3922 . elbuf(*)
3923 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3924C-----------------------------------------------
3925C External function
3926C-----------------------------------------------
3927 LOGICAL INTAB
3928 EXTERNAL INTAB
3929C-----------------------------------------------
3930C L o c a l V a r i a b l e s
3931C-----------------------------------------------
3932 INTEGER I,J,N,NK,ICOL(NNMAX,N_FR),NROW(N_FR),IP,JLT,NFT,
3933 . fr_nrow(n_fr),l,iad_s(nspmd+1),iad_r(nspmd+1),
3934 . ierror1,ierror2,ierror3,ls,lr,ssize,rsize,j0,nn,nr,nl,nrn,
3935 . nr2,nf1
3936C ---- suite pb avec elem delete.---------
3937C IF (N_FR <=0 .OR. NNMAX <=0) RETURN
3938 DO n =1,numnod
3939 inloc(n)=0
3940 ENDDO
3941 DO n =1,n_fr
3942 nrow(n)=0
3943 ENDDO
3944 DO ip =1,nspmd
3945 jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
3946 nft=iad_elem(1,ip)-1
3947 nf1=min(n_fr,nft+1)
3948 DO j=1,jlt
3949 nk=j+nft
3950 n=fr_elem(nk)
3951 inloc(n) = j
3952 ENDDO
3953 CALL dim_elemsp(
3954 1 elbuf ,iparg ,ixs ,ixq ,ixc ,
3955 2 ixt ,ixp ,ixr ,ixtg ,ixtg1 ,
3956 3 ixs10 ,ixs20 ,ixs16 ,nrow(nf1),
3957 4 inloc ,nnmax ,icol(1,nf1),igeo ,elbuf_tab )
3958 DO j=1,jlt
3959 nk=j+nft
3960 n=fr_elem(nk)
3961 inloc(n) = 0
3962 ENDDO
3963 ENDDO
3964 CALL spmd_nrow(nrow,fr_nrow,iad_elem,n_fr)
3965C------prepare comm.-----
3966 ls=1
3967 lr=1
3968 iad_s(1)=ls
3969 iad_r(1)=lr
3970 DO ip =1,nspmd
3971 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
3972 ls=ls+nrow(nk)
3973 lr=lr+fr_nrow(nk)
3974 ENDDO
3975 iad_s(ip+1)=ls
3976 iad_r(ip+1)=lr
3977 ENDDO
3978 IF ((ls+lr)>2) THEN
3979 ssize=iad_s(nspmd+1)-1
3980 rsize=iad_r(nspmd+1)-1
3981C
3982 CALL spmd_icol(
3983 1 iad_s ,iad_r ,nnmax ,icol ,nrow ,
3984 2 fr_nrow ,iad_elem ,fr_elem ,ssize ,rsize )
3985 ENDIF
3986C
3987 nr2=iad_i2m(nspmd+1)-iad_i2m(1)
3988 IF (nr2>0) THEN
3989 DO ip =1,nspmd
3990 nr=iad_i2m(ip+1)-iad_i2m(ip)
3991 IF (nr>0) THEN
3992 jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
3993 nft=iad_elem(1,ip)-1
3994 DO j=1,jlt
3995 nk=j+nft
3996 n=fr_elem(nk)
3997 inloc(n) = j
3998 ENDDO
3999 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
4000 n=fr_elem(nk)
4001 IF (intab(nr,fr_i2m(iad_i2m(ip)),n)) THEN
4002 DO l=iad_i2m(ip),iad_i2m(ip+1)-1
4003 nn=fr_i2m(l)
4004 nl=inloc(nn)
4005 IF (nl>0.AND.nn/=n) THEN
4006 nrn = max(nrow(nk),fr_nrow(nk))
4007 CALL reorder_a(nrn,icol(1,nk),nl)
4008 IF (nrn>max(nrow(nk),fr_nrow(nk))) fr_nrow(nk)=nrn
4009 ENDIF
4010 ENDDO
4011 ENDIF
4012 ENDDO
4013C
4014 DO j=1,jlt
4015 nk=j+nft
4016 n=fr_elem(nk)
4017 inloc(n) = 0
4018 ENDDO
4019 ENDIF
4020 ENDDO
4021 END IF !(NR2>0) THEN
4022C
4023 IF(ALLOCATED(iad_rl)) DEALLOCATE(iad_rl)
4024 ALLOCATE(iad_rl(n_fr+1),stat=ierror3)
4025 lr=1
4026 iad_rl(1)=lr
4027 nrmax = 0
4028 DO ip =1,nspmd
4029 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
4030 IF (nrow(nk)<fr_nrow(nk)) THEN
4031 nr=fr_nrow(nk)-nrow(nk)
4032 lr=lr+nr
4033 nrmax = max(nrmax,nr)
4034 n=fr_elem(nk)
4035 IF (inloc(n)==0) THEN
4036 inloc(n)=1
4037 ELSE
4038 nrmax=nrmax+nr
4039 ENDIF
4040 ENDIF
4041 iad_rl(nk+1)=lr
4042 ENDDO
4043 ENDDO
4044 nnrmax = nrmax
4045C
4046 DO ip =1,nspmd
4047 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
4048 IF (nrow(nk)<fr_nrow(nk)) THEN
4049 n=fr_elem(nk)
4050 inloc(n) = 0
4051 ENDIF
4052 ENDDO
4053 ENDDO
4054C
4055 n_frnn=lr-1
4056C-------d'abord c'est locale------------
4057 IF (n_frnn>0) THEN
4058 IF(ALLOCATED(fr_icol)) DEALLOCATE(fr_icol)
4059 ALLOCATE(fr_icol(lr),stat=ierror2)
4060 DO ip =1,nspmd
4061 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
4062 j0=nrow(nk)-iad_rl(nk)+1
4063 DO l=iad_rl(nk),iad_rl(nk+1)-1
4064 j=l+j0
4065 fr_icol(l)=icol(j,nk)
4066 ENDDO
4067 ENDDO
4068 ENDDO
4069 ENDIF
4070C
4071 RETURN
4072 END
4073!||====================================================================
4074!|| upd_fr_k ../engine/source/mpi/implicit/imp_fri.F
4075!||--- called by ------------------------------------------------------
4076!|| imp_buck ../engine/source/implicit/imp_buck.F
4077!|| imp_chkm ../engine/source/implicit/imp_solv.f
4078!|| imp_k_eig ../engine/stub/imp_k_eig.F
4079!|| imp_solv ../engine/source/implicit/imp_solv.F
4080!||--- calls -----------------------------------------------------
4081!|| condens_ind ../engine/source/implicit/upd_glob_k.f
4082!|| intab0 ../engine/source/implicit/imp_fsa_inv.F
4083!|| spmd_max_iv ../engine/source/mpi/implicit/imp_spmd.f
4084!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
4085!||--- uses -----------------------------------------------------
4086!|| imp_frk ../engine/share/modules/impbufdef_mod.F
4087!||====================================================================
4088 SUBROUTINE upd_fr_k(
4089 1 IADK ,JDIK ,NDOF ,IKC ,IDDL ,
4090 2 INLOC ,FR_ELEM ,IAD_ELEM ,NDDL )
4091C-----------------------------------------------
4092C M o d u l e s
4093C-----------------------------------------------
4094 USE imp_frk
4095C-----------------------------------------------
4096C I m p l i c i t T y p e s
4097C-----------------------------------------------
4098#include "implicit_f.inc"
4099C-----------------------------------------------
4100C C o m m o n B l o c k s
4101C-----------------------------------------------
4102#include "com01_c.inc"
4103#include "com04_c.inc"
4104#include "impl1_c.inc"
4105#include "task_c.inc"
4106C-----------------------------------------------
4107C D u m m y A r g u m e n t s
4108C-----------------------------------------------
4109 INTEGER IADK(*) ,JDIK(*),IDDL(*),INLOC(*),NDOF(*)
4110 integer
4111 . ikc(*), fr_elem(*),iad_elem(2,*),nddl
4112C REAL
4113C-----------------------------------------------
4114C External function
4115C-----------------------------------------------
4116 INTEGER INTAB0
4117 EXTERNAL intab0
4118C-----------------------------------------------
4119C L o c a l V a r i a b l e s
4120C-----------------------------------------------
4121 INTEGER I,J,N,NK,IP,L,IFIX,II,IAD2,IJ,IND,N_FR,NB,
4122 . k,nd,nzzk,nj,nzz,iad,jad,id,jd,idk,nc,idf,ikcfr(nddlfr)
4123 INTEGER IIC(NDFRMAX),IDDLM(NUMNOD),NDN(NSPMD),NZN(NSPMD)
4124 INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG
4125 my_real
4126 . s1,stmp
4127C
4128 ddlp0=0
4129 ddlp1=nddl
4130C
4131 stmp = zero
4132 IF (nddlfr>0) THEN
4133 n_fr = iad_elem(1,nspmd+1)-iad_elem(1,1)
4134 ALLOCATE(itag(n_fr))
4135 itag = 2
4136 DO nk=1,n_fr
4137 nb=-ifrloc(nk)
4138 IF (nb>0) itag(nb) = itag(nb) + 1
4139 ENDDO
4140 ENDIF
4141C
4142 IF (nddlfr>0) THEN
4143C-------if not the same IKC (e.g. RBE3 Ns)
4144c IKCFR (before condensation) for comm IKC
4145 iad2 = 0
4146 DO ip =1,nspmd
4147 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
4148 n=fr_elem(nk)
4149 id=iddlfr(nk)+iad2
4150 idk=iddl(n)
4151 DO j=1,ndof(n)
4152 ikcfr(id+j)=ikc(idk+j)
4153 ENDDO
4154 ENDDO
4155 iad2 = iad2 + nd_fr(ip)
4156 ENDDO
4157 CALL spmd_max_iv(ikcfr)
4158 iad2 = 0
4159 iad = 0
4160 jad = 0
4161 ii = 0
4162 ij = 0
4163 DO ip =1,nspmd
4164 ifix = 0
4165 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
4166 n=fr_elem(nk)
4167 id=iddlfr(nk)
4168 idk=iddl(n)
4169 ind = ifix
4170 DO j=1,ndof(n)
4171 iic(id+j)=ikcfr(id+iad2+j)
4172 IF (iic(id+j)/=0) ifix=ifix+1
4173 ENDDO
4174C
4175 nb=-ifrloc(nk)
4176 IF (nb<0) nb = nk
4177 s1 = one/itag(nb)
4178 stmp = stmp + s1*(ifix-ind)
4179C
4180 ENDDO
4181C -----update---condense-IKC>=1------------------------------------
4182 nd = nd_fr(ip)
4183 nzz=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
4184 iad2 = iad2 + nd_fr(ip)
4185 IF (ifix>0) THEN
4186 nzzk=nzz
4187 CALL condens_ind(nd_fr(ip),nzzk,iadfr(iad+1),jdifr(jad+1),iic)
4188 ii = ii + ifix
4189 ij = ij + nzz-nzzk
4190 ENDIF
4191 iad = iad + nd + 1
4192 jad = jad + nzz
4193 ndn(ip)=ii
4194 nzn(ip)=ij
4195 ENDDO
4196 DEALLOCATE(itag)
4197 ENDIF ! (NDDLFR>0)
4198 CALL spmd_sum_s(stmp)
4199 nddlfrb1 = nddlfrb-int(stmp)
4200 IF (nddlfr<=0) RETURN
4201C-------s'il y a condensation-------
4202 IF (ndn(nspmd)>0) THEN
4203 iad = nd_fr(1) + 1
4204 DO ip =2,nspmd
4205 ii = ndn(ip-1)
4206 IF (ii>0) THEN
4207 ii = ii+iad
4208 DO i=1,nd_fr(ip)+1
4209 iadfr(iad+i)=iadfr(ii+i)
4210 ENDDO
4211 ENDIF
4212 iad = iad + nd_fr(ip) + 1
4213 ENDDO
4214 iad = nd_fr(1) + 1
4215 jad = iadfr(iad)-iadfr(1)
4216 DO ip =2,nspmd
4217 ij = nzn(ip-1)
4218 IF (ij>0) THEN
4219 ij = ij+jad
4220 DO j=iadfr(iad+1),iadfr(iad+1+nd_fr(ip))-1
4221 jdifr(j+jad)= jdifr(j+ij)
4222 ENDDO
4223 ENDIF
4224 nzzk=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
4225 iad = iad + nd_fr(ip) + 1
4226 jad = jad + nzzk
4227 ENDDO
4228 ENDIF
4229C
4230 ifix=0
4231 DO n = 1,numnod
4232 i=inloc(n)
4233 iddlm(i)=iddl(i)-ifix
4234 DO j=1,ndof(i)
4235 nd = iddl(i)+j
4236 IF (ikc(nd)/=0) ifix=ifix+1
4237 ENDDO
4238 ENDDO
4239C
4240C-------FR2K-------
4241 iad2 = 0
4242 DO ip =1,nspmd
4243 ifix=0
4244 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
4245 n=fr_elem(nk)
4246 id=iddlfr(nk)+iad2-ifix
4247 idk=iddl(n)
4248 ind=0
4249 DO j=1,ndof(n)
4250 IF (ikc(idk+j)<1) THEN
4251 ind=ind+1
4252 ifr2k(id+ind)=iddlm(n)+ind
4253 ELSE
4254 ifix=ifix+1
4255 ENDIF
4256 ENDDO
4257 ENDDO
4258 iad2 = iad2 + nd_fr(ip)
4259 ENDDO
4260 len_v = iad2
4261C
4262 len_k = 0
4263 IF (iprec>2) THEN
4264 iad = 0
4265 iad2 = 0
4266 jad = 0
4267 DO ip =1,nspmd
4268 DO i=1,nd_fr(ip)
4269 id = i+iad
4270 ii = ifr2k(i+iad2)
4271 DO j=iadfr(id),iadfr(id+1)-1
4272 jd = j + jad
4273 k=jdifr(jd)
4274 ij = ifr2k(k+iad2)
4275 IF (ii>ij) THEN
4276 nc = iadk(ii+1)-iadk(ii)
4277 n=intab0(nc,jdik(iadk(ii)),ij)
4278 IF (n>0) THEN
4279 jfr2k(jd)=n+iadk(ii)-1
4280 ELSE
4281 write(*,*)'index error in UPD_FR_K I>J',ij,ip,nc
4282c write(*,*)'i,j,ik,iad=',i,k,ii,iad
4283 ENDIF
4284 ELSE
4285 nc = iadk(ij+1)-iadk(ij)
4286 n=intab0(nc,jdik(iadk(ij)),ii)
4287 IF (n>0) THEN
4288 jfr2k(jd)=n+iadk(ij)-1
4289 ELSE
4290 write(*,*)'index error in UPD_FR_K J>I',ii,ip,nc
4291c write(*,*)'i,j,ik,iad=',i,k,ij,iad
4292 ENDIF
4293 ENDIF
4294 ENDDO
4295 ENDDO
4296 nzzk=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
4297 iad = iad + nd_fr(ip) +1
4298 iad2 = iad2 + nd_fr(ip)
4299 jad = jad + nzzk
4300 ENDDO
4301 len_k = iad2+jad
4302 iad2 = 0
4303 DO ip =1,ispmd
4304 DO j =1,nd_fr(ip)
4305 ddlp0 = max(ddlp0,ifr2k(iad2+j))
4306 ENDDO
4307 iad2=iad2+nd_fr(ip)
4308 ENDDO
4309C
4310 DO ip =ispmd+2,nspmd
4311 ifix=0
4312 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
4313 n=fr_elem(nk)
4314 id=iddlfr(nk)+iad2-ifix
4315 idk=iddl(n)
4316 DO j=1,ndof(n)
4317 IF (ikc(idk+j)>0) ifix=ifix+1
4318 ENDDO
4319 IF(ifrloc(nk)>0) THEN
4320 ind=0
4321 DO j=1,ndof(n)
4322 IF (ikc(idk+j)<1) THEN
4323 ind=ind+1
4324 ddlp1=ifr2k(id+ind)-1
4325 GOTO 100
4326 ENDIF
4327 ENDDO
4328 ENDIF
4329 ENDDO
4330 iad2 = iad2 + nd_fr(ip)
4331 ENDDO
4332 ENDIF
4333c write(*,*)'LEN_V,LEN_K,ISPMD=',LEN_V,LEN_K,ISPMD
4334c write(*,*)'ND_FR=',(ND_FR(J),J=1,NSPMD),ISPMD
4335 100 CONTINUE
4336C
4337 RETURN
4338 END
4339!||====================================================================
4340!|| fr_dlft ../engine/source/mpi/implicit/imp_fri.F
4341!||--- called by ------------------------------------------------------
4342!|| imp_checm0 ../engine/source/implicit/imp_solv.F
4343!|| lin_solvh1 ../engine/source/implicit/lin_solv.F
4344!|| lin_solvih2 ../engine/source/implicit/lin_solv.F
4345!||--- uses -----------------------------------------------------
4346!|| imp_frk ../engine/share/modules/impbufdef_mod.F
4347!||====================================================================
4348 SUBROUTINE fr_dlft(NDDL,IDLFT0,IDLFT1)
4349C-----------------------------------------------
4350C M o d u l e s
4351C-----------------------------------------------
4352 USE imp_frk
4353C-----------------------------------------------
4354C I m p l i c i t T y p e s
4355C-----------------------------------------------
4356#include "implicit_f.inc"
4357C-----------------------------------------------
4358C D u m m y A r g u m e n t s
4359C-----------------------------------------------
4360 INTEGER IDLFT0,IDLFT1,NDDL
4361C REAL
4362C-----------------------------------------------
4363C L o c a l V a r i a b l e s
4364C-----------------------------------------------
4365 INTEGER L,IP,J
4366C
4367C
4368 idlft0 = ddlp0
4369 idlft1 = ddlp1
4370C
4371 RETURN
4372 END
4373CCgw| DIM_GLOB_K /implicit/ind_glob_k.F
4374!||====================================================================
4375!|| set_ikin2g ../engine/source/mpi/implicit/imp_fri.F
4376!||--- called by ------------------------------------------------------
4377!|| dim_glob_k ../engine/source/implicit/ind_glob_k.F
4378!||--- uses -----------------------------------------------------
4379!|| imp_frk ../engine/share/modules/impbufdef_mod.F
4380!||====================================================================
4381 SUBROUTINE set_ikin2g(NKINE,INLOC)
4382C-----------------------------------------------
4383C M o d u l e s
4384C-----------------------------------------------
4385 USE imp_frk
4386C-----------------------------------------------
4387C I m p l i c i t T y p e s
4388C-----------------------------------------------
4389#include "implicit_f.inc"
4390C-----------------------------------------------
4391C C o m m o n B l o c k s
4392C-----------------------------------------------
4393#include "com04_c.inc"
4394C-----------------------------------------------
4395C D u m m y A r g u m e n t s
4396C-----------------------------------------------
4397 INTEGER NKINE,INLOC(*)
4398C REAL
4399C-----------------------------------------------
4400C L o c a l V a r i a b l e s
4401C-----------------------------------------------
4402 INTEGER I,N,IERROR1
4403C
4404 IF (nkine<=0) RETURN
4405 IF(ALLOCATED(ikin2g)) DEALLOCATE(ikin2g)
4406 ALLOCATE(ikin2g(nkine),stat=ierror1)
4407 DO i =1,numnod
4408 n=inloc(i)
4409 IF (n>0) ikin2g(n)=i
4410 ENDDO
4411C
4412 RETURN
4413 END
4414CCgw| IND_GLOB_K /implicit/ind_glob_k.F
4415!||====================================================================
4416!|| get_ikin2g ../engine/source/mpi/implicit/imp_fri.F
4417!||--- called by ------------------------------------------------------
4418!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
4419!||--- uses -----------------------------------------------------
4420!|| imp_frk ../engine/share/modules/impbufdef_mod.F
4421!||====================================================================
4422 SUBROUTINE get_ikin2g(NKINE,INK,ILOC)
4423C-----------------------------------------------
4424C M o d u l e s
4425C-----------------------------------------------
4426 USE imp_frk
4427C-----------------------------------------------
4428C I m p l i c i t T y p e s
4429C-----------------------------------------------
4430#include "implicit_f.inc"
4431C-----------------------------------------------
4432C D u m m y A r g u m e n t s
4433C-----------------------------------------------
4434 INTEGER NKINE,ILOC(*),INK
4435C REAL
4436C-----------------------------------------------
4437C L o c a l V a r i a b l e s
4438C-----------------------------------------------
4439 INTEGER I,N,NRB
4440C
4441 NRB=nkine-ink
4442 DO n =1,nrb
4443 i=ikin2g(n)
4444 iloc(i)=n+ink
4445 ENDDO
4446 DO n =nrb+1,nkine
4447 i=ikin2g(n)
4448 iloc(i)=n-nrb
4449 ENDDO
4450C
4451 RETURN
4452 END
4453CCgw| IND_GLOB_K /implicit/ind_glob_k.F
4454!||====================================================================
4455!|| zero_ikin2g ../engine/source/mpi/implicit/imp_fri.F
4456!||--- called by ------------------------------------------------------
4457!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
4458!||--- uses -----------------------------------------------------
4459!|| imp_frk ../engine/share/modules/impbufdef_mod.F
4460!||====================================================================
4461 SUBROUTINE zero_ikin2g(NKINE,ILOC)
4462C-----------------------------------------------
4463C M o d u l e s
4464C-----------------------------------------------
4465 USE imp_frk
4466C-----------------------------------------------
4467C I m p l i c i t T y p e s
4468C-----------------------------------------------
4469#include "implicit_f.inc"
4470C-----------------------------------------------
4471C D u m m y A r g u m e n t s
4472C-----------------------------------------------
4473 INTEGER NKINE,ILOC(*),INK
4474C REAL
4475C-----------------------------------------------
4476C L o c a l V a r i a b l e s
4477C-----------------------------------------------
4478 INTEGER I,N
4479C
4480 DO N =1,nkine
4481 i=ikin2g(n)
4482 iloc(i)=0
4483 ENDDO
4484C
4485 RETURN
4486 END
4487!||====================================================================
4488!|| ind_kine_kp ../engine/source/mpi/implicit/imp_fri.F
4489!||--- called by ------------------------------------------------------
4490!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
4491!||--- calls -----------------------------------------------------
4492!|| reorder_j ../engine/source/implicit/ind_glob_k.F
4493!|| reorder_l ../engine/source/implicit/ind_glob_k.F
4494!||--- uses -----------------------------------------------------
4495!|| imp_frk ../engine/share/modules/impbufdef_mod.F
4496!||====================================================================
4497 SUBROUTINE ind_kine_kp(
4498 1 NROWK ,ICOK ,ICOKM ,NNMAX ,NKMAX ,
4499 2 NKINE ,INK ,IKPAT ,IDDL )
4500C-----------------------------------------------
4501C M o d u l e s
4502C-----------------------------------------------
4503 USE imp_frk
4504C----6---------------------------------------------------------------7---------8
4505C I m p l i c i t T y p e s
4506C-----------------------------------------------
4507#include "implicit_f.inc"
4508C-----------------------------------------------
4509C C o m m o n B l o c k s
4510C-----------------------------------------------
4511C-----------------------------------------------------------------
4512C D u m m y A r g u m e n t s
4513C-----------------------------------------------
4514 INTEGER NNMAX,NKMAX,NROWK(*),NKINE,INK,IKPAT
4515 INTEGER ICOK(NNMAX,*),ICOKM(NKMAX,*),IDDL(*)
4516C REAL
4517C-----------------------------------------------
4518C L o c a l V a r i a b l e s
4519C-----------------------------------------------
4520 INTEGER I,J,N,K,NL,NK,NJ,NRB
4521c----------------------
4522 NRB=nkine-ink
4523 IF (ikpat==0) THEN
4524 DO nk =1,nrb
4525 j=ikin2g(nk)
4526 CALL reorder_j(nrowk(nk+ink),icokm(1,nk),j,iddl)
4527 ENDDO
4528 DO nk =nrb+1,nkine
4529 j=ikin2g(nk)
4530 nj=nk-nrb
4531 CALL reorder_j(nrowk(nj),icok(1,nj),j,iddl)
4532 ENDDO
4533 ELSE
4534 DO nk =1,nrb
4535 j=ikin2g(nk)
4536 CALL reorder_l(nrowk(nk+ink),icokm(1,nk),j,iddl)
4537 ENDDO
4538 DO nk =nrb+1,nkine
4539 j=ikin2g(nk)
4540 nj=nk-nrb
4541 CALL reorder_l(nrowk(nj),icok(1,nj),j,iddl)
4542 ENDDO
4543 ENDIF
4544C----6---------------------------------------------------------------7---------8
4545 RETURN
4546 END
4547!||====================================================================
4548!|| tag_intm11 ../engine/source/mpi/implicit/imp_fri.F
4549!||--- called by ------------------------------------------------------
4550!|| imp_frki ../engine/source/mpi/implicit/imp_fri.F
4551!||====================================================================
4552 SUBROUTINE tag_intm11(
4553 1 JLT ,NS_IMP ,NE_IMP ,IRECTS ,IRECTM ,
4554 2 ILOC ,N_IMPN ,NSN )
4555C----6---------------------------------------------------------------7---------8
4556C I m p l i c i t T y p e s
4557C-----------------------------------------------
4558#include "implicit_f.inc"
4559C-----------------------------------------------------------------
4560C D u m m y A r g u m e n t s
4561C-----------------------------------------------
4562 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),
4563 . ILOC(*),N_IMPN,NSN
4564C REAL
4565C-----------------------------------------------
4566C L o c a l V a r i a b l e s
4567C-----------------------------------------------
4568 INTEGER I,J,N,N1,N2,NE,IG,M1,M2
4569C-----------------------------------------------
4570 DO i = 1, jlt
4571C--------secnd node-----
4572 ig = ns_imp(i)
4573 IF (ig>nsn) THEN
4574 ne=ne_imp(i)
4575 m1=irectm(1,ne)
4576 m2=irectm(2,ne)
4577 IF (iloc(m1)==0) THEN
4578 n_impn=n_impn+1
4579 iloc(m1)=n_impn
4580 ENDIF
4581 IF (iloc(m2)==0) THEN
4582 n_impn=n_impn+1
4583 iloc(m2)=n_impn
4584 ENDIF
4585 ENDIF
4586 ENDDO
4587C----6---------------------------------------------------------------7---------8
4588 RETURN
4589 END
4590!||====================================================================
4591!|| mav_ltfr ../engine/source/mpi/implicit/imp_fri.F
4592!||--- called by ------------------------------------------------------
4593!|| fr_matv ../engine/source/mpi/implicit/imp_fri.F
4594!||--- uses -----------------------------------------------------
4595!|| imp_intm ../engine/share/modules/imp_intm.F
4596!||====================================================================
4597 SUBROUTINE mav_ltfr(V ,W )
4598C-----------------------------------------------
4599C M o d u l e s
4600C-----------------------------------------------
4601 USE imp_intm
4602C-----------------------------------------------
4603C I m p l i c i t T y p e s
4604C-----------------------------------------------
4605#include "implicit_f.inc"
4606C-----------------------------------------------
4607C D u m m y A r g u m e n t s
4608C-----------------------------------------------
4609C REAL
4610 my_real
4611 . w(*), v(*)
4612C-----------------------------------------------
4613C L o c a l V a r i a b l e s
4614C-----------------------------------------------
4615 INTEGER I,J,K,ID
4616 my_real
4617 . l_k
4618C-----------------------------
4619 DO i=1,nddl_si
4620 fsi(i) = zero
4621 ENDDO
4622 DO i=1,nddl_si
4623 DO j =iad_si(i),iad_si(i+1)-1
4624 k =jdi_si(j)
4625 l_k = lt_si(j)
4626 fsi(i) = fsi(i) + l_k*v(k)
4627 w(k) = w(k) + l_k*usi(i)
4628 ENDDO
4629 ENDDO
4630C
4631 DO i=1,nddl_sl
4632 id = iddl_sl(i)
4633 w(id) = w(id) + diag_sl(i)*v(id)
4634 DO j =iad_ss(i),iad_ss(i+1)-1
4635 k =jdi_sl(j)
4636 l_k = lt_sl(j)
4637 w(id) = w(id) + l_k*v(k)
4638 w(k) = w(k) + l_k*v(id)
4639 ENDDO
4640 ENDDO
4641C--------------------------------------------
4642 RETURN
4643 END
4644!||====================================================================
4645!|| mav_ltfr_gpu ../engine/source/mpi/implicit/imp_fri.F
4646!||--- called by ------------------------------------------------------
4647!|| fr_matv_gpu ../engine/source/mpi/implicit/imp_fri.F
4648!||--- uses -----------------------------------------------------
4649!|| imp_intm ../engine/share/modules/imp_intm.F
4650!||====================================================================
4651 SUBROUTINE mav_ltfr_gpu(V ,W ,NINDEX)
4652C-----------------------------------------------
4653C M o d u l e s
4654C-----------------------------------------------
4655 USE imp_intm
4656C-----------------------------------------------
4657C I m p l i c i t T y p e s
4658C-----------------------------------------------
4659#include "implicit_f.inc"
4660C-----------------------------------------------
4661C D u m m y A r g u m e n t s
4662C-----------------------------------------------
4663 INTEGER NINDEX(*)
4664C REAL
4665 my_real
4666 . w(*), v(*)
4667C-----------------------------------------------
4668C L o c a l V a r i a b l e s
4669C-----------------------------------------------
4670 INTEGER I,J,K,ID,KK,II
4671 my_real
4672 . l_k
4673C-----------------------------
4674 DO i=1,nddl_si
4675 fsi(i) = zero
4676 ENDDO
4677 DO i=1,nddl_si
4678 DO j =iad_si(i),iad_si(i+1)-1
4679 k =jdi_si(j)
4680 kk=nindex(k)
4681 l_k = lt_si(j)
4682 fsi(i) = fsi(i) + l_k*v(kk)
4683 w(kk) = w(kk) + l_k*usi(i)
4684 ENDDO
4685 ENDDO
4686C
4687 DO i=1,nddl_sl
4688 id = iddl_sl(i)
4689 ii = nindex(id)
4690 w(ii) = w(ii) + diag_sl(i)*v(ii)
4691 DO j =iad_ss(i),iad_ss(i+1)-1
4692 k =jdi_sl(j)
4693 kk=nindex(k)
4694 l_k = lt_sl(j)
4695 w(ii) = w(ii) + l_k*v(kk)
4696 w(kk) = w(kk) + l_k*v(ii)
4697 ENDDO
4698 ENDDO
4699C--------------------------------------------
4700 RETURN
4701 END
4702!||====================================================================
4703!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
4704!||--- called by ------------------------------------------------------
4705!|| imp_solv ../engine/source/implicit/imp_solv.F
4706!||--- calls -----------------------------------------------------
4707!|| reorder_fr ../engine/source/mpi/implicit/imp_fri.F
4708!|| rowfr_dim ../engine/source/mpi/implicit/imp_fri.F
4709!|| rowfr_dim11 ../engine/source/mpi/implicit/imp_fri.F
4710!|| rowfr_dim24 ../engine/source/mpi/implicit/imp_fri.F
4711!|| rowfr_ind ../engine/source/mpi/implicit/imp_fri.F
4712!|| rowfr_ind11 ../engine/source/mpi/implicit/imp_fri.F
4713!|| rowfr_ind24 ../engine/source/mpi/implicit/imp_fri.f
4714!|| set_ind_fr ../engine/source/mpi/implicit/imp_fri.F
4715!||--- uses -----------------------------------------------------
4716!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
4717!||====================================================================
4718 SUBROUTINE ind_frkd(
4719 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
4720 2 IDDL ,IKC ,NDOF ,NSREM ,IND_IMP )
4721C-----------------------------------------------
4722C M o d u l e s
4723C-----------------------------------------------
4724 USE intbufdef_mod
4725C----6---------------------------------------------------------------7---------8
4726C I m p l i c i t T y p e s
4727C-----------------------------------------------
4728#include "implicit_f.inc"
4729C-----------------------------------------------
4730C C o m m o n B l o c k s
4731C-----------------------------------------------
4732#include "com04_c.inc"
4733#include "param_c.inc"
4734C-----------------------------------------------------------------
4735C D u m m y A r g u m e n t s
4736C-----------------------------------------------
4737 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
4738 . NE_IMP(*),NSREM,IND_IMP(*)
4739 INTEGER IDDL(*),IKC(*),NDOF(*)
4740C REAL
4741 TYPE(intbuf_struct_) INTBUF_TAB(*)
4742C-----------------------------------------------
4743C L o c a l V a r i a b l e s
4744C-----------------------------------------------
4745 INTEGER NIN,NTY,NROW(NSREM)
4746 INTEGER I,J,K,L,NDOFI,N,IAD,INSV11,NRTS,
4747 . INSV,NSN,NKC,J1,ND,IER1,NNMAX
4748 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ICOL
4749C------------------------------------------------------------
4750C--------dim Nrow----
4751 DO N =1,nsrem
4752 nrow(n)=0
4753 ENDDO
4754C
4755 iad=1
4756 DO nin=1,ninter
4757 nty =ipari(7,nin)
4758 IF(nty==5) iad=iad+num_imp(nin)
4759 ENDDO
4760 DO nin=1,ninter
4761 nsn =ipari(5,nin)
4762 nty =ipari(7,nin)
4763 IF(nty==3)THEN
4764 ELSEIF(nty==4)THEN
4765 ELSEIF(nty==5)THEN
4766 ELSEIF(nty==6)THEN
4767 ELSEIF(nty==7.OR.nty==10)THEN
4768C
4769 CALL rowfr_dim(num_imp(nin),ns_imp(iad),ne_imp(iad),
4770 . intbuf_tab(nin)%IRECTM,nrow ,nsn ,nin )
4771 iad=iad+num_imp(nin)
4772 ELSEIF(nty==24)THEN
4773C
4774 CALL rowfr_dim24(num_imp(nin),ns_imp(iad),ne_imp(iad),
4775 . intbuf_tab(nin)%IRECTM,nrow ,nsn ,nin ,
4776 . ind_imp ,intbuf_tab(nin)%NVOISIN)
4777 iad=iad+num_imp(nin)
4778 ELSEIF(nty==11)THEN
4779 nrts =ipari(3,nin)
4780 CALL rowfr_dim11(num_imp(nin),ns_imp(iad),ne_imp(iad),
4781 . intbuf_tab(nin)%IRECTM, nrow ,nrts ,nin )
4782 iad=iad+num_imp(nin)
4783 ENDIF
4784 ENDDO
4785C
4786 nnmax=0
4787 DO n =1,nsrem
4788 nnmax=max(nnmax,nrow(n))
4789 nrow(n)=0
4790 ENDDO
4791 ALLOCATE(icol(nnmax,nsrem),stat=ier1)
4792C--------ind Nrow----
4793 iad=1
4794 DO nin=1,ninter
4795 nty =ipari(7,nin)
4796 IF(nty==5) iad=iad+num_imp(nin)
4797 ENDDO
4798 DO nin=1,ninter
4799 nsn =ipari(5,nin)
4800 nty =ipari(7,nin)
4801 IF(nty==3)THEN
4802 ELSEIF(nty==4)THEN
4803 ELSEIF(nty==5)THEN
4804 ELSEIF(nty==6)THEN
4805 ELSEIF(nty==7.OR.nty==10)THEN
4806C
4807 CALL rowfr_ind(num_imp(nin),ns_imp(iad),ne_imp(iad),
4808 . intbuf_tab(nin)%IRECTM,nrow ,icol ,nnmax ,
4809 . nsn ,nin )
4810 iad=iad+num_imp(nin)
4811 ELSEIF(nty==24)THEN
4812C
4813 CALL rowfr_ind24(num_imp(nin),ns_imp(iad),ne_imp(iad),
4814 . intbuf_tab(nin)%IRECTM,nrow ,icol ,nnmax ,
4815 . nsn ,nin ,ind_imp ,intbuf_tab(nin)%NVOISIN)
4816 iad=iad+num_imp(nin)
4817 ELSEIF(nty==11)THEN
4818 nrts =ipari(3,nin)
4819 CALL rowfr_ind11(num_imp(nin),ns_imp(iad),ne_imp(iad),
4820 . intbuf_tab(nin)%IRECTM, nrow ,icol ,nnmax ,
4821 . nrts ,nin )
4822 iad=iad+num_imp(nin)
4823 ENDIF
4824 ENDDO
4825C
4826 DO n =1,nsrem
4827 CALL reorder_fr(nrow(n),icol(1,n),iddl)
4828 ENDDO
4829 CALL set_ind_fr(
4830 1 nsrem ,iddl ,ndof ,nrow ,icol ,
4831 2 nnmax )
4832C
4833 DEALLOCATE(icol)
4834C----6---------------------------------------------------------------7---------8
4835 RETURN
4836 END
4837!||====================================================================
4838!|| rowfr_dim ../engine/source/mpi/implicit/imp_fri.F
4839!||--- called by ------------------------------------------------------
4840!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
4841!||--- uses -----------------------------------------------------
4842!|| imp_intm ../engine/share/modules/imp_intm.F
4843!||====================================================================
4844 SUBROUTINE rowfr_dim(
4845 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NROW ,
4846 2 NSN ,NIN )
4847C-----------------------------------------------
4848C M o d u l e s
4849C-----------------------------------------------
4850 USE imp_intm
4851C----6---------------------------------------------------------------7---------8
4852C I m p l i c i t T y p e s
4853C-----------------------------------------------
4854#include "implicit_f.inc"
4855C-----------------------------------------------------------------
4856C D u m m y A r g u m e n t s
4857C-----------------------------------------------
4858 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NROW(*),NSN,NIN
4859C REAL
4860C-----------------------------------------------
4861C L o c a l V a r i a b l e s
4862C-----------------------------------------------
4863 INTEGER I,NE,IG,NS
4864C-----------------------------------------------
4865 DO i = 1, jlt
4866 ig = ns_imp(i)-nsn
4867 IF (ig>0) THEN
4868 ns=ind_int(nin)%P(ig)
4869 ne=ne_imp(i)
4870 IF (irect(3,ne)==irect(4,ne)) THEN
4871 nrow(ns)=nrow(ns)+3
4872 ELSE
4873 nrow(ns)=nrow(ns)+4
4874 ENDIF
4875 ENDIF
4876 ENDDO
4877C----6---------------------------------------------------------------7---------8
4878 RETURN
4879 END
4880!||====================================================================
4881!|| rowfr_dim11 ../engine/source/mpi/implicit/imp_fri.F
4882!||--- called by ------------------------------------------------------
4883!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
4884!||--- uses -----------------------------------------------------
4885!|| imp_intm ../engine/share/modules/imp_intm.F
4886!||====================================================================
4887 SUBROUTINE rowfr_dim11(
4888 1 JLT ,NS_IMP ,NE_IMP ,IRECTM ,NROW ,
4889 2 NSN ,NIN )
4890C-----------------------------------------------
4891C M o d u l e s
4892C-----------------------------------------------
4893 USE imp_intm
4894C----6---------------------------------------------------------------7---------8
4895C I m p l i c i t T y p e s
4896C-----------------------------------------------
4897#include "implicit_f.inc"
4898C-----------------------------------------------------------------
4899C D u m m y A r g u m e n t s
4900C-----------------------------------------------
4901 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTM(2,*),NROW(*),NSN,NIN
4902C REAL
4903C-----------------------------------------------
4904C L o c a l V a r i a b l e s
4905C-----------------------------------------------
4906 INTEGER I,NE,IG,NS1,NS2
4907C-----------------------------------------------
4908 DO i = 1, jlt
4909 ig = ns_imp(i)-nsn
4910 IF (ig>0) THEN
4911 ns1=ind_int(nin)%P(ig)
4912 ns2=ns1+1
4913 ne=ne_imp(i)
4914 nrow(ns1)=nrow(ns1)+2
4915 nrow(ns2)=nrow(ns2)+2
4916 ENDIF
4917 ENDDO
4918C----6---------------------------------------------------------------7---------8
4919 RETURN
4920 END
4921!||====================================================================
4922!|| rowfr_ind ../engine/source/mpi/implicit/imp_fri.F
4923!||--- called by ------------------------------------------------------
4924!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
4925!||--- calls -----------------------------------------------------
4926!|| reorder_a ../engine/source/implicit/ind_glob_k.F
4927!||--- uses -----------------------------------------------------
4928!|| imp_intm ../engine/share/modules/imp_intm.F
4929!||====================================================================
4930 SUBROUTINE rowfr_ind(
4931 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NROW ,
4932 2 ICOL ,NNMAX ,NSN ,NIN )
4933C-----------------------------------------------
4934C M o d u l e s
4935C-----------------------------------------------
4936 USE imp_intm
4937C----6---------------------------------------------------------------7---------8
4938C I m p l i c i t T y p e s
4939C-----------------------------------------------
4940#include "implicit_f.inc"
4941C-----------------------------------------------------------------
4942C D u m m y A r g u m e n t s
4943C-----------------------------------------------
4944 INTEGER NNMAX
4945 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NROW(*),
4946 . icol(nnmax,*),nsn,nin
4947C REAL
4948C-----------------------------------------------
4949C L o c a l V a r i a b l e s
4950C-----------------------------------------------
4951 INTEGER I,J,NE,IG,NS,NM
4952C-----------------------------------------------
4953 DO I = 1, jlt
4954 ig = ns_imp(i)-nsn
4955 IF (ig>0) THEN
4956 ns=ind_int(nin)%P(ig)
4957 ne=ne_imp(i)
4958 DO j = 1,4
4959 nm = irect(j,ne)
4960 CALL reorder_a(nrow(ns),icol(1,ns),nm)
4961 ENDDO
4962 ENDIF
4963 ENDDO
4964C----6---------------------------------------------------------------7---------8
4965 RETURN
4966 END
4967!||====================================================================
4968!|| rowfr_ind11 ../engine/source/mpi/implicit/imp_fri.F
4969!||--- called by ------------------------------------------------------
4970!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
4971!||--- calls -----------------------------------------------------
4972!|| reorder_a ../engine/source/implicit/ind_glob_k.F
4973!||--- uses -----------------------------------------------------
4974!|| imp_intm ../engine/share/modules/imp_intm.F
4975!||====================================================================
4976 SUBROUTINE rowfr_ind11(
4977 1 JLT ,NS_IMP ,NE_IMP ,IRECTM ,NROW ,
4978 2 ICOL ,NNMAX ,NSN ,NIN )
4979C-----------------------------------------------
4980C M o d u l e s
4981C-----------------------------------------------
4982 USE imp_intm
4983C----6---------------------------------------------------------------7---------8
4984C I m p l i c i t T y p e s
4985C-----------------------------------------------
4986#include "implicit_f.inc"
4987C-----------------------------------------------------------------
4988C D u m m y A r g u m e n t s
4989C-----------------------------------------------
4990 INTEGER NNMAX
4991 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTM(2,*),NROW(*),
4992 . ICOL(NNMAX,*),NSN,NIN
4993C REAL
4994C-----------------------------------------------
4995C L o c a l V a r i a b l e s
4996C-----------------------------------------------
4997 INTEGER I,NE,IG,NS1,NS2,NM1,NM2
4998C-----------------------------------------------
4999 DO i = 1, jlt
5000 ig = ns_imp(i)-nsn
5001 IF (ig>0) THEN
5002 ns1=ind_int(nin)%P(ig)
5003 ns2=ns1+1
5004 ne=ne_imp(i)
5005 nm1=irectm(1,ne)
5006 nm2=irectm(2,ne)
5007 CALL reorder_a(nrow(ns1),icol(1,ns1),nm1)
5008 CALL reorder_a(nrow(ns1),icol(1,ns1),nm2)
5009 CALL reorder_a(nrow(ns2),icol(1,ns2),nm1)
5010 CALL reorder_a(nrow(ns2),icol(1,ns2),nm2)
5011 ENDIF
5012 ENDDO
5013C----6---------------------------------------------------------------7---------8
5014 RETURN
5015 END
5016!||====================================================================
5017!|| rowfr_dim24 ../engine/source/mpi/implicit/imp_fri.F
5018!||--- called by ------------------------------------------------------
5019!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
5020!||--- calls -----------------------------------------------------
5021!|| i24msegv ../engine/source/implicit/ind_glob_k.F
5022!||--- uses -----------------------------------------------------
5023!|| imp_intm ../engine/share/modules/imp_intm.F
5024!||====================================================================
5025 SUBROUTINE rowfr_dim24(
5026 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NROW ,
5027 2 NSN ,NIN ,SUBTRIA ,NVOISIN )
5028C-----------------------------------------------
5029C M o d u l e s
5030C-----------------------------------------------
5031 USE imp_intm
5032C----6---------------------------------------------------------------7---------8
5033C I m p l i c i t T y p e s
5034C-----------------------------------------------
5035#include "implicit_f.inc"
5036C-----------------------------------------------------------------
5037C D u m m y A r g u m e n t s
5038C-----------------------------------------------
5039 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NROW(*),NSN,NIN,
5040 + SUBTRIA(*),NVOISIN(8,*)
5041C REAL
5042C-----------------------------------------------
5043C L o c a l V a r i a b l e s
5044C-----------------------------------------------
5045 INTEGER I,NE,IG,NS,IRTLM(4),NEI
5046C-----------------------------------------------
5047 DO I = 1, jlt
5048 ig = ns_imp(i)-nsn
5049 IF (ig>0) THEN
5050 ns=ind_int(nin)%P(ig)
5051 ne=ne_imp(i)
5052 IF (ne<0) THEN
5053 nei=-ne
5054 CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
5055 ELSE
5056 irtlm(1:4) = irect(1:4,ne)
5057 END IF
5058 IF (irtlm(3)==irtlm(4)) THEN
5059 nrow(ns)=nrow(ns)+3
5060 ELSE
5061 nrow(ns)=nrow(ns)+4
5062 ENDIF
5063 ENDIF
5064 ENDDO
5065C----6---------------------------------------------------------------7---------8
5066 RETURN
5067 END
5068!||====================================================================
5069!|| rowfr_ind24 ../engine/source/mpi/implicit/imp_fri.F
5070!||--- called by ------------------------------------------------------
5071!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
5072!||--- calls -----------------------------------------------------
5073!|| i24msegv ../engine/source/implicit/ind_glob_k.F
5074!|| reorder_a ../engine/source/implicit/ind_glob_k.F
5075!||--- uses -----------------------------------------------------
5076!|| imp_intm ../engine/share/modules/imp_intm.F
5077!||====================================================================
5078 SUBROUTINE rowfr_ind24(
5079 1 JLT ,NS_IMP ,NE_IMP ,IRECT ,NROW ,
5080 2 ICOL ,NNMAX ,NSN ,NIN ,SUBTRIA ,
5081 3 NVOISIN )
5082C-----------------------------------------------
5083C M o d u l e s
5084C-----------------------------------------------
5085 USE imp_intm
5086C----6---------------------------------------------------------------7---------8
5087C I m p l i c i t T y p e s
5088C-----------------------------------------------
5089#include "implicit_f.inc"
5090C-----------------------------------------------------------------
5091C D u m m y A r g u m e n t s
5092C-----------------------------------------------
5093 INTEGER NNMAX
5094 INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NROW(*),
5095 . ICOL(NNMAX,*),NSN,NIN,SUBTRIA(*),NVOISIN(8,*)
5096C REAL
5097C-----------------------------------------------
5098C L o c a l V a r i a b l e s
5099C-----------------------------------------------
5100 INTEGER I,J,NE,IG,NS,NM,IRTLM(4),NEI
5101C-----------------------------------------------
5102 DO i = 1, jlt
5103 ig = ns_imp(i)-nsn
5104 IF (ig>0) THEN
5105 ns=ind_int(nin)%P(ig)
5106 ne=ne_imp(i)
5107 IF (ne<0) THEN
5108 nei=-ne
5109 CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
5110 ELSE
5111 irtlm(1:4) = irect(1:4,ne)
5112 END IF
5113 DO j = 1,4
5114 nm = irtlm(j)
5115 CALL reorder_a(nrow(ns),icol(1,ns),nm)
5116 ENDDO
5117 ENDIF
5118 ENDDO
5119C----6---------------------------------------------------------------7---------8
5120 RETURN
5121 END
5122!||====================================================================
5123!|| set_ind_fr ../engine/source/mpi/implicit/imp_fri.F
5124!||--- called by ------------------------------------------------------
5125!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
5126!||--- calls -----------------------------------------------------
5127!|| zero1 ../engine/source/system/zero.F
5128!||--- uses -----------------------------------------------------
5129!|| imp_intm ../engine/share/modules/imp_intm.F
5130!||====================================================================
5131 SUBROUTINE set_ind_fr(
5132 1 NSREM ,IDDL ,NDOF ,NROW ,ICOL ,
5133 2 NNMAX )
5134C-----------------------------------------------
5135C M o d u l e s
5136C-----------------------------------------------
5137 USE imp_intm
5138C----6---------------------------------------------------------------7---------8
5139C I m p l i c i t T y p e s
5140C-----------------------------------------------
5141#include "implicit_f.inc"
5142C-----------------------------------------------------------------
5143C D u m m y A r g u m e n t s
5144C-----------------------------------------------
5145 INTEGER NNMAX
5146 INTEGER
5147 . NSREM,IDDL(*),NDOF(*),NROW(*) ,ICOL(NNMAX,*)
5148C-----------------------------------------------
5149C L o c a l V a r i a b l e s
5150C-----------------------------------------------
5151 INTEGER I,J,K,L,N,NL,NJ,NDOFI,NZ
5152 INTEGER IER1,IER2,IER3,IER4,IER5,IER6
5153c----------
5154 ndofi = 3
5155 IF(ALLOCATED(iddl_si)) DEALLOCATE(iddl_si)
5156 ALLOCATE(iddl_si(nsrem),stat=ier1)
5157 nddl_si =0
5158 DO n=1,nsrem
5159 iddl_si(n)=nddl_si
5160 nddl_si = nddl_si + ndofi
5161 ENDDO
5162 nz = 0
5163 DO n=1,nsrem
5164 DO k=1,ndofi
5165C-------termes kn,nj-------
5166 DO j=1,nrow(n)
5167 DO l=1,ndofi
5168 nz = nz+1
5169 ENDDO
5170 ENDDO
5171 ENDDO
5172 ENDDO
5173C
5174 IF(ALLOCATED(iad_si)) DEALLOCATE(iad_si)
5175 ALLOCATE(iad_si(nddl_si+1),stat=ier2)
5176 IF(ALLOCATED(jdi_si)) DEALLOCATE(jdi_si)
5177 ALLOCATE(jdi_si(nz),stat=ier3)
5178 IF(ALLOCATED(lt_si)) DEALLOCATE(lt_si)
5179 ALLOCATE(lt_si(nz),stat=ier4)
5180 CALL zero1(lt_si,nz)
5181C
5182 nl = 1
5183 nz = 0
5184 iad_si(nl) = nz+1
5185 DO n=1,nsrem
5186 DO k=1,ndofi
5187C-------termes knj,n-------
5188 DO j=1,nrow(n)
5189 nj = icol(j,n)
5190 DO l=1,ndofi
5191 nz = nz+1
5192 jdi_si(nz) = iddl(nj)+l
5193 ENDDO
5194 ENDDO
5195 nl = nl +1
5196 iad_si(nl) = nz+1
5197 ENDDO
5198 ENDDO
5199 nz_si = nz
5200C-------save ICOL en forme compress-------
5201 nz = 0
5202 DO n=1,nsrem
5203 nz = nz+nrow(n)
5204 ENDDO
5205 IF(ALLOCATED(iad_sinr)) DEALLOCATE(iad_sinr)
5206 ALLOCATE(iad_sinr(nsrem+1),stat=ier5)
5207 IF(ALLOCATED(jdi_sinr)) DEALLOCATE(jdi_sinr)
5208 ALLOCATE(jdi_sinr(nz),stat=ier6)
5209 nz = 0
5210 iad_sinr(1) = nz+1
5211 DO n=1,nsrem
5212 DO j=1,nrow(n)
5213 nj = icol(j,n)
5214 nz = nz+1
5215 jdi_sinr(nz) = nj
5216 ENDDO
5217 iad_sinr(n+1) = nz+1
5218 ENDDO
5219C
5220 RETURN
5221 END
5222!||====================================================================
5223!|| reorder_fr ../engine/source/mpi/implicit/imp_fri.F
5224!||--- called by ------------------------------------------------------
5225!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
5226!||====================================================================
5227 SUBROUTINE reorder_fr(N,IC,IDDL)
5228C----6---------------------------------------------------------------7---------8
5229C I m p l i c i t T y p e s
5230C-----------------------------------------------
5231#include "implicit_f.inc"
5232C-----------------------------------------------------------------
5233C D u m m y A r g u m e n t s
5234C-----------------------------------------------
5235 INTEGER N ,IC(*),IDDL(*)
5236C-----------------------------------------------
5237C L o c a l V a r i a b l e s
5238C-----------------------------------------------
5239 INTEGER I,J,II,IT,IIC,IMIN
5240C
5241C-----en ordre iddl croisante-----
5242 DO i =1,n
5243 imin=iddl(ic(i))
5244 ii=i
5245 DO j =i+1,n
5246 iic = iddl(ic(j))
5247 IF (iic<imin) THEN
5248 imin=iic
5249 ii=j
5250 ENDIF
5251 ENDDO
5252 IF (ii/=i) THEN
5253 it=ic(i)
5254 ic(i)=ic(ii)
5255 ic(ii)=it
5256 ENDIF
5257 ENDDO
5258C----6---------------------------------------------------------------7---------8
5259 RETURN
5260 END
5261!||====================================================================
5262!|| jdifrtok ../engine/source/mpi/implicit/imp_fri.F
5263!||--- uses -----------------------------------------------------
5264!|| imp_intm ../engine/share/modules/imp_intm.F
5265!||====================================================================
5266 SUBROUTINE jdifrtok(ITOK )
5267C-----------------------------------------------
5268C M o d u l e s
5269C-----------------------------------------------
5270 USE imp_intm
5271C----6---------------------------------------------------------------7---------8
5272C I m p l i c i t T y p e s
5273C-----------------------------------------------
5274#include "implicit_f.inc"
5275C-----------------------------------------------------------------
5276C D u m m y A r g u m e n t s
5277C-----------------------------------------------
5278 INTEGER ITOK(*)
5279C-----------------------------------------------
5280C L o c a l V a r i a b l e s
5281C-----------------------------------------------
5282 INTEGER I,J,NJ
5283C
5284C-----pass IDDLI to IDDLJ croisante-----
5285 DO i =1,nddl_si
5286 DO j =iad_si(i),iad_si(i+1)-1
5287 nj = jdi_si(j)
5288 jdi_si(j) = itok(nj)
5289 ENDDO
5290 ENDDO
5291C----6---------------------------------------------------------------7---------8
5292 RETURN
5293 END
5294!||====================================================================
5295!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
5296!||--- called by ------------------------------------------------------
5297!|| imp_fri ../engine/source/mpi/implicit/imp_fri.F
5298!||--- calls -----------------------------------------------------
5299!|| cp_iadd ../engine/source/mpi/implicit/imp_fri.F
5300!|| dim_frkm ../engine/source/mpi/implicit/imp_fri.F
5301!|| dim_frkm1 ../engine/source/mpi/implicit/imp_fri.F
5302!|| dim_fvn ../engine/source/mpi/implicit/imp_fri.F
5303!|| imp_frkm ../engine/source/mpi/implicit/imp_fri.F
5304!|| imp_frks ../engine/source/mpi/implicit/imp_fri.F
5305!|| imp_frsn ../engine/source/mpi/implicit/imp_fri.f
5306!|| imp_fvkm ../engine/source/mpi/implicit/imp_fri.F
5307!|| imp_fvksl ../engine/source/mpi/implicit/imp_fri.F
5308!|| imp_fvkss ../engine/source/mpi/implicit/imp_fri.F
5309!|| ind_fvn ../engine/source/mpi/implicit/imp_fri.F
5310!|| ind_sld ../engine/source/mpi/implicit/imp_fri.F
5311!|| ini_frfd ../engine/source/mpi/implicit/imp_fri.f
5312!|| ini_frkc ../engine/source/mpi/implicit/imp_fri.F
5313!|| ini_frud ../engine/source/mpi/implicit/imp_fri.F
5314!|| ini_ksi ../engine/source/mpi/implicit/imp_fri.F
5315!|| kin_kml ../engine/source/mpi/implicit/imp_fri.f
5316!|| kin_ksl ../engine/source/mpi/implicit/imp_fri.F
5317!|| scom_frk ../engine/source/mpi/implicit/imp_fri.F
5318!|| scom_frk1 ../engine/source/mpi/implicit/imp_fri.F
5319!|| scom_frud ../engine/source/mpi/implicit/imp_fri.F
5320!|| spmd_ifc1 ../engine/source/mpi/implicit/imp_spmd.F
5321!|| spmd_ifrf ../engine/source/mpi/implicit/imp_spmd.F
5322!|| tag_intml ../engine/source/mpi/implicit/imp_fri.F
5323!|| tra_frkm ../engine/source/mpi/implicit/imp_fri.f
5324!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
5325!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.F
5326!||--- uses -----------------------------------------------------
5327!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
5328!||====================================================================
5329 SUBROUTINE imp_frkd(
5330 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
5331 2 IPARI ,INTBUF_TAB,NINT2 ,IINT2 ,IDDL ,
5332 3 IKC ,NDOF ,INLOC ,NSREM ,NSL ,
5333 4 NBINTC ,INTLIST ,X ,IBFV ,
5334 5 LJ ,SKEW ,XFRAME ,ISKEW ,ICODT ,
5335 6 A ,UD ,LB ,IFDIS ,URD ,
5336 7 IDDLI ,IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,
5337 8 LRBE2 )
5338C-----------------------------------------------
5339C M o d u l e s
5340C-----------------------------------------------
5341 USE intbufdef_mod
5342C----6---------------------------------------------------------------7---------8
5343C I m p l i c i t T y p e s
5344C-----------------------------------------------
5345#include "implicit_f.inc"
5346C-----------------------------------------------
5347C C o m m o n B l o c k s
5348C-----------------------------------------------
5349#include "com01_c.inc"
5350#include "com04_c.inc"
5351#include "param_c.inc"
5352C-----------------------------------------------------------------
5353C D u m m y A r g u m e n t s
5354C-----------------------------------------------
5355 INTEGER IPARI(NPARI,*),NSREM ,NSL,NBINTC,INTLIST(*)
5356 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
5357 . nint2,iint2(*),iddl(*),ikc(*),ndof(*),inloc(*),
5358 . ibfv(*),lj(*),iskew(*),icodt(*),ifdis,iddli(*),
5359 . irbe3(*),lrbe3(*),irbe2(*),lrbe2(*)
5360C REAL
5361 my_real
5362 . x(3,*),ud(3,*),a(3,*),skew(*),xframe(*),
5363 . lb(*),urd(3,*),frbe3(*)
5364 TYPE(intbuf_struct_) INTBUF_TAB(*)
5365C-----------------------------------------------
5366C L o c a l V a r i a b l e s
5367C-----------------------------------------------
5368 INTEGER LSI,LSL,IDDLM(NUMNOD),ILOCP(NUMNOD)
5369 INTEGER I,J,K,L,N,NKC,J1,ND,LSG,
5370 . nf_sl(nsl),nf_si(nsrem),n_kine,
5371 . iad_sld(nspmd+1),iad_mld(nspmd+1),
5372 . isi ,isl,nfv,lvsi,lvsl,lfsi,lfsl,nz,
5373 . ier1,ier2,ier3,ier4,ier5,ier6,ier7,lsi0
5374 my_real
5375 . kss(6,nsl)
5376 INTEGER, DIMENSION(:),ALLOCATABLE :: IAD_M,IKCSI,IKCSL,
5377 . IFVSI,IFVSL
5378 my_real, DIMENSION(:),ALLOCATABLE :: KSI_FR,KSL_FR,
5379 . udsi,udsl,fdsi
5380C------------------------------------------------------------
5381C---IKCSI(NSREM),IKCSL(NSL): initialised by NDD=sum(IKC(id+1,3)) or 21 for NDOF=0
5382C---they are updated just after by DIM_FRKM :nb of [K}3x3-> is sent in SL
5383 CALL spmd_ifc1(nsrem ,nsl ,kss)
5384C-------iddlm-----------------
5385 nkc=0
5386 isi =0
5387 lfsi = 0
5388 DO n =1,numnod
5389 i=inloc(n)
5390 iddlm(i)=iddl(i)-nkc
5391 DO j=1,ndof(i)
5392 nd = iddl(i)+j
5393 IF (ikc(nd)/=0) nkc = nkc + 1
5394 ENDDO
5395 ENDDO
5396 IF (nsl>0) THEN
5397 CALL imp_frsn(ipari ,intbuf_tab ,nbintc,intlist)
5398 ALLOCATE(iad_m(nsl+1))
5399 ENDIF
5400 DO i=1,nsrem
5401 nf_si(i) = 0
5402 ENDDO
5403C------s'il y a des neouds kin---IKC_SL(NSL)>0->IKC_SI----
5404 CALL ini_frkc(nsrem ,nsl ,ikc ,ndof ,iddl)
5405C------com. [Ksm] secnds remotes dependant--s.KSI;r.KSL-IKC_SI,SL->nb [Ksm]--
5406 CALL dim_frkm(nsrem ,nsl ,lsi ,lsl )
5407 lsi0 = lsi
5408 lsg = lsi+lsl
5409C due to if (NSREM+NSL>0) outside CALL SPMD_MAX_I(LSG)
5410 IF (lsg >= 0) THEN
5411 IF (ifdis>0) nfv = 0
5412 IF (lsi>0) THEN
5413 ALLOCATE(ksi_fr(9*lsi),stat=ier1)
5414 CALL ini_ksi(nsrem ,ksi_fr ,iddli )
5415 ENDIF
5416 IF (lsl>0) ALLOCATE(ksl_fr(9*lsl),stat=ier2)
5417 CALL scom_frk(ksi_fr,ksl_fr,lsi ,lsl)
5418C--------condense KSL_FR------
5419 IF (lsl>0) THEN
5420 CALL kin_ksl(
5421 1 ipari ,intbuf_tab,nint2 ,iint2 ,
5422 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
5423 3 x ,ibfv ,lj ,skew ,xframe ,
5424 4 iskew ,icodt ,ndof ,ilocp ,nsl ,
5425 5 iad_m ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
5426 lsi = iad_m(nsl+1) -iad_m(1)
5427 CALL ind_sld(nsl ,ndof ,kss )
5428C-------utilise tempo KSI_FR pour K_SL modifie-(neouds mains)----------------
5429 IF(ALLOCATED(ksi_fr)) DEALLOCATE(ksi_fr)
5430 ALLOCATE(ksi_fr(9*lsi),stat=ier3)
5431 CALL upd_ksl(
5432 1 ipari ,intbuf_tab,nint2 ,iint2 ,
5433 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
5434 3 x ,ibfv ,lj ,skew ,xframe ,
5435 4 iskew ,icodt ,ilocp ,nsl ,iad_m ,
5436 5 iddl ,ikc ,ndof ,iddlm ,ud ,
5437 6 a ,lb ,kss ,ksl_fr ,ksi_fr ,
5438 7 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 )
5439C-------s'il y a imposed Ud(secnd local), il faut renvoyer UDSL->UDSI---------
5440C-------NFV: nb of /IMPVEL node in SL, use ISLM(NFV) to save node num.
5441 IF (ifdis>0) THEN
5442 CALL dim_fvn(
5443 1 ndof ,iddl ,ikc ,ilocp ,nfv )
5444 IF (nfv > 0) THEN
5445 CALL ind_fvn(
5446 1 ndof ,iddl ,ikc ,ilocp ,nfv )
5447 ALLOCATE(udsl(3*nfv))
5448C-------modif LB due au KSS et ini UDSL---put KSS dans K_SL-------
5449 CALL imp_fvkss(
5450 1 kss ,iddl ,iddlm ,ikc ,nsl ,
5451 2 ud ,lb ,nfv ,udsl ,ilocp ,
5452 3 ndof )
5453 ENDIF
5454 ENDIF ! IF (IFDIS>0)
5455 ENDIF ! IF (LSL>0)
5456C-------dim pour re-copy KSI_FR (K_SL modifie) a K_SL (ne reste que IKC=0---------
5457 CALL dim_frkm1(nsrem,nsl ,iddl ,ikc ,ndof ,
5458 . nf_si,nf_sl,lsi ,lsl ,isi ,isl )
5459C
5460 IF (lsl>0) THEN
5461 IF(ALLOCATED(ksl_fr)) DEALLOCATE(ksl_fr)
5462 ALLOCATE(ksl_fr(9*lsl),ikcsl(3*isl),stat=ier5)
5463 IF (isl>0) ikcsl=1
5464 CALL tra_frkm(nsl ,iddl ,ikc ,ndof ,iad_m ,
5465 . ksi_fr,ksl_fr,ikcsl)
5466 IF(ALLOCATED(ksi_fr)) DEALLOCATE(ksi_fr)
5467 IF (ifdis>0) ALLOCATE(ifvsl(isl))
5468 ENDIF
5469 IF (lsi>0) THEN
5470 IF(ALLOCATED(ksi_fr)) DEALLOCATE(ksi_fr)
5471 ALLOCATE(ksi_fr(9*lsi),ikcsi(3*isi),stat=ier6)
5472 IF (ifdis>0) ALLOCATE(ifvsi(isi))
5473 ENDIF
5474C-------s: KSL_FR, r:KSI_FR :[Ksm] condense-----
5475 lsg = lsi+lsl
5476C CALL SPMD_MAX_I(LSG)
5477 IF (lsg >= 0)
5478 . CALL scom_frk1(ksl_fr,ksi_fr,nf_sl,nf_si,ikcsl,ikcsi)
5479 IF(ALLOCATED(ksl_fr)) DEALLOCATE(ksl_fr)
5480 IF (ifdis>0) THEN
5481C-------ini LVSI pour recevoire Ud(lvsi)-----
5482 CALL ini_frud(nsrem ,nsl ,nfv ,ifvsi ,ifvsl ,
5483 . nf_si ,nf_sl ,lvsi )
5484 IF (lvsi>0) ALLOCATE(udsi(3*lvsi))
5485 CALL scom_frud(udsl,udsi,nf_sl,nf_si,ifvsl,ifvsi)
5486C-------modifie LB(mi) du au [Ksm]^t ,Ud(si)-----
5487 IF (lvsi>0) CALL imp_fvksl(
5488 1 iddl ,iddlm ,ikc ,ifvsi ,nf_si ,
5489 2 ksi_fr ,lb ,nsrem ,udsi )
5490 IF(ALLOCATED(udsi).AND.lvsi>0) DEALLOCATE(udsi)
5491 ENDIF
5492 IF(ALLOCATED(udsl).AND.nfv>0) DEALLOCATE(udsl)
5493 IF(ALLOCATED(ifvsi).AND.isi>0) DEALLOCATE(ifvsi)
5494 IF(ALLOCATED(ifvsl).AND.isl>0) DEALLOCATE(ifvsl)
5495 IF(ALLOCATED(ikcsl).AND.isl>0) DEALLOCATE(ikcsl)
5496C
5497 ENDIF ! (LSG>0)
5498 IF (nsl>0) THEN
5499 DEALLOCATE(iad_m)
5500 CALL imp_frks(nsl ,iddl ,ikc ,ndof ,iddlm,kss ,iad_sld )
5501 ENDIF
5502C
5503 IF (ifdis>0) nfv = 0
5504 IF (nsrem>0) THEN
5505 DO n =1,numnod
5506 ilocp(n)=0
5507 ENDDO
5508C--------N_KINE: NML---LSI number of kinematic nodes-
5509 n_kine=0
5510 CALL tag_intml(nsrem ,ilocp ,n_kine ,iddl ,ikc ,ndof ,lsi)
5511 IF (lsi>0) THEN
5512 ALLOCATE(iad_m(n_kine+1))
5513 CALL kin_kml(
5514 1 ipari ,intbuf_tab,nint2 ,iint2 ,
5515 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
5516 3 x ,ibfv ,lj ,skew ,xframe ,
5517 4 iskew ,icodt ,ndof ,ilocp ,nsrem ,
5518 5 iddl ,ikc ,iad_m ,n_kine ,irbe3 ,
5519 6 lrbe3 ,irbe2 ,lrbe2 )
5520C-------utilise tempo KSL_FR pour KML_FR modifie-----------------
5521 lsl = iad_m(n_kine+1) -iad_m(1)
5522 ALLOCATE(ksl_fr(9*lsl),stat=ier7)
5523 CALL upd_kml(
5524 1 ipari ,intbuf_tab,nint2 ,iint2 ,
5525 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
5526 3 x ,ibfv ,lj ,skew ,xframe ,
5527 4 iskew ,icodt ,ilocp ,n_kine ,iad_m ,
5528 5 iddl ,ikc ,ndof ,iddlm ,ud ,
5529 6 a ,ksl_fr ,ksi_fr ,nsrem ,nf_si ,
5530 7 iddli ,irbe3 ,lrbe3 ,frbe3 ,irbe2 ,
5531 8 lrbe2 )
5532 IF (ifdis>0) THEN
5533 CALL dim_fvn(
5534 1 ndof ,iddl ,ikc ,ilocp ,nfv )
5535 IF (nfv > 0) THEN
5536 CALL ind_fvn(
5537 1 ndof ,iddl ,ikc ,ilocp ,nfv )
5538 DO i=1,nsrem
5539 DO j =1, max(1,nf_si(i))
5540 lfsi = lfsi + 1
5541 ENDDO
5542 ENDDO
5543 ALLOCATE(fdsi(3*lfsi))
5544C-------modifie FDSI du au [Ksm] ,Ud(mi)-----
5545 CALL imp_fvkm(
5546 1 ksi_fr ,ksl_fr ,iddl ,ndof ,ikc ,
5547 2 ilocp ,iad_m ,nsrem ,n_kine ,ud ,
5548 3 fdsi ,nf_si ,nfv ,lfsi ,iddli )
5549 ENDIF
5550 ENDIF
5551 ENDIF
5552 lsi = lsi + isi + lsi0
5553C-------actualise [Ksm] et stock dans LT_SI----
5554 CALL imp_frkm(
5555 1 nsrem ,lsi ,ikcsi ,ikc ,ndof ,
5556 2 iddl ,iddlm ,ilocp ,iad_m ,ksi_fr ,
5557 3 ksl_fr ,nf_si ,iad_mld ,iddli )
5558 ENDIF
5559 IF(ALLOCATED(iad_m)) DEALLOCATE(iad_m)
5560 IF(ALLOCATED(ksi_fr)) DEALLOCATE(ksi_fr)
5561 IF(ALLOCATED(ksl_fr)) DEALLOCATE(ksl_fr)
5562 IF (ifdis>0) CALL ini_frfd(nsrem ,nfv ,ikcsi,nf_si ,fdsi )
5563 CALL cp_iadd(nsl ,nsrem,iad_sld ,iad_mld)
5564 IF (ifdis>0) CALL spmd_ifrf(lb )
5565C ------passe IAD_SL,IAD_SREM en ddl-----
5566 IF(ALLOCATED(ikcsi).AND.isi>0) DEALLOCATE(ikcsi)
5567 IF(ALLOCATED(fdsi).AND.lfsi>0) DEALLOCATE(fdsi)
5568C----6---------------------------------------------------------------7---------8
5569 RETURN
5570 END
5571!||====================================================================
5572!|| ini_frkc ../engine/source/mpi/implicit/imp_fri.F
5573!||--- called by ------------------------------------------------------
5574!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
5575!||--- calls -----------------------------------------------------
5576!|| spmd_isr ../engine/source/mpi/implicit/imp_spmd.F
5577!||--- uses -----------------------------------------------------
5578!|| imp_intm ../engine/share/modules/imp_intm.F
5579!||====================================================================
5580 SUBROUTINE ini_frkc(NSREM ,NSL ,IKC ,NDOF ,IDDL )
5581C-----------------------------------------------
5582C M o d u l e s
5583C-----------------------------------------------
5584 USE imp_intm
5585C-----------------------------------------------
5586C I m p l i c i t T y p e s
5587C-----------------------------------------------
5588#include "implicit_f.inc"
5589C-----------------------------------------------
5590C D u m m y A r g u m e n t s
5591C-----------------------------------------------
5592 INTEGER NSREM ,NSL ,IKC(*) ,NDOF(*) ,IDDL(*)
5593C REAL
5594C-----------------------------------------------
5595C L o c a l V a r i a b l e s
5596C-----------------------------------------------
5597 INTEGER I,J,N,ID,NDD,IERROR1,IERROR2
5598C--------------------------------------------
5599 IF(ALLOCATED(ikc_sl)) DEALLOCATE(ikc_sl)
5600 ALLOCATE(ikc_sl(nsl),stat=ierror1)
5601 IF(ALLOCATED(ikc_si)) DEALLOCATE(ikc_si)
5602 ALLOCATE(ikc_si(nsrem),stat=ierror2)
5603 DO i = 1, nsl
5604 n = isl(i)
5605 id = iddl(n)
5606 ndd = 0
5607 DO j = 1 , min(3,ndof(n))
5608 ndd = ndd + ikc(id+j)
5609 ENDDO
5610 IF (ndof(n)==0) ndd = 21
5611 ikc_sl(i) = ndd
5612 ENDDO
5613C
5614 CALL spmd_isr(iad_sl,iad_srem,ikc_sl,ikc_si,nsl ,nsrem )
5615C
5616 IF (nsrem==0) nddl_si=0
5617 nddl_sl=0
5618C
5619 RETURN
5620 END
5621!||====================================================================
5622!|| dim_frkm ../engine/source/mpi/implicit/imp_fri.F
5623!||--- called by ------------------------------------------------------
5624!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
5625!||--- calls -----------------------------------------------------
5626!|| spmd_isr ../engine/source/mpi/implicit/imp_spmd.F
5627!||--- uses -----------------------------------------------------
5628!|| imp_intm ../engine/share/modules/imp_intm.F
5629!||====================================================================
5630 SUBROUTINE dim_frkm(NSREM ,NSL ,SSIZE,RSIZE)
5631C-----------------------------------------------
5632C M o d u l e s
5633C-----------------------------------------------
5634 USE imp_intm
5635C-----------------------------------------------
5636C I m p l i c i t T y p e s
5637C-----------------------------------------------
5638#include "implicit_f.inc"
5639C-----------------------------------------------
5640C D u m m y A r g u m e n t s
5641C-----------------------------------------------
5642 INTEGER NSREM ,NSL ,SSIZE,RSIZE
5643C REAL
5644C-----------------------------------------------
5645C L o c a l V a r i a b l e s
5646C-----------------------------------------------
5647 INTEGER I,J,ID
5648C--------------------------------------------
5649C -----renvoie Ksl,Ksm et recevoie Kss,Kslm a condenser
5650 ssize = 0
5651 DO i = 1, nsrem
5652 IF (ikc_si(i)>0) THEN
5653C -----nb de [K}3x3--------
5654 ikc_si(i) = iad_sinr(i+1)-iad_sinr(i)
5655 ssize = ssize + ikc_si(i)
5656 ENDIF
5657 ENDDO
5658 CALL spmd_isr(iad_srem,iad_sl,ikc_si,ikc_sl,nsrem,nsl )
5659C
5660 rsize = 0
5661 DO i = 1, nsl
5662 IF (ikc_sl(i)>0) rsize = rsize + ikc_sl(i)
5663 ENDDO
5664C
5665 RETURN
5666 END
5667!||====================================================================
5668!|| ini_ksi ../engine/source/mpi/implicit/imp_fri.F
5669!||--- called by ------------------------------------------------------
5670!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
5671!||--- calls -----------------------------------------------------
5672!|| getfr_kij ../engine/source/mpi/implicit/imp_fri.F
5673!||--- uses -----------------------------------------------------
5674!|| imp_intm ../engine/share/modules/imp_intm.F
5675!||====================================================================
5676 SUBROUTINE ini_ksi(NSREM ,KSI ,IDDL )
5677C-----------------------------------------------
5678C M o d u l e s
5679C-----------------------------------------------
5680 USE imp_intm
5681C-----------------------------------------------
5682C I m p l i c i t T y p e s
5683C-----------------------------------------------
5684#include "implicit_f.inc"
5685C-----------------------------------------------
5686C D u m m y A r g u m e n t s
5687C-----------------------------------------------
5688 INTEGER NSREM ,IDDL(*)
5689C REAL
5690 my_real
5691 . KSI(9,*)
5692C-----------------------------------------------
5693C L o c a l V a r i a b l e s
5694C-----------------------------------------------
5695 INTEGER I,J,ID,JD,NM,ND,IAD
5696C--------------------------------------------
5697 nd = 3
5698 iad = 0
5699 DO i = 1, nsrem
5700 IF (ikc_si(i)>0) THEN
5701 id = iddl_si(i)
5702 DO j = iad_sinr(i), iad_sinr(i+1)-1
5703 nm = jdi_sinr(j)
5704 jd = iddl(nm)
5705 iad = iad + 1
5706 CALL getfr_kij( id ,jd ,iad_si ,jdi_si,lt_si ,
5707 1 ksi(1,iad),nd ,nd )
5708 ENDDO
5709 ENDIF
5710 ENDDO
5711C
5712 RETURN
5713 END
5714!||====================================================================
5715!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.F
5716!||--- called by ------------------------------------------------------
5717!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
5718!||--- calls -----------------------------------------------------
5719!|| bc_updfr ../engine/source/constraints/general/bcs/bc_imp0.F
5720!|| bc_updfr2 ../engine/source/constraints/general/bcs/bc_imp0.F
5721!|| bcl_frk ../engine/source/constraints/general/bcs/bc_imp0.F
5722!|| cp_real ../engine/source/implicit/produt_v.F
5723!|| fv_updfr ../engine/source/constraints/general/impvel/fv_imp0.F
5724!|| fvl_frk ../engine/source/constraints/general/impvel/fv_imp0.F
5725!|| get_iad ../engine/source/mpi/implicit/imp_fri.F
5726!|| i2_frk0 ../engine/source/interfaces/interf/i2_imp1.F
5727!|| i2_frk1 ../engine/source/interfaces/interf/i2_imp1.F
5728!|| intabfr ../engine/source/mpi/implicit/imp_fri.F
5729!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.F
5730!|| prerbe2fr ../engine/source/constraints/general/rbe2/rbe2f.F
5731!|| prerbe3fr ../engine/source/constraints/general/rbe3/rbe3f.F
5732!|| rbe2_frk ../engine/source/constraints/general/rbe2/rbe2_imp0.F
5733!|| rbe3_fr0 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
5734!|| rby_frk ../engine/source/constraints/general/rbody/rby_imp0.f
5735!||--- uses -----------------------------------------------------
5736!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
5737!|| imp_intm ../engine/share/modules/imp_intm.F
5738!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
5739!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
5740!||====================================================================
5741 SUBROUTINE upd_ksl(
5742 1 IPARI ,INTBUF_TAB,NINT2 ,IINT2 ,
5743 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
5744 3 X ,IBFV ,LJ ,SKEW ,XFRAME ,
5745 4 ISKEW ,ICODT ,INLOC ,NSL ,IAD_M ,
5746 5 IDDL ,IKC ,NDOF ,IDDLM ,UD ,
5747 6 A ,B ,KSS ,KSL_FR ,KSI_FR ,
5748 7 IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,LRBE2 )
5749C-----------------------------------------------
5750C M o d u l e s
5751C-----------------------------------------------
5752 USE imp_intm
5753 USE imp_rwl
5754 USE imp_aspc
5755 USE intbufdef_mod
5756C-----------------------------------------------
5757C I m p l i c i t T y p e s
5758C-----------------------------------------------
5759#include "implicit_f.inc"
5760C-----------------------------------------------
5761C C o m m o n B l o c k s
5762C-----------------------------------------------
5763#include "param_c.inc"
5764#include "tabsiz_c.inc"
5765C-----------------------------------------------
5766C D u m m y A r g u m e n t s
5767C-----------------------------------------------
5768 INTEGER IBFV(NIFV,*),IPARI(NPARI,*),NSL,IAD_M(*)
5769 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
5770 . nint2,iint2(*),iddl(*),ikc(*),ndof(*),inloc(*),
5771 . lj(*),iskew(*),icodt(*),iddlm(*),irbe3(nrbe3l,*),
5772 . lrbe3(*),irbe2(nrbe2l,*),lrbe2(*)
5773C REAL
5774 my_real
5775 . x(3,*),skew(lskew,*),xframe(*),frbe3(*)
5776 my_real
5777 . ud(3,*),a(3,*),b(*) ,kss(6,*),ksl_fr(9,*) ,ksi_fr(9,*)
5778 TYPE(intbuf_struct_) INTBUF_TAB(*)
5779C-----------------------------------------------
5780C L o c a l V a r i a b l e s
5781C-----------------------------------------------
5782 INTEGER I,J,N,K,M,NS,NI,NSN,ILEV,IAD_M1(NSL+1),IS,
5783 . ji,l,nnod,nj,nd,nl,isk,ifm,j1,nm,id,iad0,iad,iads,
5784 . i1,ict,ifss,ifsm,idm(4),nr,jt(3),jr(3),irot,
5785 . idlm(slrbe3/2),iadr,nn,irad,ic,eid
5786 my_real
5787 . ej(3),ksm(9),knm(9,4),krm(9,4)
5788C----4 no more sufficient for RBE3: alloc dynamic only for IFSM=1
5789 my_real,
5790 . DIMENSION(:),ALLOCATABLE :: knm3,krm3
5791C----------Kss d'abord------------------------------
5792 ifss =1
5793 ifsm=0
5794 iad_m1(1) = 1
5795 DO n=1,nsl
5796 nl =0
5797 IF (ikc_sl(n)>0) THEN
5798 nr = iad_slnr(n+1)-iad_slnr(n)
5799 nl = max(1,nr)
5800 ENDIF
5801 iad_m1(n+1) = iad_m1(n)+nl
5802 ENDDO
5803C------int2----------------------------------
5804 DO i=ni2_fr,1,-1
5805 n=ifrs2(1,i)
5806 ni=ifrs2(2,i)
5807 ji=ipari(1,n)
5808 nsn=ipari(5,n)
5809 l=intbuf_tab(n)%IRTLM(ni)
5810 nl=4*(l-1)
5811 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
5812 nnod=3
5813 ELSE
5814 nnod=4
5815 ENDIF
5816 ilev =ipari(20,n)
5817C
5818 DO is = 1,nsl
5819 IF (isl(is)==ns) THEN
5820 nr = iad_slnr(is+1)-iad_slnr(is)
5821 DO k =1,nnod
5822 nj=intbuf_tab(n)%IRECTM(nl+k)
5823 CALL intabfr(nr,jdi_slnr(iad_slnr(is)),nj,j)
5824 IF (j>0) THEN
5825 idm(k) = iddl_sl(iad_m1(is)+j-1)
5826 ELSE
5827 ENDIF
5828 ENDDO
5829 IF (ilev==1) THEN
5830 CALL i2_frk1(intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,x ,itab ,
5831 . intbuf_tab(n)%NSV,
5832 1 intbuf_tab(n)%IRTLM,ikc ,ndof ,iddl ,iddlm,
5833 2 iad_ss ,jdi_sl ,diag_sl,lt_sl ,b ,a ,
5834 3 kss(1,is),ksm ,knm ,krm ,ni ,
5835 4 idm ,ifss ,ifsm )
5836 ELSE
5837 CALL i2_frk0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,x ,itab ,
5838 . intbuf_tab(n)%NSV,
5839 1 intbuf_tab(n)%IRTLM,ikc ,ndof ,iddl ,iddlm,
5840 2 iad_ss ,jdi_sl ,diag_sl,lt_sl ,b ,a ,
5841 3 kss(1,is),ksm ,knm ,krm ,ni ,
5842 4 idm ,ifss ,ifsm )
5843 ENDIF
5844 ENDIF
5845 ENDDO
5846 ENDDO
5847C------RBE2-------
5848 DO i=nrbe2_fr,1,-1
5849 n=ifrs4(1,i)
5850 m=irbe2(3,n)
5851 ns=ifrs4(2,i)
5852 isk = irbe2(7,n)
5853 irad =irbe2(11,n)
5854 ic = irbe2(4,n)
5855C--------remove ICR---
5856 ic =(ic/512)*512
5857 DO is = 1,nsl
5858 IF (isl(is)==ns) THEN
5859 nr = iad_slnr(is+1)-iad_slnr(is)
5860 CALL intabfr(nr,jdi_slnr(iad_slnr(is)),m ,j)
5861 IF (j>0) THEN
5862 idm(1) = iddl_sl(iad_m1(is)+j-1)
5863 ELSE
5864 ENDIF
5865 CALL prerbe2fr(ic ,jt ,jr )
5866 CALL rbe2_frk(ns ,m ,x ,isk ,skew(1,isk) ,
5867 1 irad ,ndof ,iddl ,jt ,jr ,
5868 2 iad_ss,jdi_sl,diag_sl,lt_sl ,b ,
5869 3 a ,kss(1,is),ksm ,knm ,krm ,
5870 4 idm(1),ifss,ifsm )
5871 ENDIF
5872 ENDDO
5873 ENDDO
5874C------RBE3----------------------------------
5875 DO i=1,nrbe3_fr
5876 n=ifrs3(i)
5877 iad=irbe3(1,n)
5878 ns=irbe3(3,n)
5879 nnod=irbe3(5,n)
5880 irot =irbe3(6,n)
5881 eid=irbe3(2,n)
5882 iads = slrbe3/2+iad
5883C
5884 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
5885 DO is = 1,nsl
5886 IF (isl(is)==ns) THEN
5887 nr = iad_slnr(is+1)-iad_slnr(is)
5888 DO k =1,nnod
5889 nj = lrbe3(iad+k)
5890 CALL intabfr(nr,jdi_slnr(iad_slnr(is)),nj,j)
5891 IF (j>0) THEN
5892 idlm(k) = iddl_sl(iad_m1(is)+j-1)
5893 ELSE
5894 ENDIF
5895 ENDDO
5896 CALL rbe3_fr0(ns ,nnod ,lrbe3(iad+1) ,x ,irot ,
5897 2 jt ,jr ,frbe3(6*iad+1) ,skew ,ikc ,
5898 3 ndof ,iad_ss ,jdi_sl ,diag_sl,lt_sl ,
5899 2 kss(1,is),ksm ,knm ,krm ,idlm ,
5900 3 ifss ,ifsm ,itab ,lrbe3(iads+1),eid)
5901 ENDIF
5902 ENDDO
5903 ENDDO
5904C------Rigid bodies-------
5905 DO i=nrb_fr,1,-1
5906 m=ifrsr(1,i)
5907 ns=ifrsr(2,i)
5908 DO is = 1,nsl
5909 IF (isl(is)==ns) THEN
5910 nr = iad_slnr(is+1)-iad_slnr(is)
5911 CALL intabfr(nr,jdi_slnr(iad_slnr(is)),m ,j)
5912 IF (j>0) THEN
5913 idm(1) = iddl_sl(iad_m1(is)+j-1)
5914 ELSE
5915 ENDIF
5916 CALL rby_frk(ns ,m ,x ,itab ,ikc ,
5917 1 ndof ,iddl ,iddlm,iad_ss,jdi_sl,
5918 2 diag_sl,lt_sl ,b ,a ,kss(1,is),
5919 3 ksm ,knm ,krm ,idm(1),ifss,ifsm )
5920 ENDIF
5921 ENDDO
5922 ENDDO
5923C
5924 DO i1 = 1,nbc_fr
5925 n = ibc_fr(1,i1)
5926 isk= ibc_fr(2,i1)
5927 ict= ibc_fr(3,i1)
5928 DO is = 1,nsl
5929 IF (isl(is)==n) THEN
5930 nr = iad_slnr(is+1)-iad_slnr(is)
5931 IF (nr>0) THEN
5932 CALL intabfr(nr,jdi_slnr(iad_slnr(is)),n ,j)
5933 idm(1) = iddl_sl(iad_m1(is)+j-1)
5934 ELSE
5935 idm(1) = iddl_sl(iad_m1(is))
5936 ENDIF
5937 CALL bcl_frk(n ,iddl ,iddlm ,ict ,isk ,
5938 1 skew ,ikc ,iad_ss,jdi_sl,diag_sl,
5939 2 lt_sl ,b ,a ,kss(1,is),ksm ,
5940 3 idm(1) ,ifss ,ifsm )
5941 ENDIF
5942 ENDDO
5943 ENDDO
5944C
5945 DO i1 = 1,nspc_fr
5946 n = ispc_fr(i1)
5947 i = in_spc(n)
5948 iad = 6*(n-1)+1
5949 nn = ic_spc(n)
5950 DO is = 1,nsl
5951 IF (isl(is)==i) THEN
5952 nr = iad_slnr(is+1)-iad_slnr(is)
5953 IF (nr>0) THEN
5954 CALL intabfr(nr,jdi_slnr(iad_slnr(is)),i ,j)
5955 idm(1) = iddl_sl(iad_m1(is)+j-1)
5956 ELSE
5957 idm(1) = iddl_sl(iad_m1(is))
5958 ENDIF
5959 IF (nn==1) THEN
5960 ej(1)=skew_spc(iad)
5961 ej(2)=skew_spc(iad+1)
5962 ej(3)=skew_spc(iad+2)
5963 CALL l_dir(ej,j)
5964 CALL bc_updfr(i ,iddl ,ej ,j ,iddlm ,
5965 1 ikc ,iad_ss,jdi_sl,diag_sl,lt_sl ,
5966 2 b ,a ,kss(1,is),ksm ,idm(1),
5967 3 ifss ,ifsm )
5968 ELSE
5969 CALL bc_updfr2(i ,iddl ,skew_spc(iad),skew_spc(iad+3),
5970 1 iddlm ,ikc ,iad_ss,jdi_sl,diag_sl,lt_sl ,
5971 2 b ,a ,kss(1,is),ksm ,idm(1),
5972 3 ifss ,ifsm )
5973 END IF
5974 ENDIF
5975 ENDDO
5976 ENDDO
5977C
5978 IF (nfx_fr>0) THEN
5979 DO l=1,nfx_fr
5980 i = ifx_fr(1,l)
5981 j1 = ifx_fr(2,l)
5982 n=iabs(ibfv(1,i))
5983 DO is = 1,nsl
5984 IF (isl(is)==n) THEN
5985 nr = iad_slnr(is+1)-iad_slnr(is)
5986 IF (nr>0) THEN
5987 CALL intabfr(nr,jdi_slnr(iad_slnr(is)),n ,j)
5988 idm(1) = iddl_sl(iad_m1(is)+j-1)
5989 ELSE
5990 idm(1) = iddl_sl(iad_m1(is))
5991 ENDIF
5992 CALL fvl_frk(j1 ,i ,ibfv ,skew ,xframe,
5993 1 iddl ,iddlm ,ikc ,iad_ss ,jdi_sl,
5994 2 diag_sl ,lt_sl ,ud ,b ,a ,
5995 3 kss(1,is),ksm ,idm(1) ,ifss ,ifsm )
5996 ENDIF
5997 ENDDO
5998 ENDDO
5999 ENDIF
6000C
6001 DO l = 1,nrw_fr
6002 i = irw_fr(l)
6003 n=in_rwl(i)
6004 ej(1)=nor_rwl(1,i)
6005 ej(2)=nor_rwl(2,i)
6006 ej(3)=nor_rwl(3,i)
6007 CALL l_dir(ej,j1)
6008 DO is = 1,nsl
6009 IF (isl(is)==n) THEN
6010 nr = iad_slnr(is+1)-iad_slnr(is)
6011 IF (nr>0) THEN
6012 CALL intabfr(nr,jdi_slnr(iad_slnr(is)),n ,j)
6013 idm(1) = iddl_sl(iad_m1(is)+j-1)
6014 ELSE
6015 idm(1) = iddl_sl(iad_m1(is))
6016 ENDIF
6017 CALL fv_updfr(n ,ej ,j1 ,iddl ,iddlm ,
6018 1 ikc ,iad_ss,jdi_sl,diag_sl,lt_sl ,
6019 2 ud ,b ,a ,kss(1,is),ksm ,
6020 3 idm(1) ,ifss ,ifsm)
6021 ENDIF
6022 ENDDO
6023 ENDDO
6024C----------Ksm ------------------------------
6025 ifss = 0
6026 ifsm = 1
6027 iad_m1(1) = 0
6028 DO n=1,nsl
6029 iad_m1(n+1) = iad_m1(n)+ikc_sl(n)
6030 ENDDO
6031C------cp KSL_FR dans KSI_FR-(pour des kin sans modif-----
6032 DO i = 1,nsl
6033 ns = isl(i)
6034 DO j = 1,ikc_sl(i)
6035 iad = iad_m1(i)+j
6036 CALL cp_real(9,ksl_fr(1,iad),ksm)
6037 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns ,i ,
6038 1 j ,ikc_sl(i),ndof ,iad )
6039 IF (iad>0) CALL cp_real(9,ksm,ksi_fr(1,iad))
6040 ENDDO
6041 ENDDO
6042C
6043 DO i=ni2_fr,1,-1
6044 n=ifrs2(1,i)
6045 ni=ifrs2(2,i)
6046 ji=ipari(1,n)
6047 nsn=ipari(5,n)
6048 l=intbuf_tab(n)%IRTLM(ni)
6049 nl=4*(l-1)
6050 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
6051 nnod=3
6052 ELSE
6053 nnod=4
6054 ENDIF
6055 ilev =ipari(20,n)
6056C
6057 DO is = 1,nsl
6058 IF (isl(is)==ns) THEN
6059 DO j = 1,ikc_sl(is)
6060C----------------int2 herarch-------
6061 IF (inloc(ns)>nsl) THEN
6062 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns ,is ,
6063 1 j ,ikc_sl(is),ndof ,iad )
6064 CALL cp_real(9,ksi_fr(1,iad),ksm)
6065 ELSE
6066 iad = iad_m1(is)+j
6067 CALL cp_real(9,ksl_fr(1,iad),ksm)
6068 ENDIF
6069 IF (ilev==1) THEN
6070 CALL i2_frk1(intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,x ,itab ,
6071 . intbuf_tab(n)%NSV,
6072 1 intbuf_tab(n)%IRTLM,ikc ,ndof ,iddl ,iddlm,
6073 2 iad_ss ,jdi_sl ,diag_sl,lt_sl ,b ,a ,
6074 3 kss(1,is),ksm ,knm ,krm ,ni ,
6075 4 idm ,ifss ,ifsm )
6076 ELSE
6077 CALL i2_frk0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,x ,itab ,
6078 . intbuf_tab(n)%NSV,
6079 1 intbuf_tab(n)%IRTLM,ikc ,ndof ,iddl ,iddlm,
6080 2 iad_ss ,jdi_sl ,diag_sl,lt_sl ,b ,a ,
6081 3 kss(1,is),ksm ,knm ,krm ,ni ,
6082 4 idm ,ifss ,ifsm )
6083 ENDIF
6084 DO k =1,nnod
6085 nj=intbuf_tab(n)%IRECTM(nl+k)
6086 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,nj ,is ,
6087 1 j ,ikc_sl(is),ndof ,iad )
6088 CALL cp_real(9,knm(1,k),ksi_fr(1,iad))
6089 IF (ndof(nj)==6)CALL cp_real(9,krm(1,k),ksi_fr(1,iad+1))
6090 ENDDO
6091 ENDDO
6092 ENDIF
6093 ENDDO
6094 ENDDO
6095C------RBE2-------
6096 DO i=nrbe2_fr,1,-1
6097 n=ifrs4(1,i)
6098 m=irbe2(3,n)
6099 ns=ifrs4(2,i)
6100 isk = irbe2(7,n)
6101 irad =irbe2(11,n)
6102 ic =irbe2(4,n)
6103C--------remove ICR---
6104 ic =(ic/512)*512
6105 DO is = 1,nsl
6106 IF (isl(is)==ns) THEN
6107 DO j = 1,ikc_sl(is)
6108C----------------ns main int2 -------
6109 IF (inloc(ns)>nsl) THEN
6110 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns ,is ,
6111 1 j ,ikc_sl(is),ndof ,iad )
6112 CALL cp_real(9,ksi_fr(1,iad),ksm)
6113 ELSE
6114 iad = iad_m1(is)+j
6115 CALL cp_real(9,ksl_fr(1,iad),ksm)
6116 ENDIF
6117 CALL prerbe2fr(ic ,jt ,jr )
6118 CALL rbe2_frk(ns ,m ,x ,isk ,skew(1,isk) ,
6119 1 irad ,ndof ,iddl ,jt ,jr ,
6120 2 iad_ss,jdi_sl,diag_sl,lt_sl ,b ,
6121 3 a ,kss(1,is),ksm ,knm ,krm ,
6122 4 idm(1),ifss,ifsm )
6123 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,m ,is ,
6124 1 j ,ikc_sl(is),ndof ,iad )
6125 CALL cp_real(9,knm,ksi_fr(1,iad))
6126 CALL cp_real(9,krm,ksi_fr(1,iad+1))
6127 ENDDO
6128 ENDIF
6129 ENDDO
6130 ENDDO
6131C ------RBE3
6132 DO i=1,nrbe3_fr
6133 n=ifrs3(i)
6134 iadr=irbe3(1,n)
6135 ns=irbe3(3,n)
6136 nnod=irbe3(5,n)
6137 irot =irbe3(6,n)
6138 eid=irbe3(2,n)
6139 iads = slrbe3/2+iadr
6140 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
6141 ALLOCATE(knm3(9*nnod))
6142 IF (irot>0) ALLOCATE(krm3(9*nnod))
6143C
6144 DO is = 1,nsl
6145 IF (isl(is)==ns) THEN
6146 DO j = 1,ikc_sl(is)
6147C----------------int2 herarch-------
6148 IF (inloc(ns)>nsl) THEN
6149 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns ,is ,
6150 1 j ,ikc_sl(is),ndof ,iad )
6151 CALL cp_real(9,ksi_fr(1,iad),ksm)
6152 ELSE
6153 iad = iad_m1(is)+j
6154 CALL cp_real(9,ksl_fr(1,iad),ksm)
6155 ENDIF
6156 CALL rbe3_fr0(ns ,nnod ,lrbe3(iadr+1) ,x ,irot ,
6157 2 jt ,jr ,frbe3(6*iadr+1) ,skew ,ikc ,
6158 3 ndof ,iad_ss ,jdi_sl ,diag_sl,lt_sl ,
6159 2 kss(1,is),ksm ,knm3 ,krm3 ,idlm ,
6160 3 ifss ,ifsm ,itab ,lrbe3(iads+1),eid)
6161 DO k =1,nnod
6162 nj = lrbe3(iadr+k)
6163 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,nj ,is ,
6164 1 j ,ikc_sl(is),ndof ,iad )
6165 id = 9*(k-1) +1
6166 CALL cp_real(9,knm3(id),ksi_fr(1,iad))
6167 IF (irot>0.AND.ndof(nj)==6)
6168 + CALL cp_real(9,krm3(id),ksi_fr(1,iad+1))
6169 ENDDO
6170 ENDDO
6171 ENDIF
6172 ENDDO
6173 DEALLOCATE(knm3)
6174 IF (irot>0) DEALLOCATE(krm3)
6175 ENDDO
6176C------Rigid bodies-------
6177 DO i=nrb_fr,1,-1
6178 m=ifrsr(1,i)
6179 ns=ifrsr(2,i)
6180 DO is = 1,nsl
6181 IF (isl(is)==ns) THEN
6182 DO j = 1,ikc_sl(is)
6183C----------------ns main int2 -------
6184 IF (inloc(ns)>nsl) THEN
6185 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns ,is ,
6186 1 j ,ikc_sl(is),ndof ,iad )
6187 CALL cp_real(9,ksi_fr(1,iad),ksm)
6188 ELSE
6189 iad = iad_m1(is)+j
6190 CALL cp_real(9,ksl_fr(1,iad),ksm)
6191 ENDIF
6192 CALL rby_frk(ns ,m ,x ,itab ,ikc ,
6193 1 ndof ,iddl ,iddlm,iad_ss,jdi_sl,
6194 2 diag_sl,lt_sl ,b ,a ,kss(1,is),
6195 3 ksm ,knm ,krm ,idm(1),ifss,ifsm )
6196 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,m ,is ,
6197 1 j ,ikc_sl(is),ndof ,iad )
6198 CALL cp_real(9,knm,ksi_fr(1,iad))
6199 CALL cp_real(9,krm,ksi_fr(1,iad+1))
6200 ENDDO
6201 ENDIF
6202 ENDDO
6203 ENDDO
6204C
6205 DO i1 = 1,nbc_fr
6206 n = ibc_fr(1,i1)
6207 isk= ibc_fr(2,i1)
6208 ict= ibc_fr(3,i1)
6209 DO is = 1,nsl
6210 IF (isl(is)==n) THEN
6211 DO j = 1,ikc_sl(is)
6212 IF (inloc(n)>nsl) THEN
6213 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n ,is ,
6214 1 j ,ikc_sl(is),ndof ,iad )
6215 CALL cp_real(9,ksi_fr(1,iad),ksm)
6216 ELSE
6217 iad = iad_m1(is)+j
6218 CALL cp_real(9,ksl_fr(1,iad),ksm)
6219 ENDIF
6220 CALL bcl_frk(n ,iddl ,iddlm ,ict ,isk ,
6221 1 skew ,ikc ,iad_ss,jdi_sl,diag_sl,
6222 2 lt_sl ,b ,a ,kss(1,is),ksm ,
6223 3 idm(1) ,ifss ,ifsm )
6224 IF (inloc(n)<=nsl) THEN
6225 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n ,is ,
6226 1 j ,ikc_sl(is),ndof ,iad )
6227 ENDIF
6228 CALL cp_real(9,ksm,ksi_fr(1,iad))
6229 ENDDO
6230 ENDIF
6231 ENDDO
6232 ENDDO
6233C
6234 DO i1 = 1,nspc_fr
6235 n = ispc_fr(i1)
6236 i = in_spc(n)
6237 iadr = 6*(n-1)+1
6238 nn = ic_spc(n)
6239 DO is = 1,nsl
6240 IF (isl(is)==i) THEN
6241 DO j = 1,ikc_sl(is)
6242 IF (inloc(i)>nsl) THEN
6243 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,i ,is ,
6244 1 j ,ikc_sl(is),ndof ,iad )
6245 CALL cp_real(9,ksi_fr(1,iad),ksm)
6246 ELSE
6247 iad = iad_m1(is)+j
6248 CALL cp_real(9,ksl_fr(1,iad),ksm)
6249 ENDIF
6250 IF (nn==1) THEN
6251 ej(1)=skew_spc(iadr)
6252 ej(2)=skew_spc(iadr+1)
6253 ej(3)=skew_spc(iadr+2)
6254 CALL l_dir(ej,ji)
6255 CALL bc_updfr(i ,iddl ,ej ,ji ,iddlm ,
6256 1 ikc ,iad_ss,jdi_sl,diag_sl,lt_sl ,
6257 2 b ,a ,kss(1,is),ksm ,idm(1),
6258 3 ifss ,ifsm )
6259 ELSE
6260 CALL bc_updfr2(i ,iddl ,skew_spc(iadr),skew_spc(iadr+3),
6261 1 iddlm ,ikc ,iad_ss,jdi_sl,diag_sl,lt_sl ,
6262 2 b ,a ,kss(1,is),ksm ,idm(1),
6263 3 ifss ,ifsm )
6264 END IF
6265 IF (inloc(i)<=nsl) THEN
6266 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,i ,is ,
6267 1 j ,ikc_sl(is),ndof ,iad )
6268 ENDIF
6269 CALL cp_real(9,ksm,ksi_fr(1,iad))
6270 ENDDO
6271 ENDIF
6272 ENDDO
6273 ENDDO
6274C
6275 IF (nfx_fr>0) THEN
6276 DO l=1,nfx_fr
6277 i = ifx_fr(1,l)
6278 j1 = ifx_fr(2,l)
6279 n=iabs(ibfv(1,i))
6280 DO is = 1,nsl
6281 IF (isl(is)==n) THEN
6282 DO j = 1,ikc_sl(is)
6283 IF (inloc(n)>nsl) THEN
6284 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n ,is ,
6285 1 j ,ikc_sl(is),ndof ,iad )
6286 CALL cp_real(9,ksi_fr(1,iad),ksm)
6287 ELSE
6288 iad = iad_m1(is)+j
6289 CALL cp_real(9,ksl_fr(1,iad),ksm)
6290 ENDIF
6291 CALL fvl_frk(j1 ,i ,ibfv ,skew ,xframe,
6292 1 iddl ,iddlm ,ikc ,iad_ss ,jdi_sl,
6293 2 diag_sl ,lt_sl ,ud ,b ,a ,
6294 3 kss(1,is),ksm ,idm ,ifss ,ifsm )
6295 IF (inloc(n)<=nsl) THEN
6296 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n ,is ,
6297 1 j ,ikc_sl(is),ndof ,iad )
6298 ENDIF
6299 CALL cp_real(9,ksm,ksi_fr(1,iad))
6300 ENDDO
6301 ENDIF
6302 ENDDO
6303 ENDDO
6304 ENDIF
6305C
6306 DO l = 1,nrw_fr
6307 i = irw_fr(l)
6308 n=in_rwl(i)
6309 ej(1)=nor_rwl(1,i)
6310 ej(2)=nor_rwl(2,i)
6311 ej(3)=nor_rwl(3,i)
6312 CALL l_dir(ej,j1)
6313 DO is = 1,nsl
6314 IF (isl(is)==n) THEN
6315 DO j = 1,ikc_sl(is)
6316 IF (inloc(n)>nsl) THEN
6317 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n ,is ,
6318 1 j ,ikc_sl(is),ndof ,iad )
6319 CALL cp_real(9,ksi_fr(1,iad),ksm)
6320 ELSE
6321 iad = iad_m1(is)+j
6322 CALL cp_real(9,ksl_fr(1,iad),ksm)
6323 ENDIF
6324 CALL fv_updfr(n ,ej ,j1 ,iddl ,iddlm ,
6325 1 ikc ,iad_ss,jdi_sl,diag_sl,lt_sl ,
6326 2 ud ,b ,a ,kss(1,is),ksm ,
6327 3 idm(1) ,ifss ,ifsm)
6328 IF (inloc(n)<=nsl) THEN
6329 CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n ,is ,
6330 1 j ,ikc_sl(is),ndof ,iad )
6331 ENDIF
6332 CALL cp_real(9,ksm,ksi_fr(1,iad))
6333 ENDDO
6334 ENDIF
6335 ENDDO
6336 ENDDO
6337C--------------------------------------------
6338C
6339 RETURN
6340 END
6341!||====================================================================
6342!|| assem_ksl ../engine/source/mpi/implicit/imp_fri.F
6343!||--- calls -----------------------------------------------------
6344!|| assem_kii ../engine/source/implicit/imp_glob_k.F
6345!||--- uses -----------------------------------------------------
6346!|| imp_intm ../engine/share/modules/imp_intm.F
6347!||====================================================================
6348 SUBROUTINE assem_ksl(IDDL ,K_DIAG ,K_LT ,IADK ,
6349 1 JDIK ,KSS ,NSL )
6350C-----------------------------------------------
6351C M o d u l e s
6352C-----------------------------------------------
6353 USE imp_intm
6354C-----------------------------------------------
6355C I m p l i c i t T y p e s
6356C-----------------------------------------------
6357#include "implicit_f.inc"
6358C-----------------------------------------------
6359C G l o b a l P a r a m e t e r s
6360C-----------------------------------------------
6361#include "mvsiz_p.inc"
6362#include "param_c.inc"
6363C-----------------------------------------------
6364C D u m m y A r g u m e n t s
6365C-----------------------------------------------
6366 integer
6367 . iddl(*) ,iadk(*) ,jdik(*),nsl
6368 my_real
6369 . k_diag(*) ,k_lt(*) ,kss(6,*)
6370C-----------------------------------------------
6371C L o c a l V a r i a b l e s
6372C-----------------------------------------------
6373 INTEGER I, JLT , NFT ,ND ,J,N0,JLT_NEW,IS
6374 my_real
6375 . k11(3,3,mvsiz),off(mvsiz)
6376C------------------------------------
6377 nd = 3
6378 DO nft = 0 , nsl - 1 , nvsiz
6379 jlt = min( nvsiz, nsl - nft )
6380 jlt_new = 0
6381 DO i = 1 , jlt
6382 is = nft+i
6383 IF (ikc_si(is)==0) THEN
6384 jlt_new = jlt_new + 1
6385 DO j = 1 , 3
6386 k11(j,j,jlt_new) = kss(j,is)
6387 ENDDO
6388 k11(1,2,jlt_new) = kss(4,is)
6389 k11(1,3,jlt_new) = kss(5,is)
6390 k11(2,3,jlt_new) = kss(6,is)
6391 off(jlt_new) = one
6392 ENDIF
6393 ENDDO
6394 jlt = jlt_new
6395 CALL assem_kii(isl(nft+1),jlt,iddl,iadk,k_diag,k_lt,k11,nd,off)
6396 ENDDO
6397C----6---------------------------------------------------------------7---------8
6398 RETURN
6399 END
6400!||====================================================================
6401!|| assfr_kij ../engine/source/mpi/implicit/imp_fri.F
6402!||--- called by ------------------------------------------------------
6403!|| ass_spmd ../engine/source/implicit/assem_int.F
6404!|| ass_spmd11 ../engine/source/implicit/assem_int.F
6405!||====================================================================
6406 SUBROUTINE assfr_kij( ID ,JD ,IADK ,JDIK,K_LT ,
6407 1 KIJ ,ND )
6408C----6---------------------------------------------------------------7---------8
6409C I m p l i c i t T y p e s
6410C-----------------------------------------------
6411#include "implicit_f.inc"
6412C-----------------------------------------------------------------
6413C D u m m y A r g u m e n t s
6414C-----------------------------------------------
6415 INTEGER ND
6416 INTEGER ID,JD,IADK(*),JDIK(*)
6417C REAL
6418 my_real
6419 . k_lt(*) ,kij(nd,nd)
6420C-----------------------------------------------
6421C L o c a l V a r i a b l e s
6422C-----------------------------------------------
6423 INTEGER I,J,K,JDL,L,JJ
6424C----6---------------------------------------------------------------7---------8
6425 DO k=1,nd
6426 jdl= -1
6427 DO jj = iadk(id+k),iadk(id+1+k)-1
6428C---------find l'adress dans LT-----
6429 IF (jdik(jj)==(jd+1)) THEN
6430 jdl = jj-1
6431 GOTO 300
6432 ENDIF
6433 ENDDO
6434 300 CONTINUE
6435 IF (jdl>=0) THEN
6436 DO l=1,nd
6437 k_lt(jdl+l) = k_lt(jdl+l) + kij(k,l)
6438 ENDDO
6439 ELSE
6440 ENDIF
6441 ENDDO
6442C
6443C----6---------------------------------------------------------------7---------8
6444 RETURN
6445 END
6446!||====================================================================
6447!|| getfr_kij ../engine/source/mpi/implicit/imp_fri.f
6448!||--- called by ------------------------------------------------------
6449!|| imp_frkm ../engine/source/mpi/implicit/imp_fri.F
6450!|| imp_fvkm ../engine/source/mpi/implicit/imp_fri.F
6451!|| ini_ksi ../engine/source/mpi/implicit/imp_fri.F
6452!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
6453!||====================================================================
6454 SUBROUTINE getfr_kij( ID ,JD ,IADK ,JDIK,K_LT ,
6455 1 KIJ ,NK ,NL )
6456C----6---------------------------------------------------------------7---------8
6457C I m p l i c i t T y p e s
6458C-----------------------------------------------
6459#include "implicit_f.inc"
6460C-----------------------------------------------------------------
6461C D u m m y A r g u m e n t s
6462C-----------------------------------------------
6463 INTEGER NK ,NL
6464 INTEGER ID,JD,IADK(*),JDIK(*)
6465C REAL
6466 my_real
6467 . K_LT(*) ,KIJ(NK,NL)
6468C-----------------------------------------------
6469C L o c a l V a r i a b l e s
6470C-----------------------------------------------
6471 INTEGER I,J,K,JDL,L,JJ
6472C----6---------------------------------------------------------------7---------8
6473 DO K=1,nk
6474 jdl=-1
6475 DO jj = iadk(id+k),iadk(id+1+k)-1
6476C---------find l'adress dans LT-----
6477 IF (jdik(jj)==(jd+1)) THEN
6478 jdl = jj-1
6479 GOTO 300
6480 ENDIF
6481 ENDDO
6482 300 CONTINUE
6483 IF (jdl>=0) THEN
6484 DO l=1,nl
6485 kij(k,l) = k_lt(jdl+l)
6486 ENDDO
6487 ELSE
6488 ENDIF
6489 ENDDO
6490C
6491C----6---------------------------------------------------------------7---------8
6492 RETURN
6493 END
6494!||====================================================================
6495!|| putfr_kij ../engine/source/mpi/implicit/imp_fri.F
6496!||====================================================================
6497 SUBROUTINE putfr_kij( ID ,JD ,IADK ,JDIK,K_LT ,
6498 1 KIJ ,NK ,NL )
6499C----6---------------------------------------------------------------7---------8
6500C I m p l i c i t T y p e s
6501C-----------------------------------------------
6502#include "implicit_f.inc"
6503C-----------------------------------------------------------------
6504C D u m m y A r g u m e n t s
6505C-----------------------------------------------
6506 INTEGER NK ,NL
6507 INTEGER ID,JD,IADK(*),JDIK(*)
6508C REAL
6509 my_real
6510 . k_lt(*) ,kij(nk,nl)
6511C-----------------------------------------------
6512C L o c a l V a r i a b l e s
6513C-----------------------------------------------
6514 INTEGER I,J,K,JDL,L,JJ
6515C----6---------------------------------------------------------------7---------8
6516 DO k=1,nk
6517 jdl=0
6518 DO jj = iadk(id+k),iadk(id+1+k)-1
6519C---------find l'adress dans LT-----
6520 IF (jdik(jj)==(jd+1)) THEN
6521 jdl = jj-1
6522 GOTO 300
6523 ENDIF
6524 ENDDO
6525 300 CONTINUE
6526 DO l=1,nl
6527 k_lt(jdl+l) = kij(k,l)
6528 ENDDO
6529 ENDDO
6530C
6531C----6---------------------------------------------------------------7---------8
6532 RETURN
6533 END
6534!||====================================================================
6535!|| kin_ksl ../engine/source/mpi/implicit/imp_fri.F
6536!||--- called by ------------------------------------------------------
6537!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
6538!||--- calls -----------------------------------------------------
6539!|| dim_kinfrk ../engine/source/mpi/implicit/imp_fri.F
6540!|| doub_nrs ../engine/source/mpi/implicit/imp_fri.F
6541!|| ind_kinfrk ../engine/source/mpi/implicit/imp_fri.F
6542!|| ini_slnr ../engine/source/mpi/implicit/imp_fri.F
6543!|| tag_ints ../engine/source/mpi/implicit/imp_fri.F
6544!||--- uses -----------------------------------------------------
6545!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
6546!||====================================================================
6547 SUBROUTINE kin_ksl(
6548 1 IPARI ,INTBUF_TAB,NINT2 ,IINT2 ,
6549 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
6550 3 X ,IBFV ,LJ ,SKEW ,XFRAME ,
6551 4 ISKEW ,ICODT ,NDOF ,ILOCP ,NSL ,
6552 5 IAD_M ,IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
6553C-----------------------------------------------
6554C M o d u l e s
6555C-----------------------------------------------
6556 USE intbufdef_mod
6557C----6---------------------------------------------------------------7---------8
6558C I m p l i c i t T y p e s
6559C-----------------------------------------------
6560#include "implicit_f.inc"
6561C-----------------------------------------------
6562C C o m m o n B l o c k s
6563C-----------------------------------------------
6564#include "com04_c.inc"
6565#include "param_c.inc"
6566C-----------------------------------------------------------------
6567C D u m m y A r g u m e n t s
6568C-----------------------------------------------
6569 INTEGER IPARI(NPARI,*),NSL
6570 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
6571 . NINT2,IINT2(*),ILOCP(*),NDOF(*) ,
6572 . IBFV(*),LJ(*),ISKEW(*),ICODT(*),IAD_M(*),
6573 . irbe3(*),lrbe3(*),irbe2(*),lrbe2(*)
6574C REAL
6575 my_real
6576 . x(3,*),skew(*),xframe(*)
6577 TYPE(intbuf_struct_) INTBUF_TAB(*)
6578C-----------------------------------------------
6579C L o c a l V a r i a b l e s
6580C-----------------------------------------------
6581 INTEGER LNS,LNS2,NNMAX,NZ,LNS3,LNS4
6582 INTEGER I,J,K,L,N_KINE,IA2(NINT2),IA(NRBYAC),NRS(NSL)
6583 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ICOL
6584C------------------------------------------------------------
6585 DO I =1,numnod
6586 ilocp(i)=0
6587 ENDDO
6588C--------N_KINE: nm, sl (no double)----
6589 n_kine=0
6590 CALL tag_ints(nsl ,ilocp ,n_kine)
6591C
6592 DO i=1,nsl
6593 nrs(i) = 0
6594 ENDDO
6595 CALL dim_kinfrk(
6596 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
6597 2 nint2 ,iint2 ,ipari ,intbuf_tab,ilocp ,
6598 3 ia ,ia2 ,nrs ,lns ,lns2 ,
6599 4 nsl ,irbe3 ,lrbe3 ,lns3 ,irbe2 ,
6600 5 lrbe2 ,lns4 )
6601C
6602 nnmax=0
6603 DO i=1,nsl
6604 nnmax=max(nnmax,nrs(i))
6605 nrs(i)=0
6606 ENDDO
6607 ALLOCATE(icol(nnmax,nsl))
6608 CALL ind_kinfrk(
6609 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
6610 2 nint2 ,iint2 ,ipari ,intbuf_tab,ilocp ,
6611 3 ia ,ia2 ,lns ,lns2 ,nsl ,
6612 4 ibfv ,lj ,iskew ,icodt ,nrs ,
6613 5 icol ,nnmax ,irbe3 ,lrbe3 ,lns3 ,
6614 6 irbe2 ,lrbe2 ,lns4 )
6615C
6616 CALL doub_nrs(nsl ,nnmax ,nrs ,icol ,ilocp )
6617 nz = 0
6618 DO i=1,nsl
6619 DO j=1,nrs(i)
6620 nz = nz+1
6621 ENDDO
6622 ENDDO
6623 CALL ini_slnr(nsl ,nnmax ,nrs ,icol ,nz ,
6624 . ndof ,iad_m )
6625 DEALLOCATE(icol)
6626C----6---------------------------------------------------------------7---------8
6627 RETURN
6628 END
6629!||====================================================================
6630!|| doub_nrs ../engine/source/mpi/implicit/imp_fri.F
6631!||--- called by ------------------------------------------------------
6632!|| kin_ksl ../engine/source/mpi/implicit/imp_fri.F
6633!||--- calls -----------------------------------------------------
6634!|| cp_int ../engine/source/implicit/produt_v.F
6635!||--- uses -----------------------------------------------------
6636!|| imp_intm ../engine/share/modules/imp_intm.F
6637!||====================================================================
6638 SUBROUTINE doub_nrs(NSL ,NNMAX ,NRS ,ICOL ,ILOCP )
6639C-----------------------------------------------
6640C M o d u l e s
6641C-----------------------------------------------
6642 USE imp_intm
6643C----6---------------------------------------------------------------7---------8
6644C I m p l i c i t T y p e s
6645C-----------------------------------------------
6646#include "implicit_f.inc"
6647C-----------------------------------------------------------------
6648C D u m m y A r g u m e n t s
6649C-----------------------------------------------
6650 INTEGER NSL,NNMAX ,NRS(*),ILOCP(*)
6651 INTEGER ICOL(NNMAX,*)
6652C REAL
6653C-----------------------------------------------
6654C L o c a l V a r i a b l e s
6655C-----------------------------------------------
6656 integer
6657 . i,j,k,n,nj
6658C----------------------------
6659C--- partie double--traitement diff. srem puisque [k]rem est dja construit
6660 DO i=1,nsl
6661 n = isl(i)
6662 k = ilocp(n)
6663 IF (nrs(i)<nrs(k)) THEN
6664 CALL cp_int(nrs(k),icol(1,k),icol(1,i))
6665 nrs(i) = nrs(k)
6666 ENDIF
6667 ENDDO
6668C----6---------------------------------------------------------------7---------8
6669 RETURN
6670 END
6671!||====================================================================
6672!|| ini_slnr ../engine/source/mpi/implicit/imp_fri.F
6673!||--- called by ------------------------------------------------------
6674!|| kin_kml ../engine/source/mpi/implicit/imp_fri.F
6675!|| kin_ksl ../engine/source/mpi/implicit/imp_fri.F
6676!||--- uses -----------------------------------------------------
6677!|| imp_intm ../engine/share/modules/imp_intm.F
6678!||====================================================================
6679 SUBROUTINE ini_slnr(NSL ,NNMAX ,NRS ,ICOL ,NZ ,
6680 . NDOF ,IAD_M )
6681C-----------------------------------------------
6682C M o d u l e s
6683C-----------------------------------------------
6684 USE imp_intm
6685C----6---------------------------------------------------------------7---------8
6686C I m p l i c i t T y p e s
6687C-----------------------------------------------
6688#include "implicit_f.inc"
6689C-----------------------------------------------------------------
6690C D u m m y A r g u m e n t s
6691C-----------------------------------------------
6692 INTEGER NSL,NZ,NNMAX ,NRS(*),NDOF(*),IAD_M(*)
6693 INTEGER ICOL(NNMAX,*)
6694C REAL
6695C-----------------------------------------------
6696C L o c a l V a r i a b l e s
6697C-----------------------------------------------
6698 INTEGER
6699 . i,j,k,n,nj
6700C----------------------------
6701 IF(ALLOCATED(iad_slnr)) DEALLOCATE(iad_slnr)
6702 ALLOCATE(iad_slnr(nsl+1))
6703 IF(ALLOCATED(jdi_slnr)) DEALLOCATE(jdi_slnr)
6704 ALLOCATE(jdi_slnr(nz))
6705 nz = 0
6706 iad_slnr(1) = nz+1
6707 DO n=1,nsl
6708 DO j=1,nrs(n)
6709 nj = icol(j,n)
6710 nz = nz+1
6711 jdi_slnr(nz) = nj
6712 ENDDO
6713 iad_slnr(n+1) = nz+1
6714 ENDDO
6715 nz = 0
6716 iad_m(1) = nz+1
6717 DO n=1,nsl
6718 IF (ikc_sl(n)>0) THEN
6719C I = ISL(N)
6720 DO j=1,max(1,nrs(n))
6721 nz = nz+ikc_sl(n)
6722 IF (nrs(n)>0) THEN
6723 nj = icol(j,n)
6724C----------IKC_SL=NREMS when it's called by KIN_KML
6725 IF (ndof(nj)==6) nz = nz+ikc_sl(n)
6726 ENDIF
6727 ENDDO
6728 ENDIF
6729 iad_m(n+1) = nz+1
6730 ENDDO
6731C----6---------------------------------------------------------------7---------8
6732 RETURN
6733 END
6734!||====================================================================
6735!|| dim_kinfrk ../engine/source/mpi/implicit/imp_fri.F
6736!||--- called by ------------------------------------------------------
6737!|| kin_kml ../engine/source/mpi/implicit/imp_fri.F
6738!|| kin_ksl ../engine/source/mpi/implicit/imp_fri.F
6739!||--- uses -----------------------------------------------------
6740!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
6741!||====================================================================
6742 SUBROUTINE dim_kinfrk(
6743 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
6744 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,INLOC ,
6745 3 IA ,IA2 ,NRS ,LNS ,LNS2 ,
6746 4 N_KINE ,IRBE3 ,LRBE3 ,LNS3 ,IRBE2 ,
6747 5 LRBE2 ,LNS4 )
6748C-----------------------------------------------
6749C M o d u l e s
6750C-----------------------------------------------
6751 USE intbufdef_mod
6752C----6---------------------------------------------------------------7---------8
6753C I m p l i c i t T y p e s
6754C-----------------------------------------------
6755#include "implicit_f.inc"
6756C-----------------------------------------------
6757C C o m m o n B l o c k s
6758C-----------------------------------------------
6759#include "com04_c.inc"
6760#include "param_c.inc"
6761C-----------------------------------------------------------------
6762C D u m m y A r g u m e n t s
6763C-----------------------------------------------
6764C INTEGER NNMAX,NKMAX
6765 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
6766 . NINT2,IINT2(*),IPARI(NPARI,*),
6767 . IRBE3(NRBE3L,*),LRBE3(*) ,LNS3 ,
6768 . IRBE2(NRBE2L,*),LRBE2(*) ,LNS4
6769 INTEGER
6770 . INLOC(*),NRS(*),LNS ,LNS2,N_KINE,IA(*),IA2(*)
6771C REAL
6772 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
6773C-----------------------------------------------
6774C L o c a l V a r i a b l e s
6775C-----------------------------------------------
6776 integer
6777 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,
6778 . ji,ns,nnod,iad
6779C----------------------------
6780 lns2=0
6781C--------int2---------
6782 DO j=1,nint2
6783 n=iint2(j)
6784 ia2(j)=0
6785 nsn = ipari(5,n)
6786 ji=ipari(1,n)
6787 DO i=1,nsn
6788 ni=intbuf_tab(n)%NSV(i)
6789 IF (inloc(ni)>0) THEN
6790 l=intbuf_tab(n)%IRTLM(ni)
6791 nl=4*(l-1)
6792 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
6793 nnod=3
6794 ELSE
6795 nnod=4
6796 ENDIF
6797 nk = inloc(ni)
6798 IF (nk>n_kine ) nk = nk - n_kine
6799 nrs(nk) = nrs(nk)+nnod
6800 ia2(j) = n
6801 lns2 = lns2+1
6802C--------si Mi est aussi dependant------
6803 DO k =1,nnod
6804 nj=intbuf_tab(n)%IRECTM(nl+k)
6805 IF (inloc(nj)==0) inloc(nj) = n_kine + inloc(ni)
6806 ENDDO
6807 ENDIF
6808 ENDDO
6809 ENDDO
6810C
6811 lns3=0
6812C--------RBE3---------
6813 DO i=1,nrbe3
6814 iad=irbe3(1,i)
6815 ni=irbe3(3,i)
6816 nnod=irbe3(5,i)
6817 IF (ni==0) cycle
6818 IF (inloc(ni)>0) THEN
6819 nk = inloc(ni)
6820 IF (nk>n_kine ) nk = nk - n_kine
6821 nrs(nk) = nrs(nk)+nnod
6822 lns3 = lns3+1
6823C--------si Mi est aussi dependant------
6824 DO k =1,nnod
6825 nj = lrbe3(iad+k)
6826 IF (inloc(nj)==0) inloc(nj) = n_kine + inloc(ni)
6827 ENDDO
6828 ENDIF
6829 ENDDO
6830C
6831 lns=0
6832C-----active rigid body main nodes------
6833 DO j=1,nrbyac
6834 ia(j)=0
6835 n=irbyac(j)
6836 k=irbyac(j+nrbykin)
6837 m =npby(1,n)
6838 nsn =npby(2,n)
6839 DO i=1,nsn
6840 id = i+k
6841 ni=lpby(id)
6842 nk = inloc(ni)
6843 IF (nk>n_kine) nk = inloc(ni)-n_kine
6844 IF (nk>0) THEN
6845 nrs(nk) = nrs(nk)+1
6846 ia(j)=n
6847 lns = lns+1
6848 IF (inloc(m)==0) inloc(m) = n_kine + inloc(ni)
6849 ENDIF
6850 ENDDO
6851 ENDDO
6852C-----RBE2------
6853 lns4=0
6854 DO j=1,nrbe2
6855 iad=irbe2(1,j)
6856 m =irbe2(3,j)
6857 nsn =irbe2(5,j)
6858 DO i=1,nsn
6859 id = i+iad
6860 ni=lrbe2(id)
6861 nk = inloc(ni)
6862 IF (nk>n_kine) nk = inloc(ni)-n_kine
6863 IF (nk>0) THEN
6864 nrs(nk) = nrs(nk)+1
6865 lns4 = lns4+1
6866 IF (inloc(m)==0) inloc(m) = n_kine + inloc(ni)
6867 ENDIF
6868 ENDDO
6869 ENDDO
6870C----6---------------------------------------------------------------7---------8
6871 RETURN
6872 END
6873!||====================================================================
6874!|| ind_kinfrk ../engine/source/mpi/implicit/imp_fri.F
6875!||--- called by ------------------------------------------------------
6876!|| kin_kml ../engine/source/mpi/implicit/imp_fri.F
6877!|| kin_ksl ../engine/source/mpi/implicit/imp_fri.F
6878!||--- calls -----------------------------------------------------
6879!|| reorder_a ../engine/source/implicit/ind_glob_k.F
6880!||--- uses -----------------------------------------------------
6881!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
6882!|| imp_intm ../engine/share/modules/imp_intm.F
6883!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
6884!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
6885!||====================================================================
6886 SUBROUTINE ind_kinfrk(
6887 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
6888 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,INLOC ,
6889 3 IA ,IA2 ,NSS ,NSS2 ,N_KINE ,
6890 4 IBFV ,LJ ,ISKEW ,ICODT ,NRS ,
6891 5 ICOL ,NNMAX ,IRBE3 ,LRBE3 ,LNS3 ,
6892 6 IRBE2 ,LRBE2 ,LNS4 )
6893C-----------------------------------------------
6894C M o d u l e s
6895C-----------------------------------------------
6896 USE imp_intm
6897 USE imp_rwl
6898 USE imp_aspc
6899 USE intbufdef_mod
6900C----6---------------------------------------------------------------7---------8
6901C I m p l i c i t T y p e s
6902C-----------------------------------------------
6903#include "implicit_f.inc"
6904C-----------------------------------------------
6905C C o m m o n B l o c k s
6906C-----------------------------------------------
6907#include "com04_c.inc"
6908#include "param_c.inc"
6909C-----------------------------------------------------------------
6910C D u m m y A r g u m e n t s
6911C-----------------------------------------------
6912 INTEGER NNMAX
6913 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
6914 . NINT2,IINT2(*),IPARI(NPARI,*),ISKEW(*),ICODT(*)
6915 INTEGER
6916 . INLOC(*),NSS,NSS2,N_KINE,IBFV(NIFV,*),LJ(*),ICOL(NNMAX,*),
6917 . ia(*),ia2(*),nrs(*),irbe3(nrbe3l,*),lrbe3(*),lns3 ,
6918 . irbe2(nrbe2l,*),lrbe2(*),lns4
6919C REAL
6920 TYPE(intbuf_struct_) INTBUF_TAB(*)
6921C-----------------------------------------------
6922C L o c a l V a r i a b l e s
6923C-----------------------------------------------
6924 integer
6925 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,
6926 . ji,iad,nnod,
6927 . ierror1,ierror2,ierror3,ierror4,ierror5,ierror6,ierror7
6928c----------------------
6929 ni2_fr=0
6930 ni2_frs=0
6931 IF (nss2>0) THEN
6932 IF(ALLOCATED(ifrs2)) DEALLOCATE(ifrs2)
6933 ALLOCATE(ifrs2(2,nss2),stat=ierror1)
6934 DO j=1,nint2
6935 n=ia2(j)
6936 IF (n>0) THEN
6937 nsn = ipari(5,n)
6938 ji=ipari(1,n)
6939 DO i=1,nsn
6940 ni=intbuf_tab(n)%NSV(i)
6941 nk = inloc(ni)
6942 IF (nk>n_kine) nk =nk-n_kine
6943 IF (nk>0) THEN
6944 l=intbuf_tab(n)%IRTLM(ni)
6945 nl=4*(l-1)
6946 DO k =1,4
6947 nj=intbuf_tab(n)%IRECTM(nl+k)
6948 CALL reorder_a(nrs(nk),icol(1,nk),nj)
6949 ENDDO
6950 ni2_fr=ni2_fr+1
6951 ifrs2(1,ni2_fr)=n
6952 ifrs2(2,ni2_fr)=i
6953 ENDIF
6954 ENDDO
6955 ENDIF
6956 ENDDO
6957 ENDIF
6958C-----RBE2------
6959 nrbe2_fr=0
6960 nrbe2_frs=0
6961 IF (lns4>0) THEN
6962 IF(ALLOCATED(ifrs4)) DEALLOCATE(ifrsr)
6963 ALLOCATE(ifrs4(2,lns4),stat=ierror2)
6964 DO n=1,nrbe2
6965 iad=irbe2(1,n)
6966 m =irbe2(3,n)
6967 IF (inloc(m)>0) THEN
6968 nsn =irbe2(5,n)
6969 DO i=1,nsn
6970 id = i+iad
6971 ni=lrbe2(id)
6972 nk = inloc(ni)
6973 IF (nk>n_kine) nk = inloc(ni)-n_kine
6974 IF (nk>0) THEN
6975 CALL reorder_a(nrs(nk),icol(1,nk),m)
6976 nrbe2_fr=nrbe2_fr+1
6977 ifrs4(1,nrbe2_fr)=n
6978 ifrs4(2,nrbe2_fr)=ni
6979 ENDIF
6980 ENDDO
6981 ENDIF
6982 ENDDO
6983 ENDIF
6984c--------RBE3--------------
6985 nrbe3_fr=0
6986 nrbe3_frs=0
6987 IF (lns3>0) THEN
6988 IF(ALLOCATED(ifrs3)) DEALLOCATE(ifrs3)
6989 ALLOCATE(ifrs3(lns3),stat=ierror1)
6990 DO n=1,nrbe3
6991 iad=irbe3(1,n)
6992 ni=irbe3(3,n)
6993 nnod=irbe3(5,n)
6994 IF (ni==0) cycle
6995 IF (inloc(ni)>0) THEN
6996 nk = inloc(ni)
6997 IF (nk>n_kine) nk =nk-n_kine
6998 DO k =1,nnod
6999 nj = lrbe3(iad+k)
7000 CALL reorder_a(nrs(nk),icol(1,nk),nj)
7001 ENDDO
7002 nrbe3_fr=nrbe3_fr+1
7003 ifrs3(nrbe3_fr)=n
7004 ENDIF
7005 ENDDO
7006 ENDIF
7007C-----active rigid body main nodes------
7008 nrb_fr=0
7009 nrb_frs=0
7010 IF (nss>0) THEN
7011 IF(ALLOCATED(ifrsr)) DEALLOCATE(ifrsr)
7012 ALLOCATE(ifrsr(2,nss),stat=ierror2)
7013 DO j=1,nrbyac
7014 n=ia(j)
7015 IF (n>0) THEN
7016 k=irbyac(j+nrbykin)
7017 m =npby(1,n)
7018 IF (inloc(m)>0) THEN
7019 nsn =npby(2,n)
7020 DO i=1,nsn
7021 id = i+k
7022 ni=lpby(id)
7023 nk = inloc(ni)
7024 IF (nk>n_kine) nk = inloc(ni)-n_kine
7025 IF (nk>0) THEN
7026 CALL reorder_a(nrs(nk),icol(1,nk),m)
7027 nrb_fr=nrb_fr+1
7028 ifrsr(1,nrb_fr)=m
7029 ifrsr(2,nrb_fr)=ni
7030 ENDIF
7031 ENDDO
7032 ENDIF
7033 ENDIF
7034 ENDDO
7035 ENDIF
7036C+++ BC. LOCAL
7037 nbc_fr = 0
7038 DO n=1,numnod
7039 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
7040 IF (inloc(n)>0)nbc_fr = nbc_fr + 1
7041 ENDIF
7042 ENDDO
7043 IF (nbc_fr>0) THEN
7044 IF(ALLOCATED(ibc_fr)) DEALLOCATE(ibc_fr)
7045 ALLOCATE(ibc_fr(3,nbc_fr),stat=ierror5)
7046 nbc_fr = 0
7047 DO n=1,numnod
7048 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
7049 IF (inloc(n)>0) THEN
7050 nbc_fr = nbc_fr + 1
7051 ibc_fr(1,nbc_fr) = n
7052 ibc_fr(2,nbc_fr) = iskew(n)
7053 ibc_fr(3,nbc_fr) = icodt(n)
7054 ENDIF
7055 ENDIF
7056 ENDDO
7057 ENDIF
7058C+++ AUTOSPC
7059 nspc_fr = 0
7060 DO n=1,nspcl
7061 i = in_spc(n)
7062 IF (inloc(n)>0.AND.ic_spc(n)<=3)nspc_fr = nspc_fr + 1
7063 ENDDO
7064 IF (nspc_fr>0) THEN
7065 IF(ALLOCATED(ispc_fr)) DEALLOCATE(ispc_fr)
7066 ALLOCATE(ispc_fr(nspc_fr),stat=ierror5)
7067 nspc_fr = 0
7068 DO n=1,nspcl
7069 i = in_spc(n)
7070 IF (inloc(n)>0.AND.ic_spc(n)<=3) THEN
7071 nspc_fr = nspc_fr + 1
7072 ispc_fr(nspc_fr)= n
7073 ENDIF
7074 ENDDO
7075 ENDIF
7076C +++ FV---local
7077 nfx_fr = 0
7078 DO j=1,nfxvel
7079 IF (lj(j)>0.AND.lj(j)<=3) THEN
7080 n=iabs(ibfv(1,j))
7081 IF (inloc(n)>0)nfx_fr = nfx_fr + 1
7082 ENDIF
7083 ENDDO
7084 IF (nfx_fr>0) THEN
7085 IF(ALLOCATED(ifx_fr)) DEALLOCATE(ifx_fr)
7086 ALLOCATE(ifx_fr(2,nfx_fr),stat=ierror6)
7087 nfx_fr = 0
7088 DO j=1,nfxvel
7089 IF (lj(j)>0.AND.lj(j)<=3) THEN
7090 n=iabs(ibfv(1,j))
7091 IF (inloc(n)>0) THEN
7092 nfx_fr = nfx_fr + 1
7093 ifx_fr(1,nfx_fr) = j
7094 ifx_fr(2,nfx_fr) = lj(j)
7095 ENDIF
7096 ENDIF
7097 ENDDO
7098 ENDIF
7099C ---
7100C +++ sliding rigid wall---
7101 nrw_fr = 0
7102 DO j=1,n_rwl
7103 n=in_rwl(j)
7104 IF (inloc(n)>0) nrw_fr = nrw_fr + 1
7105 ENDDO
7106 IF (nrw_fr>0) THEN
7107 IF(ALLOCATED(irw_fr)) DEALLOCATE(irw_fr)
7108 ALLOCATE(irw_fr(nrw_fr),stat=ierror7)
7109 nrw_fr = 0
7110 DO j=1,n_rwl
7111 n=in_rwl(j)
7112 IF (inloc(n)>0) THEN
7113 nrw_fr = nrw_fr + 1
7114 irw_fr(nrw_fr) = j
7115 ENDIF
7116 ENDDO
7117 ENDIF
7118C ---
7119C----6---------------------------------------------------------------7---------8
7120 RETURN
7121 END
7122!||====================================================================
7123!|| get_iad ../engine/source/mpi/implicit/imp_fri.F
7124!||--- called by ------------------------------------------------------
7125!|| imp_fvkm ../engine/source/mpi/implicit/imp_fri.F
7126!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
7127!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.F
7128!||--- calls -----------------------------------------------------
7129!|| intabfr ../engine/source/mpi/implicit/imp_fri.F
7130!||====================================================================
7131 SUBROUTINE get_iad(IAD_M ,IAD_S ,JDI_S ,NM ,IS ,
7132 1 J ,NRJ ,NDOF ,IAD )
7133C----6---------------------------------------------------------------7---------8
7134C I m p l i c i t T y p e s
7135C-----------------------------------------------
7136#include "implicit_f.inc"
7137C-----------------------------------------------------------------
7138C D u m m y A r g u m e n t s
7139C-----------------------------------------------
7140 INTEGER IAD_M(*),IAD_S(*),JDI_S(*),NM ,NS,J,IAD,NRJ ,NDOF(*)
7141C REAL
7142C-----------------------------------------------
7143C L o c a l V a r i a b l e s
7144C-----------------------------------------------
7145 INTEGER I,K,NR,L,IS,NK,NZ,NJ,I0,ID
7146C----6---------------------------------------------------------------7---------8
7147 nr =iad_s(is+1)-iad_s(is)
7148 l = iad_m(is)
7149 nk =(iad_m(is+1)-iad_m(is))/nrj
7150 iad = l+(j-1)*nk
7151 IF (nm>0.AND.nr>0) THEN
7152 i0=iad_s(is)
7153 CALL intabfr(nr,jdi_s(i0),nm,id)
7154 IF (id>0) THEN
7155 nz = 0
7156 DO i = 1,id-1
7157 nj = jdi_s(i0+i-1)
7158 IF (ndof(nj)==6) THEN
7159 nz = nz + 2
7160 ELSE
7161 nz = nz +1
7162 ENDIF
7163 ENDDO
7164 iad = iad + nz
7165 ELSE
7166 iad = 0
7167 ENDIF
7168 ENDIF
7169C
7170C----6---------------------------------------------------------------7---------8
7171 RETURN
7172 END
7173!||====================================================================
7174!|| ikincf ../engine/source/mpi/implicit/imp_fri.F
7175!||--- called by ------------------------------------------------------
7176!|| dim_frkm1 ../engine/source/mpi/implicit/imp_fri.F
7177!|| tra_frkm ../engine/source/mpi/implicit/imp_fri.F
7178!||====================================================================
7179 LOGICAL FUNCTION ikincf(I)
7180C----6---------------------------------------------------------------7---------8
7181C I m p l i c i t T y p e s
7182C-----------------------------------------------
7183#include "implicit_f.inc"
7184C-----------------------------------------------------------------
7185C D u m m y A r g u m e n t s
7186C-----------------------------------------------
7187 INTEGER i
7188C-----------------------------------------------
7189C L o c a l V a r i a b l e s
7190C-----------------------------------------------
7191C----6---------------------------------------------------------------7---------8
7192 IF (i==0.OR.(i>=2.AND.i<=4).OR.i==9) THEN
7193 ikincf =.true.
7194 ELSE
7195 ikincf =.false.
7196 ENDIF
7197C
7198 RETURN
7199 END
7200!||====================================================================
7201!|| dim_frkm1 ../engine/source/mpi/implicit/imp_fri.f
7202!||--- called by ------------------------------------------------------
7203!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
7204!||--- calls -----------------------------------------------------
7205!|| ikincf ../engine/source/mpi/implicit/imp_fri.F
7206!|| spmd_isr ../engine/source/mpi/implicit/imp_spmd.F
7207!||--- uses -----------------------------------------------------
7208!|| imp_intm ../engine/share/modules/imp_intm.F
7209!||====================================================================
7210 SUBROUTINE dim_frkm1(NSREM,NSL ,IDDL ,IKC ,NDOF ,
7211 . NF_SI,NF_SL,LSI ,LSL ,MSI,MSL)
7212C-----------------------------------------------
7213C M o d u l e s
7214C-----------------------------------------------
7215 USE imp_intm
7216C-----------------------------------------------
7217C I m p l i c i t T y p e s
7218C-----------------------------------------------
7219#include "implicit_f.inc"
7220C-----------------------------------------------
7221C D u m m y A r g u m e n t s
7222C-----------------------------------------------
7223 INTEGER NSREM ,NSL ,LSI,LSL ,NF_SL(*),NF_SI(*),
7224 . iddl(*) ,ikc(*) ,ndof(*) ,msi,msl
7225C REAL
7226C-----------------------------------------------
7227C External function
7228C-----------------------------------------------
7229 LOGICAL IKINCF
7230 EXTERNAL ikincf
7231C-----------------------------------------------
7232C L o c a l V a r i a b l e s
7233C-----------------------------------------------
7234 INTEGER I,J,N,ID,NFAC,NJ
7235C----------NF_SL : new nm times of [K]3x3- of dependant---------------------------
7236 DO i = 1, nsl
7237 IF (ikc_sl(i)>0) THEN
7238 n = isl(i)
7239 id = iddl(n)
7240 IF (ndof(n)==0.OR.(ikc(id+1)/=0.AND.ikc(id+2)/=0
7241 . .AND.ikc(id+3)/=0)) THEN
7242 nfac=0
7243 DO j=iad_slnr(i),iad_slnr(i+1)-1
7244 nj = jdi_slnr(j)
7245 id = iddl(nj)
7246 IF (ikincf(ikc(id+1)).OR.ikincf(ikc(id+2)).OR.
7247 . ikincf(ikc(id+3)))
7248 . nfac = nfac +1
7249 IF (ndof(nj)==6) THEN
7250 IF (ikincf(ikc(id+4)).OR.ikincf(ikc(id+5)).OR.
7251 . ikincf(ikc(id+6)))
7252 . nfac = nfac +1
7253 ENDIF
7254 ENDDO
7255Ctmp cas particulier d_imp dans tous les directions
7256 IF (ndof(n)>0.AND.iad_slnr(i)==iad_slnr(i+1))nfac = 1
7257 ELSE
7258 nfac = 1
7259 ENDIF
7260 nf_sl(i) = nfac
7261 ELSE
7262 nf_sl(i) = 0
7263 ENDIF
7264 ENDDO
7265C
7266 CALL spmd_isr(iad_sl,iad_srem,nf_sl,nf_si,nsl ,nsrem )
7267C -----new nb. [k] modifie SL,SI---for com---ISL for IKC(3,M)
7268 msl = 0
7269 lsl = 0
7270 DO i = 1, nsl
7271 IF (ikc_sl(i)>0) THEN
7272 msl = msl + nf_sl(i)
7273 lsl = lsl + ikc_sl(i)*nf_sl(i)
7274 ENDIF
7275 ENDDO
7276c
7277 msi = 0
7278 lsi = 0
7279 DO i = 1, nsrem
7280 IF (ikc_si(i)>0) THEN
7281 msi = msi + nf_si(i)
7282 lsi = lsi + ikc_si(i)*nf_si(i)
7283 ENDIF
7284 ENDDO
7285C
7286 RETURN
7287 END
7288!||====================================================================
7289!|| tra_frkm ../engine/source/mpi/implicit/imp_fri.F
7290!||--- called by ------------------------------------------------------
7291!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
7292!||--- calls -----------------------------------------------------
7293!|| cp_real ../engine/source/implicit/produt_v.F
7294!|| ikincf ../engine/source/mpi/implicit/imp_fri.F
7295!||--- uses -----------------------------------------------------
7296!|| imp_intm ../engine/share/modules/imp_intm.F
7297!||====================================================================
7298 SUBROUTINE tra_frkm(NSL ,IDDL ,IKC ,NDOF ,IAD_M,
7299 . KSI ,KSL ,IKCSL )
7300C-----------------------------------------------
7301C M o d u l e s
7302C-----------------------------------------------
7303 USE imp_intm
7304C-----------------------------------------------
7305C I m p l i c i t T y p e s
7306C-----------------------------------------------
7307#include "implicit_f.inc"
7308C-----------------------------------------------
7309C D u m m y A r g u m e n t s
7310C-----------------------------------------------
7311 INTEGER NSL,IDDL(*),IKC(*),NDOF(*),IAD_M(*),IKCSL(3,*)
7312C REAL
7313 my_real
7314 . ksi(9,*),ksl(9,*)
7315C-----------------------------------------------
7316C External function
7317C-----------------------------------------------
7318 LOGICAL IKINCF
7319 EXTERNAL IKINCF
7320C-----------------------------------------------
7321C L o c a l V a r i a b l e s
7322C-----------------------------------------------
7323 INTEGER I,J,K,N,ID,IADI,IADL,SIZE,NJ,NB,IDM,NKC
7324 LOGICAL NODOF
7325C-------------------------------------
7326 SIZE = 9
7327 iadl=1
7328 DO i = 1, nsl
7329 IF (ikc_sl(i)>0) THEN
7330 iadi=iad_m(i)
7331 n = isl(i)
7332 id = iddl(n)
7333 IF (ndof(n)==0.OR.(ikc(id+1)/=0.AND.ikc(id+2)/=0
7334 . .AND.ikc(id+3)/=0)) THEN
7335 nodof = .true.
7336 ELSE
7337 nodof = .false.
7338 END IF
7339C
7340 DO j = 1, ikc_sl(i)
7341 DO k=iad_slnr(i),iad_slnr(i+1)-1
7342 nj = jdi_slnr(k)
7343 id = iddl(nj)
7344 IF (nodof.AND.(ikincf(ikc(id+1)).OR.ikincf(ikc(id+2)).OR.
7345 . ikincf(ikc(id+3)))) THEN
7346 CALL cp_real(SIZE,ksi(1,iadi),ksl(1,iadl))
7347 iadl=iadl+1
7348 ENDIF
7349 iadi=iadi+1
7350 IF (ndof(nj)==6) THEN
7351 IF (nodof.AND.(ikincf(ikc(id+4)).OR.ikincf(ikc(id+5)).OR.
7352 . ikincf(ikc(id+6)))) THEN
7353 CALL cp_real(SIZE,ksi(1,iadi),ksl(1,iadl))
7354 iadl=iadl+1
7355 ENDIF
7356 iadi=iadi+1
7357 ENDIF
7358 ENDDO
7359Ctmp cas particulier d_imp dans tous les directions
7360 IF (nodof) THEN
7361 IF (ndof(n)>0.AND.iad_slnr(i)==iad_slnr(i+1))THEN
7362 nb = SIZE
7363 CALL cp_real(nb,ksi(1,iadi),ksl(1,iadl))
7364 iadl=iadl+1
7365 ENDIF
7366 ELSE
7367 nb = SIZE
7368 CALL cp_real(nb,ksi(1,iadi),ksl(1,iadl))
7369 iadl=iadl+1
7370C------case /BCS
7371 IF (iad_slnr(i)==iad_slnr(i+1)) iadi = iadi + 1
7372 ENDIF
7373C
7374 END DO !J = 1, IKC_SL(I)
7375C
7376 ENDIF
7377 ENDDO
7378C------init IKCSL-------
7379 iadi = 1
7380 DO i = 1, nsl
7381 n = isl(i)
7382 IF (ikc_sl(i)>0) THEN
7383 DO j=iad_slnr(i),iad_slnr(i+1)-1
7384 nj = jdi_slnr(j)
7385 id = iddl(nj)
7386 IF (ikincf(ikc(id+1)).OR.ikincf(ikc(id+2)).OR.
7387 . ikincf(ikc(id+3))) THEN
7388 DO k =1,3
7389 ikcsl(k,iadi) = ikc(id+k)
7390 ENDDO
7391 iadi = iadi + 1
7392 ENDIF
7393 IF (ndof(nj)==6) THEN
7394 IF (ikincf(ikc(id+4)).OR.ikincf(ikc(id+5)).OR.
7395 . ikincf(ikc(id+6))) THEN
7396 DO k =1,3
7397 ikcsl(k,iadi) = ikc(id+k+3)
7398 ENDDO
7399 iadi = iadi + 1
7400 ENDIF
7401 ENDIF
7402 ENDDO
7403C----------other kin------------
7404 IF (iad_slnr(i)==iad_slnr(i+1).AND.ndof(n)>0) THEN
7405 id = iddl(n)
7406 IF (ikincf(ikc(id+1)).OR.ikincf(ikc(id+2)).OR.
7407 . ikincf(ikc(id+3))) THEN
7408 DO k =1,3
7409 ikcsl(k,iadi) = ikc(id+k)
7410 ENDDO
7411 iadi = iadi + 1
7412 ENDIF
7413 ENDIF
7414 ENDIF
7415 ENDDO
7416C
7417 RETURN
7418 END
7419!||====================================================================
7420!|| kin_kml ../engine/source/mpi/implicit/imp_fri.F
7421!||--- called by ------------------------------------------------------
7422!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
7423!||--- calls -----------------------------------------------------
7424!|| dim_kinfrk ../engine/source/mpi/implicit/imp_fri.F
7425!|| ind_kinfrk ../engine/source/mpi/implicit/imp_fri.F
7426!|| ini_slnr ../engine/source/mpi/implicit/imp_fri.F
7427!||--- uses -----------------------------------------------------
7428!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7429!||====================================================================
7430 SUBROUTINE kin_kml(
7431 1 IPARI ,INTBUF_TAB,NINT2 ,IINT2 ,
7432 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
7433 3 X ,IBFV ,LJ ,SKEW ,XFRAME ,
7434 4 ISKEW ,ICODT ,NDOF ,ILOCP ,NSREM ,
7435 5 IDDL ,IKC ,IAD_M ,NML ,IRBE3 ,
7436 6 LRBE3 ,IRBE2 ,LRBE2 )
7437C-----------------------------------------------
7438C M o d u l e s
7439C-----------------------------------------------
7440 USE intbufdef_mod
7441C----6---------------------------------------------------------------7---------8
7442C I m p l i c i t T y p e s
7443C-----------------------------------------------
7444#include "implicit_f.inc"
7445C-----------------------------------------------
7446C C o m m o n B l o c k s
7447C-----------------------------------------------
7448#include "param_c.inc"
7449C-----------------------------------------------------------------
7450C D u m m y A r g u m e n t s
7451C-----------------------------------------------
7452 INTEGER IBFV(NIFV,*),IPARI(NPARI,*),NSREM,NML
7453 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
7454 . NINT2,IINT2(*),ILOCP(*),NDOF(*) ,IDDL(*) ,IKC(*),
7455 . LJ(*),ISKEW(*),ICODT(*),IAD_M(*),IRBE3(*),LRBE3(*),
7456 . IRBE2(*),LRBE2(*)
7457C REAL
7458 my_real
7459 . X(3,*),SKEW(*),XFRAME(*)
7460 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
7461C-----------------------------------------------
7462C L o c a l V a r i a b l e s
7463C-----------------------------------------------
7464 INTEGER LNS,LNS2,NNMAX,NZ,LNS3,LNS4
7465 INTEGER I,J,K,L,N_KINE,IA2(NINT2),IA(NRBYAC)
7466 INTEGER, DIMENSION(:), ALLOCATABLE :: ICOL,NRS
7467C------------------------------------------------------------
7468 ALLOCATE(nrs(nml))
7469C
7470 DO i=1,nml
7471 nrs(i) = 0
7472 ENDDO
7473 CALL dim_kinfrk(
7474 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
7475 2 nint2 ,iint2 ,ipari ,intbuf_tab,ilocp ,
7476 3 ia ,ia2 ,nrs ,lns ,lns2 ,
7477 4 nml ,irbe3 ,lrbe3 ,lns3 ,irbe2 ,
7478 5 lrbe2 ,lns4 )
7479C
7480 nnmax=0
7481 DO i=1,nml
7482 nnmax=max(nnmax,nrs(i))
7483 nrs(i)=0
7484 ENDDO
7485 ALLOCATE(icol(nnmax*nml))
7486C--------ICOL(NNMAX,NML) for independent nodes----
7487 CALL ind_kinfrk(
7488 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
7489 2 nint2 ,iint2 ,ipari ,intbuf_tab,ilocp ,
7490 3 ia ,ia2 ,lns ,lns2 ,nml ,
7491 4 ibfv ,lj ,iskew ,icodt ,nrs ,
7492 5 icol ,nnmax ,irbe3 ,lrbe3 ,lns3 ,
7493 6 irbe2 ,lrbe2 ,lns4 )
7494C
7495 nz = 0
7496 DO i=1,nml
7497 DO j=1,nrs(i)
7498 nz = nz+1
7499 ENDDO
7500 ENDDO
7501 CALL ini_slnr(nml ,nnmax ,nrs ,icol ,nz ,
7502 . ndof ,iad_m )
7503 DEALLOCATE(nrs)
7504 DEALLOCATE(icol)
7505C----6---------------------------------------------------------------7---------8
7506 RETURN
7507 END
7508!||====================================================================
7509!|| tag_intml ../engine/source/mpi/implicit/imp_fri.F
7510!||--- called by ------------------------------------------------------
7511!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
7512!||--- uses -----------------------------------------------------
7513!|| imp_intm ../engine/share/modules/imp_intm.F
7514!||====================================================================
7515 SUBROUTINE tag_intml(NSREM ,ILOC ,N_IMPN ,IDDL ,IKC ,
7516 . NDOF ,LSI )
7517C-----------------------------------------------
7518C M o d u l e s
7519C-----------------------------------------------
7520 USE imp_intm
7521C----6---------------------------------------------------------------7---------8
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 NSREM,ILOC(*),N_IMPN,IDDL(*) ,IKC(*) ,NDOF(*) ,LSI
7529C REAL
7530C-----------------------------------------------
7531C L o c a l V a r i a b l e s
7532C-----------------------------------------------
7533 INTEGER I,J,N,IG,NM,NDD,ID,IER1,IER2
7534C-----------------------------------------------
7535 DO i = 1, nsrem
7536 DO j =iad_sinr(i),iad_sinr(i+1)-1
7537 ig = jdi_sinr(j)
7538 IF (iloc(ig)==0) THEN
7539 n_impn = n_impn + 1
7540 iloc(ig) = n_impn
7541 ENDIF
7542 ENDDO
7543 ENDDO
7544C---------------
7545 nml = n_impn
7546 IF(ALLOCATED(iml)) DEALLOCATE(iml)
7547 ALLOCATE(iml(nml),stat=ier1)
7548 DO i = 1, nsrem
7549 DO j =iad_sinr(i),iad_sinr(i+1)-1
7550 ig = jdi_sinr(j)
7551 nm = iloc(ig)
7552 iml(nm) = ig
7553 ENDDO
7554 ENDDO
7555C--------use also IKC_SL for ml IFLAG_KC ONLY----
7556 IF(ALLOCATED(ikc_sl)) DEALLOCATE(ikc_sl)
7557 ALLOCATE(ikc_sl(nml),stat=ier2)
7558 lsi = 0
7559 DO i = 1, nml
7560 n = iml(i)
7561 id = iddl(n)
7562 ndd = 0
7563 DO j = 1 , min(3,ndof(n))
7564 ndd = ndd + ikc(id+j)
7565 ENDDO
7566 IF (ndof(n)==0.OR.ndd>0) ndd = nsrem
7567 ikc_sl(i) = ndd
7568 lsi = lsi + ndd
7569 ENDDO
7570C----6---------------------------------------------------------------7---------8
7571 RETURN
7572 END
7573!||====================================================================
7574!|| scom_frk ../engine/source/mpi/implicit/imp_fri.F
7575!||--- called by ------------------------------------------------------
7576!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
7577!||--- calls -----------------------------------------------------
7578!|| spmd_exck ../engine/source/mpi/implicit/imp_spmd.F
7579!||--- uses -----------------------------------------------------
7580!|| imp_intm ../engine/share/modules/imp_intm.F
7581!||====================================================================
7582 SUBROUTINE scom_frk(KS11,KR11,SSIZE ,RSIZE)
7583C-----------------------------------------------
7584C M o d u l e s
7585C-----------------------------------------------
7586 USE imp_intm
7587C-----------------------------------------------
7588C I m p l i c i t T y p e s
7589C-----------------------------------------------
7590#include "implicit_f.inc"
7591C-----------------------------------------------
7592C C o m m o n B l o c k s
7593C-----------------------------------------------
7594#include "com01_c.inc"
7595C-----------------------------------------------
7596C D u m m y A r g u m e n t s
7597C-----------------------------------------------
7598 INTEGER SSIZE ,RSIZE
7599 my_real
7600 . KS11(9,*),KR11(9,*)
7601C-----------------------------------------------
7602C L o c a l V a r i a b l e s
7603C-----------------------------------------------
7604 INTEGER I,J,SIZE,IAD_S(NSPMD+1),IAD_R(NSPMD+1)
7605C-----------------------------------------------
7606C S o u r c e L i n e s
7607C-----------------------------------------------
7608 SIZE = 9
7609 iad_s(1) = 1
7610 iad_r(1) = 1
7611 DO i=1,nspmd
7612 iad_s(i+1) = iad_s(i)
7613 iad_r(i+1) = iad_r(i)
7614 DO j=iad_srem(i),iad_srem(i+1)-1
7615 iad_s(i+1) = iad_s(i+1) + ikc_si(j)
7616 END DO
7617 DO j=iad_sl(i),iad_sl(i+1)-1
7618 iad_r(i+1) = iad_r(i+1) + ikc_sl(j)
7619 END DO
7620 END DO
7621C
7622 CALL spmd_exck(ks11,kr11,iad_s,iad_r,SIZE ,ssize,rsize)
7623C
7624 RETURN
7625 END
7626!||====================================================================
7627!|| scom_frk1 ../engine/source/mpi/implicit/imp_fri.F
7628!||--- called by ------------------------------------------------------
7629!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.f
7630!||--- calls -----------------------------------------------------
7631!|| spmd_exci ../engine/source/mpi/implicit/imp_spmd.F
7632!|| spmd_exck ../engine/source/mpi/implicit/imp_spmd.F
7633!||--- uses -----------------------------------------------------
7634!|| imp_intm ../engine/share/modules/imp_intm.F
7635!||====================================================================
7636 SUBROUTINE scom_frk1(KS11,KR11,NFACS,NFACR,IKCS ,IKCR )
7637C-----------------------------------------------
7638C M o d u l e s
7639C-----------------------------------------------
7640 USE imp_intm
7641C-----------------------------------------------
7642C I m p l i c i t T y p e s
7643C-----------------------------------------------
7644#include "implicit_f.inc"
7645C-----------------------------------------------
7646C C o m m o n B l o c k s
7647C-----------------------------------------------
7648#include "com01_c.inc"
7649C-----------------------------------------------
7650C D u m m y A r g u m e n t s
7651C-----------------------------------------------
7652 INTEGER NFACS(*),NFACR(*),IKCS(3,*),IKCR(3,*)
7653 my_real
7654 . ks11(9,*),kr11(9,*)
7655C-----------------------------------------------
7656C L o c a l V a r i a b l e s
7657C-----------------------------------------------
7658 INTEGER I,J,SSIZE,RSIZE,SIZE,IAD_S(NSPMD+1),IAD_R(NSPMD+1)
7659C-----------------------------------------------
7660C S o u r c e L i n e s
7661C-----------------------------------------------
7662 IAD_S(1) = 1
7663 iad_r(1) = 1
7664 DO i=1,nspmd
7665 iad_s(i+1) = iad_s(i)
7666 iad_r(i+1) = iad_r(i)
7667 DO j=iad_sl(i),iad_sl(i+1)-1
7668 iad_s(i+1) = iad_s(i+1) + nfacs(j)
7669 END DO
7670 DO j=iad_srem(i),iad_srem(i+1)-1
7671 iad_r(i+1) = iad_r(i+1) + nfacr(j)
7672 END DO
7673 END DO
7674C
7675 SIZE = 3
7676 ssize = iad_s(nspmd+1) - 1
7677 rsize = iad_r(nspmd+1) - 1
7678 CALL spmd_exci(ikcs,ikcr,iad_s,iad_r,SIZE ,ssize,rsize)
7679 SIZE = 9
7680 iad_s(1) = 1
7681 iad_r(1) = 1
7682 DO i=1,nspmd
7683 iad_s(i+1) = iad_s(i)
7684 iad_r(i+1) = iad_r(i)
7685 DO j=iad_sl(i),iad_sl(i+1)-1
7686 iad_s(i+1) = iad_s(i+1) + nfacs(j)*ikc_sl(j)
7687 END DO
7688 DO j=iad_srem(i),iad_srem(i+1)-1
7689 iad_r(i+1) = iad_r(i+1) + nfacr(j)*ikc_si(j)
7690 END DO
7691 END DO
7692 ssize = iad_s(nspmd+1) - 1
7693 rsize = iad_r(nspmd+1) - 1
7694 CALL spmd_exck(ks11,kr11,iad_s,iad_r,SIZE ,ssize,rsize)
7695C
7696 RETURN
7697 END
7698!||====================================================================
7699!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
7700!||--- called by ------------------------------------------------------
7701!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
7702!||--- calls -----------------------------------------------------
7703!|| bc_updfr ../engine/source/constraints/general/bcs/bc_imp0.F
7704!|| bc_updfr2 ../engine/source/constraints/general/bcs/bc_imp0.F
7705!|| bcl_frk ../engine/source/constraints/general/bcs/bc_imp0.F
7706!|| cp_real ../engine/source/implicit/produt_v.F
7707!|| fv_updfr ../engine/source/constraints/general/impvel/fv_imp0.F
7708!|| fvl_frk ../engine/source/constraints/general/impvel/fv_imp0.F
7709!|| get_iad ../engine/source/mpi/implicit/imp_fri.F
7710!|| getfr_kij ../engine/source/mpi/implicit/imp_fri.F
7711!|| i2_frk0 ../engine/source/interfaces/interf/i2_imp1.F
7712!|| i2_frk1 ../engine/source/interfaces/interf/i2_imp1.F
7713!|| intabfr ../engine/source/mpi/implicit/imp_fri.F
7714!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.F
7715!|| prerbe2fr ../engine/source/constraints/general/rbe2/rbe2f.F
7716!|| prerbe3fr ../engine/source/constraints/general/rbe3/rbe3f.F
7717!|| rbe2_frk ../engine/source/constraints/general/rbe2/rbe2_imp0.F
7718!|| rbe3_fr0 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
7719!|| rby_frk ../engine/source/constraints/general/rbody/rby_imp0.F
7720!||--- uses -----------------------------------------------------
7721!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
7722!|| imp_intm ../engine/share/modules/imp_intm.F
7723!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
7724!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7725!||====================================================================
7726 SUBROUTINE upd_kml(
7727 1 IPARI ,INTBUF_TAB,NINT2 ,IINT2 ,
7728 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
7729 3 X ,IBFV ,LJ ,SKEW ,XFRAME ,
7730 4 ISKEW ,ICODT ,INLOC ,NSL ,IAD_M ,
7731 5 IDDL ,IKC ,NDOF ,IDDLM ,UD ,
7732 6 A ,KSL ,KSI ,NSREM ,NF_SI ,
7733 7 IDDLI ,IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,
7734 8 LRBE2 )
7735C-----------------------------------------------
7736C M o d u l e s
7737C-----------------------------------------------
7738 USE imp_intm
7739 USE imp_rwl
7740 USE imp_aspc
7741 USE intbufdef_mod
7742C-----------------------------------------------
7743C I m p l i c i t T y p e s
7744C-----------------------------------------------
7745#include "implicit_f.inc"
7746C-----------------------------------------------
7747C C o m m o n B l o c k s
7748C-----------------------------------------------
7749#include "param_c.inc"
7750#include "tabsiz_c.inc"
7751C-----------------------------------------------
7752C D u m m y A r g u m e n t s
7753C-----------------------------------------------
7754 INTEGER IPARI(NPARI,*),NSL,IAD_M(*),NSREM
7755 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
7756 . NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
7757 . ibfv(nifv,*),lj(*),iskew(*),icodt(*),iddlm(*),
7758 . nf_si(*) ,iddli(*),irbe3(nrbe3l,*),lrbe3(*),
7759 . irbe2(nrbe2l,*),lrbe2(*)
7760C REAL
7761 my_real
7762 . x(3,*),skew(lskew,*),xframe(*),
7763 . ud(3,*),a(3,*),ksl(9,*) ,ksi(9,*),frbe3(*)
7764 TYPE(intbuf_struct_) INTBUF_TAB(*)
7765C-----------------------------------------------
7766C L o c a l V a r i a b l e s
7767C-----------------------------------------------
7768 INTEGER I,J,N,K,M,NS,NI,NSN,ILEV,IAD_M1(NSREM+1),
7769 . ji,l,nnod,
7770 . nj,nd,nl,isk,ifm,j1,iflag,nss,nm,id,iad0,iad,
7771 . i1,ict,nf,nr,is,jd,ifss,ifsm,ibid,jt(3),jr(3),iads,
7772 . irot,iadr,nn,irad,ic,eid
7773 my_real
7774 . ej(3),ksm(9),knm(9,4),krm(9,4),rbid
7775 my_real,
7776 . DIMENSION(:),ALLOCATABLE :: knm3,krm3
7777C-----only [ksm] to update : secnd dependant :FRK_SI, secnd inde. LT_SI,
7778C ---- --added inde,:FRK_SL-----------
7779 ifss = 0
7780 ifsm = 1
7781 nd = 3
7782C------partie kin, vis a vis de SL--------
7783 iad_m1(1) = 1
7784 DO n=1,nsrem
7785 iad_m1(n+1) = iad_m1(n)+ikc_si(n)*nf_si(n)
7786 ENDDO
7787 DO i=1,iad_m(nsl+1)-1
7788 DO j=1,9
7789 ksl(j,i) = zero
7790 ENDDO
7791 ENDDO
7792C------int2----------------------------------
7793 DO i=ni2_fr,1,-1
7794 n=ifrs2(1,i)
7795 ni=ifrs2(2,i)
7796 ji=ipari(1,n)
7797 nsn=ipari(5,n)
7798 ns=intbuf_tab(n)%NSV(ni)
7799 l=intbuf_tab(n)%IRTLM(ni)
7800 nl=4*(l-1)
7801 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
7802 nnod=3
7803 ELSE
7804 nnod=4
7805 ENDIF
7806 ilev =ipari(20,n)
7807C
7808 IF (inloc(ns)>nsl) THEN
7809 nss = inloc(ns)-nsl
7810 nr=iad_slnr(nss+1)- iad_slnr(nss)
7811 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
7812 IF (j>0) THEN
7813 DO is = 1,nsrem
7814 iad = iad_m(nss) + j + is -2
7815 CALL cp_real(9,ksl(1,iad),ksm)
7816 IF (ilev==1) THEN
7817 CALL i2_frk1(intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,x ,itab ,
7818 . intbuf_tab(n)%NSV,
7819 1 intbuf_tab(n)%IRTLM,ikc ,ndof ,iddl ,iddlm,
7820 2 ibid ,ibid ,rbid,rbid ,rbid ,a ,
7821 3 rbid ,ksm ,knm ,krm ,ni ,
7822 4 ibid ,ifss ,ifsm)
7823 ELSE
7824 CALL i2_frk0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,x ,itab ,
7825 . intbuf_tab(n)%NSV,
7826 1 intbuf_tab(n)%IRTLM,ikc ,ndof ,iddl ,iddlm,
7827 2 ibid ,ibid ,rbid,rbid ,rbid ,a ,
7828 3 rbid ,ksm ,knm ,krm ,ni ,
7829 4 ibid ,ifss ,ifsm)
7830 ENDIF
7831 DO k =1,nnod
7832 nj=intbuf_tab(n)%IRECTM(nl+k)
7833 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),nj,j)
7834 iad = iad_m(nss) + j +is -2
7835 CALL cp_real(9,knm(1,k),ksl(1,iad))
7836 IF (ndof(nj)>3)CALL cp_real(9,krm(1,k),ksl(1,iad+nsrem))
7837 ENDDO
7838 END DO ! IS = 1,NSREM
7839 END IF !(J>0) THEN
7840 ELSE
7841 nss = inloc(ns)
7842 DO is = 1,nsrem
7843 nr =iad_sinr(is+1)- iad_sinr(is)
7844 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
7845 IF (j>0) THEN
7846 DO nf = 1,max(1,nf_si(is))
7847C-------------------in KFR_SI----
7848 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
7849 n = 0
7850 CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n ,is ,
7851 1 j ,ikc_si(is),ndof ,iad )
7852 iad = iad + nf-1
7853 CALL cp_real(9,ksi(1,iad),ksm)
7854 ELSE
7855 id = iddl_si(is)
7856 nm = jdi_sinr(iad_sinr(is)+j-1)
7857 jd = iddli(nm)
7858 CALL getfr_kij( id ,jd ,iad_si ,jdi_si,lt_si ,
7859 1 ksm ,nd ,nd )
7860 ENDIF
7861 IF (ilev==1) THEN
7862 CALL i2_frk1(intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,x ,itab ,
7863 . intbuf_tab(n)%NSV,
7864 1 intbuf_tab(n)%IRTLM,ikc ,ndof ,iddl ,iddlm,
7865 2 ibid ,ibid ,rbid,rbid ,rbid ,a ,
7866 3 rbid ,ksm ,knm ,krm ,ni ,
7867 4 ibid ,ifss ,ifsm)
7868 ELSE
7869 CALL i2_frk0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,x ,itab ,
7870 . intbuf_tab(n)%NSV,
7871 1 intbuf_tab(n)%IRTLM,ikc ,ndof ,iddl ,iddlm,
7872 2 ibid ,ibid ,rbid,rbid ,rbid ,a ,
7873 3 rbid ,ksm ,knm ,krm ,ni ,
7874 4 ibid ,ifss ,ifsm)
7875 ENDIF
7876 DO k =1,nnod
7877 nj=intbuf_tab(n)%IRECTM(nl+k)
7878 nr =iad_slnr(nss+1)- iad_slnr(nss)
7879 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),nj,j)
7880 iad = iad_m(nss) + j + is -2
7881 CALL cp_real(9,knm(1,k),ksl(1,iad))
7882 IF (ndof(nj)>3)CALL cp_real(9,krm(1,k),ksl(1,iad+nsrem))
7883 ENDDO
7884 ENDDO
7885 ENDIF
7886 ENDDO
7887 ENDIF
7888C
7889 ENDDO
7890C------RBE2-------
7891 DO i=nrbe2_fr,1,-1
7892 n=ifrs4(1,i)
7893 m=irbe2(3,n)
7894 ns=ifrs4(2,i)
7895 isk = irbe2(7,n)
7896 irad =irbe2(11,n)
7897 ic = irbe2(4,n)
7898C--------remove ICR---
7899 ic =(ic/512)*512
7900 IF (inloc(ns)>nsl) THEN
7901 nss = inloc(ns)-nsl
7902 nr=iad_slnr(nss+1)- iad_slnr(nss)
7903 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
7904 IF (j>0) THEN
7905 DO is = 1,nsrem
7906 iad = iad_m(nss) + j + is -2
7907 CALL cp_real(9,ksl(1,iad),ksm)
7908 CALL prerbe2fr(ic ,jt ,jr )
7909 CALL rbe2_frk(ns ,m ,x ,isk ,skew(1,isk) ,
7910 1 irad ,ndof ,iddl ,jt ,jr ,
7911 2 ibid ,ibid ,rbid ,rbid ,rbid ,
7912 3 a ,rbid ,ksm ,knm ,krm ,
7913 4 ibid ,ifss ,ifsm )
7914 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),m,j)
7915 iad = iad_m(nss) + j + is -2
7916 CALL cp_real(9,knm,ksl(1,iad))
7917 CALL cp_real(9,krm,ksl(1,iad+nsrem))
7918 END DO ! IS = 1,NSREM
7919 END IF !(J>0) THEN
7920 ELSE
7921 nss = inloc(ns)
7922 DO is = 1,nsrem
7923 nr =iad_sinr(is+1)- iad_sinr(is)
7924 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
7925 IF (j>0) THEN
7926 DO nf = 1,max(1,nf_si(is))
7927C----------------in KFR_SI------
7928 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
7929 n = 0
7930 CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n ,is ,
7931 1 j ,ikc_si(is),ndof ,iad )
7932 iad = iad + nf-1
7933 CALL cp_real(9,ksi(1,iad),ksm)
7934 ELSE
7935 id = iddl_si(is)
7936 nm = jdi_sinr(j+iad_sinr(is)-1)
7937 jd = iddli(nm)
7938 CALL getfr_kij(id ,jd ,iad_si ,jdi_si,lt_si ,
7939 1 ksm ,nd ,nd )
7940 ENDIF
7941 CALL prerbe2fr(ic ,jt ,jr )
7942 CALL rbe2_frk(ns ,m ,x ,isk ,skew(1,isk) ,
7943 1 irad ,ndof ,iddl ,jt ,jr ,
7944 2 ibid ,ibid ,rbid ,rbid ,rbid ,
7945 3 a ,rbid ,ksm ,knm ,krm ,
7946 4 ibid ,ifss ,ifsm )
7947 nr=iad_slnr(nss+1)- iad_slnr(nss)
7948 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),m,j)
7949 iad = iad_m(nss) + j + is -2
7950 CALL cp_real(9,knm,ksl(1,iad))
7951 CALL cp_real(9,krm,ksl(1,iad+nsrem))
7952 ENDDO
7953 ENDIF
7954 ENDDO
7955 ENDIF
7956 ENDDO
7957C------RBE3----------------------------------
7958 DO i=1,nrbe3_fr
7959 n=ifrs3(i)
7960 ns=irbe3(3,n)
7961 iadr=irbe3(1,n)
7962 nnod=irbe3(5,n)
7963 irot =irbe3(6,n)
7964 eid =irbe3(2,n)
7965 iads = slrbe3/2+iadr
7966 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
7967 ALLOCATE(knm3(9*nnod))
7968 IF (irot>0) ALLOCATE(krm3(9*nnod))
7969 IF (inloc(ns)>nsl) THEN
7970 nss = inloc(ns)-nsl
7971 nr=iad_slnr(nss+1)- iad_slnr(nss)
7972 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
7973 IF (j>0) THEN
7974 DO is = 1,nsrem
7975 iad = iad_m(nss) + j + is -2
7976 CALL cp_real(9,ksl(1,iad),ksm)
7977 CALL rbe3_fr0(ns ,nnod ,lrbe3(iadr+1) ,x ,irot ,
7978 2 jt ,jr ,frbe3(6*iadr+1) ,skew ,ikc ,
7979 3 ndof ,ibid ,ibid ,rbid ,rbid ,
7980 2 rbid ,ksm ,knm3 ,krm3 ,ibid ,
7981 3 ifss ,ifsm ,itab ,lrbe3(iads+1),eid)
7982 DO k =1,nnod
7983 nj = lrbe3(iadr+k)
7984 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),nj,j)
7985 iad = iad_m(nss) + j +is -2
7986 id = 9*(k-1) + 1
7987 CALL cp_real(9,knm3(id),ksl(1,iad))
7988 IF (irot>0.AND.ndof(nj)==6)
7989 + CALL cp_real(9,krm3(id),ksl(1,iad+nsrem))
7990 ENDDO
7991 END DO ! IS = 1,NSREM
7992 END IF !(J>0) THEN
7993 ELSE
7994 nss = inloc(ns)
7995 DO is = 1,nsrem
7996 nr =iad_sinr(is+1)- iad_sinr(is)
7997 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
7998 IF (j>0) THEN
7999 DO nf = 1,max(1,nf_si(is))
8000C-------------------in KFR_SI----
8001 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8002 n = 0
8003 CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n ,is ,
8004 1 j ,ikc_si(is),ndof ,iad )
8005 iad = iad + nf-1
8006 CALL cp_real(9,ksi(1,iad),ksm)
8007 ELSE
8008 id = iddl_si(is)
8009 nm = jdi_sinr(iad_sinr(is)+j-1)
8010 jd = iddli(nm)
8011 CALL getfr_kij( id ,jd ,iad_si ,jdi_si,lt_si ,
8012 1 ksm ,nd ,nd )
8013 ENDIF
8014 CALL rbe3_fr0(ns ,nnod ,lrbe3(iadr+1) ,x ,irot ,
8015 2 jt ,jr ,frbe3(6*iadr+1) ,skew ,ikc ,
8016 3 ndof ,ibid ,ibid ,rbid ,rbid ,
8017 2 rbid ,ksm ,knm3 ,krm3 ,ibid ,
8018 3 ifss ,ifsm ,itab ,lrbe3(iads+1),eid)
8019 DO k =1,nnod
8020 nj = lrbe3(iadr+k)
8021 nr =iad_slnr(nss+1)- iad_slnr(nss)
8022 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),nj,j)
8023 iad = iad_m(nss) + j + is -2
8024 id = 9*(k-1) + 1
8025 CALL cp_real(9,knm3(id),ksl(1,iad))
8026 IF (irot>0.AND.ndof(nj)==6)
8027 + CALL cp_real(9,krm3(id),ksl(1,iad+nsrem))
8028 ENDDO
8029 ENDDO
8030 ENDIF !(J>0)
8031 ENDDO
8032 ENDIF
8033 DEALLOCATE(knm3)
8034 IF (irot>0) DEALLOCATE(krm3)
8035C
8036 ENDDO
8037C------Rigid bodies-------
8038 DO i=nrb_fr,1,-1
8039 m=ifrsr(1,i)
8040 ns=ifrsr(2,i)
8041 IF (inloc(ns)>nsl) THEN
8042 nss = inloc(ns)-nsl
8043 nr=iad_slnr(nss+1)- iad_slnr(nss)
8044 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
8045 IF (j>0) THEN
8046 DO is = 1,nsrem
8047 iad = iad_m(nss) + j + is -2
8048 CALL cp_real(9,ksl(1,iad),ksm)
8049 CALL rby_frk(ns ,m ,x ,itab ,ikc ,
8050 1 ndof ,iddl ,iddlm,ibid ,ibid ,
8051 2 rbid ,rbid ,rbid ,a ,rbid ,
8052 3 ksm ,knm ,krm ,ibid,ifss,ifsm)
8053 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),m,j)
8054 iad = iad_m(nss) + j + is -2
8055 CALL cp_real(9,knm,ksl(1,iad))
8056 CALL cp_real(9,krm,ksl(1,iad+nsrem))
8057 END DO ! IS = 1,NSREM
8058 END IF !(J>0) THEN
8059 ELSE
8060 nss = inloc(ns)
8061 DO is = 1,nsrem
8062 nr =iad_sinr(is+1)- iad_sinr(is)
8063 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
8064 IF (j>0) THEN
8065 DO nf = 1,max(1,nf_si(is))
8066C----------------in KFR_SI------
8067 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8068 n = 0
8069 CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n ,is ,
8070 1 j ,ikc_si(is),ndof ,iad )
8071 iad = iad + nf-1
8072 CALL cp_real(9,ksi(1,iad),ksm)
8073 ELSE
8074 id = iddl_si(is)
8075 nm = jdi_sinr(j+iad_sinr(is)-1)
8076 jd = iddli(nm)
8077 CALL getfr_kij(id ,jd ,iad_si ,jdi_si,lt_si ,
8078 1 ksm ,nd ,nd )
8079 ENDIF
8080 CALL rby_frk(ns ,m ,x ,itab ,ikc ,
8081 1 ndof ,iddl ,iddlm,ibid ,ibid ,
8082 2 rbid ,rbid ,rbid ,a ,rbid ,
8083 3 ksm ,knm ,krm ,ibid,ifss,ifsm)
8084 nr=iad_slnr(nss+1)- iad_slnr(nss)
8085 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),m,j)
8086 iad = iad_m(nss) + j + is - 2
8087 CALL cp_real(9,knm,ksl(1,iad))
8088 CALL cp_real(9,krm,ksl(1,iad+nsrem))
8089 ENDDO
8090 ENDIF
8091 ENDDO
8092 ENDIF
8093 ENDDO
8094C
8095 DO i1 = 1,nbc_fr
8096 ns = ibc_fr(1,i1)
8097 isk= ibc_fr(2,i1)
8098 ict= ibc_fr(3,i1)
8099 IF (inloc(ns)>nsl) THEN
8100 nss = inloc(ns)-nsl
8101 nr=iad_slnr(nss+1)- iad_slnr(nss)
8102 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
8103 IF (j>0) THEN
8104 DO is = 1,nsrem
8105 iad = iad_m(nss) + j + is -2
8106 CALL cp_real(9,ksl(1,iad),ksm)
8107 CALL bcl_frk(ns ,iddl ,iddlm ,ict ,isk ,
8108 1 skew ,ikc ,ibid ,ibid ,rbid ,
8109 2 rbid ,rbid ,a ,rbid ,ksm ,
8110 3 ibid ,ifss ,ifsm )
8111 CALL cp_real(9,knm,ksl(1,iad))
8112 END DO ! IS = 1,NSREM
8113 END IF !(J>0) THEN
8114 ELSE
8115 nss = inloc(ns)
8116 DO is = 1,nsrem
8117 nr =iad_sinr(is+1)- iad_sinr(is)
8118 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
8119 IF (j>0) THEN
8120 DO nf = 1,max(1,nf_si(is))
8121C----------------in KFR_SI------
8122 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8123 n = 0
8124 CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n ,is ,
8125 1 j ,ikc_si(is),ndof ,iad )
8126 iad = iad + nf-1
8127 CALL cp_real(9,ksi(1,iad),ksm)
8128 ELSE
8129 id = iddl_si(is)
8130 nm = jdi_sinr(iad_sinr(is)+j-1)
8131 jd = iddli(nm)
8132 CALL getfr_kij( id ,jd ,iad_si ,jdi_si,lt_si ,
8133 1 ksm ,nd ,nd )
8134 ENDIF
8135 CALL bcl_frk(ns ,iddl ,iddlm ,ict ,isk ,
8136 1 skew ,ikc ,ibid ,ibid ,rbid ,
8137 2 rbid ,rbid ,a ,rbid ,ksm ,
8138 3 ibid ,ifss ,ifsm )
8139C--------------!!!!!!!!! still--in KFR_SI--!!!!!!----
8140 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8141 CALL cp_real(9,knm,ksi(1,iad))
8142 ELSE
8143 iad = iad_m(nss) + is -1
8144 CALL cp_real(9,knm,ksl(1,iad))
8145 ENDIF
8146 ENDDO
8147 ENDIF
8148 ENDDO
8149 ENDIF
8150 ENDDO
8151C
8152 DO i1 = 1,nspc_fr
8153 n = ispc_fr(i1)
8154 ns = in_spc(n)
8155 iadr = 6*(n-1)+1
8156 nn = ic_spc(n)
8157 IF (inloc(ns)>nsl) THEN
8158 nss = inloc(ns)-nsl
8159 nr=iad_slnr(nss+1)- iad_slnr(nss)
8160 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
8161 IF (j>0) THEN
8162 DO is = 1,nsrem
8163 iad = iad_m(nss) + j + is -2
8164 CALL cp_real(9,ksl(1,iad),ksm)
8165 CALL bc_updfr(ns ,iddl ,skew_spc(iadr),ji ,iddlm ,
8166 1 ikc ,ibid ,ibid ,rbid ,rbid ,
8167 2 rbid ,a ,rbid ,ksm ,ibid ,
8168 3 ifss ,ifsm )
8169 IF (nn==1) THEN
8170 ej(1)=skew_spc(iadr)
8171 ej(2)=skew_spc(iadr+1)
8172 ej(3)=skew_spc(iadr+2)
8173 CALL l_dir(ej,ji)
8174 CALL bc_updfr(i ,iddl ,ej ,ji ,iddlm ,
8175 1 ikc ,ibid ,ibid ,rbid ,rbid ,
8176 2 rbid ,a ,rbid ,ksm ,ibid ,
8177 3 ifss ,ifsm )
8178 ELSE
8179 CALL bc_updfr2(i ,iddl ,skew_spc(iadr),skew_spc(iadr+3),
8180 1 iddlm ,ibid ,ibid ,ibid ,rbid ,rbid ,
8181 2 rbid ,a ,rbid ,ksm ,ibid ,
8182 3 ifss ,ifsm )
8183 END IF
8184 CALL cp_real(9,knm,ksl(1,iad))
8185 END DO ! IS = 1,NSREM
8186 END IF !(J>0) THEN
8187 ELSE
8188 nss = inloc(ns)
8189 DO is = 1,nsrem
8190 nr =iad_sinr(is+1)- iad_sinr(is)
8191 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
8192 IF (j>0) THEN
8193 DO nf = 1,max(1,nf_si(is))
8194C----------------in KFR_SI------
8195 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8196 n = 0
8197 CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n ,is ,
8198 1 j ,ikc_si(is),ndof ,iad )
8199 iad = iad + nf-1
8200 CALL cp_real(9,ksi(1,iad),ksm)
8201 ELSE
8202 id = iddl_si(is)
8203 nm = jdi_sinr(iad_sinr(is)+j-1)
8204 jd = iddli(nm)
8205 CALL getfr_kij( id ,jd ,iad_si ,jdi_si,lt_si ,
8206 1 ksm ,nd ,nd )
8207 ENDIF
8208 IF (nn==1) THEN
8209 ej(1)=skew_spc(iadr)
8210 ej(2)=skew_spc(iadr+1)
8211 ej(3)=skew_spc(iadr+2)
8212 CALL l_dir(ej,ji)
8213 CALL bc_updfr(i ,iddl ,ej ,ji ,iddlm ,
8214 1 ikc ,ibid ,ibid ,rbid ,rbid ,
8215 2 rbid ,a ,rbid ,ksm ,ibid ,
8216 3 ifss ,ifsm )
8217 ELSE
8218 CALL bc_updfr2(i ,iddl ,skew_spc(iadr),skew_spc(iadr+3),
8219 1 iddlm ,ibid ,ibid ,ibid ,rbid ,rbid ,
8220 2 rbid ,a ,rbid ,ksm ,ibid ,
8221 3 ifss ,ifsm )
8222 END IF
8223C--------------!!!!!!!!! still--in KFR_SI--!!!!!!----
8224 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8225 CALL cp_real(9,knm,ksi(1,iad))
8226 ELSE
8227 iad = iad_m(nss) + is -1
8228 CALL cp_real(9,knm,ksl(1,iad))
8229 ENDIF
8230 ENDDO
8231 ENDIF
8232 ENDDO
8233 ENDIF
8234 ENDDO
8235C
8236 IF (nfx_fr>0) THEN
8237 DO l=1,nfx_fr
8238 i = ifx_fr(1,l)
8239 j1 = ifx_fr(2,l)
8240 ns=iabs(ibfv(1,i))
8241 IF (inloc(ns)>nsl) THEN
8242 nss = inloc(ns)-nsl
8243 nr=iad_slnr(nss+1)- iad_slnr(nss)
8244 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
8245 IF (j>0) THEN
8246 DO is = 1,nsrem
8247 iad = iad_m(nss) + j + is -2
8248 CALL cp_real(9,ksl(1,iad),ksm)
8249 CALL fvl_frk(j1 ,i ,ibfv ,skew ,xframe,
8250 1 iddl ,iddlm ,ikc ,ibid ,ibid ,
8251 2 rbid ,rbid ,ud ,rbid ,a ,
8252 3 rbid ,ksm ,ibid ,ifss ,ifsm )
8253 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
8254 iad = iad_m(nss) + j + is -2
8255 CALL cp_real(9,knm,ksl(1,iad))
8256 CALL cp_real(9,krm,ksl(1,iad+nsrem))
8257 END DO ! IS = 1,NSREM
8258 END IF !(J>0) THEN
8259 ELSE
8260 nss = inloc(ns)
8261 DO is = 1,nsrem
8262 nr =iad_sinr(is+1)- iad_sinr(is)
8263 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
8264 IF (j>0) THEN
8265 DO nf = 1,max(1,nf_si(is))
8266C----------------in KFR_SI------
8267 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8268 n = 0
8269 CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n ,is ,
8270 1 j ,ikc_si(is),ndof ,iad )
8271 iad = iad + nf-1
8272 CALL cp_real(9,ksi(1,iad),ksm)
8273 ELSE
8274 id = iddl_si(is)
8275 nm = jdi_sinr(iad_sinr(is)+j-1)
8276 jd = iddli(nm)
8277 CALL getfr_kij( id ,jd ,iad_si ,jdi_si,lt_si ,
8278 1 ksm ,nd ,nd )
8279 ENDIF
8280 CALL fvl_frk(j1 ,i ,ibfv ,skew ,xframe,
8281 1 iddl ,iddlm ,ikc ,ibid ,ibid ,
8282 2 rbid ,rbid ,ud ,rbid ,a ,
8283 3 rbid ,ksm ,ibid ,ifss ,ifsm )
8284C--------------!!!!!!!!! still--in KFR_SI--!!!!!!----
8285 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8286 CALL cp_real(9,knm,ksi(1,iad))
8287 ELSE
8288 iad = iad_m(nss) + is -1
8289 CALL cp_real(9,knm,ksl(1,iad))
8290 ENDIF
8291 ENDDO
8292 ENDIF
8293 ENDDO
8294 ENDIF
8295 ENDDO
8296 ENDIF
8297C
8298 DO l = 1,nrw_fr
8299 i = irw_fr(l)
8300 ns=in_rwl(i)
8301 ej(1)=nor_rwl(1,i)
8302 ej(2)=nor_rwl(2,i)
8303 ej(3)=nor_rwl(3,i)
8304 CALL l_dir(ej,j1)
8305 IF (inloc(ns)>nsl) THEN
8306 nss = inloc(ns)-nsl
8307 nr=iad_slnr(nss+1)- iad_slnr(nss)
8308 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
8309 IF (j>0) THEN
8310 DO is = 1,nsrem
8311 iad = iad_m(nss) + j + is -2
8312 CALL cp_real(9,ksl(1,iad),ksm)
8313 CALL fv_updfr(ns ,ej ,j1 ,iddl ,iddlm ,
8314 1 ikc ,ibid ,ibid ,rbid ,rbid ,
8315 2 ud ,rbid ,a ,rbid ,ksm ,
8316 3 ibid ,ifss ,ifsm )
8317 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
8318 iad = iad_m(nss) + j + is -2
8319 CALL cp_real(9,knm,ksl(1,iad))
8320 CALL cp_real(9,krm,ksl(1,iad+nsrem))
8321 END DO ! IS = 1,NSREM
8322 END IF !(J>0) THEN
8323 ELSE
8324 nss = inloc(ns)
8325 DO is = 1,nsrem
8326 nr =iad_sinr(is+1)- iad_sinr(is)
8327 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
8328 IF (j>0) THEN
8329 DO nf = 1,max(1,nf_si(is))
8330C----------------in KFR_SI------
8331 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8332 n = 0
8333 CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n ,is ,
8334 1 j ,ikc_si(is),ndof ,iad )
8335 iad = iad + nf-1
8336 CALL cp_real(9,ksi(1,iad),ksm)
8337 ELSE
8338 id = iddl_si(is)
8339 nm = jdi_sinr(iad_sinr(is)+j-1)
8340 jd = iddli(nm)
8341 CALL getfr_kij( id ,jd ,iad_si ,jdi_si,lt_si ,
8342 1 ksm ,nd ,nd )
8343 ENDIF
8344 CALL fv_updfr(ns ,ej ,j1 ,iddl ,iddlm ,
8345 1 ikc ,ibid ,ibid ,rbid ,rbid ,
8346 2 ud ,rbid ,a ,rbid ,ksm ,
8347 3 ibid ,ifss ,ifsm )
8348C--------------!!!!!!!!! still--in KFR_SI--!!!!!!----
8349 IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
8350 CALL cp_real(9,knm,ksi(1,iad))
8351 ELSE
8352 iad = iad_m(nss) + is -1
8353 CALL cp_real(9,knm,ksl(1,iad))
8354 ENDIF
8355 ENDDO
8356 ENDIF
8357 ENDDO
8358 ENDIF
8359 ENDDO
8360C--------------------------------------------
8361C
8362 RETURN
8363 END
8364!||====================================================================
8365!|| imp_frkm ../engine/source/mpi/implicit/imp_fri.F
8366!||--- called by ------------------------------------------------------
8367!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
8368!||--- calls -----------------------------------------------------
8369!|| cp_int ../engine/source/implicit/produt_v.F
8370!|| cp_real ../engine/source/implicit/produt_v.F
8371!|| getfr_kij ../engine/source/mpi/implicit/imp_fri.F
8372!||--- uses -----------------------------------------------------
8373!|| imp_intm ../engine/share/modules/imp_intm.F
8374!||====================================================================
8375 SUBROUTINE imp_frkm(
8376 1 NSREM ,IKINM ,IKCSI ,IKC ,NDOF ,
8377 2 IDDL ,IDDLM ,INLOC ,IAD_M ,FRK_SI ,
8378 3 FRK_SL ,NF_SI ,IAD_MLD ,IDDLI )
8379C-----------------------------------------------
8380C M o d u l e s
8381C-----------------------------------------------
8382 USE imp_intm
8383C----6---------------------------------------------------------------7---------8
8384C I m p l i c i t T y p e s
8385C-----------------------------------------------
8386#include "implicit_f.inc"
8387C-----------------------------------------------
8388C C o m m o n B l o c k s
8389C-----------------------------------------------
8390#include "com01_c.inc"
8391C-----------------------------------------------------------------
8392C D u m m y A r g u m e n t s
8393C-----------------------------------------------
8394 integer
8395 . nsrem,iddl(*),iddlm(*),inloc(*),ikc(*),ndof(*),iad_m(*),
8396 . ikcsi(3,*),ikinm ,nf_si(*) ,iad_mld(*) ,iddli(*)
8397 my_real
8398 . frk_si(3,3,*) ,frk_sl(3,3,*)
8399C-----------------------------------------------
8400C L o c a l V a r i a b l e s
8401C-----------------------------------------------
8402 INTEGER I,J,N,K,P,L,NL,NJ,NDOFI,NZ,NDS,NKC,IAD,J1,K1,ID,NS,NM
8403 INTEGER IDDL_CP(NDDL_SI),IAD_CP(NDDL_SI+1),JDI_CP(NZ_SI),
8404 . iad_m1(nsrem+1),nr,idm,jd,iadi,
8405 . ier1,ier2,ier3,ier4,ier5,ier6
8406 my_real
8407 . kij(3,3),lt_cp(nz_si)
8408c----------IDDL_SL->condense--For the case of no Kine nodes should change also local id->globle --
8409C-------------(debug) 257564:
8410 CALL cp_int((nddl_si+1),iad_si,iad_cp)
8411 CALL cp_int(nz_si,jdi_si,jdi_cp)
8412 CALL cp_real(nz_si,lt_si,lt_cp)
8413c---------ini IAD_MLD----
8414 ndofi = 3
8415 nl = 0
8416 nz = 0
8417 iad_mld(1) = nl +1
8418 IF (ikinm==0 ) THEN
8419 DO p=1,nspmd
8420 DO i=iad_srem(p),iad_srem(p+1)-1
8421 nl = nl + ndofi
8422 DO k = 1,ndofi
8423 DO j1 =iad_sinr(i), iad_sinr(i+1)-1
8424 nj = jdi_sinr(j1)
8425 id = iddl(nj)
8426 idm = iddlm(nj)
8427C-----------INPEND. LT_CP-------
8428 IF (ndof(nj)>0) THEN
8429 id = iddl_si(i)
8430 jd = iddli(nj)
8431 CALL getfr_kij( id ,jd ,iad_cp ,jdi_cp,lt_cp ,
8432 1 kij ,ndofi,ndofi )
8433 DO k1 = 1,ndofi
8434 nz = nz + 1
8435 jdi_si(nz) = idm + k1
8436 lt_si(nz) = kij(k,k1)
8437 ENDDO
8438 END IF !(NDOF(NJ)>0) THEN
8439 END DO !J1 =IAD_SINR(I), IAD_SINR(I+1)-1
8440 END DO !DO K = 1,NDOFI
8441 END DO
8442 iad_mld(p+1) = nl +1
8443 END DO !DO P=1,NSPMD
8444 ELSE
8445C
8446 iad_m1(1) = 0
8447 DO n=1,nsrem
8448 iad_m1(n+1) = iad_m1(n)+ikc_si(n)*nf_si(n)
8449 ENDDO
8450c----------DIMENSION----
8451 nl = 0
8452 nz = 0
8453 iad = 1
8454 DO i=1,nsrem
8455C-----------SECND DEPEND.: FRK_SI---------
8456 IF (ikc_si(i)>0) THEN
8457 DO j =1, nf_si(i)
8458 DO k = 1,ndofi
8459 IF (ikcsi(k,iad)==0) THEN
8460 nl = nl + 1
8461 DO j1 =iad_sinr(i), iad_sinr(i+1)-1
8462 nj = jdi_sinr(j1)
8463 id = iddl(nj)
8464 DO k1 = 1,ndofi
8465 IF (ikc(k1+id)==0) nz = nz + 1
8466 ENDDO
8467C-----------DEPEND. SUP-:FRK_SL--------
8468 ns = inloc(nj)
8469 IF (ikc_sl(ns)>0) THEN
8470 DO l =iad_slnr(ns), iad_slnr(ns+1)-1
8471 nm = jdi_slnr(l)
8472 id = iddl(nm)
8473 DO k1 = 1,ndofi
8474 IF (ikc(k1+id)==0) nz = nz + 1
8475 ENDDO
8476 ENDDO
8477 ENDIF
8478 ENDDO
8479 ENDIF
8480 ENDDO
8481 iad = iad + 1
8482 ENDDO
8483C-----------SECND INDEPEND.:LT,FRK_SL---------
8484 ELSE
8485 DO k = 1,ndofi
8486 nl = nl + 1
8487 DO j1 =iad_sinr(i), iad_sinr(i+1)-1
8488 nj = jdi_sinr(j1)
8489 id = iddl(nj)
8490 ns = inloc(nj)
8491 IF (ikc_sl(ns)>0) THEN
8492C-----------DEPEND. SUP-:FRK_SL--------
8493C-------------debug 257564: forget /BCS
8494 nr = iad_slnr(ns+1)-iad_slnr(ns)
8495 IF (nr==0) THEN
8496 DO k1 = 1,ndofi
8497 IF (ikc(k1+id)==0) nz = nz + 1
8498 ENDDO
8499 ELSE
8500 DO l =iad_slnr(ns), iad_slnr(ns+1)-1
8501 nm = jdi_slnr(l)
8502 id = iddl(nm)
8503 DO k1 = 1,ndofi
8504 IF (ikc(k1+id)==0) nz = nz + 1
8505 ENDDO
8506 IF (ndof(nm)==6) THEN
8507 DO k1 = 1,ndofi
8508 IF (ikc(k1+id+3)==0) nz = nz + 1
8509 ENDDO
8510 END IF
8511 ENDDO
8512 END IF !(NR==0) THEN
8513 ELSE
8514C-----------INPEND. LT_CP-------
8515 nz = nz + ndofi
8516 ENDIF
8517 ENDDO
8518 ENDDO
8519 ENDIF
8520 ENDDO
8521C
8522 nddl_si = nl
8523C
8524 IF(ALLOCATED(iad_si)) DEALLOCATE(iad_si)
8525 ALLOCATE(iad_si(nl+1),stat=ier1)
8526 IF (nz>nz_si) THEN
8527 IF(ALLOCATED(jdi_si)) DEALLOCATE(jdi_si)
8528 ALLOCATE(jdi_si(nz),stat=ier2)
8529 IF(ALLOCATED(lt_si)) DEALLOCATE(lt_si)
8530 ALLOCATE(lt_si(nz),stat=ier3)
8531 ENDIF
8532 nz_si =nz
8533C
8534 nl = 0
8535 nz = 0
8536 iad = 1
8537 iad_si(nl+1) = nz+1
8538 DO p=1,nspmd
8539 DO i=iad_srem(p),iad_srem(p+1)-1
8540C-----------SECND DEPEND.: FRK_SI---------
8541 IF (ikc_si(i)>0) THEN
8542 nr = iad_sinr(i+1)-iad_sinr(i)
8543 DO j =1, nf_si(i)
8544 DO k = 1,ndofi
8545 IF (ikcsi(k,iad)==0) THEN
8546 nl = nl + 1
8547 DO j1 =iad_sinr(i), iad_sinr(i+1)-1
8548 nj = jdi_sinr(j1)
8549 id = iddl(nj)
8550 idm = iddlm(nj)
8551 IF (ndof(nj)>0) THEN
8552 nkc = 0
8553 iadi = iad_m1(i) +nf_si(i)*(j1-iad_sinr(i))+ j
8554 DO k1 = 1,ndofi
8555 IF (ikc(k1+id)==0) THEN
8556 nz = nz + 1
8557 jdi_si(nz) = idm + k1-nkc
8558 lt_si(nz) = frk_si(k,k1,iadi)
8559 ELSE
8560 nkc = nkc + 1
8561 ENDIF
8562 ENDDO
8563 END IF !(NDOF(NJ)>0) THEN
8564C-----------DEPEND. SUP-:FRK_SL--------
8565 ns = inloc(nj)
8566 IF (ikc_sl(ns)>0) THEN
8567 DO l =iad_slnr(ns), iad_slnr(ns+1)-1
8568 nm = jdi_slnr(l)
8569 id = iddl(nm)
8570 idm = iddlm(nm)
8571 IF (ndof(nm)>0) THEN
8572 nkc = 0
8573 iadi = iad_m(ns) + l-iad_slnr(ns) + i
8574 DO k1 = 1,ndofi
8575 IF (ikc(k1+id)==0) THEN
8576 nz = nz + 1
8577 jdi_si(nz) = idm + k1-nkc
8578 lt_si(nz) = frk_sl(k,k1,iadi)
8579 ELSE
8580 nkc = nkc + 1
8581 ENDIF
8582 ENDDO
8583 END IF !(NDOF(NM)>0) THEN
8584 ENDDO
8585 ENDIF
8586 ENDDO
8587 iad_si(nl+1) = nz+1
8588 ENDIF
8589 ENDDO
8590 iad = iad + 1
8591 ENDDO
8592C-----------SECND INDEPEND.:LT,FRK_SL---------
8593 ELSE
8594 DO k = 1,ndofi
8595 nl = nl + 1
8596 DO j1 =iad_sinr(i), iad_sinr(i+1)-1
8597 nj = jdi_sinr(j1)
8598 id = iddl(nj)
8599 idm = iddlm(nj)
8600c IF (NDOF(NJ)>0) THEN
8601C
8602 nkc = 0
8603 ns = inloc(nj)
8604 IF (ikc_sl(ns)>0) THEN
8605C-----------DEPEND. SUP-:FRK_SL--------
8606 nr = iad_slnr(ns+1)-iad_slnr(ns)
8607C-----------/BCS--------
8608 IF (nr==0) THEN
8609 jd = iddli(nj)
8610 CALL getfr_kij(iddl_si(i),jd ,iad_cp ,jdi_cp,lt_cp ,
8611 1 kij ,ndofi,ndofi )
8612 nkc = 0
8613 DO k1 = 1,ndofi
8614 IF (ikc(k1+id)==0) THEN
8615 nz = nz + 1
8616 jdi_si(nz) = idm + k1 -nkc
8617 lt_si(nz) = kij(k,k1)
8618 ELSE
8619 nkc = nkc + 1
8620 END IF !(IKC(K1+ID)==0) THEN
8621 ENDDO
8622 ELSE
8623 DO l =iad_slnr(ns), iad_slnr(ns+1)-1
8624 nm = jdi_slnr(l)
8625 id = iddl(nm)
8626 idm = iddlm(nm)
8627 nkc = 0
8628 iadi = iad_m(ns) + l-iad_slnr(ns) +i-1
8629 DO k1 = 1,ndofi
8630 IF (ikc(k1+id)==0) THEN
8631 nz = nz + 1
8632 jdi_si(nz) = idm + k1-nkc
8633 lt_si(nz) = frk_sl(k1,k,iadi)
8634 ELSE
8635 nkc = nkc + 1
8636 ENDIF
8637 ENDDO
8638 IF (ndof(nm)==6) THEN
8639 DO k1 = 4,ndofi+3
8640 IF (ikc(k1+id)==0) THEN
8641 nz = nz + 1
8642 jdi_si(nz) = idm + k1-nkc
8643 lt_si(nz) = frk_sl(k1-3,k,iadi+nsrem)
8644 ELSE
8645 nkc = nkc + 1
8646 ENDIF
8647 ENDDO
8648 END IF
8649 ENDDO
8650 END IF !(NR==0) THEN
8651 ELSEIF (ndof(nj)>0) THEN
8652C-----------INPEND. LT_CP-------
8653 id = iddl_si(i)
8654 jd = iddli(nj)
8655 CALL getfr_kij( id ,jd ,iad_cp ,jdi_cp,lt_cp ,
8656 1 kij ,ndofi,ndofi )
8657 DO k1 = 1,ndofi
8658 nz = nz + 1
8659 jdi_si(nz) = idm + k1
8660 lt_si(nz) = kij(k,k1)
8661 ENDDO
8662 ENDIF !IF IKC_SL
8663C END IF !(NDOF(NJ)>0) THEN
8664 ENDDO !DO J1
8665 iad_si(nl+1) = nz+1
8666 ENDDO !DO K
8667 ENDIF !IF IKC_SI
8668 ENDDO !DO I=
8669 iad_mld(p+1) = nl+1
8670 ENDDO ! DO P=
8671 END IF !IF (IKINM==0 )
8672C
8673 IF(ALLOCATED(iddl_si)) DEALLOCATE(iddl_si)
8674c IF(ALLOCATED(IKC_SI)) DEALLOCATE(IKC_SI)
8675 IF(ALLOCATED(ikc_sl)) DEALLOCATE(ikc_sl)
8676 IF(ALLOCATED(usi)) DEALLOCATE(usi)
8677 ALLOCATE(usi(nddl_si),stat=ier4)
8678 IF(ALLOCATED(fsi)) DEALLOCATE(fsi)
8679 ALLOCATE(fsi(nddl_si),stat=ier5)
8680C
8681 RETURN
8682 END
8683!||====================================================================
8684!|| dim_fvn ../engine/source/mpi/implicit/imp_fri.F
8685!||--- called by ------------------------------------------------------
8686!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
8687!||====================================================================
8688 SUBROUTINE dim_fvn(
8689 1 NDOF ,IDDL ,IKC ,INLOC ,NFV )
8690C----6---------------------------------------------------------------7---------8
8691C I m p l i c i t T y p e s
8692C-----------------------------------------------
8693#include "implicit_f.inc"
8694C-----------------------------------------------
8695C C o m m o n B l o c k s
8696C-----------------------------------------------
8697#include "com04_c.inc"
8698C-----------------------------------------------------------------
8699C D u m m y A r g u m e n t s
8700C-----------------------------------------------
8701 INTEGER NFV, INLOC(*),NDOF(*),IKC(*),IDDL(*)
8702C REAL
8703C-----------------------------------------------
8704C L o c a l V a r i a b l e s
8705C-----------------------------------------------
8706 integer
8707 . i,j,k,n,nd,ns
8708C----------------------------
8709 nfv=0
8710C--------imposed velocity---------------
8711 DO n = 1, numnod
8712C--------local secnd node-----
8713 IF (inloc(n)>0) THEN
8714 ns = 0
8715 DO j = 1, min(3,ndof(n))
8716 nd = iddl(n)+j
8717 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) ns=1
8718 ENDDO
8719 IF (ns==1) nfv = nfv +1
8720 ENDIF
8721 ENDDO
8722C
8723C----6---------------------------------------------------------------7---------8
8724 RETURN
8725 END
8726!||====================================================================
8727!|| ind_fvn ../engine/source/mpi/implicit/imp_fri.F
8728!||--- called by ------------------------------------------------------
8729!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
8730!||--- uses -----------------------------------------------------
8731!|| imp_intm ../engine/share/modules/imp_intm.F
8732!||====================================================================
8733 SUBROUTINE ind_fvn(
8734 1 NDOF ,IDDL ,IKC ,INLOC ,NFV )
8735C-----------------------------------------------
8736C M o d u l e s
8737C-----------------------------------------------
8738 USE imp_intm
8739C----6---------------------------------------------------------------7---------8
8740C I m p l i c i t T y p e s
8741C-----------------------------------------------
8742#include "implicit_f.inc"
8743C-----------------------------------------------
8744C C o m m o n B l o c k s
8745C-----------------------------------------------
8746#include "com04_c.inc"
8747C-----------------------------------------------------------------
8748C D u m m y A r g u m e n t s
8749C-----------------------------------------------
8750 INTEGER NFV,INLOC(*),NDOF(*),IKC(*),IDDL(*)
8751C REAL
8752C-----------------------------------------------
8753C L o c a l V a r i a b l e s
8754C-----------------------------------------------
8755 integer
8756 . i,j,k,n,nd,ns,nf
8757C-----------use islm-----------------
8758 IF(ALLOCATED(islm)) DEALLOCATE(islm)
8759 ALLOCATE(islm(nfv))
8760 nf=0
8761C--------imposed velocity---------------
8762 DO n = 1, numnod
8763C--------local secnd node-----
8764 IF (inloc(n)>0) THEN
8765 ns=0
8766 DO j = 1, min(3,ndof(n))
8767 nd = iddl(n)+j
8768 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) ns = 1
8769 ENDDO
8770 IF (ns==1) THEN
8771 nf = nf + 1
8772 islm(nf) = n
8773 ENDIF
8774 ENDIF
8775 ENDDO
8776C----6---------------------------------------------------------------7---------8
8777 RETURN
8778 END
8779!||====================================================================
8780!|| imp_fvkss ../engine/source/mpi/implicit/imp_fri.F
8781!||--- called by ------------------------------------------------------
8782!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
8783!||--- calls -----------------------------------------------------
8784!|| get_kii ../engine/source/implicit/imp_glob_k.F
8785!|| intabfr ../engine/source/mpi/implicit/imp_fri.F
8786!|| put_kii ../engine/source/implicit/imp_glob_k.F
8787!||--- uses -----------------------------------------------------
8788!|| imp_intm ../engine/share/modules/imp_intm.F
8789!||====================================================================
8790 SUBROUTINE imp_fvkss(
8791 1 KSS ,IDDL ,IDDLM ,IKC ,NSL ,
8792 2 D_IMP ,LB ,NFV ,UDSL ,INLOC ,
8793 3 NDOF )
8794C-----------------------------------------------
8795C M o d u l e s
8796C-----------------------------------------------
8797 USE imp_intm
8798C----6---------------------------------------------------------------7---------8
8799C I m p l i c i t T y p e s
8800C-----------------------------------------------
8801#include "implicit_f.inc"
8802C-----------------------------------------------------------------
8803C D u m m y A r g u m e n t s
8804C-----------------------------------------------
8805 INTEGER NFV,NSL,IDDLM(*),IKC(*),IDDL(*),
8806 . inloc(*),ndof(*)
8807C REAL
8808 my_real
8809 . kss(6,*), d_imp(3,*) ,lb(*) ,udsl(3,*)
8810C-----------------------------------------------
8811C L o c a l V a r i a b l e s
8812C-----------------------------------------------
8813 integer
8814 . i,j,k,n,id,nd,ns,nkc,nm,is,nr,nj,nn,nl,im,
8815 . iad_m1(nsl+1),iadn(nsl),jj
8816 my_real
8817 . f_imp(6) ,kii(6,6)
8818C----------------------------
8819 iad_m1(1) = 1
8820 nn = 0
8821 DO i=1,nsl
8822 nl =0
8823 IF (ikc_sl(i)>0) THEN
8824 nr = iad_slnr(i+1)-iad_slnr(i)
8825 nl = max(1,nr)
8826 nn = nn + nl
8827 iadn(i) = nn
8828 ENDIF
8829 iad_m1(i+1) = iad_m1(i)+nl
8830 ENDDO
8831 DO i = 1, nfv
8832 n = islm(i)
8833 id = iddl(n)
8834 im = iddlm(n)
8835 DO k = 1, 3
8836 nd = id + k
8837 IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
8838 udsl(k,i) = d_imp(k,n)
8839 ELSE
8840 udsl(k,i) = zero
8841 ENDIF
8842 ENDDO
8843 DO is = 1, nsl
8844 IF (inloc(n)>nsl) THEN
8845 nr = iad_slnr(is+1)-iad_slnr(is)
8846 CALL intabfr(nr,jdi_slnr(is),n,j)
8847 IF (j>0) THEN
8848 nn = iad_m1(is) + j -1
8849 nd = ndof(n)
8850 CALL get_kii(nn ,iddl_sl,iad_ss,diag_sl,lt_sl,kii,nd)
8851 DO j = 1, nd
8852 DO k = j+1, nd
8853 kii(k,j) = kii(j,k)
8854 ENDDO
8855 ENDDO
8856 DO k = 1, nd
8857 f_imp(k) = kii(k,1)*udsl(1,i)+ kii(k,2)*udsl(2,i)+
8858 . kii(k,3)*udsl(3,i)
8859 ENDDO
8860 nkc = 1
8861 DO k = 1, nd
8862 IF (ikc(id+k)==0) THEN
8863 nm = im + nkc
8864 lb(nm) = lb(nm) -f_imp(k)
8865 nkc = nkc + 1
8866 ENDIF
8867 ENDDO
8868 ENDIF
8869 ELSE
8870 IF (n==isl(is)) THEN
8871 j = is
8872 f_imp(1) = kss(1,j)*udsl(1,i)+ kss(4,j)*udsl(2,i)+
8873 . kss(5,j)*udsl(3,i)
8874 f_imp(2) = kss(4,j)*udsl(1,i)+ kss(2,j)*udsl(2,i)+
8875 . kss(6,j)*udsl(3,i)
8876 f_imp(3) = kss(5,j)*udsl(1,i)+ kss(6,j)*udsl(2,i)+
8877 . kss(3,j)*udsl(3,i)
8878 nd = 3
8879 nkc = 1
8880 DO k = 1, nd
8881 IF (ikc(id+k)==0) THEN
8882 nm = im + nkc
8883 lb(nm) = lb(nm) -f_imp(k)
8884 nkc = nkc + 1
8885 ENDIF
8886 ENDDO
8887 DO k = 1, nd
8888 kii(k,k) = kss(k,j)
8889 ENDDO
8890 kii(1,2)=kss(4,j)
8891 kii(1,3)=kss(5,j)
8892 kii(2,3)=kss(6,j)
8893 kii(2,1)=kii(1,2)
8894 kii(3,1)=kii(1,3)
8895 kii(3,2)=kii(2,3)
8896 CALL put_kii(iadn(j),iddl_sl,iad_ss,diag_sl,lt_sl,kii,nd)
8897 ENDIF
8898 ENDIF
8899 ENDDO ! IS = 1, NSL
8900 ENDDO
8901C----6---------------------------------------------------------------7---------8
8902 RETURN
8903 END
8904!||====================================================================
8905!|| ini_frud ../engine/source/mpi/implicit/imp_fri.F
8906!||--- called by ------------------------------------------------------
8907!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
8908!||--- calls -----------------------------------------------------
8909!|| intabfr ../engine/source/mpi/implicit/imp_fri.F
8910!|| spmd_exci ../engine/source/mpi/implicit/imp_spmd.F
8911!||--- uses -----------------------------------------------------
8912!|| imp_intm ../engine/share/modules/imp_intm.F
8913!||====================================================================
8914 SUBROUTINE ini_frud(NSREM ,NSL ,NFV ,IFVSI ,IFVSL ,
8915 . NF_SI ,NF_SL ,LVSI )
8916C-----------------------------------------------
8917C M o d u l e s
8918C-----------------------------------------------
8919 USE imp_intm
8920C-----------------------------------------------
8921C I m p l i c i t T y p e s
8922C-----------------------------------------------
8923#include "implicit_f.inc"
8924C-----------------------------------------------
8925C C o m m o n B l o c k s
8926C-----------------------------------------------
8927#include "com01_c.inc"
8928C-----------------------------------------------
8929C D u m m y A r g u m e n t s
8930C-----------------------------------------------
8931 INTEGER NSREM ,NSL,NFV ,IFVSI(*) ,IFVSL(*) ,
8932 . nf_sl(*),nf_si(*),lvsi
8933C REAL
8934C-----------------------------------------------
8935C L o c a l V a r i a b l e s
8936C-----------------------------------------------
8937 INTEGER I,J,N,K,IAD,NJ,L
8938 INTEGER SSIZE ,RSIZE,SIZE,IAD_S(NSPMD+1),IAD_R(NSPMD+1)
8939C--------------------------------------------
8940 iad = 1
8941 DO i = 1, nsl
8942 IF (ikc_sl(i)>0) THEN
8943 DO k=1,nf_sl(i)
8944 ifvsl(iad) = 0
8945 iad = iad + 1
8946 ENDDO
8947 ENDIF
8948 ENDDO
8949C
8950 iad = 1
8951 DO i = 1, nsl
8952 IF (ikc_sl(i)>0.AND.nf_sl(i)>0) THEN
8953 n = isl(i)
8954 CALL intabfr(nfv,islm,n,j)
8955 IF (j>0) THEN
8956 ifvsl(iad) = j
8957 ELSE
8958 DO k=iad_slnr(i),iad_slnr(i+1)-1
8959 nj = jdi_slnr(k)
8960 CALL intabfr(nfv,islm,nj,l)
8961 IF (l>0) ifvsl(iad+k-iad_slnr(i)) = l
8962 ENDDO
8963 ENDIF
8964 iad = iad + nf_sl(i)
8965 ENDIF
8966 ENDDO
8967C
8968 iad_s(1) = 1
8969 iad_r(1) = 1
8970 DO i=1,nspmd
8971 iad_s(i+1) = iad_s(i)
8972 iad_r(i+1) = iad_r(i)
8973 DO j=iad_sl(i),iad_sl(i+1)-1
8974 iad_s(i+1) = iad_s(i+1) + nf_sl(j)
8975 END DO
8976 DO j=iad_srem(i),iad_srem(i+1)-1
8977 iad_r(i+1) = iad_r(i+1) + nf_si(j)
8978 END DO
8979 END DO
8980C
8981 SIZE = 1
8982 ssize = iad_s(nspmd+1) - 1
8983 rsize = iad_r(nspmd+1) - 1
8984 CALL spmd_exci(ifvsl,ifvsi,iad_s,iad_r,SIZE ,ssize,rsize)
8985C
8986 lvsi = 0
8987 iad = 1
8988 DO i = 1, nsrem
8989 IF (ikc_si(i)>0) THEN
8990 DO k=1,nf_si(i)
8991 IF (ifvsi(iad) > 0) lvsi = lvsi +1
8992 iad = iad + 1
8993 ENDDO
8994 ENDIF
8995 ENDDO
8996C
8997 RETURN
8998 END
8999!||====================================================================
9000!|| scom_frud ../engine/source/mpi/implicit/imp_fri.F
9001!||--- called by ------------------------------------------------------
9002!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
9003!||--- calls -----------------------------------------------------
9004!|| spmd_exck ../engine/source/mpi/implicit/imp_spmd.F
9005!||--- uses -----------------------------------------------------
9006!|| imp_intm ../engine/share/modules/imp_intm.F
9007!||====================================================================
9008 SUBROUTINE scom_frud(UDS,UDR,NF_S,NF_R,IKCS,IKCR )
9009C-----------------------------------------------
9010C M o d u l e s
9011C-----------------------------------------------
9012 USE imp_intm
9013C-----------------------------------------------
9014C I m p l i c i t T y p e s
9015C-----------------------------------------------
9016#include "implicit_f.inc"
9017C-----------------------------------------------
9018C C o m m o n B l o c k s
9019C-----------------------------------------------
9020#include "com01_c.inc"
9021C-----------------------------------------------
9022C D u m m y A r g u m e n t s
9023C-----------------------------------------------
9024 INTEGER IKCS(*),IKCR(*),NF_S(*),NF_R(*)
9025 my_real
9026 . uds(3,*),udr(3,*)
9027C-----------------------------------------------
9028C L o c a l V a r i a b l e s
9029C-----------------------------------------------
9030 INTEGER I ,J ,K ,L,IADS,IADR,IER1,ID,ID0
9031 INTEGER SSIZE ,RSIZE,SIZE,IAD_S(NSPMD+1),IAD_R(NSPMD+1)
9032 my_real, DIMENSION(:,:),ALLOCATABLE :: uds1
9033C-----------------------------------------------
9034C S o u r c e L i n e s
9035C-----------------------------------------------
9036 SIZE = 3
9037 iads = 1
9038 iadr = 1
9039 iad_s(1) = 1
9040 iad_r(1) = 1
9041 DO i=1,nspmd
9042 iad_s(i+1) = iad_s(i)
9043 iad_r(i+1) = iad_r(i)
9044 DO j=iad_sl(i),iad_sl(i+1)-1
9045 DO k = 1,nf_s(j)
9046 iad_s(i+1) = iad_s(i+1) + min(1,ikcs(iads))
9047 iads = iads + 1
9048 END DO
9049 END DO
9050 DO j=iad_srem(i),iad_srem(i+1)-1
9051 DO k = 1,nf_r(j)
9052 iad_r(i+1) = iad_r(i+1) + min(1,ikcr(iadr))
9053 iadr = iadr + 1
9054 END DO
9055 END DO
9056 END DO
9057 ssize = iad_s(nspmd+1) - 1
9058 rsize = iad_r(nspmd+1) - 1
9059 IF (ssize>0) THEN
9060 ALLOCATE(uds1(3,ssize),stat=ier1)
9061 iads = 1
9062 DO i=1,nspmd
9063 id = iad_s(i)
9064 DO j=iad_sl(i),iad_sl(i+1)-1
9065 DO k = 1,nf_s(j)
9066 id0 = ikcs(iads)
9067 IF (id0>0) THEN
9068 DO l = 1,3
9069 uds1(l,id) = uds(l,id0)
9070 END DO
9071 id = id + 1
9072 ENDIF
9073 iads = iads + 1
9074 END DO
9075 END DO
9076 END DO
9077 ENDIF
9078 CALL spmd_exck(uds1,udr ,iad_s,iad_r,SIZE ,ssize,rsize)
9079 IF (ssize>0) DEALLOCATE(uds1)
9080C
9081 RETURN
9082 END
9083!||====================================================================
9084!|| imp_fvksl ../engine/source/mpi/implicit/imp_fri.F
9085!||--- called by ------------------------------------------------------
9086!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
9087!||--- calls -----------------------------------------------------
9088!|| imp_fvksm ../engine/source/mpi/implicit/imp_fri.F
9089!||--- uses -----------------------------------------------------
9090!|| imp_intm ../engine/share/modules/imp_intm.F
9091!||====================================================================
9092 SUBROUTINE imp_fvksl(
9093 1 IDDL ,IDDLM ,IKC ,IFVSI ,NF_SI ,
9094 2 KSI ,LB ,NSREM ,UDSI )
9095C-----------------------------------------------
9096C M o d u l e s
9097C-----------------------------------------------
9098 USE imp_intm
9099C----6---------------------------------------------------------------7---------8
9100C I m p l i c i t T y p e s
9101C-----------------------------------------------
9102#include "implicit_f.inc"
9103C-----------------------------------------------------------------
9104C D u m m y A r g u m e n t s
9105C-----------------------------------------------
9106 INTEGER NSREM,IDDLM(*),IKC(*),IDDL(*),IFVSI(*),NF_SI(*)
9107C REAL
9108 my_real
9109 . ksi(9,*),lb(*) ,udsi(3,*)
9110C-----------------------------------------------
9111C L o c a l V a r i a b l e s
9112C-----------------------------------------------
9113 integer
9114 . i,j,j1,nj,iad,iadu,iadi,id,nd,jd,iad_m1(nsrem+1)
9115C----------------------------
9116 iad_m1(1) = 0
9117 DO i=1,nsrem
9118 iad_m1(i+1) = iad_m1(i)+ikc_si(i)*nf_si(i)
9119 ENDDO
9120 iad = 0
9121 iadu = 0
9122 DO i=1,nsrem
9123 IF (ikc_si(i)>0) THEN
9124 DO j =1, nf_si(i)
9125 iad = iad + 1
9126 IF (ifvsi(iad)>0) THEN
9127 iadu = iadu + 1
9128 DO j1 = iad_sinr(i),iad_sinr(i+1)-1
9129 nj = jdi_sinr(j1)
9130 iadi = iad_m1(i) +nf_si(i)*(j1-iad_sinr(i))+ j
9131 CALL imp_fvksm(
9132 1 nj ,iddl ,iddlm ,ikc ,
9133 2 udsi(1,iadu),ksi(1,iadi),lb )
9134 ENDDO
9135 ENDIF
9136 ENDDO
9137 ENDIF
9138 ENDDO
9139C----6---------------------------------------------------------------7---------8
9140 RETURN
9141 END
9142!||====================================================================
9143!|| imp_fvksm ../engine/source/mpi/implicit/imp_fri.F
9144!||--- called by ------------------------------------------------------
9145!|| imp_fvksl ../engine/source/mpi/implicit/imp_fri.F
9146!||====================================================================
9147 SUBROUTINE imp_fvksm(
9148 1 NJ ,IDDL ,IDDLM ,IKC ,
9149 2 UDS ,KSM ,LB )
9150C----6---------------------------------------------------------------7---------8
9151C I m p l i c i t T y p e s
9152C-----------------------------------------------
9153#include "implicit_f.inc"
9154C-----------------------------------------------------------------
9155C D u m m y A r g u m e n t s
9156C-----------------------------------------------
9157 INTEGER NJ,IDDLM(*),IKC(*),IDDL(*)
9158C REAL
9159 my_real
9160 . ksm(3,3), lb(*) ,uds(3)
9161C-----------------------------------------------
9162C L o c a l V a r i a b l e s
9163C-----------------------------------------------
9164 integer
9165 . k,n,nd,ns,nkc,nm
9166 my_real
9167 . lbd(3)
9168C----------------------------
9169 DO k=1,3
9170 lbd(k) = ksm(1,k)*uds(1)+ ksm(2,k)*uds(2)+
9171 . ksm(3,k)*uds(3)
9172 ENDDO
9173C
9174 nkc = 1
9175 DO k = 1, 3
9176 nd = iddl(nj)+k
9177 nm = iddlm(nj) + nkc
9178 IF (ikc(nd)==0) THEN
9179 lb(nm) = lb(nm) -lbd(k)
9180 nkc = nkc + 1
9181 ENDIF
9182 ENDDO
9183C----6---------------------------------------------------------------7---------8
9184 RETURN
9185 END
9186!||====================================================================
9187!|| imp_fvkm ../engine/source/mpi/implicit/imp_fri.F
9188!||--- called by ------------------------------------------------------
9189!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
9190!||--- calls -----------------------------------------------------
9191!|| get_iad ../engine/source/mpi/implicit/imp_fri.F
9192!|| getfr_kij ../engine/source/mpi/implicit/imp_fri.F
9193!|| intabfr ../engine/source/mpi/implicit/imp_fri.F
9194!||--- uses -----------------------------------------------------
9195!|| imp_intm ../engine/share/modules/imp_intm.F
9196!||====================================================================
9197 SUBROUTINE imp_fvkm(
9198 1 KFR_SI ,KFR_SL ,IDDL ,NDOF ,IKC ,
9199 2 INLOC ,IAD_M ,NSREM ,NSL ,UD0 ,
9200 3 FDSI ,NF_SI ,NFV ,NFD ,IDDLI )
9201C-----------------------------------------------
9202C M o d u l e s
9203C-----------------------------------------------
9204 USE imp_intm
9205C----6---------------------------------------------------------------7---------8
9206C I m p l i c i t T y p e s
9207C-----------------------------------------------
9208#include "implicit_f.inc"
9209C-----------------------------------------------------------------
9210C D u m m y A r g u m e n t s
9211C-----------------------------------------------
9212 INTEGER NSREM,IAD_M(*),NSL,IDDL(*),NDOF(*),INLOC(*),
9213 . ikc(*),nf_si(*),nfv,nfd,iddli(*)
9214C REAL
9215 my_real
9216 . ud0(3,*),kfr_si(3,3,*),kfr_sl(3,3,*),fdsi(3,*)
9217C-----------------------------------------------
9218C L o c a l V a r i a b l e s
9219C-----------------------------------------------
9220 INTEGER I,J,N,K,M,NS,IAD_M1(NSREM+1),IS,JD,
9221 . nj,nd,nl,j1,nss,nm,id,iad,nf,nr,iadi
9222 my_real
9223 . ksm(3,3),ud(3,nfv)
9224C----------------------------
9225 nd = 3
9226 DO i = 1, nfd
9227 DO k =1,nd
9228 fdsi(k,i) = zero
9229 ENDDO
9230 ENDDO
9231 iad_m1(1) = 1
9232 DO n=1,nsrem
9233 iad_m1(n+1) = iad_m1(n)+ikc_si(n)*nf_si(n)
9234 ENDDO
9235 DO i = 1, nfv
9236 ns = islm(i)
9237 DO k =1,nd
9238 id = iddl(ns)+k
9239 IF ((ikc(id)>=2.AND.ikc(id)<=4).OR.ikc(id)==9) THEN
9240 ud(k,i)=ud0(k,ns)
9241 ELSE
9242 ud(k,i)=zero
9243 ENDIF
9244 ENDDO
9245 iad = 0
9246 DO is = 1,nsrem
9247 nr =iad_sinr(is+1)- iad_sinr(is)
9248 CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
9249 DO nf = 1,max(1,nf_si(is))
9250 iad = iad + 1
9251C----------------in KFR_SL------
9252 IF (inloc(ns)>nsl) THEN
9253C
9254 DO j = iad_sinr(is), iad_sinr(is+1)-1
9255 nj = jdi_sinr(j)
9256 nss = inloc(nj)
9257 nr=iad_slnr(nss+1)- iad_slnr(nss)
9258 CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j1)
9259 IF (j1>0) THEN
9260 iadi = iad_m(nss) + j1 + is -2
9261 DO k =1,nd
9262 fdsi(k,iad) = fdsi(k,iad)+kfr_sl(1,k,iadi)*ud(1,i)+
9263 . kfr_sl(2,k,iadi)*ud(2,i)+kfr_sl(3,k,iadi)*ud(3,i)
9264 ENDDO
9265 ENDIF !(J1>0)
9266 ENDDO
9267C----------------in KFR_SI------
9268 ELSEIF (ikc_si(is)>0.AND.j>0) THEN
9269 n = 0
9270 CALL get_iad(iad_m1,iad_slnr,jdi_slnr,n ,is ,
9271 1 j ,ikc_si(is),ndof ,iadi )
9272 iadi = iadi + nf-1
9273 DO k =1,nd
9274 fdsi(k,iad) = fdsi(k,iad)+kfr_si(1,k,iadi)*ud(1,i)+
9275 . kfr_si(2,k,iadi)*ud(2,i)+kfr_si(3,k,iadi)*ud(3,i)
9276 ENDDO
9277 ELSEIF (j>0) THEN
9278 id = iddl_si(is)
9279 nm = jdi_sinr(iad_sinr(is)+j-1)
9280 jd = iddli(nm)
9281 CALL getfr_kij( id ,jd ,iad_si ,jdi_si,lt_si ,
9282 1 ksm ,nd ,nd )
9283 DO k =1,nd
9284 fdsi(k,iad) = fdsi(k,iad)+ksm(1,k)*ud(1,i)+
9285 . ksm(2,k)*ud(2,i)+ksm(3,k)*ud(3,i)
9286 ENDDO
9287 ENDIF
9288 ENDDO
9289 ENDDO
9290 ENDDO
9291C----6---------------------------------------------------------------7---------8
9292 RETURN
9293 END
9294!||====================================================================
9295!|| ini_frfd ../engine/source/mpi/implicit/imp_fri.F
9296!||--- called by ------------------------------------------------------
9297!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
9298!||--- uses -----------------------------------------------------
9299!|| imp_intm ../engine/share/modules/imp_intm.F
9300!||====================================================================
9301 SUBROUTINE ini_frfd(NSREM ,NFV ,IKCSI ,NF_SI ,FDSI )
9302C-----------------------------------------------
9303C M o d u l e s
9304C-----------------------------------------------
9305 USE imp_intm
9306C----6---------------------------------------------------------------7---------8
9307C I m p l i c i t T y p e s
9308C-----------------------------------------------
9309#include "implicit_f.inc"
9310C-----------------------------------------------------------------
9311C D u m m y A r g u m e n t s
9312C-----------------------------------------------
9313 integer
9314 . nsrem,ikcsi(3,*),nf_si(*) ,nfv
9315 my_real
9316 . fdsi(3,*)
9317C-----------------------------------------------
9318C L o c a l V a r i a b l e s
9319C-----------------------------------------------
9320 INTEGER I,J,N,K,NL,NDOFI,IAD,IADI
9321C
9322 DO i=1,nddl_si
9323 fsi(i) = zero
9324 ENDDO
9325C
9326 IF (nfv==0) RETURN
9327 ndofi = 3
9328 nl = 0
9329 iad = 1
9330 iadi = 1
9331 DO i=1,nsrem
9332C-----------SECND DEPEND.: FRK_SI---------
9333 IF (ikc_si(i)>0) THEN
9334 DO j =1, nf_si(i)
9335 DO k = 1,ndofi
9336 IF (ikcsi(k,iad)==0) THEN
9337 nl = nl + 1
9338 fsi(nl)=-fdsi(k,iadi+j-1)
9339 ENDIF
9340 ENDDO
9341 iad = iad + 1
9342 ENDDO
9343C-----------SECND INDEPEND.:LT,FRK_SL---------
9344 ELSE
9345 DO k = 1,ndofi
9346 nl = nl + 1
9347 fsi(nl)=-fdsi(k,iadi)
9348 ENDDO
9349 ENDIF
9350 iadi = iadi + max(1,nf_si(i))
9351 ENDDO
9352C
9353 RETURN
9354 END
9355!||====================================================================
9356!|| cp_slnr ../engine/source/mpi/implicit/imp_fri.F
9357!||--- calls -----------------------------------------------------
9358!|| cp_int ../engine/source/implicit/produt_v.F
9359!||--- uses -----------------------------------------------------
9360!|| imp_intm ../engine/share/modules/imp_intm.F
9361!||====================================================================
9362 SUBROUTINE cp_slnr(IAD_CP ,JDI_CP ,NSL ,NZ)
9363C-----------------------------------------------
9364C M o d u l e s
9365C-----------------------------------------------
9366 USE imp_intm
9367C----6---------------------------------------------------------------7---------8
9368C I m p l i c i t T y p e s
9369C-----------------------------------------------
9370#include "implicit_f.inc"
9371C-----------------------------------------------------------------
9372C D u m m y A r g u m e n t s
9373C-----------------------------------------------
9374 INTEGER NSL,NZ ,IAD_CP(*),JDI_CP(*)
9375C REAL
9376C-----------------------------------------------
9377C L o c a l V a r i a b l e s
9378C-----------------------------------------------
9379C----------------------------
9380 CALL cp_int((nsl+1),iad_slnr,iad_cp)
9381 CALL cp_int(nz,jdi_slnr,jdi_cp)
9382C
9383 IF(ALLOCATED(iml)) DEALLOCATE(iml)
9384 ALLOCATE(iml(nsl))
9385 CALL cp_int(nsl,isl,iml)
9386C----6---------------------------------------------------------------7---------8
9387 RETURN
9388 END
9389!||====================================================================
9390!|| ind_sld ../engine/source/mpi/implicit/imp_fri.F
9391!||--- called by ------------------------------------------------------
9392!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
9393!||--- calls -----------------------------------------------------
9394!|| put_kii ../engine/source/implicit/imp_glob_k.F
9395!|| zero1 ../engine/source/system/zero.F
9396!||--- uses -----------------------------------------------------
9397!|| imp_intm ../engine/share/modules/imp_intm.F
9398!||====================================================================
9399 SUBROUTINE ind_sld(NSL ,NDOF ,KSS )
9400C-----------------------------------------------
9401C M o d u l e s
9402C-----------------------------------------------
9403 USE imp_intm
9404C-----------------------------------------------
9405C I m p l i c i t T y p e s
9406C-----------------------------------------------
9407#include "implicit_f.inc"
9408C-----------------------------------------------
9409C D u m m y A r g u m e n t s
9410C-----------------------------------------------
9411 INTEGER NSL ,NDOF(*)
9412 my_real
9413 . kss(6,*)
9414C REAL
9415C-----------------------------------------------
9416C L o c a l V a r i a b l e s
9417C-----------------------------------------------
9418 INTEGER I,J,K,N,P,ID,NJ,NB,NL,NZ,J1,K1,NK,NN,IAD,
9419 . ier1,ier2,ier3,ier4,ier5,ier6,nd
9420 my_real
9421 . kii(6,6)
9422C-------------------------------------
9423C------IDDL as function of kinematic nodes first-----
9424 nn = 0
9425 DO i = 1,nsl
9426 IF (ikc_sl(i)>0) THEN
9427C----------int2,rb-,others-----------
9428 nb = iad_slnr(i+1)-iad_slnr(i)
9429 nn = nn + max(1,nb)
9430 ENDIF
9431 ENDDO
9432 IF(ALLOCATED(iddl_sl)) DEALLOCATE(iddl_sl)
9433 ALLOCATE(iddl_sl(nn),stat=ier1)
9434C------dim--[K_SL]-partie depedant only----LT---
9435 nn = 0
9436 nl = 0
9437 nz = 0
9438 DO i = 1,nsl
9439 IF (ikc_sl(i)>0) THEN
9440C----------int2,rb------------
9441 DO j=iad_slnr(i),iad_slnr(i+1)-1
9442 nn = nn +1
9443 iddl_sl(nn) = nl
9444 nj = jdi_slnr(j)
9445 DO k =1,ndof(nj)
9446 nl = nl + 1
9447 DO k1 = 1, k-1
9448 nz = nz + 1
9449 ENDDO
9450 ENDDO
9451C------ mimj -------
9452 DO j1=iad_slnr(i),j-1
9453 nk = jdi_slnr(j1)
9454 DO k =1,ndof(nk)
9455 nz = nz + ndof(nk)
9456 ENDDO
9457 ENDDO
9458 ENDDO
9459C----------other kin------------
9460 IF (iad_slnr(i)==iad_slnr(i+1)) THEN
9461 nn = nn +1
9462 iddl_sl(nn) = nl
9463 n = isl(i)
9464 DO k =1,min(3,ndof(n))
9465 nl = nl + 1
9466 DO k1 = 1, k-1
9467 nz = nz + 1
9468 ENDDO
9469 ENDDO
9470 ENDIF
9471 ENDIF
9472 ENDDO
9473C-----allocation------
9474 nddl_sl = nl
9475 nz_sl = nz
9476 IF(ALLOCATED(iad_ss)) DEALLOCATE(iad_ss)
9477 ALLOCATE(iad_ss(nl+1),stat=ier2)
9478 IF(ALLOCATED(jdi_sl)) DEALLOCATE(jdi_sl)
9479 ALLOCATE(jdi_sl(nz),stat=ier3)
9480C
9481 nl = 0
9482 nz = 0
9483 nn = 0
9484 iad_ss(nl+1) = nz + 1
9485 DO i = 1, nsl
9486 IF (ikc_sl(i)>0) THEN
9487 iad = nn
9488 DO j=iad_slnr(i),iad_slnr(i+1)-1
9489 nn = nn +1
9490 nj = jdi_slnr(j)
9491 DO k =1,ndof(nj)
9492 nl = nl + 1
9493C------ mij d'abord-------
9494 DO j1=iad_slnr(i),j-1
9495 nk = jdi_slnr(j1)
9496 id = iad + j1-iad_slnr(i)+1
9497 DO k1 =1,ndof(nk)
9498 nz = nz + 1
9499 jdi_sl(nz) = iddl_sl(id)+ k1
9500 ENDDO
9501 ENDDO
9502C------ mii ------
9503 DO k1 = 1, k-1
9504 nz = nz + 1
9505 jdi_sl(nz) = iddl_sl(nn) + k1
9506 ENDDO
9507 iad_ss(nl+1) = nz + 1
9508 ENDDO
9509 ENDDO
9510C----------other kin------------
9511 IF (iad_slnr(i)==iad_slnr(i+1)) THEN
9512 nn = nn +1
9513 n = isl(i)
9514 DO k =1,min(3,ndof(n))
9515 nl = nl + 1
9516 DO k1 = 1, k-1
9517 nz = nz + 1
9518 jdi_sl(nz) = iddl_sl(nn) + k1
9519 ENDDO
9520 iad_ss(nl+1) = nz + 1
9521 ENDDO
9522 ENDIF
9523 ENDIF
9524 ENDDO
9525C
9526 IF(ALLOCATED(diag_sl)) DEALLOCATE(diag_sl)
9527 IF(ALLOCATED(lt_sl)) DEALLOCATE(lt_sl)
9528 ALLOCATE(diag_sl(nl),stat=ier4)
9529 ALLOCATE(lt_sl(nz),stat=ier5)
9530 CALL zero1(diag_sl,nl)
9531 CALL zero1(lt_sl,nz)
9532C----------initiation for the case /BCS
9533 nn = 0
9534 DO i = 1, nsl
9535 IF (ikc_sl(i)>0) THEN
9536C----------other kin------------
9537 IF (iad_slnr(i)==iad_slnr(i+1)) THEN
9538 nn = nn +1
9539 n = isl(i)
9540 nd = min(3,ndof(n))
9541 DO k = 1, nd
9542 kii(k,k) = kss(k,i)
9543 ENDDO
9544 kii(1,2)=kss(4,i)
9545 kii(1,3)=kss(5,i)
9546 kii(2,3)=kss(6,i)
9547 kii(2,1)=kii(1,2)
9548 kii(3,1)=kii(1,3)
9549 kii(3,2)=kii(2,3)
9550 CALL put_kii(nn,iddl_sl,iad_ss,diag_sl,lt_sl,kii,nd)
9551 ENDIF
9552 ENDIF
9553 ENDDO
9554C
9555 RETURN
9556 END
9557!||====================================================================
9558!|| imp_frks ../engine/source/mpi/implicit/imp_fri.F
9559!||--- called by ------------------------------------------------------
9560!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
9561!||--- calls -----------------------------------------------------
9562!|| cp_int ../engine/source/implicit/produt_v.F
9563!|| cp_real ../engine/source/implicit/produt_v.F
9564!|| get_kii ../engine/source/implicit/imp_glob_k.F
9565!|| get_kij ../engine/source/implicit/imp_glob_k.F
9566!||--- uses -----------------------------------------------------
9567!|| imp_intm ../engine/share/modules/imp_intm.F
9568!||====================================================================
9569 SUBROUTINE imp_frks(NSL ,IDDL ,IKC ,NDOF ,IDDLM,
9570 . KSS ,IAD_SLD )
9571C-----------------------------------------------
9572C M o d u l e s
9573C-----------------------------------------------
9574 USE imp_intm
9575C-----------------------------------------------
9576C I m p l i c i t T y p e s
9577C-----------------------------------------------
9578#include "implicit_f.inc"
9579C-----------------------------------------------
9580C C o m m o n B l o c k s
9581C-----------------------------------------------
9582#include "com01_c.inc"
9583C-----------------------------------------------
9584C D u m m y A r g u m e n t s
9585C-----------------------------------------------
9586 INTEGER NSL ,IDDL(*),IKC(*),NDOF(*),IDDLM(*),IAD_SLD(*)
9587C REAL
9588 my_real
9589 . kss(6,*)
9590C-----------------------------------------------
9591C L o c a l V a r i a b l e s
9592C-----------------------------------------------
9593 INTEGER IDDL_CP(NDDL_SL),IAD_CP(NDDL_SL+1),JDI_CP(NZ_SL),
9594 . nr,nk,nn,idm,jd,iadi,idj,idjm,iad,ndofi
9595 INTEGER I,J,K,N,P,ID,NJ,NB,NKC,NL,NZ,K1,NKC1,J1,NM,
9596 . ier1,ier2,ier3,ier4,ier5,ier6
9597 my_real
9598 . kii(6,6),kij(6,6),lt_cp(nz_sl),diag_cp(nddl_sl)
9599C-------------------------------------
9600C----------s'il y a kin modif copy----
9601 IF (nddl_sl>0) THEN
9602 nn = 0
9603 DO i = 1,nsl
9604 IF (ikc_sl(i)>0) THEN
9605C----------int2,rb------------
9606 nb = iad_slnr(i+1)-iad_slnr(i)
9607 nn = nn + max(1,nb)
9608 ENDIF
9609 ENDDO
9610 CALL cp_int((nddl_sl+1),iad_ss,iad_cp)
9611 CALL cp_int(nn,iddl_sl,iddl_cp)
9612 CALL cp_int(nz_sl,jdi_sl,jdi_cp)
9613 CALL cp_real(nddl_sl,diag_sl,diag_cp)
9614 CALL cp_real(nz_sl,lt_sl,lt_cp)
9615 ENDIF
9616C------dim--[K_SL]-
9617 nl = 0
9618 nz = 0
9619 DO i = 1,nsl
9620 IF (ikc_sl(i)>0) THEN
9621 DO j=iad_slnr(i),iad_slnr(i+1)-1
9622 nj = jdi_slnr(j)
9623 id = iddl(nj)
9624 DO k =1,ndof(nj)
9625 IF (ikc(id+k)==0) THEN
9626 nl = nl + 1
9627C----------mij----------
9628 DO j1=iad_slnr(i),j-1
9629 nk = jdi_slnr(j1)
9630 idj = iddl(nk)
9631 DO k1 =1,ndof(nk)
9632 IF (ikc(idj+k1)==0) nz = nz + 1
9633 ENDDO
9634 ENDDO
9635 DO k1 = 1, k-1
9636 IF (ikc(id+k1)==0) nz = nz + 1
9637 ENDDO
9638 ENDIF
9639 ENDDO
9640 ENDDO
9641 IF (iad_slnr(i)==iad_slnr(i+1)) THEN
9642 n = isl(i)
9643 id = iddl(n)
9644 DO k =1,min(3,ndof(n))
9645 IF (ikc(id+k)==0) THEN
9646 nl = nl + 1
9647 DO k1 = 1, k-1
9648 IF (ikc(id+k1)==0) nz = nz + 1
9649 ENDDO
9650 ENDIF
9651 ENDDO
9652 ENDIF
9653C------independent nodes---------
9654 ELSE
9655 n = isl(i)
9656 DO k =1,min(3,ndof(n))
9657 nl = nl + 1
9658 DO k1 = 1, k-1
9659 nz = nz + 1
9660 ENDDO
9661 ENDDO
9662 ENDIF
9663 ENDDO
9664C-----allocation------
9665 IF(ALLOCATED(iddl_sl)) DEALLOCATE(iddl_sl)
9666 ALLOCATE(iddl_sl(nl),stat=ier4)
9667 IF (nl>nddl_sl) THEN
9668 IF(ALLOCATED(iad_ss)) DEALLOCATE(iad_ss)
9669 ALLOCATE(iad_ss(nl+1),stat=ier1)
9670C---------iddl devient idtok---
9671 IF(ALLOCATED(diag_sl)) DEALLOCATE(diag_sl)
9672 ALLOCATE(diag_sl(nl),stat=ier5)
9673 ENDIF
9674 IF (nz>nz_sl) THEN
9675 IF(ALLOCATED(jdi_sl)) DEALLOCATE(jdi_sl)
9676 ALLOCATE(jdi_sl(nz),stat=ier2)
9677 IF(ALLOCATED(lt_sl)) DEALLOCATE(lt_sl)
9678 ALLOCATE(lt_sl(nz),stat=ier3)
9679 ENDIF
9680 nddl_sl = nl
9681 nz_sl = nz
9682C
9683 nl = 0
9684 nz = 0
9685 nn = 0
9686 iad_ss(nl+1) = nz + 1
9687 iad_sld(1) = nl + 1
9688 DO p = 1,nspmd
9689 DO i = iad_sl(p), iad_sl(p+1)-1
9690 IF (ikc_sl(i)>0) THEN
9691 iad = nn
9692 DO j=iad_slnr(i),iad_slnr(i+1)-1
9693 nn = nn + 1
9694 nj = jdi_slnr(j)
9695 id = iddl(nj)
9696 idm = iddlm(nj)
9697 CALL get_kii(nn ,iddl_cp,iad_cp,diag_cp,lt_cp ,kii,ndof(nj))
9698 nkc =0
9699 DO k =1,ndof(nj)
9700 IF (ikc(id+k)==0) THEN
9701 nl = nl + 1
9702 iddl_sl(nl) =idm+k-nkc
9703 diag_sl(nl) = kii(k,k)
9704C----------mij----------
9705 DO j1=iad_slnr(i),j-1
9706 nk = jdi_slnr(j1)
9707 idj = iddl(nk)
9708 idjm = iddlm(nk)
9709 nm = iad + j1 - iad_slnr(i) + 1
9710 CALL get_kij(nm ,nn ,iddl_cp,iad_cp,jdi_cp,lt_cp ,kij ,
9711 . ndof(nk),ndof(nj) ,ier1 )
9712 nkc1 = 0
9713 DO k1 =1,ndof(nk)
9714 IF (ikc(idj+k1)==0) THEN
9715 nz = nz + 1
9716 jdi_sl(nz) = idjm + k1- nkc1
9717 lt_sl(nz) = kij(k1,k)
9718C LT_SL(NZ) = KIJ(K,K1)
9719 ELSE
9720 nkc1 = nkc1 + 1
9721 ENDIF
9722 ENDDO
9723 ENDDO
9724C----------mii----------
9725 nkc1 =0
9726 DO k1 = 1, k-1
9727 IF (ikc(id+k1)==0) THEN
9728 nz = nz + 1
9729 jdi_sl(nz) = idm + k1- nkc1
9730 lt_sl(nz) = kii(k1,k)
9731 ELSE
9732 nkc1 =nkc1+1
9733 ENDIF
9734 ENDDO
9735 iad_ss(nl+1) = nz+1
9736 ELSE
9737 nkc =nkc+1
9738 ENDIF
9739 ENDDO
9740 ENDDO
9741 IF (iad_slnr(i)==iad_slnr(i+1)) THEN
9742 n = isl(i)
9743 id = iddl(n)
9744 idm = iddlm(n)
9745 nn = nn + 1
9746C
9747 ndofi = min(3,ndof(n))
9748 CALL get_kii(nn ,iddl_cp,iad_cp,diag_cp,lt_cp ,kii,ndofi)
9749 nkc =0
9750 DO k =1,ndofi
9751 IF (ikc(id+k)==0) THEN
9752 nl = nl + 1
9753 iddl_sl(nl) =idm+k-nkc
9754 diag_sl(nl) = kii(k,k)
9755 nkc1 =0
9756 DO k1 = 1, k-1
9757 IF (ikc(id+k1)==0) THEN
9758 nz = nz + 1
9759 jdi_sl(nz) = idm + k1- nkc1
9760 lt_sl(nz) = kii(k1,k)
9761 ELSE
9762 nkc1 =nkc1+1
9763 ENDIF
9764 ENDDO
9765 iad_ss(nl+1) = nz+1
9766 ELSE
9767 nkc =nkc+1
9768 ENDIF
9769 ENDDO
9770 ENDIF
9771C------independent nodes---------
9772 ELSE
9773 n = isl(i)
9774 idm = iddlm(n)
9775 DO k =1,min(3,ndof(n))
9776 nl = nl + 1
9777 iddl_sl(nl) =idm+k
9778 diag_sl(nl) =kss(k,i)
9779 DO k1 = 1, k-1
9780 nz = nz + 1
9781 jdi_sl(nz) = idm + k1
9782 id = k1 + k + 1
9783 lt_sl(nz) = kss(id,i)
9784 ENDDO
9785 iad_ss(nl+1) = nz+1
9786 ENDDO
9787 ENDIF
9788 ENDDO
9789 iad_sld(p+1) = nl + 1
9790 ENDDO
9791C
9792 RETURN
9793 END
9794!||====================================================================
9795!|| cp_iadd ../engine/source/mpi/implicit/imp_fri.f
9796!||--- called by ------------------------------------------------------
9797!|| imp_frkd ../engine/source/mpi/implicit/imp_fri.F
9798!||--- calls -----------------------------------------------------
9799!|| cp_int ../engine/source/implicit/produt_v.F
9800!||--- uses -----------------------------------------------------
9801!|| imp_intm ../engine/share/modules/imp_intm.F
9802!||====================================================================
9803 SUBROUTINE cp_iadd(NSL ,NSREM,IAD_SLD ,IAD_MLD)
9804C-----------------------------------------------
9805C M o d u l e s
9806C-----------------------------------------------
9807 USE imp_intm
9808C----6---------------------------------------------------------------7---------8
9809C I m p l i c i t T y p e s
9810C-----------------------------------------------
9811#include "implicit_f.inc"
9812C-----------------------------------------------
9813C C o m m o n B l o c k s
9814C-----------------------------------------------
9815#include "com01_c.inc"
9816C-----------------------------------------------------------------
9817C D u m m y A r g u m e n t s
9818C-----------------------------------------------
9819 INTEGER NSL ,NSREM,IAD_SLD(*),IAD_MLD(*)
9820C REAL
9821C-----------------------------------------------
9822C L o c a l V a r i a b l e s
9823C-----------------------------------------------
9824 INTEGER L
9825C----------------------------
9826 l = nspmd + 1
9827 IF (nsl >0) CALL cp_int(l,iad_sld,iad_sl)
9828 IF (nsrem >0) CALL cp_int(l,iad_mld,iad_srem)
9829C----6---------------------------------------------------------------7---------8
9830 RETURN
9831 END
9832!||====================================================================
9833!|| nddli_frb ../engine/source/mpi/implicit/imp_fri.F
9834!||--- called by ------------------------------------------------------
9835!|| getnddli_g ../engine/source/mpi/implicit/imp_fri.F
9836!||--- calls -----------------------------------------------------
9837!|| spmd_nrow ../engine/source/mpi/implicit/imp_spmd.F
9838!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
9839!||--- uses -----------------------------------------------------
9840!|| imp_frk ../engine/share/modules/impbufdef_mod.F
9841!||====================================================================
9842 SUBROUTINE nddli_frb(
9843 1 NDOF ,IKC ,IDDL ,NDOFI ,NDDLIFB ,
9844 2 FR_ELEM ,IAD_ELEM )
9845C-----------------------------------------------
9846C M o d u l e s
9847C-----------------------------------------------
9848 USE imp_frk
9849C-----------------------------------------------
9850C I m p l i c i t T y p e s
9851C-----------------------------------------------
9852#include "implicit_f.inc"
9853C-----------------------------------------------
9854C C o m m o n B l o c k s
9855C-----------------------------------------------
9856#include "com01_c.inc"
9857C-----------------------------------------------
9858C D u m m y A r g u m e n t s
9859C-----------------------------------------------
9860 INTEGER NDOFI(*) ,IDDL(*),IKC(*),NDOF(*),NDDLIFB
9861 integer
9862 . fr_elem(*),iad_elem(2,*)
9863C REAL
9864C-----------------------------------------------
9865C L o c a l V a r i a b l e s
9866C-----------------------------------------------
9867 INTEGER I,J,N,NK,IP,L,IFRE,II,IAD2,IJ,IND,N_FR,NB,
9868 . k,nd,nzzk,nj,nzz,iad,jad,id,jd,idk,nc
9869 INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG,ICONT
9870 my_real
9871 . s1,stmp
9872C
9873 stmp = zero
9874 n_fr = iad_elem(1,nspmd+1)-iad_elem(1,1)
9875 IF (n_fr>0) THEN
9876 ALLOCATE(itag(n_fr),icont(n_fr))
9877 itag = 0
9878 DO ip =1,nspmd
9879 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
9880 n=fr_elem(nk)
9881 idk=iddl(n)
9882 ifre = 0
9883 DO j=1,min(ndof(n),ndofi(n))
9884 IF (ikc(idk+j)==0) ifre=ifre+1
9885 ENDDO
9886 itag(nk) = ifre
9887 ENDDO
9888 ENDDO
9889 CALL spmd_nrow(itag,icont,iad_elem,n_fr)
9890 DO nk=1,n_fr
9891 icont(nk)=min(itag(nk),icont(nk))
9892 IF (icont(nk)>0) THEN
9893 icont(nk) = itag(nk)
9894 itag(nk) = 2
9895 ENDIF
9896 ENDDO
9897 DO nk=1,n_fr
9898 nb=-ifrloc(nk)
9899 IF (nb>0.AND.icont(nk)>0) itag(nb) = itag(nb) + 1
9900 ENDDO
9901 DO nk=1,n_fr
9902 IF (icont(nk)>0) THEN
9903 nb=-ifrloc(nk)
9904 IF (nb<0) nb = nk
9905 s1 = one/itag(nb)
9906 stmp = stmp + s1*icont(nk)
9907 ENDIF
9908 ENDDO
9909 DEALLOCATE(itag,icont)
9910 END IF !(N_FR>0) THEN
9911 CALL spmd_sum_s(stmp)
9912 nddlifb = int(stmp)
9913C
9914 RETURN
9915 END
9916!||====================================================================
9917!|| ndofi_nsl ../engine/source/mpi/implicit/imp_fri.F
9918!||--- called by ------------------------------------------------------
9919!|| nddli_ns ../engine/source/mpi/implicit/imp_fri.F
9920!||--- uses -----------------------------------------------------
9921!|| imp_intm ../engine/share/modules/imp_intm.f
9922!||====================================================================
9923 SUBROUTINE ndofi_nsl(NSL ,NDDLI ,NDOFI )
9924C-----------------------------------------------
9925C M o d u l e s
9926C-----------------------------------------------
9927 USE imp_intm
9928C-----------------------------------------------
9929C I m p l i c i t T y p e s
9930C-----------------------------------------------
9931#include "implicit_f.inc"
9932C-----------------------------------------------
9933C C o m m o n B l o c k s
9934C-----------------------------------------------
9935#include "com04_c.inc"
9936C-----------------------------------------------
9937C D u m m y A r g u m e n t s
9938C-----------------------------------------------
9939 INTEGER NSL,NDOFI(*) ,NDDLI
9940C REAL
9941C-----------------------------------------------
9942C L o c a l V a r i a b l e s
9943C-----------------------------------------------
9944C--------MIS jour NDOFI pour NSL----
9945 INTEGER I,J,N,IDK,NC,NDOFII
9946 ndofii = 3
9947 IF (nddli==0) THEN
9948 DO n =1,numnod
9949 ndofi(n)= 0
9950 ENDDO
9951 ENDIF
9952 DO i =1,nsl
9953 n=isl(i)
9954 IF(ndofi(n)==0) ndofi(n)= -ndofii
9955 ENDDO
9956C
9957 RETURN
9958 END
9959!||====================================================================
9960!|| getnddli_g ../engine/source/mpi/implicit/imp_fri.F
9961!||--- called by ------------------------------------------------------
9962!|| imp_solv ../engine/source/implicit/imp_solv.F
9963!||--- calls -----------------------------------------------------
9964!|| nddli_frb ../engine/source/mpi/implicit/imp_fri.F
9965!|| nddli_ns ../engine/source/mpi/implicit/imp_fri.F
9966!|| spmd_nddlig ../engine/source/mpi/implicit/imp_spmd.F
9967!||--- uses -----------------------------------------------------
9968!|| imp_frk ../engine/share/modules/impbufdef_mod.F
9969!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
9970!||====================================================================
9971 SUBROUTINE getnddli_g(
9972 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
9973 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,NDOFI ,
9974 3 NDOF ,IKC ,IDDL ,FR_ELEM ,IAD_ELEM ,
9975 4 NDDLI ,NSL ,NDDLIG ,IRBE3 ,LRBE3 ,
9976 5 IRBE2 ,LRBE2 )
9977C-----------------------------------------------
9978C M o d u l e s
9979C-----------------------------------------------
9980 USE imp_frk
9981 USE intbufdef_mod
9982C-----------------------------------------------
9983C I m p l i c i t T y p e s
9984C-----------------------------------------------
9985#include "implicit_f.inc"
9986C-----------------------------------------------
9987C C o m m o n B l o c k s
9988C-----------------------------------------------
9989#include "param_c.inc"
9990C-----------------------------------------------
9991C D u m m y A r g u m e n t s
9992C-----------------------------------------------
9993 INTEGER NDOFI(*) ,IDDL(*),IKC(*),NDOF(*),NDDLI,NDDLIG,NSL
9994 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
9995 . NINT2,IINT2(*),IPARI(NPARI,*),
9996 . IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
9997 INTEGER
9998 . FR_ELEM(*),IAD_ELEM(2,*)
9999C REAL
10000 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
10001C-----------------------------------------------
10002C L o c a l V a r i a b l e s
10003C-----------------------------------------------
10004 INTEGER NDDLIFB,NDDLINS
10005C
10006 CALL NDDLI_FRB(
10007 1 ndof ,ikc ,iddl ,ndofi ,nddlifb ,
10008 2 fr_elem ,iad_elem )
10009 CALL nddli_ns(
10010 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
10011 2 nint2 ,iint2 ,ipari ,intbuf_tab,ndofi ,
10012 3 ndof ,ikc ,iddl ,nsl ,nddli ,
10013 4 nddlins ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
10014 CALL spmd_nddlig(nddlins ,nddlifb ,nddlig )
10015C
10016 RETURN
10017 END
10018!||====================================================================
10019!|| nddli_ns ../engine/source/mpi/implicit/imp_fri.F
10020!||--- called by ------------------------------------------------------
10021!|| getnddli_g ../engine/source/mpi/implicit/imp_fri.F
10022!||--- calls -----------------------------------------------------
10023!|| ndofi_nsl ../engine/source/mpi/implicit/imp_fri.F
10024!||--- uses -----------------------------------------------------
10025!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
10026!||====================================================================
10027 SUBROUTINE nddli_ns(
10028 1 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
10029 2 NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,NDOFI ,
10030 3 NDOF ,IKC ,IDDL ,NSL ,NDDLI ,
10031 4 NDDLINS ,IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
10032C-----------------------------------------------
10033C M o d u l e s
10034C-----------------------------------------------
10035 USE intbufdef_mod
10036C----6---------------------------------------------------------------7---------8
10037C I m p l i c i t T y p e s
10038C-----------------------------------------------
10039#include "implicit_f.inc"
10040C-----------------------------------------------
10041C C o m m o n B l o c k s
10042C-----------------------------------------------
10043#include "com04_c.inc"
10044#include "param_c.inc"
10045C-----------------------------------------------------------------
10046C D u m m y A r g u m e n t s
10047C-----------------------------------------------
10048C INTEGER NNMAX,NKMAX
10049 INTEGER NDOFI(*) ,IDDL(*),IKC(*),NDOF(*),NDDLINS,NSL
10050 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
10051 . NINT2,IINT2(*),IPARI(NPARI,*),NDDLI,
10052 . IRBE3(NRBE3L,*),LRBE3(*),IRBE2(NRBE2L,*),LRBE2(*)
10053C REAL
10054 TYPE(intbuf_struct_) INTBUF_TAB(*)
10055C-----------------------------------------------
10056C L o c a l V a r i a b l e s
10057C-----------------------------------------------
10058 integer
10059 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,nm,
10060 . ji,ns,nnod,ndofii,iad
10061C------------
10062 CALL ndofi_nsl(nsl ,nddli ,ndofi )
10063 DO j=1,nint2
10064 n=iint2(j)
10065 nsn = ipari(5,n)
10066 ji=ipari(1,n)
10067 DO i=1,nsn
10068 ni=intbuf_tab(n)%NSV(i)
10069 IF (ndofi(ni)<0) THEN
10070 l=intbuf_tab(n)%IRTLM(i)
10071 nl=4*(l-1)
10072 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
10073 nnod=3
10074 ELSE
10075 nnod=4
10076 ENDIF
10077 DO m=1,nnod
10078 nm=intbuf_tab(n)%IRECTM(nl+m)
10079 IF (ndofi(nm)==0) ndofi(nm) = -6
10080 ENDDO
10081 ENDIF
10082 ENDDO
10083 ENDDO
10084C----RBE2-----
10085 DO n=1,nrbe2
10086 iad=irbe2(1,n)
10087 m =irbe2(3,n)
10088 nsn =irbe2(5,n)
10089 DO i=1,nsn
10090 id = i+iad
10091 ni=lrbe2(id)
10092 IF (ndofi(ni)<0) THEN
10093 IF (ndofi(m)==0) ndofi(m) = -6
10094 ENDIF
10095 ENDDO
10096 ENDDO
10097C--------RBE3----
10098 DO n=1,nrbe3
10099 iad=irbe3(1,n)
10100 ni=irbe3(3,n)
10101 IF (ni==0) cycle
10102 nnod=irbe3(5,n)
10103 IF (ndofi(ni)<0) THEN
10104 DO m=1,nnod
10105 nm=lrbe3(iad+m)
10106 IF (ndofi(nm)==0) ndofi(nm) = -6
10107 ENDDO
10108 ENDIF
10109 ENDDO
10110C-----active rigid body main nodes------
10111 DO j=1,nrbyac
10112 n=irbyac(j)
10113 k=irbyac(j+nrbykin)
10114 m =npby(1,n)
10115 nsn =npby(2,n)
10116 DO i=1,nsn
10117 id = i+k
10118 ni=lpby(id)
10119 IF (ndofi(ni)<0) THEN
10120 IF (ndofi(m)==0) ndofi(m) = -6
10121 ENDIF
10122 ENDDO
10123 ENDDO
10124C-----mis jour NDOFI pour NSL+kin------
10125 nddlins = nddli
10126 DO n =1,numnod
10127 IF(ndofi(n)<0) THEN
10128 ndofii = min(-ndofi(n),ndof(n))
10129 id=iddl(n)
10130 DO j=1,ndofii
10131 IF (ikc(id+j)==0) nddlins = nddlins+1
10132 ENDDO
10133 END IF
10134 ENDDO
10135C----6---------------------------------------------------------------7---------8
10136 RETURN
10137 END
10138!||====================================================================
10139!|| spc_fr_k ../engine/source/mpi/implicit/imp_fri.F
10140!||--- called by ------------------------------------------------------
10141!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
10142!||--- calls -----------------------------------------------------
10143!|| intab0 ../engine/source/implicit/imp_fsa_inv.F
10144!||--- uses -----------------------------------------------------
10145!|| imp_frk ../engine/share/modules/impbufdef_mod.F
10146!||====================================================================
10147 SUBROUTINE spc_fr_k(
10148 1 IADK ,JDIK ,NDOF ,IDDL ,FR_ELEM ,
10149 2 IAD_ELEM )
10150C-----------------------------------------------
10151C M o d u l e s
10152C-----------------------------------------------
10153 USE imp_frk
10154C-----------------------------------------------
10155C I m p l i c i t T y p e s
10156C-----------------------------------------------
10157#include "implicit_f.inc"
10158C-----------------------------------------------
10159C C o m m o n B l o c k s
10160C-----------------------------------------------
10161#include "com01_c.inc"
10162#include "impl1_c.inc"
10163C-----------------------------------------------
10164C D u m m y A r g u m e n t s
10165C-----------------------------------------------
10166 INTEGER IADK(*) ,JDIK(*),IDDL(*),NDOF(*)
10167 INTEGER
10168 . FR_ELEM(*),IAD_ELEM(2,*)
10169C REAL
10170C-----------------------------------------------
10171C External function
10172C-----------------------------------------------
10173 INTEGER INTAB0
10174 EXTERNAL INTAB0
10175C-----------------------------------------------
10176C L o c a l V a r i a b l e s
10177C-----------------------------------------------
10178 INTEGER I,J,N,NK,IP,L,IFIX,II,IAD2,IJ,IND,N_FR,NB,
10179 . K,ND,NZZK,NJ,NZZ,IAD,JAD,ID,JD,IDK,NC
10180C
10181 IF (NDDLFR<=0) return
10182C-------FR2K-------
10183 iad2 = 0
10184 DO ip =1,nspmd
10185 DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
10186 n=fr_elem(nk)
10187 id=iddlfr(nk)+iad2
10188 idk=iddl(n)
10189 DO j=1,ndof(n)
10190 ifr2k(id+j)=idk+j
10191 ENDDO
10192 ENDDO
10193 iad2 = iad2 + nd_fr(ip)
10194 ENDDO
10195 len_v = iad2
10196C
10197 len_k = 0
10198 iad = 0
10199 iad2 = 0
10200 jad = 0
10201 IF (ikpat==0) THEN
10202 DO ip =1,nspmd
10203 DO i=1,nd_fr(ip)
10204 id = i+iad
10205 ii = ifr2k(i+iad2)
10206 DO j=iadfr(id),iadfr(id+1)-1
10207 jd = j + jad
10208 k=jdifr(jd)
10209 ij = ifr2k(k+iad2)
10210 IF (ii<ij) THEN
10211 nc = iadk(ii+1)-iadk(ii)
10212 n=intab0(nc,jdik(iadk(ii)),ij)
10213 IF (n>0) THEN
10214 jfr2k(jd)=n+iadk(ii)-1
10215 ELSE
10216 write(*,*)'index error in SPC_FR_K I<J',ij,ip,nc
10217 ENDIF
10218 ELSE
10219 nc = iadk(ij+1)-iadk(ij)
10220 n=intab0(nc,jdik(iadk(ij)),ii)
10221 IF (n>0) THEN
10222 jfr2k(jd)=n+iadk(ij)-1
10223 ELSE
10224 write(*,*)'index error in SPC_FR_K J<I',ii,ip,nc
10225 ENDIF
10226 ENDIF
10227 ENDDO
10228 ENDDO
10229 nzzk=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
10230 iad = iad + nd_fr(ip) +1
10231 iad2 = iad2 + nd_fr(ip)
10232 jad = jad + nzzk
10233 ENDDO
10234 ELSE
10235 DO ip =1,nspmd
10236 DO i=1,nd_fr(ip)
10237 id = i+iad
10238 ii = ifr2k(i+iad2)
10239 DO j=iadfr(id),iadfr(id+1)-1
10240 jd = j + jad
10241 k=jdifr(jd)
10242 ij = ifr2k(k+iad2)
10243 IF (ii>ij) THEN
10244 nc = iadk(ii+1)-iadk(ii)
10245 n=intab0(nc,jdik(iadk(ii)),ij)
10246 IF (n>0) THEN
10247 jfr2k(jd)=n+iadk(ii)-1
10248 ELSE
10249 write(*,*)'index error in SPC_FR_K I>J',ij,ip,nc
10250 ENDIF
10251 ELSE
10252 nc = iadk(ij+1)-iadk(ij)
10253 n=intab0(nc,jdik(iadk(ij)),ii)
10254 IF (n>0) THEN
10255 jfr2k(jd)=n+iadk(ij)-1
10256 ELSE
10257 write(*,*)'index error in SPC_FR_K J>I',ii,ip,nc
10258 ENDIF
10259 ENDIF
10260 ENDDO
10261 ENDDO
10262 nzzk=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
10263 iad = iad + nd_fr(ip) +1
10264 iad2 = iad2 + nd_fr(ip)
10265 jad = jad + nzzk
10266 ENDDO
10267 END IF !(IKPAT>0)
10268 len_k = iad2+jad
10269C
10270 RETURN
10271 END
10272
l_dir
subroutine l_dir(ej, j)
Definition bc_imp0.F:405
bc_fi
subroutine bc_fi(n, ej, j1, a)
Definition bc_imp0.F:1036
fv_updkd2
subroutine fv_updkd2(skew, skew1, kdd, diag_k)
Definition bc_imp0.F:2515
bcl_frk
subroutine bcl_frk(n, iddl, iddlm, ict, isk, skew, ikc, iadk, jdik, diag_k, lt_k, lb, a, kss, ksm, idlm, ifss, ifsm)
Definition bc_imp0.F:1414
bc_updfr2
subroutine bc_updfr2(n, iddl, skew, skew1, iddlm, ikc, iadk, jdik, diag_k, lt_k, lb, a, kss, ksm, idlm, ifss, ifsm)
Definition bc_imp0.F:2613
bcl_impd
subroutine bcl_impd(ict, isk, skew, i, d)
Definition bc_imp0.F:721
bc_updfr
subroutine bc_updfr(n, iddl, ej, jj, iddlm, ikc, iadk, jdik, diag_k, lt_k, lb, a, kss, ksm, idlm, ifss, ifsm)
Definition bc_imp0.F:1332
bc_updd
subroutine bc_updd(n, ej, j, d)
Definition bc_imp0.F:843
bc_updf
subroutine bc_updf(nbc, ibc, skew, a)
Definition bc_imp0.F:974
bc_upd2d
subroutine bc_upd2d(n, skew, skew1, d)
Definition bc_imp0.F:2469
bc_fi2
subroutine bc_fi2(n, skew, skew1, a)
Definition bc_imp0.F:2562
bcl_impkd
subroutine bcl_impkd(ict, isk, skew, kdd, diag_k)
Definition bc_imp0.F:914
bc_imp0
subroutine bc_imp0(icodt, icodr, iskew, ifix, ndof, iadn)
Definition bc_imp0.F:31
my_real
#define my_real
Definition cppsort.cpp:32
fvl_frk
subroutine fvl_frk(j1, n, ibfv, skew, xframe, iddl, iddlm, ikc, iadk, jdik, diag_k, lt_k, ud, lb, a, kss, ksm, idlm, ifss, ifsm)
Definition fv_imp0.F:1633
fv_updfr
subroutine fv_updfr(n, ej, j1, iddl, iddlm, ikc, iadk, jdik, diag_k, lt_k, ud, lb, a, kss, ksm, idlm, ifss, ifsm)
Definition fv_imp0.F:1700
fv_updf
subroutine fv_updf(nfx, ifx, ibfv, skew, xframe, a)
Definition fv_imp0.F:1427
fv_updkd
subroutine fv_updkd(ej, j, kdd, diag_k)
Definition fv_imp0.F:1519
fv_impd
subroutine fv_impd(ibfv, lj, skew, xframe, ud, rd)
Definition fv_imp0.F:932
kin_updf
subroutine kin_updf(n, ej, j1, a)
Definition fv_imp0.F:1487
zero1
subroutine zero1(r, n)
Definition hm_read_rbe3.F:1481
prerbe3fr
subroutine prerbe3fr(irbe3, n, jt, jr)
Definition hm_read_rbe3.F:1499
i2_frfm0
subroutine i2_frfm0(x, irect, crst, nsv, irtl, a, ar, ii, ndof)
Definition i2_imp1.F:1600
i2_frfm1
subroutine i2_frfm1(x, irect, dpara, nsv, irtl, a, ii)
Definition i2_imp1.F:1508
i2_frup1
subroutine i2_frup1(x, irect, dpara, nsv, irtl, ii, kii, kjj)
Definition i2_imp1.F:1792
i2_frk0
subroutine i2_frk0(irect, crst, x, itab, nsv, irtl, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, ii, idlm, iss, ism)
Definition i2_imp1.F:2470
i2_frup0
subroutine i2_frup0(x, irect, crst, nsv, irtl, ii, ndof, kss, k)
Definition i2_imp1.F:1702
i2_frk1
subroutine i2_frk1(irect, dpara, x, itab, nsv, irtl, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, ii, idlm, iss, ism)
Definition i2_imp1.F:2629
i2_frrd0
subroutine i2_frrd0(x, irect, crst, nsv, irtl, d, dr, ii, ndof)
Definition i2_imp2.F:478
i2_frrd1
subroutine i2_frrd1(x, irect, dpara, nsv, irtl, d, ii)
Definition i2_imp2.F:384
i7mainfr
subroutine i7mainfr(a, v, d, x, ms, ipari, intbuf_tab, num_imp, ns_imp, ne_imp)
Definition i7ke3.F:210
ini_intm
subroutine ini_intm(iloc, n_imps, n_impn)
Definition imp_fri.F:1203
ind_fvn
subroutine ind_fvn(ndof, iddl, ikc, inloc, nfv)
Definition imp_fri.F:8735
cp_iadd
subroutine cp_iadd(nsl, nsrem, iad_sld, iad_mld)
Definition imp_fri.F:9804
ini_ddfv
subroutine ini_ddfv(iddl, ikc, ndof, ipari, intbuf_tab, d, dr, dd, ddr, nsl, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:880
ind_fr_k0
subroutine ind_fr_k0(ndof, nrow, nnmax, icol, fr_elem, iad_elem, n_fr)
Definition imp_fri.F:3727
ini_frkc
subroutine ini_frkc(nsrem, nsl, ikc, ndof, iddl)
Definition imp_fri.F:5581
rowfr_dim24
subroutine rowfr_dim24(jlt, ns_imp, ne_imp, irect, nrow, nsn, nin, subtria, nvoisin)
Definition imp_fri.F:5028
kin_kml
subroutine kin_kml(ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, ndof, ilocp, nsrem, iddl, ikc, iad_m, nml, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:7437
imp_frks
subroutine imp_frks(nsl, iddl, ikc, ndof, iddlm, kss, iad_sld)
Definition imp_fri.F:9571
ikincf
logical function ikincf(i)
Definition imp_fri.F:7180
rowfr_ind24
subroutine rowfr_ind24(jlt, ns_imp, ne_imp, irect, nrow, icol, nnmax, nsn, nin, subtria, nvoisin)
Definition imp_fri.F:5082
upd_fr_k
subroutine upd_fr_k(iadk, jdik, ndof, ikc, iddl, inloc, fr_elem, iad_elem, nddl)
Definition imp_fri.F:4091
kin_nrmax
subroutine kin_nrmax(nnmax, nkmax, nrowk, icok, icokm, iloc, ink, fr_elem, iad_elem)
Definition imp_fri.F:3219
reorder_fr
subroutine reorder_fr(n, ic, iddl)
Definition imp_fri.F:5228
ini_ksi
subroutine ini_ksi(nsrem, ksi, iddl)
Definition imp_fri.F:5677
ini_frud
subroutine ini_frud(nsrem, nsl, nfv, ifvsi, ifvsl, nf_si, nf_sl, lvsi)
Definition imp_fri.F:8916
upd_ksl
subroutine upd_ksl(ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, inloc, nsl, iad_m, iddl, ikc, ndof, iddlm, ud, a, b, kss, ksl_fr, ksi_fr, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition imp_fri.F:5749
mav_ltfr
subroutine mav_ltfr(v, w)
Definition imp_fri.F:4598
upd_fr
subroutine upd_fr(a, ar, x, ipari, intbuf_tab, ndof, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:2830
zero_ikin2g
subroutine zero_ikin2g(nkine, iloc)
Definition imp_fri.F:4462
tag_ints
subroutine tag_ints(nsl, iloc, n_impn)
Definition imp_fri.F:825
fr_u2d
subroutine fr_u2d(ndof, lx, d, a, nsrem, nsl)
Definition imp_fri.F:2536
scom_frud
subroutine scom_frud(uds, udr, nf_s, nf_r, ikcs, ikcr)
Definition imp_fri.F:9009
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_sld
subroutine ind_sld(nsl, ndof, kss)
Definition imp_fri.F:9400
imp_fvksl
subroutine imp_fvksl(iddl, iddlm, ikc, ifvsi, nf_si, ksi, lb, nsrem, udsi)
Definition imp_fri.F:9095
ind_kine_kp
subroutine ind_kine_kp(nrowk, icok, icokm, nnmax, nkmax, nkine, ink, ikpat, iddl)
Definition imp_fri.F:4500
jdifrtok
subroutine jdifrtok(itok)
Definition imp_fri.F:5267
imp_fvksm
subroutine imp_fvksm(nj, iddl, iddlm, ikc, uds, ksm, lb)
Definition imp_fri.F:9150
intabfr
subroutine intabfr(nic, ic, n, intab)
Definition imp_fri.F:2140
dim_frkm
subroutine dim_frkm(nsrem, nsl, ssize, rsize)
Definition imp_fri.F:5631
tag_intml
subroutine tag_intml(nsrem, iloc, n_impn, iddl, ikc, ndof, lsi)
Definition imp_fri.F:7517
fr_matv_gpu
subroutine fr_matv_gpu(nsrem, nsl, lx, f, nindex)
Definition imp_fri.F:2494
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
doub_nrs
subroutine doub_nrs(nsl, nnmax, nrs, icol, ilocp)
Definition imp_fri.F:6639
assem_ksl
subroutine assem_ksl(iddl, k_diag, k_lt, iadk, jdik, kss, nsl)
Definition imp_fri.F:6350
ind_kinfrk
subroutine ind_kinfrk(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ia, ia2, nss, nss2, n_kine, ibfv, lj, iskew, icodt, nrs, icol, nnmax, irbe3, lrbe3, lns3, irbe2, lrbe2, lns4)
Definition imp_fri.F:6893
nddli_frb
subroutine nddli_frb(ndof, ikc, iddl, ndofi, nddlifb, fr_elem, iad_elem)
Definition imp_fri.F:9845
imp_frii
subroutine imp_frii(ninter)
Definition imp_fri.F:456
imp_fvkss
subroutine imp_fvkss(kss, iddl, iddlm, ikc, nsl, d_imp, lb, nfv, udsl, inloc, ndof)
Definition imp_fri.F:8794
putfr_kij
subroutine putfr_kij(id, jd, iadk, jdik, k_lt, kij, nk, nl)
Definition imp_fri.F:6499
dim_fvn
subroutine dim_fvn(ndof, iddl, ikc, inloc, nfv)
Definition imp_fri.F:8690
ndofi_nsl
subroutine ndofi_nsl(nsl, nddli, ndofi)
Definition imp_fri.F:9924
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
dim_kinefr
subroutine dim_kinefr(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, lns, lns2, lnss, lnss2, nk_m, irbe3, lns3, lnss3, irbe2, lrbe2, lnr2, lnrs2)
Definition imp_fri.F:1253
imp_frsn
subroutine imp_frsn(ipari, intbuf_tab, nbintc, intlist)
Definition imp_fri.F:384
ind_frkd
subroutine ind_frkd(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, iddl, ikc, ndof, nsrem, ind_imp)
Definition imp_fri.F:4721
fr_a2b
subroutine fr_a2b(ndof, lb, a, nsl)
Definition imp_fri.F:2952
ind_nrfr
subroutine ind_nrfr(nft, nel, npn, npp, nnmax, nrow, icol, fr_elem, iad_elem, n_fr, icok)
Definition imp_fri.F:3631
kin_ksl
subroutine kin_ksl(ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, ndof, ilocp, nsl, iad_m, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:6553
get_iad
subroutine get_iad(iad_m, iad_s, jdi_s, nm, is, j, nrj, ndof, iad)
Definition imp_fri.F:7133
fr_matv
subroutine fr_matv(a, v, d, ms, x, dr, ar, ipari, intbuf_tab, ndof, num_imp, ns_imp, ne_imp, lx, nsrem, nsl, ibfv, skew, xframe, f, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:2418
tag_intm11
subroutine tag_intm11(jlt, ns_imp, ne_imp, irects, irectm, iloc, n_impn, nsn)
Definition imp_fri.F:4555
getnddli_g
subroutine getnddli_g(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndofi, ndof, ikc, iddl, fr_elem, iad_elem, nddli, nsl, nddlig, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:9977
imp_frsl
subroutine imp_frsl(nbintc, nsrem, nsl)
Definition imp_fri.F:701
imp_frfv
subroutine imp_frfv(num_imp, ns_imp, ne_imp, ipari, intbuf_tab, iddl, ikc, ndof, nsrem, nsl, d_imp, dd, dr_imp, ddr, a, ar, ms, v, x, lb, nddl, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2, de, nddl0, w_ddl)
Definition imp_fri.F:143
rowfr_dim11
subroutine rowfr_dim11(jlt, ns_imp, ne_imp, irectm, nrow, nsn, nin)
Definition imp_fri.F:4890
rowfr_ind11
subroutine rowfr_ind11(jlt, ns_imp, ne_imp, irectm, nrow, icol, nnmax, nsn, nin)
Definition imp_fri.F:4979
ini_slnr
subroutine ini_slnr(nsl, nnmax, nrs, icol, nz, ndof, iad_m)
Definition imp_fri.F:6681
mav_ltfr_gpu
subroutine mav_ltfr_gpu(v, w, nindex)
Definition imp_fri.F:4652
ini_frfd
subroutine ini_frfd(nsrem, nfv, ikcsi, nf_si, fdsi)
Definition imp_fri.F:9302
diag_int
subroutine diag_int(nsl, ndof, ipari, intbuf_tab, kss, x, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:1839
imp_frki
subroutine imp_frki(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, lj, skew, xframe, iskew, icodt, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition imp_fri.F:260
ind_nrmax
subroutine ind_nrmax(nft, nel, npn, npps, nnmax, nrow, icol, iad_rl, fr_icol, n_frnn)
Definition imp_fri.F:3274
imp_diags
subroutine imp_diags(diag_k, ndof, nsl, ipari, intbuf_tab, irbe3, lrbe3, irbe2)
Definition imp_fri.F:2175
assfr_kij
subroutine assfr_kij(id, jd, iadk, jdik, k_lt, kij, nd)
Definition imp_fri.F:6408
dim_kinfrk
subroutine dim_kinfrk(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ia, ia2, nrs, lns, lns2, n_kine, irbe3, lrbe3, lns3, irbe2, lrbe2, lns4)
Definition imp_fri.F:6748
scom_frk1
subroutine scom_frk1(ks11, kr11, nfacs, nfacr, ikcs, ikcr)
Definition imp_fri.F:7637
dim_nrmax
subroutine dim_nrmax(nrow, fr_elem, iad_elem, nnmax)
Definition imp_fri.F:3114
tra_frkm
subroutine tra_frkm(nsl, iddl, ikc, ndof, iad_m, ksi, ksl, ikcsl)
Definition imp_fri.F:7300
iddl_int
subroutine iddl_int(nsl, iddl, ikc, ndof, iddlm, ipari, intbuf_tab, irbe3, lrbe3, frbe3, x, skew, irbe2, lrbe2)
Definition imp_fri.F:1616
imp_diagsn
subroutine imp_diagsn(diag_k, ndof, nsl, ipari, intbuf_tab, irbe3, lrbe3, irbe2)
Definition imp_fri.F:2289
ini_dd0
subroutine ini_dd0(iddl, ikc, ndof, ipari, intbuf_tab, dd, ddr, nsl, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:1044
upd_kml
subroutine upd_kml(ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, inloc, nsl, iad_m, iddl, ikc, ndof, iddlm, ud, a, ksl, ksi, nsrem, nf_si, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition imp_fri.F:7735
rowfr_dim
subroutine rowfr_dim(jlt, ns_imp, ne_imp, irect, nrow, nsn, nin)
Definition imp_fri.F:4847
dim_frkm1
subroutine dim_frkm1(nsrem, nsl, iddl, ikc, ndof, nf_si, nf_sl, lsi, lsl, msi, msl)
Definition imp_fri.F:7212
imp_fr7i
subroutine imp_fr7i(ipari, intbuf_tab, num_imp, ns_imp, nsrem, nbintc, intlist)
Definition imp_fri.F:506
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
cp_slnr
subroutine cp_slnr(iad_cp, jdi_cp, nsl, nz)
Definition imp_fri.F:9363
spc_fr_k
subroutine spc_fr_k(iadk, jdik, ndof, iddl, fr_elem, iad_elem)
Definition imp_fri.F:10150
imp_frkd
subroutine imp_frkd(npby, lpby, itab, nrbyac, irbyac, ipari, intbuf_tab, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, lj, skew, xframe, iskew, icodt, a, ud, lb, ifdis, urd, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition imp_fri.F:5338
fr_dlft
subroutine fr_dlft(nddl, idlft0, idlft1)
Definition imp_fri.F:4349
fr_u2dd
subroutine fr_u2dd(d, dr, x, ipari, intbuf_tab, ndof, a, ar, lx, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:2607
imp_frkm
subroutine imp_frkm(nsrem, ikinm, ikcsi, ikc, ndof, iddl, iddlm, inloc, iad_m, frk_si, frk_sl, nf_si, iad_mld, iddli)
Definition imp_fri.F:8379
rowfr_ind
subroutine rowfr_ind(jlt, ns_imp, ne_imp, irect, nrow, icol, nnmax, nsn, nin)
Definition imp_fri.F:4933
imp_fvkm
subroutine imp_fvkm(kfr_si, kfr_sl, iddl, ndof, ikc, inloc, iad_m, nsrem, nsl, ud0, fdsi, nf_si, nfv, nfd, iddli)
Definition imp_fri.F:9201
fr_a2bd
subroutine fr_a2bd(ndof, ipari, intbuf_tab, lb, a, ar, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:3000
nddli_ns
subroutine nddli_ns(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndofi, ndof, ikc, iddl, nsl, nddli, nddlins, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:10032
ind_kinefr
subroutine ind_kinefr(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, nss, nss2, nss_s, nss2_s, kn_m, ibfv, lj, iskew, icodt, irbe3, nss3, nss3_s, irbe2, lrbe2, nsr2, nrs2_s)
Definition imp_fri.F:1365
scom_frk
subroutine scom_frk(ks11, kr11, ssize, rsize)
Definition imp_fri.F:7583
getfr_kij
subroutine getfr_kij(id, jd, iadk, jdik, k_lt, kij, nk, nl)
Definition imp_fri.F:6456
set_ind_fr
subroutine set_ind_fr(nsrem, iddl, ndof, nrow, icol, nnmax)
Definition imp_fri.F:5134
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
tag_intm
subroutine tag_intm(jlt, ns_imp, ne_imp, irect, nsv, iloc, n_impn, nsn)
Definition imp_fri.F:773
put_kii
subroutine put_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:653
assem_kii
subroutine assem_kii(ni, nel, iddl, iadk, k_diag, k_lt, kii, nd, off)
Definition imp_glob_k.F:962
get_kii
subroutine get_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:591
get_kij
subroutine get_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:713
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_chkm
subroutine imp_chkm(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, nsensor, 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, dirul, lgrav, irbe3, lrbe3, frbe3, frwl6, irbe2, lrbe2, icfield, lcfield, cfield, elbuf_tab, weight_md, stack, dimfb, fbsav6, stabsen, tabsensor, drape_sh4n, drape_sh3n, h3d_data, nddl0, nnzk0, impbuf_tab, cptreac, fthreac, nodreac, drapeg, th_surf, dpl0cld, vel0cld, snpc, stf, wfext_md, igrsurf)
Definition imp_solv.F:3132
imp_intfr
subroutine imp_intfr(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, dirul, skew, xframe, iskew, icodt, de, d_imp, lb, ifdis, nddl, dr_imp, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2, dd, ddr, a, ar, ac, acr, ms, v, nddl0, r02, rby, icodr, nt_rw, w_ddl, weight, irflag)
Definition imp_solv.F:7316
spmd_ifrf_gpu
subroutine spmd_ifrf_gpu(f_imp, nindex)
Definition imp_spmd.F:4143
spmd_ifru
subroutine spmd_ifru(lx)
Definition imp_spmd.F:3790
spmd_exci
subroutine spmd_exci(its, itr, iad_s, iad_r, size, ssize, rsize)
Definition imp_spmd.F:3555
spmd_isr
subroutine spmd_isr(iad_s, iad_r, its, itr, ssize, rsize)
Definition imp_spmd.F:3441
spmd_exck
subroutine spmd_exck(ks11, kr11, iad_s, iad_r, size, ssize, rsize)
Definition imp_spmd.F:3675
spmd_sumf_v
subroutine spmd_sumf_v(v)
Definition imp_spmd.F:1650
spmd_ifcd
subroutine spmd_ifcd(d_imp, ssize, rsize)
Definition imp_spmd.F:2326
spmd_ifrf
subroutine spmd_ifrf(f_imp)
Definition imp_spmd.F:3908
spmd_nddlig
subroutine spmd_nddlig(nddl, nddlfr, nddlg)
Definition imp_spmd.F:4734
spmd_inis
subroutine spmd_inis(iad_s, iad_r)
Definition imp_spmd.F:2003
spmd_ifru_gpu
subroutine spmd_ifru_gpu(lx, nindex)
Definition imp_spmd.F:4024
spmd_inisl
subroutine spmd_inisl(nbintc, inbsl)
Definition imp_spmd.F:2090
spmd_ifc1
subroutine spmd_ifc1(ssize, rsize, kss)
Definition imp_spmd.F:2190
spmd_ifcf
subroutine spmd_ifcf(f_imp, ssize, rsize)
Definition imp_spmd.F:2450
spmd_sum_s
subroutine spmd_sum_s(s)
Definition imp_spmd.F:1037
spmd_icol
subroutine spmd_icol(iad_s, iad_r, nnmax, icol, nrow, fr_nrow, iad_elem, fr_elem, ssize, rsize)
Definition imp_spmd.F:2679
spmd_max_iv
subroutine spmd_max_iv(iv)
Definition imp_spmd.F:5017
spmd_nrow
subroutine spmd_nrow(nrow, fr_nrow, iad_elem, tsize)
Definition imp_spmd.F:2577
reorder_j
subroutine reorder_j(n, ic, ni, iddl)
Definition ind_glob_k.F:4369
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
i24msegv
subroutine i24msegv(ie, irtlmv, subtria, irtlm, nvoisin)
Definition ind_glob_k.F:7940
reorder_l
subroutine reorder_l(n, ic, ni, iddl)
Definition ind_glob_k.F:4434
reorder_a
subroutine reorder_a(n, ic, id)
Definition ind_glob_k.F:4268
rbe3cl
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
Definition kinchk.F:1586
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
imp_aspc
Definition impbufdef_mod.F:526
imp_aspc::in_spc
integer, dimension(:), allocatable in_spc
Definition impbufdef_mod.F:529
imp_aspc::ic_spc
integer, dimension(:), allocatable ic_spc
Definition impbufdef_mod.F:529
imp_aspc::nspcl
integer nspcl
Definition impbufdef_mod.F:527
imp_frk
Definition impbufdef_mod.F:740
imp_frk::ndfrmax
integer ndfrmax
Definition impbufdef_mod.F:742
imp_frk::nrmax
integer nrmax
Definition impbufdef_mod.F:742
imp_frk::fr_icol
integer, dimension(:), allocatable fr_icol
Definition impbufdef_mod.F:750
imp_frk::nddlfrb1
integer nddlfrb1
Definition impbufdef_mod.F:746
imp_frk::ifrloc
integer, dimension(:), allocatable ifrloc
Definition impbufdef_mod.F:749
imp_frk::ifr2k
integer, dimension(:), allocatable ifr2k
Definition impbufdef_mod.F:758
imp_frk::ikin2g
integer, dimension(:), allocatable ikin2g
Definition impbufdef_mod.F:752
imp_frk::len_v
integer len_v
Definition impbufdef_mod.F:742
imp_frk::n_frnn
integer n_frnn
Definition impbufdef_mod.F:742
imp_frk::iadfr
integer, dimension(:), allocatable iadfr
Definition impbufdef_mod.F:754
imp_frk::iddlfr
integer, dimension(:), allocatable iddlfr
Definition impbufdef_mod.F:754
imp_frk::jfr2k
integer, dimension(:), allocatable jfr2k
Definition impbufdef_mod.F:758
imp_frk::jdifr
integer, dimension(:), allocatable jdifr
Definition impbufdef_mod.F:754
imp_frk::ddlp0
integer ddlp0
Definition impbufdef_mod.F:746
imp_frk::len_k
integer len_k
Definition impbufdef_mod.F:742
imp_frk::iad_rl
integer, dimension(:), allocatable iad_rl
Definition impbufdef_mod.F:750
imp_frk::nd_fr
integer, dimension(:), allocatable nd_fr
Definition impbufdef_mod.F:754
imp_frk::nzkfr
integer nzkfr
Definition impbufdef_mod.F:742
imp_frk::nddlfr
integer nddlfr
Definition impbufdef_mod.F:742
imp_frk::ddlp1
integer ddlp1
Definition impbufdef_mod.F:746
imp_frk::nddlfrb
integer nddlfrb
Definition impbufdef_mod.F:746
imp_intm
Definition imp_intm.F:118
imp_intm::iddmr2
integer, dimension(:,:), allocatable iddmr2
Definition imp_intm.F:158
imp_intm::ibc_fr
integer, dimension(:,:), allocatable ibc_fr
Definition imp_intm.F:167
imp_intm::iddml
integer, dimension(:,:), allocatable iddml
Definition imp_intm.F:156
imp_intm::ifrsr
integer, dimension(:,:), allocatable ifrsr
Definition imp_intm.F:153
imp_intm::nrb_frs
integer nrb_frs
Definition imp_intm.F:127
imp_intm::ifrs2
integer, dimension(:,:), allocatable ifrs2
Definition imp_intm.F:153
imp_intm::ifrs3
integer, dimension(:), allocatable ifrs3
Definition imp_intm.F:154
imp_intm::jdi_sinr
integer, dimension(:), allocatable jdi_sinr
Definition imp_intm.F:176
imp_intm::nfx_fr
integer nfx_fr
Definition imp_intm.F:127
imp_intm::nrbe2_frs
integer nrbe2_frs
Definition imp_intm.F:127
imp_intm::nspc_fr
integer nspc_fr
Definition imp_intm.F:127
imp_intm::inbsl
integer, dimension(:,:), allocatable inbsl
Definition imp_intm.F:144
imp_intm::iad_sinr
integer, dimension(:), allocatable iad_sinr
Definition imp_intm.F:176
imp_intm::iddmi2
integer, dimension(:,:,:), allocatable iddmi2
Definition imp_intm.F:157
imp_intm::jdi_si
integer, dimension(:), allocatable jdi_si
Definition imp_intm.F:174
imp_intm::iddl_sl
integer, dimension(:), allocatable iddl_sl
Definition imp_intm.F:178
imp_intm::iad_ss
integer, dimension(:), allocatable iad_ss
Definition imp_intm.F:175
imp_intm::ifx_fr
integer, dimension(:,:), allocatable ifx_fr
Definition imp_intm.F:167
imp_intm::nz_sl
integer nz_sl
Definition imp_intm.F:173
imp_intm::nrbe2_fr
integer nrbe2_fr
Definition imp_intm.F:127
imp_intm::nbc_fr
integer nbc_fr
Definition imp_intm.F:127
imp_intm::ifrsr_s
integer, dimension(:), allocatable ifrsr_s
Definition imp_intm.F:160
imp_intm::islm
integer, dimension(:), allocatable islm
Definition imp_intm.F:140
imp_intm::nrbe3_frs
integer nrbe3_frs
Definition imp_intm.F:127
imp_intm::fr_srem
integer, dimension(:), allocatable fr_srem
Definition imp_intm.F:131
imp_intm::iddsl
integer, dimension(:,:), allocatable iddsl
Definition imp_intm.F:156
imp_intm::iad_si
integer, dimension(:), allocatable iad_si
Definition imp_intm.F:174
imp_intm::nml
integer nml
Definition imp_intm.F:127
imp_intm::ispc_fr
integer, dimension(:), allocatable ispc_fr
Definition imp_intm.F:168
imp_intm::jdi_sl
integer, dimension(:), allocatable jdi_sl
Definition imp_intm.F:175
imp_intm::ni2_fr
integer ni2_fr
Definition imp_intm.F:127
imp_intm::shf_int
integer, dimension(:), allocatable shf_int
Definition imp_intm.F:136
imp_intm::iad_slnr
integer, dimension(:), allocatable iad_slnr
Definition imp_intm.F:177
imp_intm::iddmr
integer, dimension(:,:), allocatable iddmr
Definition imp_intm.F:156
imp_intm::iddmi3
integer, dimension(:,:,:), allocatable iddmi3
Definition imp_intm.F:157
imp_intm::ifrs3_s
integer, dimension(:), allocatable ifrs3_s
Definition imp_intm.F:160
imp_intm::nrbe3_fr
integer nrbe3_fr
Definition imp_intm.F:127
imp_intm::ikc_sl
integer, dimension(:), allocatable ikc_sl
Definition imp_intm.F:175
imp_intm::iad_sl
integer, dimension(:), allocatable iad_sl
Definition imp_intm.F:145
imp_intm::ikc_si
integer, dimension(:), allocatable ikc_si
Definition imp_intm.F:174
imp_intm::intp_d
integer intp_d
Definition imp_intm.F:173
imp_intm::ni2_frs
integer ni2_frs
Definition imp_intm.F:127
imp_intm::nddl_si
integer nddl_si
Definition imp_intm.F:173
imp_intm::ifrs4_s
integer, dimension(:), allocatable ifrs4_s
Definition imp_intm.F:161
imp_intm::irw_fr
integer, dimension(:), allocatable irw_fr
Definition imp_intm.F:171
imp_intm::nrb_fr
integer nrb_fr
Definition imp_intm.F:127
imp_intm::nddl_sl
integer nddl_sl
Definition imp_intm.F:173
imp_intm::iad_srem
integer, dimension(:), allocatable iad_srem
Definition imp_intm.F:145
imp_intm::nz_si
integer nz_si
Definition imp_intm.F:173
imp_intm::ind_int
type(int_pointer2), dimension(:), allocatable ind_int
Definition imp_intm.F:133
imp_intm::ifrs2_s
integer, dimension(:), allocatable ifrs2_s
Definition imp_intm.F:160
imp_intm::nrw_fr
integer nrw_fr
Definition imp_intm.F:170
imp_intm::isl
integer, dimension(:), allocatable isl
Definition imp_intm.F:138
imp_intm::iml
integer, dimension(:), allocatable iml
Definition imp_intm.F:142
imp_intm::iddl_si
integer, dimension(:), allocatable iddl_si
Definition imp_intm.F:178
imp_intm::jdi_slnr
integer, dimension(:), allocatable jdi_slnr
Definition imp_intm.F:177
imp_intm::ifrs4
integer, dimension(:,:), allocatable ifrs4
Definition imp_intm.F:153
imp_rwl
Definition impbufdef_mod.F:387
imp_rwl::in_rwl
integer, dimension(:), allocatable in_rwl
Definition impbufdef_mod.F:391
imp_rwl::n_rwl
integer n_rwl
Definition impbufdef_mod.F:389
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
cp_real
subroutine cp_real(n, x, xc)
Definition produt_v.F:871
cp_int
subroutine cp_int(n, x, xc)
Definition produt_v.F:916
produt_vmhp
subroutine produt_vmhp(nddl0, nddl, iddl, ndof, ikc, dd, ddr, y, r, w_imp)
Definition produt_v.F:3321
rbe2_frk
subroutine rbe2_frk(ns, m, x, isk, skew0, irad, ndof, iddl, jt, jr, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, idlm, iss, ism)
Definition rbe2_imp0.F:1739
rbe2_impkd
subroutine rbe2_impkd(m, ns, x, isk, jt, jr, ndof, skew0, kdd, diag_km, diag_kn, irad)
Definition rbe2_imp0.F:1645
prerbe2fr
subroutine prerbe2fr(ic, jt, jr)
Definition rbe2f.F:1059
rbe2frf
subroutine rbe2frf(ns, m, a, ar, jt, jr, x, isk, skew0, irad)
Definition rbe2f.F:706
rbe2_frd
subroutine rbe2_frd(ns, m, x, v, vr, jt, jr, skew0, isk, irad)
Definition rbe2v.F:1025
rbe3_fr0
subroutine rbe3_fr0(ns, nml, iml, x, irot, jt, jr, frbe3, skew, ikc, ndof, iadk, jdik, diag_k, lt_k, kss, ksm, knm, krm, idlm, iss, ism, itab, isk, id)
Definition rbe3_imp0.F:1074
rbe3_frupd
subroutine rbe3_frupd(nir, iml, fdstnb, mdstnb, ndof, jt, irot, kss, diag_m3)
Definition rbe3_imp0.F:1017
rbe3frf
subroutine rbe3frf(nml, iml, ns, a, ar, fdstnb, mdstnb, jt, jr, irot)
Definition rbe3f.F:1908
rbe3_frd
subroutine rbe3_frd(nml, iml, ns, d, dr, fdstnb, mdstnb, jt, jr, irot)
Definition rbe3v.F:231
updfr_rb
subroutine updfr_rb(xs, ys, zs, kii, k)
Definition rby_imp0.F:652
rby_frk
subroutine rby_frk(ns, m, x, itab, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, idlm, iss, ism)
Definition rby_imp0.F:894
rby_impf
subroutine rby_impf(x, m, n, ndof, a, ar)
Definition rby_imp0.F:612
rby_imp0
subroutine rby_imp0(x, rby, lpby, npby, skew, nrbyac, irbyac, nsc, isij, nmc, imij, nss, iss, iskew, itab, weight, ms, in, nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b)
Definition rby_imp0.F:37
rby_imp3
subroutine rby_imp3(x, m, n, d, dr, a, ar)
Definition rby_impd.F:156
nl
character *2 function nl()
Definition message.F:2354
condens_ind
subroutine condens_ind(nddl, nnz, iadk, jdik, ikc)
Definition upd_glob_k.F:330
upd_glob_k
subroutine upd_glob_k(icodt, icodr, iskew, ibfv, npc, tf, vel, xframe, rby, x, skew, lpby, npby, itab, weight, ms, in, nrbyac, irbyac, nsc, isij, nmc, imij, nss, iss, nint2, iint2, nsc2, isij2, nss2, iss2, ipari, intbuf_tab, nddl, nnz, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, ud, b, nkud, ikud, bkud, nmc2, imij2, nt_rw, rd, lj, irbe3, lrbe3, frbe3, iss3, irbe2, lrbe2, isb2, nsrb2)
Definition upd_glob_k.F:66