OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
imp_int_k.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| imp_int_k ../engine/source/implicit/imp_int_k.F
25!||--- called by ------------------------------------------------------
26!|| imp_chkm ../engine/source/implicit/imp_solv.F
27!|| imp_solv ../engine/source/implicit/imp_solv.f
28!||--- calls -----------------------------------------------------
29!|| i10ke3 ../engine/source/interfaces/int10/i10ke3.F
30!|| i11ke3 ../engine/source/interfaces/int11/i11ke3.F
31!|| i24ke3 ../engine/source/interfaces/int24/i24ke3.F
32!|| i5ke3 ../engine/source/interfaces/inter3d/i5ke3.F
33!|| i7ke3 ../engine/source/interfaces/int07/i7ke3.F
34!|| upd_int_k ../engine/source/implicit/upd_glob_k.F
35!||--- uses -----------------------------------------------------
36!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
37!|| imp_inttd ../engine/share/modules/imp_mod_def.F90
38!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
39!|| sensor_mod ../common_source/modules/sensor_mod.F90
40!||====================================================================
41 SUBROUTINE imp_int_k( A ,V ,
42 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
43 2 TF ,VEL ,NSENSOR,SENSOR_TAB,XFRAME ,
44 3 RBY ,X ,SKEW ,LPBY ,NPBY ,
45 4 ITAB ,WEIGHT,MS ,IN ,NRBYAC,
46 5 IRBYAC,NSS ,ISS ,IPARI ,INTBUF_TAB,
47 6 NINT2 ,IINT2 ,IAINT2 ,NSS2 ,
48 7 ISS2 ,NDDLI ,NNZI ,IADI ,JDII ,
49 8 DIAG_I ,LT_I ,IDDLI ,NDDL ,IADK ,
50 9 JDIK ,IKC ,DIAG_K,LT_K ,IDDL ,
51 A NUM_IMP,NS_IMP,NE_IMP,INDEX2,NDOFI ,
52 B ITOK ,UD ,LB ,GAPMIN,DIRUL ,
53 C NT_RW ,NUM_IMP1,IRBE3,LRBE3,FRBE3 ,
54 D NSS3 ,ISS3 ,IRBE2 ,LRBE2,NSB2 ,
55 E ISB2 )
56C-----------------------------------------------
57C M o d u l e s
58C-----------------------------------------------
59 USE imp_inttd
60 USE intbufdef_mod
61 USE imp_intbuf
62 USE sensor_mod
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "com04_c.inc"
71#include "param_c.inc"
72#include "impl1_c.inc"
73#include "com08_c.inc"
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C-----------------------------------------------
77 INTEGER ,INTENT(IN) :: NSENSOR
78 INTEGER NPC(*),IBFV(NIFV,*),DIRUL(*),
79 . ICODT(*),ICODR(*),ISKEW(*),ITOK(*),NDDL,NT_RW
80 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ITAB(*),
81 . IPARI(NPARI,*), NRBYAC,IRBYAC(*),
82 . IDDL(*),IKC(*),NSS(*),ISS(*),NSS2(*),ISS2(*),
83 . IADK(*),JDIK(*),NDDLI,NNZI,IADI(*),JDII(*),
84 . IDDLI(*),NDOFI(*),NINT2 ,IINT2(*),IAINT2(*)
85 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),INDEX2(*),NUM_IMP1(*)
86 INTEGER IRBE3(NRBE3L,*),LRBE3(*),NSS3(*),ISS3(*),
87 . IRBE2(*),LRBE2(*),NSB2(*),ISB2(*)
88 my_real
89 . A(3,*),V(3,*),RBY(NRBY,*),X(3,*) ,SKEW(*),IN(*),MS(*)
90 my_real
91 . tf(*), vel(lfxvelr,*),diag_k(*),lt_k(*),
92 . diag_i(*),lt_i(*),lb(*),ud(3,*),gapmin,xframe(nxframe,*),
93 . frbe3(*)
94 TYPE(intbuf_struct_) INTBUF_TAB(*)
95 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 INTEGER I,J,N, IAD,NTY,I_INT7,NUM_IMP0,
100 . lrem(ninter), isens
101 my_real ts
102C REAL
103C
104 IF (nt_imp1>0) THEN
105 iad=1
106 gapmin=ep20
107 i_int7 = imp_int7
108 imp_int7 = 3
109C-----------int5 first-------------
110 DO n=1,ninter
111 nty =ipari(7,n)
112 IF (num_imp(n)==0) cycle
113 IF(nty==5) THEN
114C
115 isens = ipari(64,n)
116 IF(isens/=0) THEN ! SENSOR
117 ts = sensor_tab(isens)%TSTART
118 ELSE
119 ts = tt
120 ENDIF
121C
122 IF(tt>=ts) THEN ! If interface is activated
123 CALL i5ke3( a,v ,ms ,
124 1 ipari(1,n),intbuf_tab(n) ,x ,
125 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,
126 3 iddli ,diag_i ,lt_i , iadi ,jdii )
127 ENDIF
128 iad=iad+num_imp(n)
129 ENDIF
130 END DO
131C
132 DO n=1,ninter
133 nty =ipari(7,n)
134 lrem(n) = 0
135 IF(nty==7) THEN
136C
137 isens = ipari(64,n)
138 IF(isens/=0) THEN ! SENSOR
139 ts = sensor_tab(isens)%TSTART
140 ELSE
141 ts = tt
142 ENDIF
143C
144 IF(tt>=ts) THEN ! If interface is activated
145 CALL i7ke3( a,v ,ms ,
146 1 ipari ,intbuf_tab(n) ,x ,n ,
147 2 num_imp1(n),ns_imp1(iad),ne_imp1(iad) ,ind_imp1(iad),
148 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
149 4 lrem(n) )
150 ENDIF
151 iad=iad+num_imp1(n)
152 ELSEIF(nty==10)THEN
153 CALL i10ke3( a,v ,ms ,
154 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
155 2 num_imp1(n),ns_imp1(iad),ne_imp1(iad) ,ind_imp1(iad),
156 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
157 4 lrem(n) )
158 iad=iad+num_imp1(n)
159 ELSEIF(nty==11)THEN
160C
161 isens = ipari(64,n)
162 IF(isens/=0) THEN ! SENSOR
163 ts = sensor_tab(isens)%TSTART
164 ELSE
165 ts = tt
166 ENDIF
167C
168 IF(tt>=ts) THEN ! If interface is activated
169 CALL i11ke3( a, v ,ms ,
170 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
171 2 num_imp1(n),ns_imp1(iad),ne_imp1(iad) ,
172 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
173 4 lrem(n) ,itab )
174 ENDIF
175 iad=iad+num_imp1(n)
176 ELSEIF(nty==24) THEN
177C
178 isens = ipari(64,n)
179 IF(isens/=0) THEN ! SENSOR
180 ts = sensor_tab(isens)%TSTART
181 ELSE
182 ts = tt
183 ENDIF
184C
185 IF(tt>=ts) THEN ! If interface is activated
186c CALL I24KE3( A,V ,MS ,
187c 1 IPARI ,INTBUF_TAB(N) ,X ,N ,
188c 2 NUM_IMP1(N),NS_IMP1(IAD),NE_IMP1(IAD) ,IND_IMP1(IAD),
189c 3 IDDLI ,DIAG_I ,LT_I , IADI ,JDII ,GAPMIN ,
190c 4 LREM(N) )
191 CALL i24ke3( a,v ,ms ,
192 1 ipari ,intbuf_tab(n) ,x ,n ,
193c 2 NUM_IMP1(N),NS_IMP1(IAD),NE_IMP1(IAD) ,IND_IMP1(IAD),
194 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
195 4 lrem(n) ,intbuf_tab_imp(n))
196 ENDIF
197 iad=iad+num_imp1(n)
198 ELSE
199 ENDIF
200 ENDDO
201 imp_int7 = i_int7
202 DO n=1,ninter
203 nty =ipari(7,n)
204 num_imp0 = num_imp(n)-num_imp1(n)
205 IF(nty==7) THEN
206C
207 isens = ipari(64,n)
208 IF(isens/=0) THEN ! SENSOR
209 ts = sensor_tab(isens)%TSTART
210 ELSE
211 ts = tt
212 ENDIF
213C
214 IF(tt>=ts) THEN ! If interface is activated
215 CALL i7ke3( a,v ,ms ,
216 1 ipari ,intbuf_tab(n) ,x ,n ,
217 2 num_imp0 ,ns_imp1(iad),ne_imp1(iad) ,ind_imp1(iad),
218 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
219 4 lrem(n) )
220 ENDIF
221 iad=iad+num_imp0
222 ELSEIF(nty==10)THEN
223 CALL i10ke3( a,v ,ms ,
224 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
225 2 num_imp0 ,ns_imp1(iad),ne_imp1(iad) ,ind_imp1(iad),
226 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
227 4 lrem(n) )
228 iad=iad+num_imp0
229 ELSEIF(nty==11)THEN
230C
231 isens = ipari(64,n)
232 IF(isens/=0) THEN ! SENSOR
233 ts = sensor_tab(isens)%TSTART
234 ELSE
235 ts = tt
236 ENDIF
237C
238 IF(tt>=ts) THEN ! If interface is activated
239 CALL i11ke3( a, v ,ms ,
240 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
241 2 num_imp0 ,ns_imp1(iad),ne_imp1(iad) ,
242 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
243 4 lrem(n) ,itab )
244 ENDIF
245 iad=iad+num_imp0
246 ELSEIF(nty==24) THEN
247C
248 isens = ipari(64,n)
249 IF(isens/=0) THEN ! SENSOR
250 ts = sensor_tab(isens)%TSTART
251 ELSE
252 ts = tt
253 ENDIF
254C
255 IF(tt>=ts) THEN ! If interface is activated
256 CALL i24ke3( a,v ,ms ,
257 1 ipari ,intbuf_tab(n) ,x ,n ,
258c 2 NUM_IMP1(N),NS_IMP1(IAD),NE_IMP1(IAD) ,IND_IMP1(IAD),
259 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
260 4 lrem(n) ,intbuf_tab_imp(n))
261 ENDIF
262 iad=iad+num_imp0
263 ELSE
264 ENDIF
265 ENDDO
266 ELSE
267C----- normal branche------------
268 iad=1
269 gapmin=ep20
270 DO n=1,ninter
271 nty =ipari(7,n)
272 IF (num_imp(n)==0) cycle
273 IF(nty==5) THEN
274C
275 isens = ipari(64,n)
276 IF(isens/=0) THEN ! SENSOR
277 ts = sensor_tab(isens)%TSTART
278 ELSE
279 ts = tt
280 ENDIF
281C
282 IF(tt>=ts) THEN ! If interface is activated
283 CALL i5ke3( a,v ,ms ,
284 1 ipari(1,n),intbuf_tab(n) ,x ,
285 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,
286 3 iddli ,diag_i ,lt_i , iadi ,jdii )
287 ENDIF
288 iad=iad+num_imp(n)
289 ENDIF
290 END DO
291 DO n=1,ninter
292 nty =ipari(7,n)
293 lrem(n) = 0
294 IF(nty==7) THEN
295C
296 isens = ipari(64,n)
297 IF(isens/=0) THEN ! SENSOR
298 ts = sensor_tab(isens)%TSTART
299 ELSE
300 ts = tt
301 ENDIF
302C
303 IF(tt>=ts) THEN ! If interface is activated
304 CALL i7ke3( a,v ,ms ,
305 1 ipari ,intbuf_tab(n) ,x ,n ,
306 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,index2(iad),
307 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
308 4 lrem(n) )
309 ENDIF
310 iad=iad+num_imp(n)
311 ELSEIF(nty==10)THEN
312 CALL i10ke3( a,v ,ms ,
313 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
314 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,index2(iad),
315 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
316 4 lrem(n) )
317 iad=iad+num_imp(n)
318 ELSEIF(nty==11)THEN
319C
320 isens = ipari(64,n)
321 IF(isens/=0) THEN ! SENSOR
322 ts = sensor_tab(isens)%TSTART
323 ELSE
324 ts = tt
325 ENDIF
326C
327 IF(tt>=ts) THEN ! If interface is activated
328 CALL i11ke3( a, v ,ms ,
329 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
330 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,
331 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
332 4 lrem(n) ,itab )
333 ENDIF
334 iad=iad+num_imp(n)
335 ELSEIF(nty==24) THEN
336C
337 isens = ipari(64,n)
338 IF(isens/=0) THEN ! SENSOR
339 ts = sensor_tab(isens)%TSTART
340 ELSE
341 ts = tt
342 ENDIF
343C
344 IF(tt>=ts) THEN ! If interface is activated
345 CALL i24ke3( a,v ,ms ,
346 1 ipari ,intbuf_tab(n) ,x ,n ,
347 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
348 4 lrem(n) ,intbuf_tab_imp(n))
349 ENDIF
350 iad=iad+num_imp(n)
351 ENDIF
352 ENDDO
353 END IF !(NT_IMP1>0)
354C
355 IF(gapmin<zero)RETURN
356 CALL upd_int_k(icodt ,icodr ,iskew ,ibfv ,npc ,
357 1 tf ,vel ,xframe ,
358 2 rby ,x ,skew ,lpby ,npby ,
359 3 itab ,weight,ms ,in ,nrbyac,
360 4 irbyac,nss ,iss ,ipari ,intbuf_tab,
361 5 nint2 ,iint2 ,iaint2 ,nss2 ,
362 5 iss2 ,nddli ,nnzi ,iadi ,jdii ,
363 6 diag_i ,lt_i ,iddli ,nddl ,iadk ,
364 7 jdik ,ikc ,diag_k,lt_k ,iddl ,
365 8 ndofi ,itok ,ud ,lb ,dirul ,
366 9 nt_rw ,irbe3 ,lrbe3 ,frbe3 ,nss3 ,
367 a iss3 ,irbe2 ,lrbe2 ,nsb2 ,isb2 )
368C
369 RETURN
370 END
371!||====================================================================
372!|| imp_intdt ../engine/source/implicit/imp_int_k.F
373!||--- called by ------------------------------------------------------
374!|| imp_dtkin ../engine/source/implicit/imp_int_k.F
375!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
376!||--- calls -----------------------------------------------------
377!|| i11main_crit_tri ../engine/source/interfaces/intsort/i11main_crit_tri.F
378!|| i7main_crit_tri ../engine/source/interfaces/intsort/i7main_crit_tri.F
379!|| imp_icomcrit ../engine/source/implicit/imp_int_k.F
380!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
381!||--- uses -----------------------------------------------------
382!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
383!|| sensor_mod ../common_source/modules/sensor_mod.F90
384!||====================================================================
385 SUBROUTINE imp_intdt(
386 1 IPARI ,INTBUF_TAB,X ,
387 2 V ,VR ,ISENDTO ,IRECVFROM,
388 4 NEWFRONT ,ITASK ,DTK ,ITAB ,
389 5 INTLIST ,NBINTC ,DT_MIN ,MS ,
390 6 NSENSOR ,SENSOR_TAB,MAXDGAP)
391C-----------------------------------------------
392C M o d u l e s
393C-----------------------------------------------
394 USE intbufdef_mod
395 USE sensor_mod
396C-----------------------------------------------
397C I m p l i c i t T y p e s
398C-----------------------------------------------
399#include "implicit_f.inc"
400C-----------------------------------------------
401C C o m m o n B l o c k s
402C-----------------------------------------------
403#include "com01_c.inc"
404#include "com04_c.inc"
405#include "com08_c.inc"
406#include "param_c.inc"
407#include "task_c.inc"
408C-----------------------------------------------
409C D u m m y A r g u m e n t s
410C-----------------------------------------------
411 INTEGER ,INTENT(IN) :: NSENSOR
412 INTEGER IPARI(NPARI,*), ITAB(*),
413 . newfront(*),nbintc,intlist(*),
414 . isendto(ninter+1,*),irecvfrom(ninter+1,*),
415 . itask
416 my_real
417 . x(3,*), v(3,*),vr(3,*),dtk(*),dt_min,ms(*),
418 . maxdgap(ninter)
419
420 TYPE(intbuf_struct_) INTBUF_TAB(*)
421 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
422C-----------------------------------------------
423C L o c a l V a r i a b l e s
424C-----------------------------------------------
425 INTEGER N, KK,LL, RETRI, NBLIST, IFQ,
426 . INACTI, NSNROLD, IAD17, IGN, IGE, NME, NMES,
427 . NELTST ,ITYPTST ,I,NTY, ISENS, INTERACT
428C REAL
429 my_real
430 . xslv_l(18,ninter),xmsr_l(12,ninter),
431 . vslv_l(6,ninter),vmsr_l(6,ninter),
432 . size_t(ninter),dti,fac, ts
433C-------------DT kine par interface--------
434C Init variable globale interface
435C DO KK=1,NBINTC
436C N = INTLIST(KK)
437 DO n=1,ninter
438 xslv_l(1,n)= -ep30
439 xslv_l(2,n)= -ep30
440 xslv_l(3,n)= -ep30
441 xslv_l(4,n)= ep30
442 xslv_l(5,n)= ep30
443 xslv_l(6,n)= ep30
444 xslv_l( 7,n)= -ep30
445 xslv_l( 8,n)= -ep30
446 xslv_l( 9,n)= -ep30
447 xslv_l(10,n)= ep30
448 xslv_l(11,n)= ep30
449 xslv_l(12,n)= ep30
450 xslv_l(13,n)= -ep30
451 xslv_l(14,n)= -ep30
452 xslv_l(15,n)= -ep30
453 xslv_l(16,n)= ep30
454 xslv_l(17,n)= ep30
455 xslv_l(18,n)= ep30
456
457 xmsr_l(1,n)= -ep30
458 xmsr_l(2,n)= -ep30
459 xmsr_l(3,n)= -ep30
460 xmsr_l(4,n)= ep30
461 xmsr_l(5,n)= ep30
462 xmsr_l(6,n)= ep30
463 xmsr_l( 7,n)= -ep30
464 xmsr_l( 8,n)= -ep30
465 xmsr_l( 9,n)= -ep30
466 xmsr_l(10,n)= ep30
467 xmsr_l(11,n)= ep30
468 xmsr_l(12,n)= ep30
469
470 vslv_l(1,n)= -ep30
471 vslv_l(2,n)= -ep30
472 vslv_l(3,n)= -ep30
473 vslv_l(4,n)= ep30
474 vslv_l(5,n)= ep30
475 vslv_l(6,n)= ep30
476 vmsr_l(1,n)= -ep30
477 vmsr_l(2,n)= -ep30
478 vmsr_l(3,n)= -ep30
479 vmsr_l(4,n)= ep30
480 vmsr_l(5,n)= ep30
481 vmsr_l(6,n)= ep30
482 size_t(n)=zero
483 END DO
484 dt_min = ep30
485C DO KK=1,NBINTC
486C
487C N = INTLIST(KK)
488 DO n=1,ninter
489 dtk(n) = ep30
490C----------ICONT-----
491 ipari(29,n) = 0
492C
493 nty =ipari(7,n)
494 IF(nty==7.OR.nty==10.OR.nty==18)THEN
495 i7kglo = 1
496C IPARI(4,N) = NRTM ; IPARI(5,N)=NSN
497C
498 isens = 0
499 IF(nty == 7) isens = ipari(64,n)
500 IF(isens/=0) THEN
501 ts = sensor_tab(isens)%TSTART
502 ELSE
503 ts = tt
504 ENDIF
505C
506 IF(tt>=ts) THEN
507 CALL i7main_crit_tri(
508 1 ipari ,x ,n ,
509 2 itask ,v ,xslv_l ,xmsr_l,vslv_l,
510 3 vmsr_l,intbuf_tab(n) )
511 ENDIF
512 ELSEIF(nty==11)THEN
513 i7kglo = 1
514C
515 isens = ipari(64,n)
516 IF(isens/=0) THEN
517 ts = sensor_tab(isens)%TSTART
518 ELSE
519 ts = tt
520 ENDIF
521C
522 IF(tt>=ts) THEN
523 CALL i11main_crit_tri(
524 1 ipari ,x ,n ,
525 2 itask ,v ,xslv_l ,xmsr_l , vslv_l,
526 4 vmsr_l ,intbuf_tab(n) )
527 ENDIF
528 ENDIF
529C
530 CALL imp_icomcrit(
531 1 intbuf_tab ,ipari ,newfront ,isendto ,
532 2 irecvfrom,dtk(n) ,itab ,xslv_l ,xmsr_l ,
533 3 vslv_l ,vmsr_l ,size_t ,n ,sensor_tab,
534 4 intlist ,nbintc ,maxdgap ,nsensor )
535C
536 IF (nspmd>1)CALL spmd_min_s(dtk(n))
537 dt_min = min(dt_min,dtk(n))
538 ENDDO
539C
540 RETURN
541 END
542!||====================================================================
543!|| imp_icomcrit ../engine/source/implicit/imp_int_k.F
544!||--- called by ------------------------------------------------------
545!|| imp_intdt ../engine/source/implicit/imp_int_k.F
546!||--- calls -----------------------------------------------------
547!|| intab ../engine/source/implicit/ind_glob_k.F
548!|| spmd_get_stif ../engine/source/mpi/interfaces/send_cand.F
549!|| spmd_get_stif11 ../engine/source/mpi/interfaces/send_cand.F
550!|| spmd_sync_mmx ../engine/source/mpi/interfaces/spmd_sync_mmx.F
551!||--- uses -----------------------------------------------------
552!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
553!|| sensor_mod ../common_source/modules/sensor_mod.F90
554!||====================================================================
555 SUBROUTINE imp_icomcrit(
556 1 INTBUF_TAB,IPARI ,NEWFRONT,ISENDTO,
557 2 IRCVFROM,DT2T ,ITAB ,XSLV_L ,XMSR_L ,
558 3 VSLV_L ,VMSR_L ,SIZE_T ,N ,SENSOR_TAB,
559 4 INTLIST ,NBINTC ,MAXDGAP,NSENSOR )
560C-----------------------------------------------
561C M o d u l e s
562C-----------------------------------------------
563 USE intbufdef_mod
564 USE sensor_mod
565C----6---------------------------------------------------------------7---------8
566C I m p l i c i t T y p e s
567C-----------------------------------------------
568#include "implicit_f.inc"
569C-----------------------------------------------
570C C o m m o n B l o c k s
571C-----------------------------------------------
572#include "param_c.inc"
573#include "com01_c.inc"
574#include "com04_c.inc"
575#include "com08_c.inc"
576C-----------------------------------------------------------------
577C D u m m y A r g u m e n t s
578C-----------------------------------------------
579 INTEGER ,INTENT(IN) :: NSENSOR
580 INTEGER IPARI(NPARI,*), NEWFRONT(*), ITAB(*),
581 . ISENDTO(NINTER+1,*) ,IRCVFROM(NINTER+1,*),N,
582 . NBINTC,INTLIST(*)
583C REAL
584 my_real
585 . DT2T,XSLV_L(6,*), XMSR_L(6,*), VSLV_L(6,*),
586 .vmsr_l(6,*), size_t(*),maxdgap(ninter)
587
588 TYPE(intbuf_struct_) INTBUF_TAB(*)
589 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
590C-----------------------------------------------
591C L o c a l V a r i a b l e s
592C-----------------------------------------------
593 INTEGER I,J,IAD,K,IADD, NBNEW, LISTNEW(1),
594 . INTERACT,ISENS
595 my_real
596 . XX,XY,XZ,DIST0,VX,VY,VZ,GAPINF,VV,DTI,
597 . MINBOX,
598 . STARTT, STOPT, TZINF(1), TS,PMAX(NINTER)
599 INTEGER :: NTY
600C-----------------------------------------------
601C External function
602C-----------------------------------------------
603 LOGICAL INTAB
604 EXTERNAL INTAB
605C
606C
607C Precalcul des interfaces utiles
608C
609 DO j=1,ninter
610 pmax=zero
611 END DO
612 nbnew = 0
613 i = n
614 nty= ipari(7,i)
615 IF(nty/=17.AND. intab(nbintc,intlist,n))THEN
616C
617 interact = 0
618 isens = 0
619 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 21.OR.
620 . nty == 5.OR.nty == 19 ) isens = ipari(64,i)
621 IF(isens/=0) THEN
622 ts = sensor_tab(isens)%TSTART
623 IF (tt>=ts) interact = 1
624 ELSE
625 startt = intbuf_tab(i)%VARIABLES(3)
626 stopt = intbuf_tab(i)%VARIABLES(11)
627 IF (startt<=tt.AND.tt<=stopt) interact = 1
628 ENDIF
629C
630 IF(interact/=0) THEN
631 nbnew = nbnew + 1
632 listnew(nbnew) = n
633 tzinf(nbnew) = intbuf_tab(i)%VARIABLES(8)
634 ENDIF
635 END IF
636C
637 IF(nspmd>1)THEN
638 CALL spmd_sync_mmx(
639 1 isendto,ircvfrom,newfront,xslv_l,xmsr_l,
640 2 vslv_l ,vmsr_l ,listnew ,nbnew ,tzinf ,
641 3 size_t ,ipari ,pmax ,maxdgap)
642 END IF
643C
644 IF (nbnew==0) RETURN
645C
646 nty =ipari(7,i)
647 IF(nty/=17)THEN
648 intbuf_tab(i)%VARIABLES(8)=tzinf(1)
649 IF(nspmd>1) THEN
650 IF (newfront(i)<0)THEN
651 IF(nty==7.OR.nty==10) THEN
652 CALL spmd_get_stif(
653 1 newfront(i) ,intbuf_tab(i)%I_STOK(1),
654 2 intbuf_tab(i)%CAND_N,intbuf_tab(i)%CAND_E,
655 3 ipari(5,i),i,isendto,ircvfrom,intbuf_tab(i)%NSV,
656 4 itab)
657 ELSEIF(nty==11) THEN
658 CALL spmd_get_stif11(
659 1 newfront(i) ,intbuf_tab(i)%I_STOK(1) ,
660 2 intbuf_tab(i)%CAND_N , intbuf_tab(i)%GAP_S,
661 3 ipari(3,i),i,isendto,ircvfrom, intbuf_tab(i)%IRECTS,
662 4 itab)
663 ENDIF
664 ENDIF
665 END IF !(NSPMD>1) THEN
666C maj dist = tzinf - gap ***: seulement pour etre coherent avec smp
667 intbuf_tab(i)%VARIABLES(5) = intbuf_tab(i)%VARIABLES(8)-
668 - intbuf_tab(i)%VARIABLES(2)
669C calcul du critere de tri DIST0
670 xx=max(xslv_l(1,i)-xmsr_l(4,i),xmsr_l(1,i)-xslv_l(4,i),zero)
671 xy=max(xslv_l(2,i)-xmsr_l(5,i),xmsr_l(2,i)-xslv_l(5,i),zero)
672 xz=max(xslv_l(3,i)-xmsr_l(6,i),xmsr_l(3,i)-xslv_l(6,i),zero)
673 dist0 = intbuf_tab(i)%VARIABLES(5) - sqrt(xx**2+xy**2+xz**2)
674C
675C Traitement VMAX
676C
677 vx=max(vslv_l(1,i)-vmsr_l(4,i),vmsr_l(1,i)-vslv_l(4,i),zero)
678 vy=max(vslv_l(2,i)-vmsr_l(5,i),vmsr_l(2,i)-vslv_l(5,i),zero)
679 vz=max(vslv_l(3,i)-vmsr_l(6,i),vmsr_l(3,i)-vslv_l(6,i),zero)
680 vv=sqrt(vx**2+vy**2+vz**2)
681 IF (vv/=zero) THEN
682 gapinf = intbuf_tab(i)%VARIABLES(6)
683 IF (gapinf==zero) gapinf = intbuf_tab(i)%VARIABLES(2)
684C-------supposee s est encore loin de M ------
685 gapinf =gapinf+max(zero,dist0)
686 dti = onep8*gapinf/vv
687Ctmp DTI = ZEP9*GAPINF/VV
688 IF(dti<dt2t) dt2t = dti
689 ENDIF
690 IF(dist0<=zero) THEN
691 intbuf_tab(i)%VARIABLES(5) = -one
692 ENDIF
693 ENDIF
694C
695 RETURN
696 END
697!||====================================================================
698!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
699!||--- called by ------------------------------------------------------
700!|| imp_solv ../engine/source/implicit/imp_solv.F
701!||--- calls -----------------------------------------------------
702!|| cp_inttd ../engine/source/implicit/imp_int_k.f
703!|| imp_i11xv ../engine/source/implicit/imp_int_k.F
704!|| imp_i7xv ../engine/source/implicit/imp_int_k.F
705!|| imp_intdt ../engine/source/implicit/imp_int_k.F
706!|| imp_tripi ../engine/source/implicit/imp_int_k.f
707!||--- uses -----------------------------------------------------
708!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
709!|| groupdef_mod ../common_source/modules/groupdef_mod.F
710!|| h3d_mod ../engine/share/modules/h3d_mod.F
711!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
712!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.F90
713!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
714!|| sensor_mod ../common_source/modules/sensor_mod.f90
715!|| timer_mod ../engine/source/system/timer_mod.f90
716!||====================================================================
717 SUBROUTINE imp_inttd0(TIMERS,
718 1 IPARI ,INTBUF_TAB ,X ,D ,
719 2 MS ,ITAB ,IN ,D_IMP ,DR_IMP ,
720 3 IMSCH ,I2MSCH ,ISIZXV,ILENXV ,IGRBRIC ,
721 4 ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17 ,
722 5 IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM,FR_ELEM ,
723 6 NBINTC,INTLIST,ITASK ,KINET ,NEWFRONT,
724 7 NUM_IMP,NS_IMP,NE_IMP,IND_IMP ,ISENDTO ,
725 8 IRECVFROM,WEIGHT ,IXS ,TEMP ,
726 9 DT2PREV,WA,NUM_IMP1,IRLEN20,ISLEN20,
727 A IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E,
728 B IKINE,DIAG_SMS,COUNT_REMSLV,COUNT_REMSLVE,
729 C NSENSOR,SENSOR_TAB,XDP,H3D_DATA,MULTI_FVM,FORNEQS,
730 D MAXDGAP,INTERFACES,GLOB_THERM)
731C-----------------------------------------------
732C M o d u l e s
733C-----------------------------------------------
734 USE timer_mod
735 USE intbufdef_mod
736 USE h3d_mod
737 USE multi_fvm_mod
738 USE groupdef_mod
739 USE sensor_mod
740 USE interfaces_mod
741 use glob_therm_mod
742C-----------------------------------------------
743C I m p l i c i t T y p e s
744C-----------------------------------------------
745#include "implicit_f.inc"
746C-----------------------------------------------
747C C o m m o n B l o c k s
748C-----------------------------------------------
749#include "com01_c.inc"
750#include "com04_c.inc"
751#include "com08_c.inc"
752#include "param_c.inc"
753#include "task_c.inc"
754#include "impl1_c.inc"
755C-----------------------------------------------
756C D u m m y A r g u m e n t s
757C-----------------------------------------------
758 TYPE(timer_) :: TIMERS
759 INTEGER ,INTENT(IN) :: NSENSOR
760 INTEGER IPARI(NPARI,*), ITAB(*),
761 . NEWFRONT(*),NBINTC,INTLIST(*),
762 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
763 . ITASK,IMSCH ,I2MSCH ,ISIZXV,ILENXV,IRLEN20,ISLEN20,
764 . IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E
765 INTEGER ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
766 . IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM(*),FR_ELEM(*) ,
767 . WEIGHT(*),IXS(*) ,NUM_IMP1(*),
768 . NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
769 . KINET(*),IKINE(*),COUNT_REMSLV(*),
770 . count_remslve(*)
771
772 DOUBLE PRECISION XDP(3,*)
773
774 my_real
775 . x(3,*), d(3,*),ms(*),wa(*),
776 . dt2prev, temp(*),d_imp(3,*),dr_imp(3,*),in(*),diag_sms(*),
777 . forneqs(3,*),maxdgap(ninter)
778
779 TYPE(intbuf_struct_) INTBUF_TAB(*)
780 TYPE(H3D_DATABASE) :: H3D_DATA
781 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
782!
783 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
784 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
785 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
786 type (glob_therm_) , INTENT(IN) :: GLOB_THERM
787C-----------------------------------------------
788C L o c a l V a r i a b l e s
789C-----------------------------------------------
790 INTEGER N, KK,LL, RETRI, NBLIST, IFQ,
791 . INACTI, NSNROLD, IAD17, IGN, IGE, NME, NMES,
792 . NB ,ILIST(1) ,I,NTY,KD(50), KFI,IAD,NSN,NMN,
793 . JFI,JD(50),IDNS,IDNM,IDSTIF,NTHR_CP,ISENS ,
794 . interact
795C REAL
796 my_real
797 . dtk(ninter),v(3,numnod),vr(3,numnod),
798 . x_tmp(3,numnod),dti,fac,fac1,dt_min,dx,dy,dz,
799 . startt,stopt, ts
800C-------------before inttri------
801 nt_imp1 = 0
802 DO n = 1,ninter
803 num_imp1(n)=0
804 ENDDO
805C----deactive cette fonction.
806 IF (ittoff>0) RETURN
807 nthr_cp = nthread
808 IF (nthread>1) nthread = 1
809 dti = one/dt2
810 DO i=1,numnod
811 v(1,i)=d_imp(1,i)*dti
812 v(2,i)=d_imp(2,i)*dti
813 v(3,i)=d_imp(3,i)*dti
814 ENDDO
815 IF (iroddl/=0) THEN
816 DO i=1,numnod
817 vr(1,i)=dr_imp(1,i)*dti
818 vr(2,i)=dr_imp(2,i)*dti
819 vr(3,i)=dr_imp(3,i)*dti
820 ENDDO
821 ENDIF
822 CALL imp_intdt(
823 1 ipari ,intbuf_tab ,x ,
824 2 v ,vr ,isendto ,irecvfrom,
825 4 newfront ,itask ,dtk ,itab ,
826 5 intlist ,nbintc ,dt_min ,ms ,
827 6 nsensor ,sensor_tab,maxdgap)
828 IF (dt_min >= dt2) GOTO 1000
829 DO n = 1,ninter
830 num_imp(n) = 0
831 END DO
832C-------------dans inttri------
833c NI18 = 0
834c LI18 = 1
835c IAD17 = 1
836C
837 iad=1
838 nb = 1
839C
840C DO KK=1,NBINTC
841C N = INTLIST(KK)
842 DO n=1,ninter
843 nty = ipari(7,n)
844 IF (nty/=7.AND.nty/=10.AND.nty/=11) GOTO 999
845 IF (dtk(n)>=dt2) GOTO 999
846 nsn =ipari(5,n)
847 nmn =ipari(6,n)
848C
849 interact = 0
850 isens = 0
851 IF(nty == 7.OR.nty == 11) isens = ipari(64,n)
852 IF(isens/=0) THEN !CMAAAAA
853 ts = sensor_tab(isens)%TSTART
854 IF (tt>=ts) interact = 1
855 ELSE
856 startt = intbuf_tab(n)%VARIABLES(3)
857 stopt = intbuf_tab(n)%VARIABLES(11)
858 IF (startt<=tt.AND.tt<=stopt) interact = 1
859 ENDIF
860 IF(interact/=0) GOTO 999
861C
862 retri = 0
863 ilist(1) = n
864 fac = dtk(n)/dt2
865 fac1 = dti*fac
866 IF(nty==11)THEN
867 CALL imp_i11xv(
868 1 x ,intbuf_tab(n)%NSV,intbuf_tab(n)%MSR,nsn ,nmn ,
869 2 x_tmp ,d_imp ,dr_imp ,v ,vr ,
870 3 fac ,fac1 )
871 ELSE
872 CALL imp_i7xv(
873 1 x ,intbuf_tab(n)%NSV ,intbuf_tab(n)%MSR,nsn ,nmn ,
874 2 intbuf_tab(n)%STFNS,x_tmp ,d_imp ,dr_imp ,v ,
875 3 vr ,fac ,fac1 )
876 ENDIF
877 CALL imp_tripi(timers,
878 1 ipari ,intbuf_tab,x_tmp ,d ,
879 2 v ,ms ,itab ,vr ,in ,
880 3 imsch ,i2msch ,isizxv,ilenxv ,igrbric ,
881 4 islen7,irlen7 ,islen11,irlen11,islen17,
882 5 irlen17,irlen7t,islen7t,iad_elem,fr_elem ,
883 6 nb ,ilist ,itask ,kinet,newfront,
884 7 num_imp,ns_imp,ne_imp,ind_imp,iad ,
885 8 isendto ,irecvfrom ,retri,weight,
886 9 ixs ,temp ,dt2prev,wa ,n ,nty,
887 a irlen20,islen20,irlen20t,islen20t,irlen20e,
888 b islen20e,ikine,diag_sms,count_remslv,count_remslve,
889 c sensor_tab,xdp ,h3d_data, multi_fvm ,forneqs,
890 d interfaces,nsensor,glob_therm)
891 999 CONTINUE
892 ENDDO
893C
894 nt_imp1=iad-1
895C---------necessair pour spmd-----
896 CALL cp_inttd(nt_imp1,num_imp ,ns_imp,ne_imp,ind_imp,num_imp1)
897 1000 CONTINUE
898 IF (nthr_cp>1) nthread = nthr_cp
899C
900 RETURN
901 END
902!||====================================================================
903!|| imp_i11xv ../engine/source/implicit/imp_int_k.F
904!||--- called by ------------------------------------------------------
905!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
906!||====================================================================
907 SUBROUTINE imp_i11xv(
908 1 X ,NSV ,MSR ,NSN ,NMN ,
909 1 X_TMP ,D ,DR ,V ,VR ,
910 3 FACD ,FACV )
911C-----------------------------------------------
912C I m p l i c i t T y p e s
913C-----------------------------------------------
914#include "implicit_f.inc"
915C-----------------------------------------------
916C C o m m o n B l o c k s
917C-----------------------------------------------
918#include "com01_c.inc"
919C-----------------------------------------------
920C D u m m y A r g u m e n t s
921C-----------------------------------------------
922 INTEGER NSN,NMN,NSV(*),MSR(*)
923 my_real
924 . X(3,*),V(3,*),VR(3,*),D(3,*),DR(3,*),
925 . X_TMP(3,*),FACD,FACV
926C-----------------------------------------------
927C L o c a l V a r i a b l e s
928C-----------------------------------------------
929 INTEGER I,J
930C REAL
931 my_real
932 . dx,dy,dz
933C------------------------------------
934 DO j=1,nsn
935 i=nsv(j)
936 IF (i>0) THEN
937 dx = d(1,i)*facd
938 dy = d(2,i)*facd
939 dz = d(3,i)*facd
940 x_tmp(1,i)=x(1,i) + dx
941 x_tmp(2,i)=x(2,i) + dy
942 x_tmp(3,i)=x(3,i) + dz
943 v(1,i)=d(1,i)*facv
944 v(2,i)=d(2,i)*facv
945 v(3,i)=d(3,i)*facv
946 END IF
947 END DO
948 DO j=1,nmn
949 i=msr(j)
950 IF (i>0) THEN
951 dx = d(1,i)*facd
952 dy = d(2,i)*facd
953 dz = d(3,i)*facd
954 x_tmp(1,i)=x(1,i) + dx
955 x_tmp(2,i)=x(2,i) + dy
956 x_tmp(3,i)=x(3,i) + dz
957 v(1,i)=d(1,i)*facv
958 v(2,i)=d(2,i)*facv
959 v(3,i)=d(3,i)*facv
960 END IF
961 END DO
962C
963 IF (iroddl/=0) THEN
964 DO j=1,nsn
965 i=nsv(j)
966 IF (i>0) THEN
967 vr(1,i)=dr(1,i)*facv
968 vr(2,i)=dr(2,i)*facv
969 vr(3,i)=dr(3,i)*facv
970 END IF
971 END DO
972 DO j=1,nmn
973 i=msr(j)
974 IF (i>0) THEN
975 vr(1,i)=dr(1,i)*facv
976 vr(2,i)=dr(2,i)*facv
977 vr(3,i)=dr(3,i)*facv
978 END IF
979 END DO
980 END IF
981C
982 RETURN
983 END
984!||====================================================================
985!|| imp_i7xv ../engine/source/implicit/imp_int_k.F
986!||--- called by ------------------------------------------------------
987!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
988!||====================================================================
989 SUBROUTINE imp_i7xv(
990 1 X ,NSV ,MSR ,NSN ,NMN ,
991 1 STFN ,X_TMP ,D ,DR ,V ,
992 3 VR ,FACD ,FACV )
993C-----------------------------------------------
994C I m p l i c i t T y p e s
995C-----------------------------------------------
996#include "implicit_f.inc"
997C-----------------------------------------------
998C C o m m o n B l o c k s
999C-----------------------------------------------
1000#include "com01_c.inc"
1001C-----------------------------------------------
1002C D u m m y A r g u m e n t s
1003C-----------------------------------------------
1004 INTEGER NSN,NMN,NSV(*),MSR(*)
1005 my_real
1006 . x(3,*),v(3,*),vr(3,*),d(3,*),dr(3,*),
1007 . x_tmp(3,*),facd,facv,stfn(*)
1008C-----------------------------------------------
1009C L o c a l V a r i a b l e s
1010C-----------------------------------------------
1011 INTEGER I,J
1012C REAL
1013 my_real
1014 . dx,dy,dz
1015C------------------------------------
1016 DO j=1,nsn
1017 IF (stfn(j)/=zero) THEN
1018 i=nsv(j)
1019 dx = d(1,i)*facd
1020 dy = d(2,i)*facd
1021 dz = d(3,i)*facd
1022 x_tmp(1,i)=x(1,i) + dx
1023 x_tmp(2,i)=x(2,i) + dy
1024 x_tmp(3,i)=x(3,i) + dz
1025 v(1,i)=d(1,i)*facv
1026 v(2,i)=d(2,i)*facv
1027 v(3,i)=d(3,i)*facv
1028 END IF
1029 END DO
1030 DO j=1,nmn
1031 i=msr(j)
1032 IF (i>0) THEN
1033 dx = d(1,i)*facd
1034 dy = d(2,i)*facd
1035 dz = d(3,i)*facd
1036 x_tmp(1,i) = x(1,i) + dx
1037 x_tmp(2,i) = x(2,i) + dy
1038 x_tmp(3,i) = x(3,i) + dz
1039 v(1,i) = d(1,i)*facv
1040 v(2,i) = d(2,i)*facv
1041 v(3,i) = d(3,i)*facv
1042 END IF
1043 END DO
1044C
1045 IF (iroddl/=0) THEN
1046 DO j=1,nsn
1047 IF (stfn(j)/=zero) THEN
1048 i=nsv(j)
1049 vr(1,i)=dr(1,i)*facv
1050 vr(2,i)=dr(2,i)*facv
1051 vr(3,i)=dr(3,i)*facv
1052 END IF
1053 END DO
1054 DO j=1,nmn
1055 i=msr(j)
1056 IF (i>0) THEN
1057 vr(1,i)=dr(1,i)*facv
1058 vr(2,i)=dr(2,i)*facv
1059 vr(3,i)=dr(3,i)*facv
1060 END IF
1061 END DO
1062 END IF
1063C
1064 RETURN
1065 END
1066!||====================================================================
1067!|| imp_tripi ../engine/source/implicit/imp_int_k.F
1068!||--- called by ------------------------------------------------------
1069!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
1070!||--- calls -----------------------------------------------------
1071!|| i10main_opt_tri ../engine/source/interfaces/intsort/i10opt_opt_tri.f
1072!|| i10main_tri ../engine/source/interfaces/intsort/i10main_tri.F
1073!|| i11main_opt_tri ../engine/source/interfaces/intsort/i11main_opt_tri.F
1074!|| i11main_tri ../engine/source/interfaces/intsort/i11main_tri.F
1075!|| i20main_opt_tri ../engine/source/interfaces/intsort/i20main_opt_tri.f
1076!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
1077!|| i7main_opt_tri ../engine/source/interfaces/intsort/i7main_opt_tri.F
1078!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.f
1079!|| imp_i10mainf ../engine/source/interfaces/int10/i10ke3.f
1080!|| imp_i11mainf ../engine/source/interfaces/int11/i11ke3.F
1081!|| imp_i7mainf ../engine/source/interfaces/int07/i7ke3.F
1082!|| spmd_i7xvcom2 ../engine/source/mpi/interfaces/spmd_i7xvcom2.F
1083!|| spmd_ifront ../engine/source/mpi/interfaces/spmd_ifront.F
1084!|| spmd_sd_xv ../engine/source/mpi/nodes/spmd_sd_xv.F
1085!||--- uses -----------------------------------------------------
1086!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
1087!|| groupdef_mod ../common_source/modules/groupdef_mod.F
1088!|| h3d_mod ../engine/share/modules/h3d_mod.F
1089!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1090!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.F90
1091!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
1092!|| sensor_mod ../common_source/modules/sensor_mod.F90
1093!|| timer_mod ../engine/source/system/timer_mod.F90
1094!||====================================================================
1095 SUBROUTINE imp_tripi(TIMERS,
1096 1 IPARI ,INTBUF_TAB ,X ,D ,
1097 2 V ,MS ,ITAB ,VR ,IN ,
1098 3 IMSCH ,I2MSCH ,ISIZXV,ILENXV ,IGRBRIC ,
1099 4 ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
1100 5 IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM,FR_ELEM ,
1101 6 NBINTC,INTLIST,ITASK ,KINET,NEWFRONT,
1102 7 NUM_IMP,NS_IMP,NE_IMP,IND_IMP,IAD ,
1103 8 ISENDTO ,IRECVFROM ,RETRI,WEIGHT,
1104 9 IXS ,TEMP ,DT2PREV,WAG ,N ,NTY ,
1105 A IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,IRLEN20E,
1106 B ISLEN20E,IKINE,DIAG_SMS,COUNT_REMSLV,COUNT_REMSLVE,
1107 C SENSOR_TAB,XDP,H3D_DATA,MULTI_FVM,FORNEQS,
1108 D INTERFACES,NSENSOR ,GLOB_THERM)
1109C-----------------------------------------------
1110C M o d u l e s
1111C-----------------------------------------------
1112 USE timer_mod
1113 USE intbufdef_mod
1114 USE h3d_mod
1115 USE multi_fvm_mod
1116 USE groupdef_mod
1117 USE sensor_mod
1118 USE interfaces_mod
1119 use glob_therm_mod
1120C-----------------------------------------------
1121C I m p l i c i t T y p e s
1122C-----------------------------------------------
1123#include "implicit_f.inc"
1124C-----------------------------------------------
1125C C o m m o n B l o c k s
1126C-----------------------------------------------
1127#include "com01_c.inc"
1128#include "com04_c.inc"
1129#include "com08_c.inc"
1130#include "param_c.inc"
1131C-----------------------------------------------
1132C D u m m y A r g u m e n t s
1133C-----------------------------------------------
1134 TYPE(TIMER_) :: TIMERS
1135 INTEGER ,INTENT(IN) :: NSENSOR
1136 INTEGER IPARI(NPARI,*), ITAB(*),
1137 . NEWFRONT(*),NBINTC,INTLIST(*),IKINE(*),
1138 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
1139 . ITASK,IMSCH ,I2MSCH ,ISIZXV,ILENXV,COUNT_REMSLV(*),
1140 . COUNT_REMSLVE(*)
1141 INTEGER ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
1142 . IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E,
1143 . IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM(*),FR_ELEM(*) ,
1144 . WEIGHT(*),IAD,N,IXS(*) ,
1145 . NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1146 . KINET(*),NTY
1147
1148 DOUBLE PRECISION XDP(3,*)
1149
1150 my_real
1151 . x(3,*), d(3,*),v(*),ms(*),wag(*),
1152 . vr(3,*),dt2prev, temp(*),in(*), diag_sms(*),forneqs(3,*)
1153
1154 TYPE(intbuf_struct_) INTBUF_TAB(*)
1155 TYPE(H3D_DATABASE) :: H3D_DATA
1156 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
1157!
1158 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
1159 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
1160 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
1161 type (glob_therm_), INTENT(IN) :: GLOB_THERM
1162C-----------------------------------------------
1163C L o c a l V a r i a b l e s
1164C-----------------------------------------------
1165 INTEGER KK,LL, RETRI, NBLIST, IFQ,
1166 . INACTI, NSNROLD, IAD17, IGN, IGE, NME, NMES,
1167 . i,l1,l2,l3,jtask,lindmax,ibid ,ibidlen,nrtm_t,
1168 . eshift,renum(numnod), nsnfiold(nspmd), isens
1169 INTEGER INT24E2EUSE
1170 INTEGER LSKYI_SMS_NEW ! AMS Counter for Interface values. Not need in implicit but kept for compatibility
1171C REAL
1172 my_real
1173 . dti, ts
1174 my_real
1175 . rdum(3,1)
1176C-------------dans inttri------
1177 lskyi_sms_new = 0 ! Value is set to zero than ignored.
1178 int24e2euse=0
1179 rdum(1:3,1)=zero
1180 ibid =0
1181 jtask = itask + 1
1182 IF (nspmd>1) THEN
1183 IF(isizxv>0) CALL spmd_sd_xv(
1184 1 x ,d ,v ,vr ,ms ,
1185 2 in ,iad_elem,fr_elem,weight,imsch,
1186 3 d ,isizxv ,ilenxv ,xdp)
1187 l1 = 1+nixs*numels
1188 l2 = l1+6*numels10
1189 l3 = l2+12*numels20
1190 CALL spmd_i7xvcom2(
1191 1 ipari ,x ,v ,ms ,
1192 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
1193 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
1194 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
1195 5 igrbric ,temp ,1 ,irlen7t ,islen7t ,
1196 6 irlen20 ,islen20,irlen20t,islen20t,irlen20e,
1197 7 islen20e,ikine ,diag_sms,sensor_tab,intbuf_tab,int24e2euse,
1198 8 forneqs ,multi_fvm,interfaces)
1199 CALL spmd_i7xvcom2(
1200 1 ipari ,x ,v ,ms ,
1201 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
1202 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
1203 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
1204 5 igrbric ,temp ,2 ,irlen7t ,islen7t ,
1205 6 irlen20 ,islen20,irlen20t,islen20t,irlen20e,
1206 7 islen20e,ikine ,diag_sms,sensor_tab,intbuf_tab,int24e2euse,
1207 8 forneqs ,multi_fvm,interfaces)
1208 ENDIF
1209 nrtm_t = ipari(4,n)
1210 eshift = 0
1211 IF(nty==7.OR.nty==18)THEN
1212C
1213 isens = ipari(64,n)
1214 IF(isens/=0) THEN ! SENSOR
1215 ts = sensor_tab(isens)%TSTART
1216 ELSE
1217 ts = tt
1218 ENDIF
1219C
1220 IF(tt>=ts) THEN ! If interface is activated
1221 CALL i7main_tri(timers,
1222 1 ipari ,x ,v ,
1223 2 ms ,n ,itask ,wag ,weight ,
1224 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1225 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1226 5 nsnfiold,eshift ,ibid ,ibid ,ibid ,
1227 6 intbuf_tab,h3d_data,ixs,multi_fvm,glob_therm)
1228 ENDIF
1229 ELSEIF(nty==10)THEN
1230C
1231 CALL i10main_tri(timers,
1232 1 npari ,ipari(1,n),x ,v ,
1233 2 ms ,n ,itask ,wag ,weight ,
1234 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1235 4 nrtm_t ,renum ,nsnfiold ,eshift ,ibid ,
1236 5 ibid ,ibid ,itab ,intbuf_tab ,
1237 6 h3d_data ,glob_therm )
1238 ELSEIF(nty==11)THEN
1239C
1240 isens = ipari(64,n)
1241 IF(isens/=0) THEN ! SENSOR
1242 ts = sensor_tab(isens)%TSTART
1243 ELSE
1244 ts = tt
1245 ENDIF
1246C
1247 IF(tt>=ts) THEN ! If interface is activated
1248 CALL i11main_tri(timers,
1249 1 ipari ,x ,v ,
1250 2 ms ,n ,itask ,weight ,isendto ,
1251 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
1252 4 nrtm_t ,eshift ,ibid ,renum ,nsnfiold ,
1253 5 intbuf_tab ,ibid ,ibid)
1254 ENDIF
1255
1256 ELSEIF(nty == 20)THEN
1257C
1258 CALL i20main_tri(timers,
1259 1 ipari ,x ,v ,
1260 2 ms ,n ,itask ,wag ,weight ,
1261 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1262 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1263 5 nsnfiold,eshift ,ibid ,ibid ,diag_sms,
1264 5 ibid ,intbuf_tab ,h3d_data ,glob_therm)
1265 ENDIF
1266C
1267 IF (nspmd>1.AND.retri==1) THEN
1268C--------- a modifier par interface---
1269 CALL spmd_ifront(
1270 1 ipari ,newfront,isendto ,irecvfrom,
1271 2 nsensor,nbintc ,intlist ,ibidlen ,ibidlen ,
1272 3 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1273 4 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1274 5 ibidlen,ibidlen,sensor_tab,intbuf_tab, 1)
1275 CALL spmd_ifront(
1276 1 ipari ,newfront,isendto ,irecvfrom,
1277 2 nsensor,nbintc ,intlist ,ibidlen ,ibidlen ,
1278 3 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1279 4 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1280 5 ibidlen,ibidlen,sensor_tab,intbuf_tab, 2)
1281
1282
1283 ENDIF
1284C
1285 IF(nty==7)THEN
1286C
1287 isens = ipari(64,n)
1288 IF(isens/=0) THEN ! SENSOR
1289 ts = sensor_tab(isens)%TSTART
1290 ELSE
1291 ts = tt
1292 ENDIF
1293C
1294 IF(tt>=ts) THEN ! If interface is activated
1295 CALL i7main_opt_tri(
1296 1 ipari ,intbuf_tab(n),x ,v ,
1297 2 n ,itask ,count_remslv, lskyi_sms_new )
1298 ENDIF
1299 ELSEIF(nty==10)THEN
1300 CALL i10main_opt_tri(
1301 1 ipari(1,n),intbuf_tab(n),x ,v ,
1302 2 n ,itask ,count_remslv , lskyi_sms_new )
1303 ELSEIF(nty==11)THEN
1304C
1305 isens = ipari(64,n)
1306 IF(isens/=0) THEN ! SENSOR
1307 ts = sensor_tab(isens)%TSTART
1308 ELSE
1309 ts = tt
1310 ENDIF
1311C
1312 IF(tt>=ts) THEN ! If interface is activated
1313 CALL i11main_opt_tri(
1314 1 ipari ,intbuf_tab(n),x ,v ,
1315 2 n ,itask ,count_remslv , lskyi_sms_new )
1316 ENDIF
1317 ELSEIF(nty == 20)THEN
1318 CALL i20main_opt_tri(
1319 1 ipari ,intbuf_tab(n),x ,v ,
1320 2 n ,itask ,count_remslv ,count_remslve )
1321 ENDIF
1322C-------------dans intfop2------
1323 lindmax = ipari(18,n)*ipari(23,n)
1324
1325C
1326 IF(nty==7)THEN
1327C
1328 isens = ipari(64,n)
1329 IF(isens/=0) THEN ! SENSOR
1330 ts = sensor_tab(isens)%TSTART
1331 ELSE
1332 ts = tt
1333 ENDIF
1334C
1335 IF(tt>=ts) THEN ! If interface is activated
1336 CALL imp_i7mainf(
1337 1 ipari ,intbuf_tab(n),x ,v ,
1338 2 ms ,n ,lindmax ,jtask ,
1339 3 num_imp(n),ns_imp(iad) ,ne_imp(iad) ,ind_imp(iad))
1340 iad=iad+num_imp(n)
1341 ENDIF
1342 ELSEIF(nty==10)THEN
1343C
1344 CALL imp_i10mainf(
1345 1 ipari(1,n),intbuf_tab(n),x ,v ,
1346 2 ms ,n ,lindmax ,jtask ,
1347 3 num_imp(n),ns_imp(iad) ,ne_imp(iad) ,ind_imp(iad))
1348 iad=iad+num_imp(n)
1349 ELSEIF(nty==11)THEN
1350C
1351 isens = ipari(64,n)
1352 IF(isens/=0) THEN ! SENSOR
1353 ts = sensor_tab(isens)%TSTART
1354 ELSE
1355 ts = tt
1356 ENDIF
1357C
1358 IF(tt>=ts) THEN ! If interface is activated
1359 CALL imp_i11mainf(
1360 1 ipari(1,n),intbuf_tab(n),x ,v ,
1361 2 ms ,n ,lindmax ,jtask ,
1362 3 num_imp(n),ns_imp(iad) ,ne_imp(iad) ,itab)
1363 iad=iad+num_imp(n)
1364 ENDIF
1365 ENDIF
1366C
1367 RETURN
1368 END
1369!||====================================================================
1370!|| cp_inttd ../engine/source/implicit/imp_int_k.F
1371!||--- called by ------------------------------------------------------
1372!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
1373!||--- calls -----------------------------------------------------
1374!|| cp_int ../engine/source/implicit/produt_v.F
1375!||--- uses -----------------------------------------------------
1376!|| imp_inttd ../engine/share/modules/imp_mod_def.F90
1377!||====================================================================
1378 SUBROUTINE cp_inttd(NT_IMP1,NUMIMP ,NS_IMP,NE_IMP,IND_IMP,NUMIMP1)
1379C-----------------------------------------------
1380C M o d u l e s
1381C-----------------------------------------------
1382 USE imp_inttd
1383C-----------------------------------------------
1384C I m p l i c i t T y p e s
1385C-----------------------------------------------
1386#include "implicit_f.inc"
1387C-----------------------------------------------
1388C C o m m o n B l o c k s
1389C-----------------------------------------------
1390#include "com04_c.inc"
1391C-----------------------------------------------
1392C D u m m y A r g u m e n t s
1393C-----------------------------------------------
1394 INTEGER NUMIMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1395 . numimp1(*),nt_imp1
1396C-----------------------------------------------
1397C L o c a l V a r i a b l e s
1398C-----------------------------------------------
1399 INTEGER I,J,K,L,N,IAD,IAD1,IADT
1400 INTEGER IERROR1,IERROR2,IERROR3,IERROR4
1401C-----------------------------------------------
1402C S o u r c e L i n e s
1403C-----------------------------------------------
1404 IF(nt_imp1==0) RETURN
1405 IF(ALLOCATED(ns_imp1)) DEALLOCATE(ns_imp1)
1406 ALLOCATE(ns_imp1(nt_imp1),stat=ierror1)
1407 IF(ALLOCATED(ne_imp1)) DEALLOCATE(ne_imp1)
1408 ALLOCATE(ne_imp1(nt_imp1),stat=ierror2)
1409 IF(ALLOCATED(ind_imp1)) DEALLOCATE(ind_imp1)
1410 ALLOCATE(ind_imp1(nt_imp1),stat=ierror3)
1411 IF(ALLOCATED(iad1_nin)) DEALLOCATE(iad1_nin)
1412 ALLOCATE(iad1_nin(ninter),stat=ierror4)
1413C
1414 CALL cp_int(ninter,numimp,numimp1)
1415 CALL cp_int(nt_imp1,ns_imp,ns_imp1)
1416 CALL cp_int(nt_imp1,ne_imp,ne_imp1)
1417 CALL cp_int(nt_imp1,ind_imp,ind_imp1)
1418 iad1 = 0
1419 DO n = 1,ninter
1420 iad1_nin(n) =iad1
1421 iad1 =iad1 + numimp1(n)
1422 END DO
1423C
1424 RETURN
1425 END
1426!||====================================================================
1427!|| sav_inttd ../engine/source/implicit/imp_int_k.F
1428!||--- called by ------------------------------------------------------
1429!|| imp_solv ../engine/source/implicit/imp_solv.F
1430!||--- uses -----------------------------------------------------
1431!|| imp_inttd ../engine/share/modules/imp_mod_def.F90
1432!||====================================================================
1433 SUBROUTINE sav_inttd(NT_IMP,NUMIMP,NS_IMP,NE_IMP,IND_IMP,
1434 1 NUMIMP1)
1435C-----------------------------------------------
1436C M o d u l e s
1437C-----------------------------------------------
1438 USE imp_inttd
1439C-----------------------------------------------
1440C I m p l i c i t T y p e s
1441C-----------------------------------------------
1442#include "implicit_f.inc"
1443C-----------------------------------------------
1444C C o m m o n B l o c k s
1445C-----------------------------------------------
1446#include "com01_c.inc"
1447#include "com04_c.inc"
1448#include "impl1_c.inc"
1449C-----------------------------------------------
1450C D u m m y A r g u m e n t s
1451C-----------------------------------------------
1452 INTEGER NT_IMP,NUMIMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1453 . NUMIMP1(*)
1454C-----------------------------------------------
1455C L o c a l V a r i a b l e s
1456C-----------------------------------------------
1457 INTEGER I,J,K,L,N,IAD,IAD1,IADT
1458 INTEGER IERROR1,IERROR2,IERROR3,IERROR4
1459C-----------------------------------------------
1460C S o u r c e L i n e s
1461C-----------------------------------------------
1462 IF(nt_imp1==0) RETURN
1463C------dans NS_IMP1 input: NT_IMP1 , output:d'abord NT_IMP1, + NT_IMP-NT_IMP1
1464C------dans NS_IMP input:d'abord NT_IMP1, + NT_IMP-NT_IMP1, output: NT_IMP
1465 nt_imp = nt_imp + nt_imp1
1466 IF(nspmd>1) THEN
1467 iad1 = 0
1468 DO n = 1,ninter
1469 DO i = 1,numimp1(n)
1470 ns_imp(iad1+i)=ns_imp1(iad1+i)
1471 END DO
1472 iad1 =iad1 + numimp1(n)
1473 END DO
1474 ENDIF
1475C----
1476 IF(ALLOCATED(ns_imp1)) DEALLOCATE(ns_imp1)
1477 ALLOCATE(ns_imp1(nt_imp),stat=ierror1)
1478 IF(ALLOCATED(ne_imp1)) DEALLOCATE(ne_imp1)
1479 ALLOCATE(ne_imp1(nt_imp),stat=ierror2)
1480 IF(ALLOCATED(ind_imp1)) DEALLOCATE(ind_imp1)
1481 ALLOCATE(ind_imp1(nt_imp),stat=ierror3)
1482C
1483 iad1 = 0
1484 DO n = 1,ninter
1485 DO i = 1,numimp1(n)
1486 ns_imp1(iad1+i) = ns_imp(iad1+i)
1487 ne_imp1(iad1+i) = ne_imp(iad1+i)
1488 ind_imp1(iad1+i) = ind_imp(iad1+i)
1489 END DO
1490 iad1 =iad1 + numimp1(n)
1491 END DO
1492 DO n = 1,ninter
1493 DO i = 1,numimp(n)
1494 ns_imp1(iad1+i) = ns_imp(iad1+i)
1495 ne_imp1(iad1+i) = ne_imp(iad1+i)
1496 ind_imp1(iad1+i) = ind_imp(iad1+i)
1497 END DO
1498 iad1 =iad1 + numimp(n)
1499 END DO
1500C--------change ind for NS_IMP,INE_IMP,IND_IMP---
1501 iad = 0
1502 iad1 = 0
1503 DO n = 1,ninter
1504 DO i = 1,numimp1(n)
1505 ns_imp(iad+i) = ns_imp1(iad1+i)
1506 ne_imp(iad+i) = ne_imp1(iad1+i)
1507 ind_imp(iad+i) = ind_imp1(iad1+i)
1508 END DO
1509 iad =iad + numimp1(n) + numimp(n)
1510 iad1 = iad1 + numimp1(n)
1511 END DO
1512 iad = 0
1513 DO n = 1,ninter
1514 iadt =iad + numimp1(n)
1515 DO i = 1,numimp(n)
1516 ns_imp(iadt+i) = ns_imp1(iad1+i)
1517 ne_imp(iadt+i) = ne_imp1(iad1+i)
1518 ind_imp(iadt+i) = ind_imp1(iad1+i)
1519 END DO
1520 iad1 =iad1 + numimp(n)
1521 iad =iad + numimp1(n) + numimp(n)
1522 END DO
1523C--------change ind for NUM_IMP---
1524 DO n = 1,ninter
1525 numimp(n) = numimp1(n) + numimp(n)
1526 END DO
1527C
1528 RETURN
1529 END
1530!||====================================================================
1531!|| imp_rnumcd ../engine/source/implicit/imp_int_k.F
1532!||--- called by ------------------------------------------------------
1533!|| i10main_tri ../engine/source/interfaces/intsort/i10main_tri.F
1534!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
1535!|| i22main_tri ../engine/source/interfaces/intsort/i22main_tri.F
1536!|| i23main_tri ../engine/source/interfaces/intsort/i23main_tri.f
1537!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
1538!||--- uses -----------------------------------------------------
1539!|| imp_inttd ../engine/share/modules/imp_mod_def.F90
1540!||====================================================================
1541 SUBROUTINE imp_rnumcd(CAND_N ,NIN,NSN,NUM_IMP,INDEX )
1542C-----------------------------------------------
1543C M o d u l e s
1544C-----------------------------------------------
1545 USE imp_inttd
1546C-----------------------------------------------
1547C I m p l i c i t T y p e s
1548C-----------------------------------------------
1549#include "implicit_f.inc"
1550C-----------------------------------------------
1551C D u m m y A r g u m e n t s
1552C-----------------------------------------------
1553 INTEGER CAND_N(*) ,NIN,NSN,NUM_IMP,INDEX(*)
1554C-----------------------------------------------
1555C L o c a l V a r i a b l e s
1556C-----------------------------------------------
1557 INTEGER I, NI,IAD
1558C-----------------------------------------------
1559C S o u r c e L i n e s
1560C-----------------------------------------------
1561 iad = iad1_nin(nin)
1562 DO i = 1, num_imp
1563 ni = ns_imp1(iad+i)
1564 IF(ni>nsn) THEN
1565 ni = ni - nsn
1566 ns_imp1(iad+i) = cand_n(index(i))
1567 END IF
1568 END DO
1569C
1570 RETURN
1571 END
1572!||====================================================================
1573!|| imp_dtkin ../engine/source/implicit/imp_int_k.F
1574!||--- called by ------------------------------------------------------
1575!|| imp_solv ../engine/source/implicit/imp_solv.F
1576!||--- calls -----------------------------------------------------
1577!|| imp_intdt ../engine/source/implicit/imp_int_k.F
1578!||--- uses -----------------------------------------------------
1579!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1580!|| sensor_mod ../common_source/modules/sensor_mod.F90
1581!||====================================================================
1582 SUBROUTINE imp_dtkin(
1583 1 IPARI ,INTBUF_TAB ,X ,V ,
1584 2 VR ,ITAB ,D_IMP ,DR_IMP ,NBINTC ,
1585 3 INTLIST,ITASK ,NEWFRONT,ISENDTO ,IRECVFROM,
1586 4 IDDL ,NDOF ,IKC ,SCAL ,MS ,
1587 5 NSENSOR,SENSOR_TAB, MAXDGAP)
1588C-----------------------------------------------
1589C M o d u l e s
1590C-----------------------------------------------
1591 USE intbufdef_mod
1592 USE sensor_mod
1593C-----------------------------------------------
1594C I m p l i c i t T y p e s
1595C-----------------------------------------------
1596#include "implicit_f.inc"
1597C-----------------------------------------------
1598C C o m m o n B l o c k s
1599C-----------------------------------------------
1600#include "com01_c.inc"
1601#include "com04_c.inc"
1602#include "com08_c.inc"
1603#include "param_c.inc"
1604#include "impl1_c.inc"
1605#include "task_c.inc"
1606C-----------------------------------------------
1607C D u m m y A r g u m e n t s
1608C-----------------------------------------------
1609 INTEGER ,INTENT(IN) :: NSENSOR
1610 INTEGER IPARI(NPARI,*), ITAB(*),
1611 . NEWFRONT(*),NBINTC,INTLIST(*),
1612 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
1613 . ITASK
1614 INTEGER IDDL(*) ,NDOF(*),IKC(*)
1615 my_real
1616 . X(3,*), V(3,*),VR(3,*),
1617 . D_IMP(3,*),DR_IMP(3,*),SCAL,MS(*),
1618 . maxdgap(ninter)
1619
1620 TYPE(intbuf_struct_) INTBUF_TAB(*)
1621 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
1622C-----------------------------------------------
1623C L o c a l V a r i a b l e s
1624C-----------------------------------------------
1625 INTEGER N,I,J,ID,NTHR_CP
1626C REAL
1627 my_real
1628 . dtk(ninter),dti,dt_min
1629C-------------before inttri------
1630 scal = one
1631 IF (ittoff>0.OR.imconv==1.OR.imconv<=-2) RETURN
1632 nthr_cp = nthread
1633 IF (nthread>1) nthread = 1
1634 dti = one/dt2
1635 DO i=1,numnod
1636 v(1,i)=d_imp(1,i)*dti
1637 v(2,i)=d_imp(2,i)*dti
1638 v(3,i)=d_imp(3,i)*dti
1639 ENDDO
1640 IF (iroddl/=0) THEN
1641 DO i=1,numnod
1642 vr(1,i)=dr_imp(1,i)*dti
1643 vr(2,i)=dr_imp(2,i)*dti
1644 vr(3,i)=dr_imp(3,i)*dti
1645 ENDDO
1646 ENDIF
1647 CALL imp_intdt(
1648 1 ipari ,intbuf_tab ,x ,
1649 2 v ,vr ,isendto ,irecvfrom,
1650 4 newfront ,itask ,dtk ,itab ,
1651 5 intlist ,nbintc ,dt_min ,ms ,
1652 6 nsensor ,sensor_tab,maxdgap)
1653C
1654 scal = dt_min*dti
1655 IF (scal<one) THEN
1656 DO i=1,numnod
1657 d_imp(1,i)=d_imp(1,i)*scal
1658 d_imp(2,i)=d_imp(2,i)*scal
1659 d_imp(3,i)=d_imp(3,i)*scal
1660 ENDDO
1661 IF (iroddl/=0) THEN
1662 DO i=1,numnod
1663 dr_imp(1,i)=dr_imp(1,i)*scal
1664 dr_imp(2,i)=dr_imp(2,i)*scal
1665 dr_imp(3,i)=dr_imp(3,i)*scal
1666 ENDDO
1667 ENDIF
1668 ENDIF
1669C
1670 IF (nthr_cp>1) nthread = nthr_cp
1671C
1672 RETURN
1673 END
1674!||====================================================================
1675!|| kin_knl ../engine/source/implicit/imp_int_k.F
1676!||--- called by ------------------------------------------------------
1677!|| imp_solv ../engine/source/implicit/imp_solv.F
1678!||--- calls -----------------------------------------------------
1679!|| dim_kinkn ../engine/source/implicit/imp_int_k.F
1680!|| iddl_mint ../engine/source/implicit/imp_int_k.F
1681!|| ini_kinkn ../engine/source/implicit/imp_int_k.F
1682!|| rbe3_mint ../engine/source/implicit/imp_int_k.F
1683!||--- uses -----------------------------------------------------
1684!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
1685!|| imp_knon ../engine/share/modules/impbufdef_mod.F
1686!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1687!||====================================================================
1688 SUBROUTINE kin_knl(
1689 1 IPARI ,INTBUF_TAB ,NUM_IMP ,NS_IMP ,NE_IMP ,
1690 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
1691 3 NINT2 ,IINT2 ,IBFV ,LJ ,ISKEW ,
1692 4 ICODT ,NDOFI ,IDDL ,IKC ,NDOF ,
1693 5 INLOC ,IRBE3 ,LRBE3 ,FRBE3 ,X ,
1694 6 SKEW ,IRBE2 ,LRBE2 )
1695C-----------------------------------------------
1696C M o d u l e s
1697C-----------------------------------------------
1698 USE imp_knon
1699 USE imp_aspc
1700 USE intbufdef_mod
1701C-----------------------------------------------
1702C I m p l i c i t T y p e s
1703C-----------------------------------------------
1704#include "implicit_f.inc"
1705C-----------------------------------------------
1706C C o m m o n B l o c k s
1707C-----------------------------------------------
1708#include "com04_c.inc"
1709#include "param_c.inc"
1710C-----------------------------------------------
1711C D u m m y A r g u m e n t s
1712C-----------------------------------------------
1713 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
1714 . ne_imp(*),ndofi(*)
1715 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
1716 . NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
1717 . IBFV(*),LJ(*),ISKEW(*),ICODT(*),IRBE3(NRBE3L,*),LRBE3(*),
1718 . IRBE2(NRBE2L,*),LRBE2(*)
1719C REAL
1720 my_real
1721 . x(*),skew(*),frbe3(*)
1722 TYPE(intbuf_struct_) INTBUF_TAB(*)
1723C-----------------------------------------------
1724C L o c a l V a r i a b l e s
1725C-----------------------------------------------
1726 INTEGER I,J,N, IAD,NTY,NDOFII(NUMNOD),NKC,
1727 . ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,nd,nmt,irot,numn
1728C-----------------------------------------------
1729 DO n=1,numnod
1730 ndofii(n) = iabs(ndofi(n))
1731 ENDDO
1732 numn_kn = 0
1733 DO n=1,numnod
1734 IF (ndofii(n)>0) numn_kn = numn_kn + 1
1735 ENDDO
1736C--------allocation------
1737C
1738 ALLOCATE(in_kn(numn_kn),id_kn(3,numn_kn),stat=ierr1)
1739 IF (numn_kn > 0) THEN
1740 id_kn = -7
1741 n = 0
1742C------------valeur nega pour les nsl nodes-----
1743 DO i=1,numnod
1744 IF (ndofii(i)>0) THEN
1745 n = n + 1
1746 in_kn(n) = i
1747 ENDIF
1748 ENDDO
1749 END IF
1750 CALL dim_kinkn(
1751 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
1752 2 iint2 ,ipari ,intbuf_tab,ndofii ,ibfv ,
1753 3 lj ,iskew ,icodt ,nrb_kn ,ni2_kn ,
1754 4 nbc_kn ,nfx_kn ,nrw_kn ,irbe3 ,nrbe3_kn ,
1755 5 nspc_kn ,irbe2 ,lrbe2 ,nrbe2_kn )
1756 IF (ni2_kn>0) THEN
1757 ALLOCATE(ii2_kn(2,ni2_kn),id_knm2(6,4,ni2_kn),stat=ierr2)
1758 ENDIF
1759 IF (nrb_kn>0) THEN
1760 ALLOCATE(irb_kn(2,nrb_kn),id_knm(6,nrb_kn),stat=ierr3)
1761 ENDIF
1762 IF (nbc_kn>0) THEN
1763 IF(ALLOCATED(ibc_kn)) DEALLOCATE(ibc_kn)
1764 ALLOCATE(ibc_kn(3,nbc_kn),stat=ierr4)
1765 ENDIF
1766 IF (nspc_kn>0) THEN
1767 IF(ALLOCATED(ispc_kn)) DEALLOCATE(ispc_kn)
1768 ALLOCATE(ispc_kn(nspc_kn),stat=ierr4)
1769 ENDIF
1770C--
1771 IF (nfx_kn>0) THEN
1772 IF(ALLOCATED(ifx_kn)) DEALLOCATE(ifx_kn)
1773 ALLOCATE(ifx_kn(2,nfx_kn),stat=ierr5)
1774 ENDIF
1775C
1776 IF (nrw_kn>0) THEN
1777 IF(ALLOCATED(irw_kn)) DEALLOCATE(irw_kn)
1778 ALLOCATE(irw_kn(nrw_kn),stat=ierr6)
1779 ENDIF
1780C
1781 IF (nrbe3_kn>0) THEN
1782 ALLOCATE(irbe3_kn(nrbe3_kn),stat=ierr6)
1783 ENDIF
1784C
1785 IF (nrbe2_kn>0) THEN
1786 ALLOCATE(irbe2_kn(2,nrbe2_kn),id_knm4(6,nrbe2_kn),stat=ierr3)
1787 ENDIF
1788C
1789 CALL ini_kinkn(
1790 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
1791 2 iint2 ,ipari ,intbuf_tab,ndofii ,ibfv ,
1792 3 lj ,iskew ,icodt ,nrb_kn ,irb_kn ,
1794 4 ifx_kn ,nrw_kn ,irw_kn ,irbe3 ,nrbe3_kn ,
1795 5 irbe3_kn ,nspc_kn ,ispc_kn ,irbe2 ,lrbe2 ,
1796 6 nrbe2_kn ,irbe2_kn )
1797C ------ini RBE3---
1798 IF (nrbe3_kn>0) THEN
1799 iad=0
1800 nmt = 0
1801 irot=0
1802 DO i=1,nrbe3_kn
1803 n=irbe3_kn(i)
1804 numn = irbe3(5,n)
1805 iad=max(iad,numn)
1806 nmt = nmt + numn
1807 irot=max(irot,irbe3(6,n))
1808 ENDDO
1809 ALLOCATE(id_knm3(6,iad,nrbe3_kn),stat=ierr3)
1810 id_knm3=0
1811 rkn_max=iad
1812 ALLOCATE(fcdi_kn(18*nmt),stat=ierr5)
1813 fcdi_kn=zero
1814 IF (irot>0) THEN
1815 ALLOCATE(mcdi_kn(18*nmt),stat=ierr5)
1816 mcdi_kn=zero
1817 ENDIF
1818 CALL rbe3_mint(irbe3 ,lrbe3 ,frbe3 ,x ,skew ,
1819 . nrbe3_kn,irbe3_kn ,fcdi_kn,mcdi_kn)
1820 ENDIF
1821C--------- use NDOFII(I)--as IDDLM ------------
1822 IF (numn_kn == 0) RETURN
1823 nkc=0
1824 DO n =1,numnod
1825 i=inloc(n)
1826 ndofii(i)=iddl(i)-nkc
1827 DO j=1,ndof(i)
1828 nd = iddl(i)+j
1829 IF (ikc(nd)/=0) nkc = nkc + 1
1830 ENDDO
1831 ENDDO
1832 CALL iddl_mint(numn_kn,in_kn ,iddl ,ikc ,ndof ,
1833 . ndofii ,ipari ,intbuf_tab,id_kn ,nrb_kn ,
1835 . irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,id_knm3 ,
1836 . rkn_max ,irbe2 ,nrbe2_kn,irbe2_kn,id_knm4 )
1837C------------return origine NDOFI(I)----
1838 DO i=1,numnod
1839 IF (ndofi(i)<0) ndofi(i) = 0
1840 ENDDO
1841 RETURN
1842 END
1843!||====================================================================
1844!|| dim_kinkn ../engine/source/implicit/imp_int_k.F
1845!||--- called by ------------------------------------------------------
1846!|| kin_knl ../engine/source/implicit/imp_int_k.F
1847!||--- uses -----------------------------------------------------
1848!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
1849!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
1850!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1851!||====================================================================
1852 SUBROUTINE dim_kinkn(
1853 1 NPBY ,LPBY ,NRBYAC ,IRBYAC ,NINT2 ,
1854 2 IINT2 ,IPARI ,INTBUF_TAB,INLOC ,IBFV ,
1855 3 LJ ,ISKEW ,ICODT ,LNS ,LNS2 ,
1856 4 LBCL ,LFXL ,LRW ,IRBE3 ,LNS3 ,
1857 5 LSPCL ,IRBE2 ,LRBE2 ,LNS4 )
1858C-----------------------------------------------
1859C M o d u l e s
1860C-----------------------------------------------
1861 USE imp_rwl
1862 USE imp_aspc
1863 USE intbufdef_mod
1864C-----------------------------------------------
1865C I m p l i c i t T y p e s
1866C-----------------------------------------------
1867#include "implicit_f.inc"
1868C-----------------------------------------------
1869C C o m m o n B l o c k s
1870C-----------------------------------------------
1871#include "com04_c.inc"
1872#include "param_c.inc"
1873C-----------------------------------------------
1874C D u m m y A r g u m e n t s
1875C-----------------------------------------------
1876 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
1877 . nint2,iint2(*),ipari(npari,*)
1878 INTEGER IBFV(NIFV,*),LJ(*),ISKEW(*) ,ICODT(*),LSPCL
1879 INTEGER INLOC(*),LNS ,LNS2,LBCL ,LFXL ,LRW,IRBE3(NRBE3L,*),LNS3,
1880 . irbe2(nrbe2l,*),lrbe2(*),lns4
1881C REAL
1882
1883 TYPE(intbuf_struct_) INTBUF_TAB(*)
1884C-----------------------------------------------
1885C L o c a l V a r i a b l e s
1886C-----------------------------------------------
1887 INTEGER
1888 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,
1889 . ji,k10,k11,k12,k13,k14,kfi,ns
1890C----------------------------
1891 lns2=0
1892 DO j=1,nint2
1893 n=iint2(j)
1894 nsn = ipari(5,n)
1895 ji=ipari(1,n)
1896 k10=ji-1
1897 k11=k10+4*ipari(3,n)
1898C------IRECT(4,NSN)-----
1899 k12=k11+4*ipari(4,n)
1900C------NSV(NSN)--node number---
1901 k13=k12+nsn
1902C------MSR(NMN)-----
1903 k14=k13+ipari(6,n)
1904C------IRTL(NSN)--main el number---
1905 kfi=k14+nsn
1906 DO i=1,nsn
1907 ni=intbuf_tab(n)%NSV(i)
1908 IF (inloc(ni)>0) THEN
1909 lns2=lns2+1
1910 ENDIF
1911 ENDDO
1912 ENDDO
1913C--------RBE3--------------------
1914 lns3=0
1915 DO n=1,nrbe3
1916 ni = irbe3(3,n)
1917 IF (ni==0) cycle
1918 IF (inloc(ni)>0) THEN
1919 lns3=lns3+1
1920 ENDIF
1921 ENDDO
1922C-----active rigid body main nodes------
1923 lns=0
1924 DO j=1,nrbyac
1925 n=irbyac(j)
1926 k=irbyac(j+nrbykin)
1927 m =npby(1,n)
1928 nsn =npby(2,n)
1929 DO i=1,nsn
1930 id = i+k
1931 ni=lpby(id)
1932 IF (inloc(ni)>0) THEN
1933 lns=lns+1
1934 IF (inloc(m)==0) inloc(m) = 1
1935 ENDIF
1936 ENDDO
1937 ENDDO
1938C
1939 lbcl = 0
1940 DO n=1,numnod
1941 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
1942 IF (inloc(n)>0)lbcl = lbcl + 1
1943 ENDIF
1944 ENDDO
1945 lspcl = 0
1946 DO n=1,nspcl
1947 IF (inloc(n)>0.AND.ic_spc(n)<=3)lspcl = lspcl + 1
1948 ENDDO
1949C ---
1950 lfxl = 0
1951 DO j=1,nfxvel
1952 IF (lj(j)>0.AND.lj(j)<=3) THEN
1953 n=iabs(ibfv(1,j))
1954 IF (inloc(n)>0)lfxl = lfxl + 1
1955 ENDIF
1956 ENDDO
1957C
1958 lrw = 0
1959 DO j=1,n_rwl
1960 n=in_rwl(j)
1961 IF (inloc(n)>0) lrw = lrw + 1
1962 ENDDO
1963C-----Rbe2------
1964 lns4=0
1965 DO n=1,nrbe2
1966 k=irbe2(1,n)
1967 m =irbe2(3,n)
1968 nsn =irbe2(5,n)
1969 DO i=1,nsn
1970 id = i+k
1971 ni=lrbe2(id)
1972 IF (inloc(ni)>0) THEN
1973 lns4=lns4+1
1974 IF (inloc(m)==0) inloc(m) = 2
1975 ENDIF
1976 ENDDO
1977 ENDDO
1978C----6---------------------------------------------------------------7---------8
1979 RETURN
1980 END
1981!||====================================================================
1982!|| ini_kinkn ../engine/source/implicit/imp_int_k.F
1983!||--- called by ------------------------------------------------------
1984!|| kin_knl ../engine/source/implicit/imp_int_k.F
1985!||--- uses -----------------------------------------------------
1986!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
1987!|| imp_rwl ../engine/share/modules/impbufdef_mod.f
1988!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1989!||====================================================================
1990 SUBROUTINE ini_kinkn(
1991 1 NPBY ,LPBY ,NRBYAC ,IRBYAC ,NINT2 ,
1992 2 IINT2 ,IPARI ,INTBUF_TAB,INLOC ,IBFV ,
1993 3 LJ ,ISKEW ,ICODT ,NRB_MV ,IRB_MV ,
1994 3 NI2_MV ,II2_MV ,NBC_MV ,IBC_MV ,NFX_MV ,
1995 4 IFX_MV ,NRW_MV ,IRW_MV ,IRBE3 ,NRBE3_MV ,
1996 5 IRBE3_MV ,NSPC_MV ,ISPC_MV ,IRBE2 ,LRBE2 ,
1997 6 NRBE2_MV ,IRBE2_MV )
1998C-----------------------------------------------
1999C M o d u l e s
2000C-----------------------------------------------
2001 USE imp_rwl
2002 USE imp_aspc
2003 USE intbufdef_mod
2004C-----------------------------------------------
2005C I m p l i c i t T y p e s
2006C-----------------------------------------------
2007#include "implicit_f.inc"
2008C-----------------------------------------------
2009C C o m m o n B l o c k s
2010C-----------------------------------------------
2011#include "com04_c.inc"
2012#include "param_c.inc"
2013C-----------------------------------------------
2014C D u m m y A r g u m e n t s
2015C-----------------------------------------------
2016 INTEGER IBFV(NIFV,*),LJ(*),ISKEW(*) ,ICODT(*)
2017 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
2018 . nint2,iint2(*),ipari(npari,*),irbe3(nrbe3l,*),
2019 . irbe2(nrbe2l,*),lrbe2(*)
2020 INTEGER
2021 . inloc(*),nrb_mv,ni2_mv,irb_mv(2,*),ii2_mv(2,*),
2022 . nbc_mv,ibc_mv(3,*) ,nfx_mv,ifx_mv(2,*),nrw_mv,irw_mv(*),
2023 . nrbe3_mv,irbe3_mv(*),nspc_mv,ispc_mv(*),nrbe2_mv,irbe2_mv(*)
2024C REAL
2025
2026 TYPE(intbuf_struct_) INTBUF_TAB(*)
2027C-----------------------------------------------
2028C L o c a l V a r i a b l e s
2029C-----------------------------------------------
2030 INTEGER
2031 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,nr3,nr4,
2032 . ji,k10,k11,k12,k13,k14,kfi,ni2,nrb,nbc,nfx,nrw,nspc
2033c----------------------
2034 ni2=0
2035 IF (ni2_mv>0) THEN
2036 DO j=1,nint2
2037 n=iint2(j)
2038 nsn = ipari(5,n)
2039 ji=ipari(1,n)
2040 k10=ji-1
2041 k11=k10+4*ipari(3,n)
2042C------IRECT(4,NSN)-----
2043 k12=k11+4*ipari(4,n)
2044C------NSV(NSN)--node number---
2045 k13=k12+nsn
2046C------MSR(NMN)-----
2047 k14=k13+ipari(6,n)
2048C------IRTL(NSN)--main el number---
2049 kfi=k14+nsn
2050 DO i=1,nsn
2051 ni=intbuf_tab(n)%NSV(i)
2052 IF (inloc(ni)>0) THEN
2053 ni2=ni2+1
2054 ii2_mv(1,ni2)=n
2055 ii2_mv(2,ni2)=i
2056 ENDIF
2057 ENDDO
2058 ENDDO
2059 IF (ni2/=ni2_mv) WRITE(*,*)'pb cal NI2_M'
2060 ENDIF
2061C--------RBE3--------------------
2062 IF (nrbe3_mv>0) THEN
2063 nr3=0
2064 DO n=1,nrbe3
2065 ni = irbe3(3,n)
2066 IF (ni==0) cycle
2067 IF (inloc(ni)>0) THEN
2068 nr3=nr3+1
2069 irbe3_mv(nr3)=n
2070 ENDIF
2071 ENDDO
2072 IF (nr3/=nrbe3_mv) WRITE(*,*)'pb cal NRBE3_M'
2073 ENDIF
2074C-----active rigid body main nodes------
2075 nrb=0
2076 IF (nrb_mv>0) THEN
2077 DO j=1,nrbyac
2078 n=irbyac(j)
2079 k=irbyac(j+nrbykin)
2080 m =npby(1,n)
2081 IF (inloc(m)>0) THEN
2082 nsn =npby(2,n)
2083 DO i=1,nsn
2084 id = i+k
2085 ni=lpby(id)
2086 IF (inloc(ni)>0) THEN
2087 nrb=nrb+1
2088 irb_mv(1,nrb)=m
2089 irb_mv(2,nrb)=ni
2090 ENDIF
2091 ENDDO
2092 ENDIF
2093 ENDDO
2094 IF (nrb/=nrb_mv) WRITE(*,*)'pb cal NRB_M'
2095 ENDIF
2096C +++
2097 IF (nbc_mv>0) THEN
2098 nbc = 0
2099 DO n=1,numnod
2100 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
2101 IF (inloc(n)>0) THEN
2102 nbc = nbc + 1
2103 ibc_mv(1,nbc) = n
2104 ibc_mv(2,nbc) = iskew(n)
2105 ibc_mv(3,nbc) = icodt(n)
2106 ENDIF
2107 ENDIF
2108 ENDDO
2109 IF (nbc/=nbc_mv) WRITE(*,*)'pb cal NBC_M'
2110 ENDIF
2111C-
2112 IF (nspc_mv>0) THEN
2113 nspc = 0
2114 DO n=1,nspcl
2115 IF (inloc(n)>0.AND.ic_spc(n)<=3)THEN
2116 nspc = nspc + 1
2117 ispc_mv(nspc) = n
2118 ENDIF
2119 ENDDO
2120 IF (nspc/=nspc_mv) WRITE(*,*)'pb cal NSPC_M'
2121 ENDIF
2122C---
2123 IF (nfx_mv>0) THEN
2124 nfx = 0
2125 DO j=1,nfxvel
2126 IF (lj(j)>0.AND.lj(j)<=3) THEN
2127 n=iabs(ibfv(1,j))
2128 IF (inloc(n)>0) THEN
2129 nfx = nfx + 1
2130 ifx_mv(1,nfx) = j
2131 ifx_mv(2,nfx) = lj(j)
2132 ENDIF
2133 ENDIF
2134 ENDDO
2135 IF (nfx/=nfx_mv) WRITE(*,*)'pb cal NFX_M'
2136 ENDIF
2137C
2138 IF (nrw_mv>0) THEN
2139 nrw = 0
2140 DO j=1,n_rwl
2141 n=in_rwl(j)
2142 IF (inloc(n)>0) THEN
2143 nrw = nrw + 1
2144 irw_mv(nrw) = j
2145 ENDIF
2146 ENDDO
2147 IF (nrw/=nrw_mv) WRITE(*,*)'pb cal NRW_M'
2148 ENDIF
2149C-----RBE2------
2150 nr4=0
2151 IF (nrbe2_mv>0) THEN
2152 DO n=1,nrbe2
2153 k=irbe2(1,n)
2154 m =irbe2(3,n)
2155 IF (inloc(m)>0) THEN
2156 nsn =irbe2(5,n)
2157 DO i=1,nsn
2158 id = i+k
2159 ni=lrbe2(id)
2160 IF (inloc(ni)>0) THEN
2161 nr4=nr4+1
2162 irb_mv(1,nr4)=n
2163 irb_mv(2,nr4)=ni
2164 ENDIF
2165 ENDDO
2166 ENDIF
2167 ENDDO
2168 IF (nr4/=nrbe2_mv) WRITE(*,*)'pb cal NRBE2'
2169 ENDIF
2170C ---
2171C----6---------------------------------------------------------------7---------8
2172 RETURN
2173 END
2174!||====================================================================
2175!|| iddl_mint ../engine/source/implicit/imp_int_k.F
2176!||--- called by ------------------------------------------------------
2177!|| kin_knl ../engine/source/implicit/imp_int_k.F
2178!||--- uses -----------------------------------------------------
2179!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2180!||====================================================================
2181 SUBROUTINE iddl_mint(NML ,IML ,IDDL ,IKC ,NDOF ,
2182 . IDDLM ,IPARI ,INTBUF_TAB,IDDML ,NRB_FR ,
2183 . IFRSR ,IDDMR ,NI2_FR ,IFRS2 ,IDDMI2 ,
2184 . IRBE3 ,LRBE3 ,NRBE3_FR,IFRS3 ,IDDMI3 ,
2185 . M_MAX ,IRBE2 ,NRBE2_FR,IFRS4 ,IDDMI4 )
2186C-----------------------------------------------
2187C M o d u l e s
2188C-----------------------------------------------
2189 USE intbufdef_mod
2190C-----------------------------------------------
2191C I m p l i c i t T y p e s
2192C-----------------------------------------------
2193#include "implicit_f.inc"
2194C-----------------------------------------------
2195C C o m m o n B l o c k s
2196C-----------------------------------------------
2197#include "param_c.inc"
2198C-----------------------------------------------
2199C D u m m y A r g u m e n t s
2200C-----------------------------------------------
2201 INTEGER NML,IML(*),IDDL(*) ,IKC(*) ,NDOF(*) ,IDDLM(*),M_MAX
2202 INTEGER IPARI(NPARI,*),IDDML(3,*),NRB_FR ,
2203 . iddmr(6,*) ,ni2_fr ,iddmi2(6,4,*) ,ifrsr(2,*),
2204 . ifrs2(2,*),irbe3(nrbe3l,*),lrbe3(*),nrbe3_fr,ifrs3(*),
2205 . iddmi3(6,m_max,*),irbe2(nrbe2l,*),nrbe2_fr,ifrs4(*),
2206 . iddmi4(6,*)
2207
2208 TYPE(intbuf_struct_) INTBUF_TAB(*)
2209C-----------------------------------------------
2210C L o c a l V a r i a b l e s
2211C-----------------------------------------------
2212 INTEGER I,ID,N,J,NDD,I1
2213 INTEGER M,NSN,JI,K10,K11,K12,K13,K14,L,NNOD,NJ,NL,NI,IAD
2214 INTEGER IERROR1,IERROR2,IERROR3,IERROR4,IERROR5,IERROR6
2215C-----------------------------------------------
2216C S o u r c e L i n e s
2217C-----------------------------------------------
2218C
2219 IF (nml>0) THEN
2220C--------initialization for ndof=0---
2221 DO i = 1, nml
2222 n = iml(i)
2223 ndd = 0
2224 DO j = 1 , min(3,ndof(n))
2225 id = iddl(n) + j
2226 IF (ikc(id)<1) THEN
2227 ndd = ndd + 1
2228 iddml(j,i) = iddlm(n) + ndd
2229 ELSE
2230 iddml(j,i) = -ikc(id)
2231 ENDIF
2232 ENDDO
2233 ENDDO
2234 ENDIF
2235C
2236 IF (nrb_fr>0) THEN
2237 DO i = 1, nrb_fr
2238 n = ifrsr(1,i)
2239 ndd = 0
2240 DO j = 1 , ndof(n)
2241 id = iddl(n) + j
2242 IF (ikc(id)<1) THEN
2243 ndd = ndd + 1
2244 iddmr(j,i) = iddlm(n) + ndd
2245 ELSE
2246 iddmr(j,i) = -ikc(id)
2247 ENDIF
2248 ENDDO
2249 ENDDO
2250 ENDIF
2251C
2252 IF (ni2_fr>0) THEN
2253 DO i=1,ni2_fr
2254 n=ifrs2(1,i)
2255 ni=ifrs2(2,i)
2256 ji=ipari(1,n)
2257 nsn=ipari(5,n)
2258 k10=ji-1
2259 k11=k10+4*ipari(3,n)
2260C------IRECT(4,NSN)-----
2261 k12=k11+4*ipari(4,n)
2262C------NSV(NSN)--node number---
2263 k13=k12+nsn
2264C------MSR(NMN)-----
2265 k14=k13+ipari(6,n)
2266 l=intbuf_tab(n)%IRTLM(ni)
2267 nl=4*(l-1)
2268 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2269 nnod=3
2270 ELSE
2271 nnod=4
2272 ENDIF
2273C-------si noeud main est dependant aussi-----
2274 DO m=1,nnod
2275 nj=intbuf_tab(n)%IRECTM(nl+m)
2276 ndd = 0
2277 DO j = 1 , ndof(nj)
2278 id = iddl(nj) + j
2279 IF (ikc(id)<1) THEN
2280 ndd = ndd + 1
2281 iddmi2(j,m,i) = iddlm(nj) + ndd
2282 ELSE
2283 iddmi2(j,m,i) = -ikc(id)
2284 ENDIF
2285 ENDDO
2286 ENDDO
2287 ENDDO
2288 ENDIF
2289C-------RBE3-----------
2290 IF (nrbe3_fr>0) THEN
2291 DO i=1,nrbe3_fr
2292 n=ifrs3(i)
2293 ni=irbe3(3,n)
2294 nnod=irbe3(5,n)
2295 iad=irbe3(1,n)
2296C-------
2297 DO m=1,nnod
2298 nj=lrbe3(iad+m)
2299 ndd = 0
2300 DO j = 1 , ndof(nj)
2301 id = iddl(nj) + j
2302 IF (ikc(id)<1) THEN
2303 ndd = ndd + 1
2304 iddmi3(j,m,i) = iddlm(nj) + ndd
2305 ELSE
2306 iddmi3(j,m,i) = -ikc(id)
2307 ENDIF
2308 ENDDO
2309 ENDDO
2310 ENDDO
2311 ENDIF
2312C------RBE2
2313 IF (nrbe2_fr>0) THEN
2314 DO i = 1, nrbe2_fr
2315 n = ifrsr(1,i)
2316 m = irbe2(3,n)
2317 ndd = 0
2318 DO j = 1 , ndof(m)
2319 id = iddl(m) + j
2320 IF (ikc(id)<1) THEN
2321 ndd = ndd + 1
2322 iddmi4(j,i) = iddlm(m) + ndd
2323 ELSE
2324 iddmi4(j,i) = -ikc(id)
2325 ENDIF
2326 ENDDO
2327 ENDDO
2328 ENDIF
2329C
2330 RETURN
2331 END
2332!||====================================================================
2333!|| rbe3_mint ../engine/source/implicit/imp_int_k.F
2334!||--- called by ------------------------------------------------------
2335!|| kin_knl ../engine/source/implicit/imp_int_k.F
2336!||--- calls -----------------------------------------------------
2337!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
2338!||====================================================================
2339 SUBROUTINE rbe3_mint(IRBE3 ,LRBE3 ,FRBE3 ,X ,SKEW,
2340 . NRBE3_KN,IRBE3_KN ,FRCDI ,MRCDI )
2341C-----------------------------------------------
2342C I m p l i c i t T y p e s
2343C-----------------------------------------------
2344#include "implicit_f.inc"
2345C-----------------------------------------------
2346C C o m m o n B l o c k s
2347C-----------------------------------------------
2348#include "param_c.inc"
2349#include "tabsiz_c.inc"
2350C-----------------------------------------------
2351C D u m m y A r g u m e n t s
2352C-----------------------------------------------
2353 INTEGER IRBE3(NRBE3L,*),LRBE3(*) ,NRBE3_KN,IRBE3_KN(*)
2354 my_real
2355 . frbe3(*),x(*),skew(*),frcdi(*),mrcdi(*)
2356C-----------------------------------------------
2357C L o c a l V a r i a b l e s
2358C-----------------------------------------------
2359 INTEGER I,ID,N,J,NDD,I1,IAD,NMT,IROTG,IADS
2360 INTEGER M,NNOD,NJ,NL,NI
2361C-----------------------------------------------
2362C S o u r c e L i n e s
2363C-----------------------------------------------
2364 IF (nrbe3_kn>0) THEN
2365C------- init FRCDI,MRCDI
2366 nmt = slrbe3/2
2367 iads =1
2368 DO i=1,nrbe3_kn
2369 n=irbe3_kn(i)
2370 ni=irbe3(3,n)
2371 nnod=irbe3(5,n)
2372 iad=irbe3(1,n)
2373 irotg =irbe3(6,n)
2374 CALL rbe3cl(lrbe3(iad+1),lrbe3(nmt+iad+1),ni ,x ,
2375 . frbe3(iad+1),skew ,nnod ,irotg ,frcdi(iads),
2376 . mrcdi(iads) ,irbe3(2,n))
2377C-------
2378 iads = iads + nnod
2379 ENDDO
2380 ENDIF
2381C
2382 RETURN
2383 END
2384!||====================================================================
2385!|| int_matv ../engine/source/implicit/imp_int_k.F
2386!||--- called by ------------------------------------------------------
2387!|| mav_lt2 ../engine/source/implicit/produt_v.F
2388!||--- calls -----------------------------------------------------
2389!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
2390!|| imp3_u2x ../engine/source/airbag/monv_imp0.F
2391!|| int_fku3 ../engine/source/implicit/imp_int_k.F
2392!|| zeror ../engine/source/system/zero.F
2393!||--- uses -----------------------------------------------------
2394!|| imp_knon ../engine/share/modules/impbufdef_mod.F
2395!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2396!||====================================================================
2397 SUBROUTINE int_matv(IPARI ,INTBUF_TAB ,NDOF ,NUM_IMP,
2398 1 NS_IMP ,NE_IMP ,INDEX2 ,A ,AR ,
2399 2 V ,X ,MS ,X_IMP ,IBFV ,
2400 3 SKEW ,XFRAME ,U ,F ,IUPD ,
2401 4 IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
2402C-----------------------------------------------
2403C M o d u l e s
2404C-----------------------------------------------
2405 USE imp_knon
2406 USE intbufdef_mod
2407C-----------------------------------------------
2408C I m p l i c i t T y p e s
2409C-----------------------------------------------
2410#include "implicit_f.inc"
2411C-----------------------------------------------
2412C C o m m o n B l o c k s
2413C-----------------------------------------------
2414#include "com04_c.inc"
2415#include "param_c.inc"
2416C-----------------------------------------------
2417C D u m m y A r g u m e n t s
2418C-----------------------------------------------
2419 INTEGER IPARI(NPARI,*), INDEX2(*),NDOF(*)
2420 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IBFV(*),IUPD,
2421 . IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
2422 my_real
2423 . X(3,*),A(3,*),AR(3,*), F(*), U(*),
2424 . X_IMP(3,*),V(3,*),SKEW(*) ,XFRAME(*),MS(*)
2425
2426 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2427C-----------------------------------------------
2428C L o c a l V a r i a b l e s
2429C-----------------------------------------------
2430 INTEGER I, J,N,K,K1,KK1,N1,N2,N3,N4,ID,IAD,IS,NN,NTY
2431 my_real
2432 . D(3,NUMNOD)
2433C----------------actualise D,X_IMP---------------------
2434 CALL IMP3_U2X(X ,IPARI ,INTBUF_TAB ,NDOF ,
2435 . U ,D ,AR ,X_IMP ,NUMN_KN,
2436 . IN_KN ,ID_KN ,NRB_KN ,IRB_KN,ID_KNM ,
2437 . NI2_KN,II2_KN ,ID_KNM2,NFX_KN,IFX_KN ,
2438 . NBC_KN,IBC_KN ,NRW_KN,IRW_KN ,IBFV ,
2439 . SKEW ,XFRAME ,IRBE3 ,LRBE3 ,NRBE3_KN,
2440 . IRBE3_KN,ID_KNM3,RKN_MAX,FCDI_KN,MCDI_KN,
2441 . nspc_kn,ispc_kn ,irbe2 ,lrbe2 ,nrbe2_kn,
2442 . irbe2_kn,id_knm4)
2443 CALL zeror(a,numnod)
2444 IF ((nrb_kn+ni2_kn+nrbe3_kn)>0) CALL zeror(ar,numnod)
2445C----------------
2446 IF (iupd>0) THEN
2447 CALL int_fku3(a ,v ,ms ,d ,
2448 1 ipari ,intbuf_tab ,x_imp,num_imp,
2449 2 ns_imp ,ne_imp ,index2,iupd )
2450 CALL imp3_a2b(ipari ,intbuf_tab ,ndof ,x_imp ,
2451 1 a ,ar ,numn_kn,in_kn,id_kn ,
2452 2 nrb_kn ,irb_kn ,id_knm ,ni2_kn,ii2_kn,
2453 3 id_knm2,nfx_kn ,ifx_kn ,nbc_kn,ibc_kn,
2454 4 nrw_kn ,irw_kn ,ibfv ,skew ,xframe,
2455 5 f ,irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,
2456 6 id_knm3,rkn_max,fcdi_kn,mcdi_kn,nspc_kn,
2457 7 ispc_kn,irbe2 ,lrbe2 ,nrbe2_kn,irbe2_kn,
2458 . id_knm4)
2459 ELSE
2460 CALL int_fku3(a ,v ,ms ,d ,
2461 1 ipari ,intbuf_tab ,x ,num_imp,
2462 2 ns_imp ,ne_imp ,index2 ,iupd )
2463 CALL imp3_a2b(ipari ,intbuf_tab ,ndof ,x ,
2464 1 a ,ar ,numn_kn,in_kn,id_kn ,
2465 2 nrb_kn ,irb_kn ,id_knm ,ni2_kn,ii2_kn,
2466 3 id_knm2,nfx_kn ,ifx_kn ,nbc_kn,ibc_kn,
2467 4 nrw_kn ,irw_kn ,ibfv ,skew ,xframe,
2468 5 f ,irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,
2469 6 id_knm3,rkn_max,fcdi_kn,mcdi_kn,nspc_kn,
2470 7 ispc_kn,irbe2 ,lrbe2 ,nrbe2_kn,irbe2_kn,
2471 . id_knm4)
2472 ENDIF
2473 RETURN
2474 END
2475!||====================================================================
2476!|| int_matvp ../engine/source/implicit/imp_int_k.F
2477!||--- called by ------------------------------------------------------
2478!|| mav_lth ../engine/source/implicit/produt_v.F
2479!|| mav_lth0 ../engine/source/implicit/produt_v.F
2480!|| mav_ltp ../engine/source/implicit/produt_v.F
2481!||--- calls -----------------------------------------------------
2482!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
2483!|| imp3_u2x ../engine/source/airbag/monv_imp0.F
2484!|| int_fku3 ../engine/source/implicit/imp_int_k.F
2485!|| spmd_ifcd ../engine/source/mpi/implicit/imp_spmd.F
2486!|| spmd_ifcf ../engine/source/mpi/implicit/imp_spmd.F
2487!|| zeror ../engine/source/system/zero.F
2488!||--- uses -----------------------------------------------------
2489!|| imp_intm ../engine/share/modules/imp_intm.F
2490!|| imp_knon ../engine/share/modules/impbufdef_mod.F
2491!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2492!||====================================================================
2493 SUBROUTINE int_matvp(IPARI ,INTBUF_TAB ,NDOF ,NUM_IMP,
2494 1 NS_IMP ,NE_IMP ,INDEX2 ,A ,AR ,
2495 2 V ,X ,MS ,X_IMP ,IBFV ,
2496 3 SKEW ,XFRAME ,U ,F ,DR ,
2497 4 NSREM ,NSL ,IUPD ,IRBE3 ,LRBE3 ,
2498 5 IRBE2 ,LRBE2 )
2499C-----------------------------------------------
2500C M o d u l e s
2501C-----------------------------------------------
2502 USE imp_knon
2503 USE imp_intm
2504 USE intbufdef_mod
2505C-----------------------------------------------
2506C I m p l i c i t T y p e s
2507C-----------------------------------------------
2508#include "implicit_f.inc"
2509C-----------------------------------------------
2510C C o m m o n B l o c k s
2511C-----------------------------------------------
2512#include "com04_c.inc"
2513#include "param_c.inc"
2514C-----------------------------------------------
2515C D u m m y A r g u m e n t s
2516C-----------------------------------------------
2517 INTEGER IPARI(NPARI,*), INDEX2(*),NSREM ,NSL
2518 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IBFV(*),IUPD,NDOF(*),
2519 . irbe3(*) ,lrbe3(*),irbe2(*) ,lrbe2(*)
2520 my_real
2521 . x(3,*),a(3,*),ar(3,*), f(*), u(*),
2522 . x_imp(3,*),skew(*) ,xframe(*),dr(3,*),v(3,*),ms(*)
2523
2524 TYPE(intbuf_struct_) INTBUF_TAB(*)
2525C-----------------------------------------------
2526C L o c a l V a r i a b l e s
2527C-----------------------------------------------
2528 INTEGER I, J,N,K,K1,KK1,N1,N2,N3,N4,ID,IAD,IS,NN,NTY
2529 my_real
2530 . D(3,NUMNOD)
2531C----------------actualise D,X_IMP---------------------
2532 CALL IMP3_U2X(X ,IPARI ,INTBUF_TAB ,NDOF ,
2533 . U ,D ,AR ,X_IMP ,NUMN_KN,
2534 . IN_KN ,ID_KN ,NRB_KN ,IRB_KN,ID_KNM ,
2535 . NI2_KN,II2_KN ,ID_KNM2,NFX_KN,IFX_KN ,
2536 . nbc_kn,ibc_kn ,nrw_kn,irw_kn ,ibfv ,
2537 . skew ,xframe ,irbe3 ,lrbe3 ,nrbe3_kn,
2538 . irbe3_kn,id_knm3,rkn_max,fcdi_kn,mcdi_kn,
2539 . nspc_kn,ispc_kn ,irbe2 ,lrbe2 ,nrbe2_kn,
2540 . irbe2_kn,id_knm4)
2541 CALL zeror(a,numnod)
2542 IF ((nrb_kn+ni2_kn+nrbe3_kn)>0) CALL zeror(ar,numnod)
2543C-----renvoie D (NSL) et receive DFI (NSREM)-----
2544 IF ((nsrem+nsl)>0) THEN
2545 CALL spmd_ifcd(d ,nsl, nsrem)
2546 IF (nsrem>0) CALL zeror(ffi,nsrem)
2547 ENDIF
2548C----------------
2549 IF (iupd>0) THEN
2550 CALL int_fku3(a ,v ,ms ,d ,
2551 1 ipari ,intbuf_tab,x_imp,num_imp,
2552 2 ns_imp ,ne_imp ,index2,iupd )
2553 IF ((nsrem+nsl)>0) CALL spmd_ifcf(a, nsrem ,nsl)
2554 CALL imp3_a2b(ipari ,intbuf_tab ,ndof ,x_imp ,
2555 1 a ,ar ,numn_kn,in_kn,id_kn ,
2556 2 nrb_kn ,irb_kn ,id_knm ,ni2_kn,ii2_kn,
2557 3 id_knm2,nfx_kn ,ifx_kn ,nbc_kn,ibc_kn,
2558 4 nrw_kn ,irw_kn ,ibfv ,skew ,xframe,
2559 5 f ,irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,
2560 6 id_knm3,rkn_max,fcdi_kn,mcdi_kn,nspc_kn,
2561 7 ispc_kn,irbe2 ,lrbe2 ,nrbe2_kn,irbe2_kn,
2562 . id_knm4)
2563 ELSE
2564 CALL int_fku3(a ,v ,ms ,d ,
2565 1 ipari ,intbuf_tab ,x ,num_imp,
2566 2 ns_imp ,ne_imp ,index2 ,iupd )
2567 IF ((nsrem+nsl)>0) CALL spmd_ifcf(a, nsrem ,nsl)
2568 CALL imp3_a2b(ipari ,intbuf_tab ,ndof ,x ,
2569 1 a ,ar ,numn_kn,in_kn,id_kn ,
2570 2 nrb_kn ,irb_kn ,id_knm ,ni2_kn,ii2_kn,
2571 3 id_knm2,nfx_kn ,ifx_kn ,nbc_kn,ibc_kn,
2572 4 nrw_kn ,irw_kn ,ibfv ,skew ,xframe,
2573 5 f ,irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,
2574 6 id_knm3,rkn_max,fcdi_kn,mcdi_kn,nspc_kn,
2575 7 ispc_kn,irbe2 ,lrbe2 ,nrbe2_kn,irbe2_kn,
2576 . id_knm4)
2577 ENDIF
2578 RETURN
2579 END
2580!||====================================================================
2581!|| int_fku3 ../engine/source/implicit/imp_int_k.F
2582!||--- called by ------------------------------------------------------
2583!|| int_matv ../engine/source/implicit/imp_int_k.F
2584!|| int_matvp ../engine/source/implicit/imp_int_k.F
2585!||--- calls -----------------------------------------------------
2586!|| i10fku3 ../engine/source/interfaces/int10/i10ke3.F
2587!|| i11fku3 ../engine/source/interfaces/int11/i11ke3.F
2588!|| i7fku3 ../engine/source/interfaces/int07/i7ke3.F
2589!||--- uses -----------------------------------------------------
2590!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2591!||====================================================================
2592 SUBROUTINE int_fku3(A ,V ,MS ,D ,IPARI ,
2593 1 INTBUF_TAB ,X ,NUM_IMP,NS_IMP ,
2594 1 NE_IMP ,INDEX2 ,IUPD )
2595C-----------------------------------------------
2596C M o d u l e s
2597C-----------------------------------------------
2598 USE intbufdef_mod
2599C-----------------------------------------------
2600C I m p l i c i t T y p e s
2601C-----------------------------------------------
2602#include "implicit_f.inc"
2603C-----------------------------------------------
2604C C o m m o n B l o c k s
2605C-----------------------------------------------
2606#include "com04_c.inc"
2607#include "param_c.inc"
2608C-----------------------------------------------
2609C D u m m y A r g u m e n t s
2610C-----------------------------------------------
2611 INTEGER IPARI(NPARI,*), INDEX2(*)
2612 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IUPD
2613 my_real
2614 . x(3,*),a(3,*),d(3,*), ms(*),v(3,*)
2615
2616 TYPE(intbuf_struct_) INTBUF_TAB(*)
2617C-----------------------------------------------
2618C L o c a l V a r i a b l e s
2619C-----------------------------------------------
2620 INTEGER I, J,N,K,K1,ID,IAD,IS,NN,NTY,I_INT7
2621C
2622 IAD = 1
2623C-----------int5 first-------------
2624 DO n=1,ninter
2625 nty =ipari(7,n)
2626 IF(nty==7) THEN
2627 CALL i7fku3( a ,v ,ms ,d ,
2628 1 ipari ,intbuf_tab(n),x ,n ,
2629 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,index2(iad),iupd )
2630 iad=iad+num_imp(n)
2631 ELSEIF(nty==10)THEN
2632 CALL i10fku3( a ,v ,ms ,d ,
2633 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
2634 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,index2(iad),iupd )
2635 iad=iad+num_imp(n)
2636 ELSEIF(nty==11)THEN
2637 CALL i11fku3( a ,v ,ms ,d ,
2638 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
2639 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,iupd )
2640 iad=iad+num_imp(n)
2641 ENDIF
2642 ENDDO
2643c IMP_INT7 = I_INT7
2644C
2645 RETURN
2646 END
2647!||====================================================================
2648!|| pr_kint ../engine/source/implicit/imp_int_k.F
2649!||====================================================================
2650 SUBROUTINE pr_kint(NDDLI ,IMCONV,
2651 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I )
2652C-----------------------------------------------
2653C I m p l i c i t T y p e s
2654C-----------------------------------------------
2655#include "implicit_f.inc"
2656C-----------------------------------------------
2657C C o m m o n B l o c k s
2658C-----------------------------------------------
2659#include "task_c.inc"
2660C-----------------------------------------------
2661C D u m m y A r g u m e n t s
2662C-----------------------------------------------
2663C REAL
2664 INTEGER
2665 . NDDLI,IADI(*),JDII(*),ITOK(*),IMCONV
2666 my_real
2667 . DIAG_I(*),LT_I(*)
2668C-----------------------------------------------
2669C L o c a l V a r i a b l e s
2670C-----------------------------------------------
2671Ctmp +3
2672 INTEGER i,j,N,ID,ND,NKC,IDF,nnod,nk,iad,iad2,id2
2673 CHARACTER CHIF
2674 CHARACTER*10 FILNAME
2675C------
2676 idf = ispmd+13
2677 WRITE(chif,'(I1)')ispmd
2678 filname='KINT'//chif//'.TMP'
2679 OPEN(unit=idf,file=filname,status='UNKNOWN',form='FORMATTED')
2680 write(idf,*)'NDDLI,=', nddli
2681 if (imconv<0) return
2682 write(idf,*)'[Ki]=',nddli
2683 DO i =1,nddli
2684 write(idf,*)'DIAG_I,itok=',diag_i(i),itok(i)
2685 ENDDO
2686 DO i =1,nddli
2687 write(idf,*)'NR,I=',iadi(i+1)-iadi(i),i
2688 DO j=iadi(i),iadi(i+1)-1
2689 write(idf,*)'LT_I,NJ,J=',lt_i(j),itok(jdii(j)),j
2690 ENDDO
2691 ENDDO
2692C------------------------------------------
2693 RETURN
2694 END
subroutine imp_i10mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, ind_imp)
Definition i10ke3.F:435
subroutine i10fku3(a, v, ms, d, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iupd)
Definition i10ke3.F:293
subroutine i10ke3(a, v, ms, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem)
Definition i10ke3.F:41
subroutine i10main_tri(timers, npari, ipari, x, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, itab, intbuf_tab, h3d_data, glob_therm)
Definition i10main_tri.F:59
subroutine i10main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
subroutine imp_i11mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, itab)
Definition i11ke3.F:309
subroutine i11ke3(a, v, ms, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem, itab)
Definition i11ke3.F:41
subroutine i11fku3(a, v, ms, d, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, iupd)
Definition i11ke3.F:468
subroutine i11main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
subroutine i11main_opt_tri(ipari, intbuf_tab, x, v, nin, itask, count_remslv, lskyi_sms_new)
subroutine i11main_tri(timers, ipari, x, v, ms, nin, itask, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, nrtm_t, eshift, nodnx_sms, renum, nsnfiold, intbuf_tab, temp, nodadt_therm)
Definition i11main_tri.F:57
subroutine i20main_opt_tri(ipari, x, v, nin, itask, count_remslv, count_remslve, intbuf_tab)
subroutine i20main_tri(timers, ipari, x, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, temp, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, diag_sms, nodnx_sms, intbuf_tab, h3d_data, glob_therm)
Definition i20main_tri.F:62
subroutine i23main_tri(timers, ipari, x, intbuf_tab, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, h3d_data, multi_fvm, intheat, idt_therm, nodadt_therm)
Definition i23main_tri.F:59
subroutine i24ke3(a, v, ms, ipari, intbuf_tab, x, nin, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem, intbuf_tab_imp)
Definition i24ke3.F:42
subroutine i5ke3(a, v, ms, ipari, intbuf_tab, x, num_imp, cand_n, cand_e, iddl, k_diag, k_lt, iadk, jdik)
Definition i5ke3.F:42
subroutine i7ke3(a, v, ms, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem)
Definition i7ke3.F:42
subroutine i7fku3(a, v, ms, d, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iupd)
Definition i7ke3.F:602
subroutine imp_i7mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, ind_imp)
Definition i7ke3.F:403
subroutine i7main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
subroutine i7main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
subroutine i7main_tri(timers, ipari, x, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, temp, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, intbuf_tab, h3d_data, ixs, multi_fvm, glob_therm)
Definition i7main_tri.F:66
subroutine iddl_mint(nml, iml, iddl, ikc, ndof, iddlm, ipari, intbuf_tab, iddml, nrb_fr, ifrsr, iddmr, ni2_fr, ifrs2, iddmi2, irbe3, lrbe3, nrbe3_fr, ifrs3, iddmi3, m_max, irbe2, nrbe2_fr, ifrs4, iddmi4)
Definition imp_int_k.F:2186
subroutine imp_rnumcd(cand_n, nin, nsn, num_imp, index)
Definition imp_int_k.F:1542
subroutine cp_inttd(nt_imp1, numimp, ns_imp, ne_imp, ind_imp, numimp1)
Definition imp_int_k.F:1379
subroutine int_matvp(ipari, intbuf_tab, ndof, num_imp, ns_imp, ne_imp, index2, a, ar, v, x, ms, x_imp, ibfv, skew, xframe, u, f, dr, nsrem, nsl, iupd, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_int_k.F:2499
subroutine int_fku3(a, v, ms, d, ipari, intbuf_tab, x, num_imp, ns_imp, ne_imp, index2, iupd)
Definition imp_int_k.F:2595
subroutine imp_icomcrit(intbuf_tab, ipari, newfront, isendto, ircvfrom, dt2t, itab, xslv_l, xmsr_l, vslv_l, vmsr_l, size_t, n, sensor_tab, intlist, nbintc, maxdgap, nsensor)
Definition imp_int_k.F:560
subroutine imp_intdt(ipari, intbuf_tab, x, v, vr, isendto, irecvfrom, newfront, itask, dtk, itab, intlist, nbintc, dt_min, ms, nsensor, sensor_tab, maxdgap)
Definition imp_int_k.F:391
subroutine imp_i7xv(x, nsv, msr, nsn, nmn, stfn, x_tmp, d, dr, v, vr, facd, facv)
Definition imp_int_k.F:993
subroutine pr_kint(nddli, imconv, iadi, jdii, itok, diag_i, lt_i)
Definition imp_int_k.F:2652
subroutine rbe3_mint(irbe3, lrbe3, frbe3, x, skew, nrbe3_kn, irbe3_kn, frcdi, mrcdi)
Definition imp_int_k.F:2341
subroutine sav_inttd(nt_imp, numimp, ns_imp, ne_imp, ind_imp, numimp1)
Definition imp_int_k.F:1435
subroutine kin_knl(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ibfv, lj, iskew, icodt, ndofi, iddl, ikc, ndof, inloc, irbe3, lrbe3, frbe3, x, skew, irbe2, lrbe2)
Definition imp_int_k.F:1695
subroutine imp_tripi(timers, ipari, intbuf_tab, x, d, v, ms, itab, vr, in, imsch, i2msch, isizxv, ilenxv, igrbric, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, iad_elem, fr_elem, nbintc, intlist, itask, kinet, newfront, num_imp, ns_imp, ne_imp, ind_imp, iad, isendto, irecvfrom, retri, weight, ixs, temp, dt2prev, wag, n, nty, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, count_remslv, count_remslve, sensor_tab, xdp, h3d_data, multi_fvm, forneqs, interfaces, nsensor, glob_therm)
Definition imp_int_k.F:1109
subroutine dim_kinkn(npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ibfv, lj, iskew, icodt, lns, lns2, lbcl, lfxl, lrw, irbe3, lns3, lspcl, irbe2, lrbe2, lns4)
Definition imp_int_k.F:1858
subroutine int_matv(ipari, intbuf_tab, ndof, num_imp, ns_imp, ne_imp, index2, a, ar, v, x, ms, x_imp, ibfv, skew, xframe, u, f, iupd, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_int_k.F:2402
subroutine imp_inttd0(timers, ipari, intbuf_tab, x, d, ms, itab, in, d_imp, dr_imp, imsch, i2msch, isizxv, ilenxv, igrbric, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, iad_elem, fr_elem, nbintc, intlist, itask, kinet, newfront, num_imp, ns_imp, ne_imp, ind_imp, isendto, irecvfrom, weight, ixs, temp, dt2prev, wa, num_imp1, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, count_remslv, count_remslve, nsensor, sensor_tab, xdp, h3d_data, multi_fvm, forneqs, maxdgap, interfaces, glob_therm)
Definition imp_int_k.F:731
subroutine imp_dtkin(ipari, intbuf_tab, x, v, vr, itab, d_imp, dr_imp, nbintc, intlist, itask, newfront, isendto, irecvfrom, iddl, ndof, ikc, scal, ms, nsensor, sensor_tab, maxdgap)
Definition imp_int_k.F:1588
subroutine ini_kinkn(npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ibfv, lj, iskew, icodt, nrb_mv, irb_mv, ni2_mv, ii2_mv, nbc_mv, ibc_mv, nfx_mv, ifx_mv, nrw_mv, irw_mv, irbe3, nrbe3_mv, irbe3_mv, nspc_mv, ispc_mv, irbe2, lrbe2, nrbe2_mv, irbe2_mv)
Definition imp_int_k.F:1998
subroutine imp_i11xv(x, nsv, msr, nsn, nmn, x_tmp, d, dr, v, vr, facd, facv)
Definition imp_int_k.F:911
subroutine imp_int_k(a, v, icodt, icodr, iskew, ibfv, npc, tf, vel, nsensor, sensor_tab, xframe, rby, x, skew, lpby, npby, itab, weight, ms, in, nrbyac, irbyac, nss, iss, ipari, intbuf_tab, nint2, iint2, iaint2, nss2, iss2, nddli, nnzi, iadi, jdii, diag_i, lt_i, iddli, nddl, iadk, jdik, ikc, diag_k, lt_k, iddl, num_imp, ns_imp, ne_imp, index2, ndofi, itok, ud, lb, gapmin, dirul, nt_rw, num_imp1, irbe3, lrbe3, frbe3, nss3, iss3, irbe2, lrbe2, nsb2, isb2)
Definition imp_int_k.F:56
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
subroutine spmd_min_s(s)
Definition imp_spmd.F:1273
subroutine spmd_ifcd(d_imp, ssize, rsize)
Definition imp_spmd.F:2326
subroutine spmd_ifcf(f_imp, ssize, rsize)
Definition imp_spmd.F:2450
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
Definition kinchk.F:1586
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
subroutine imp3_a2b(ipari, intbuf_tab, ndof, x_imp, a, ar, numn, inl, iddl, nrb, irb, iddlm, ni2, ii2, iddlm2, nfx, ifx, nbc, ibc, nrw, irw, ibfv, skew, xframe, lb, irbe3, lrbe3, nr3, ir3, iddlm3, r3_max, fcdi, mcdi, nspc, ispc, irbe2, lrbe2, nr2, ir2, iddlm4)
Definition monv_imp0.F:2331
initmumps id
integer, dimension(:), allocatable ic_spc
integer nspcl
integer nbc_kn
integer rkn_max
integer numn_kn
integer nrbe3_kn
integer, dimension(:,:), allocatable id_knm4
integer, dimension(:,:), allocatable irb_kn
integer, dimension(:,:,:), allocatable id_knm2
integer, dimension(:), allocatable ispc_kn
integer, dimension(:), allocatable irw_kn
integer, dimension(:,:), allocatable id_kn
integer, dimension(:), allocatable in_kn
integer, dimension(:,:), allocatable ibc_kn
integer, dimension(:,:), allocatable irbe2_kn
integer, dimension(:,:), allocatable ii2_kn
integer, dimension(:,:), allocatable id_knm
integer nspc_kn
integer ni2_kn
integer nrw_kn
integer, dimension(:,:,:), allocatable id_knm3
integer nfx_kn
integer nrbe2_kn
integer, dimension(:,:), allocatable ifx_kn
integer, dimension(:), allocatable irbe3_kn
integer nrb_kn
integer, dimension(:), allocatable in_rwl
integer n_rwl
subroutine cp_int(n, x, xc)
Definition produt_v.F:916
subroutine spmd_get_stif11(newfront, i_stok, cand_s, stfs, nrts, nin, isendto, ircvfrom, irects, itab)
Definition send_cand.F:566
subroutine spmd_get_stif(newfront, i_stok, cand_n, stfn, nsn, nin, isendto, ircvfrom, nsv, itab)
Definition send_cand.F:156
subroutine spmd_i7xvcom2(ipari, x, v, ms, imsch, i2msch, dt2prev, intlist, nbintc, islen7, irlen7, islen11, irlen11, islen17, irlen17, ixs, ixs16, nsensor, igrbric, temp, iflag, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, sensor_tab, intbuf_tab, int24e2euse, forneqs, multi_fvm, interfaces)
subroutine spmd_ifront(ipari, newfront, isendto, ircvfrom, nsensor, nbintc, intlist, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, sensor_tab, intbuf_tab, mode)
Definition spmd_ifront.F:46
subroutine spmd_sd_xv(x, d, v, vr, ms, in, iad_elem, fr_elem, weight, imsch, w, isizxv, ilenxv, xdp)
Definition spmd_sd_xv.F:42
subroutine spmd_sync_mmx(isendto, ircvfrom, newfront, xslv_l, xmsr_l, vslv_l, vmsr_l, intlist, nintc, tzinf, size_t, ipari, delta_pmax_gap, maxdgap)
character *2 function nl()
Definition message.F:2354
subroutine upd_int_k(icodt, icodr, iskew, ibfv, npc, tf, vel, xframe, rby, x, skew, lpby, npby, itab, weight, ms, in, nrbyac, irbyac, nss, iss, ipari, intbuf_tab, nint2, iint2, iaint2, nss2, iss2, nddli, nnzi, iadi, jdii, diag_i, lt_i, iddli, nddl, iadk, jdik, ikc, diag_k, lt_k, iddl, ndofi, itok, ud, lb, luj, nt_rw, irbe3, lrbe3, frbe3, nss3, iss3, irbe2, lrbe2, nsb2, isb2)
Definition upd_glob_k.F:465
subroutine zeror(a, n)
Definition zero.F:39