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 kin by 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 Pre-calculation of useful interfaces
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 ***: Only to be coherent with SMP
667 intbuf_tab(i)%VARIABLES(5) = intbuf_tab(i)%VARIABLES(8)-
668 - intbuf_tab(i)%VARIABLES(2)
669C calculation of the sorting criterion 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 Vmax treatment
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-------assumed s is still far from 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!|| output_mod ../common_source/modules/output/output_mod.F90
715!|| sensor_mod ../common_source/modules/sensor_mod.F90
716!|| timer_mod ../engine/source/system/timer_mod.F90
717!||====================================================================
718 SUBROUTINE imp_inttd0(output, TIMERS,
719 1 IPARI ,INTBUF_TAB ,X ,D ,
720 2 MS ,ITAB ,IN ,D_IMP ,DR_IMP ,
721 3 IMSCH ,I2MSCH ,ISIZXV,ILENXV ,IGRBRIC ,
722 4 ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17 ,
723 5 IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM,FR_ELEM ,
724 6 NBINTC,INTLIST,ITASK ,KINET ,NEWFRONT,
725 7 NUM_IMP,NS_IMP,NE_IMP,IND_IMP ,ISENDTO ,
726 8 IRECVFROM,WEIGHT ,IXS ,TEMP ,
727 9 DT2PREV,WA,NUM_IMP1,IRLEN20,ISLEN20,
728 A IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E,
729 B IKINE,DIAG_SMS,COUNT_REMSLV,COUNT_REMSLVE,
730 C NSENSOR,SENSOR_TAB,XDP,H3D_DATA,MULTI_FVM,FORNEQS,
731 D MAXDGAP,INTERFACES,GLOB_THERM)
732C-----------------------------------------------
733C M o d u l e s
734C-----------------------------------------------
735 use output_mod
736 USE timer_mod
737 USE intbufdef_mod
738 USE h3d_mod
739 USE multi_fvm_mod
740 USE groupdef_mod
741 USE sensor_mod
742 USE interfaces_mod
743 use glob_therm_mod
744C-----------------------------------------------
745C I m p l i c i t T y p e s
746C-----------------------------------------------
747#include "implicit_f.inc"
748C-----------------------------------------------
749C C o m m o n B l o c k s
750C-----------------------------------------------
751#include "com01_c.inc"
752#include "com04_c.inc"
753#include "com08_c.inc"
754#include "param_c.inc"
755#include "task_c.inc"
756#include "impl1_c.inc"
757C-----------------------------------------------
758C D u m m y A r g u m e n t s
759C-----------------------------------------------
760 type(output_) :: output
761 TYPE(TIMER_) :: TIMERS
762 INTEGER ,INTENT(IN) :: NSENSOR
763 INTEGER IPARI(NPARI,*), ITAB(*),
764 . NEWFRONT(*),NBINTC,INTLIST(*),
765 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
766 . ITASK,IMSCH ,I2MSCH ,ISIZXV,ILENXV,IRLEN20,ISLEN20,
767 . IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E
768 INTEGER ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
769 . IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM(*),FR_ELEM(*) ,
770 . WEIGHT(*),IXS(*) ,NUM_IMP1(*),
771 . num_imp(*),ns_imp(*),ne_imp(*),ind_imp(*),
772 . kinet(*),ikine(*),count_remslv(*),
773 . count_remslve(*)
774
775 DOUBLE PRECISION XDP(3,*)
776
777 my_real
778 . x(3,*), d(3,*),ms(*),wa(*),
779 . dt2prev, temp(*),d_imp(3,*),dr_imp(3,*),in(*),diag_sms(*),
780 . forneqs(3,*),maxdgap(ninter)
781
782 TYPE(intbuf_struct_) INTBUF_TAB(*)
783 TYPE(H3D_DATABASE) :: H3D_DATA
784 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
785!
786 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
787 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
788 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
789 type (glob_therm_) , INTENT(IN) :: GLOB_THERM
790C-----------------------------------------------
791C L o c a l V a r i a b l e s
792C-----------------------------------------------
793 INTEGER N, KK,LL, RETRI, NBLIST, IFQ,
794 . INACTI, NSNROLD, IAD17, IGN, IGE, NME, NMES,
795 . NB ,ILIST(1) ,I,NTY,KD(50), KFI,IAD,NSN,NMN,
796 . jfi,jd(50),idns,idnm,idstif,nthr_cp,isens ,
797 . interact
798C REAL
799 my_real
800 . dtk(ninter),v(3,numnod),vr(3,numnod),
801 . x_tmp(3,numnod),dti,fac,fac1,dt_min,dx,dy,dz,
802 . startt,stopt, ts
803C-------------before inttri------
804 nt_imp1 = 0
805 DO n = 1,ninter
806 num_imp1(n)=0
807 ENDDO
808C----deactivate this function.
809 IF (ittoff>0) RETURN
810 nthr_cp = nthread
811 IF (nthread>1) nthread = 1
812 dti = one/dt2
813 DO i=1,numnod
814 v(1,i)=d_imp(1,i)*dti
815 v(2,i)=d_imp(2,i)*dti
816 v(3,i)=d_imp(3,i)*dti
817 ENDDO
818 IF (iroddl/=0) THEN
819 DO i=1,numnod
820 vr(1,i)=dr_imp(1,i)*dti
821 vr(2,i)=dr_imp(2,i)*dti
822 vr(3,i)=dr_imp(3,i)*dti
823 ENDDO
824 ENDIF
825 CALL imp_intdt(
826 1 ipari ,intbuf_tab ,x ,
827 2 v ,vr ,isendto ,irecvfrom,
828 4 newfront ,itask ,dtk ,itab ,
829 5 intlist ,nbintc ,dt_min ,ms ,
830 6 nsensor ,sensor_tab,maxdgap)
831 IF (dt_min >= dt2) GOTO 1000
832 DO n = 1,ninter
833 num_imp(n) = 0
834 END DO
835C-------------in inttri------
836c NI18 = 0
837c LI18 = 1
838c IAD17 = 1
839C
840 iad=1
841 nb = 1
842C
843C DO KK=1,NBINTC
844C N = INTLIST(KK)
845 DO n=1,ninter
846 nty = ipari(7,n)
847 IF (nty/=7.AND.nty/=10.AND.nty/=11) GOTO 999
848 IF (dtk(n)>=dt2) GOTO 999
849 nsn =ipari(5,n)
850 nmn =ipari(6,n)
851C
852 interact = 0
853 isens = 0
854 IF(nty == 7.OR.nty == 11) isens = ipari(64,n)
855 IF(isens/=0) THEN !CMAAAAA
856 ts = sensor_tab(isens)%TSTART
857 IF (tt>=ts) interact = 1
858 ELSE
859 startt = intbuf_tab(n)%VARIABLES(3)
860 stopt = intbuf_tab(n)%VARIABLES(11)
861 IF (startt<=tt.AND.tt<=stopt) interact = 1
862 ENDIF
863 IF(interact/=0) GOTO 999
864C
865 retri = 0
866 ilist(1) = n
867 fac = dtk(n)/dt2
868 fac1 = dti*fac
869 IF(nty==11)THEN
870 CALL imp_i11xv(
871 1 x ,intbuf_tab(n)%NSV,intbuf_tab(n)%MSR,nsn ,nmn ,
872 2 x_tmp ,d_imp ,dr_imp ,v ,vr ,
873 3 fac ,fac1 )
874 ELSE
875 CALL imp_i7xv(
876 1 x ,intbuf_tab(n)%NSV ,intbuf_tab(n)%MSR,nsn ,nmn ,
877 2 intbuf_tab(n)%STFNS,x_tmp ,d_imp ,dr_imp ,v ,
878 3 vr ,fac ,fac1 )
879 ENDIF
880 CALL imp_tripi(output, timers,
881 1 ipari ,intbuf_tab,x_tmp ,d ,
882 2 v ,ms ,itab ,vr ,in ,
883 3 imsch ,i2msch ,isizxv,ilenxv ,igrbric ,
884 4 islen7,irlen7 ,islen11,irlen11,islen17,
885 5 irlen17,irlen7t,islen7t,iad_elem,fr_elem ,
886 6 nb ,ilist ,itask ,kinet,newfront,
887 7 num_imp,ns_imp,ne_imp,ind_imp,iad ,
888 8 isendto ,irecvfrom ,retri,weight,
889 9 ixs ,temp ,dt2prev,wa ,n ,nty,
890 a irlen20,islen20,irlen20t,islen20t,irlen20e,
891 b islen20e,ikine,diag_sms,count_remslv,count_remslve,
892 c sensor_tab,xdp ,h3d_data, multi_fvm ,forneqs,
893 d interfaces,nsensor,glob_therm)
894 999 CONTINUE
895 ENDDO
896C
897 nt_imp1=iad-1
898C---------necessary for spmd-----
899 CALL cp_inttd(nt_imp1,num_imp ,ns_imp,ne_imp,ind_imp,num_imp1)
900 1000 CONTINUE
901 IF (nthr_cp>1) nthread = nthr_cp
902C
903 RETURN
904 END
905!||====================================================================
906!|| imp_i11xv ../engine/source/implicit/imp_int_k.F
907!||--- called by ------------------------------------------------------
908!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
909!||====================================================================
910 SUBROUTINE imp_i11xv(
911 1 X ,NSV ,MSR ,NSN ,NMN ,
912 1 X_TMP ,D ,DR ,V ,VR ,
913 3 FACD ,FACV )
914C-----------------------------------------------
915C I m p l i c i t T y p e s
916C-----------------------------------------------
917#include "implicit_f.inc"
918C-----------------------------------------------
919C C o m m o n B l o c k s
920C-----------------------------------------------
921#include "com01_c.inc"
922C-----------------------------------------------
923C D u m m y A r g u m e n t s
924C-----------------------------------------------
925 INTEGER NSN,NMN,NSV(*),MSR(*)
926 my_real
927 . X(3,*),V(3,*),VR(3,*),D(3,*),DR(3,*),
928 . X_TMP(3,*),FACD,FACV
929C-----------------------------------------------
930C L o c a l V a r i a b l e s
931C-----------------------------------------------
932 INTEGER I,J
933C REAL
934 my_real
935 . dx,dy,dz
936C------------------------------------
937 DO j=1,nsn
938 i=nsv(j)
939 IF (i>0) THEN
940 dx = d(1,i)*facd
941 dy = d(2,i)*facd
942 dz = d(3,i)*facd
943 x_tmp(1,i)=x(1,i) + dx
944 x_tmp(2,i)=x(2,i) + dy
945 x_tmp(3,i)=x(3,i) + dz
946 v(1,i)=d(1,i)*facv
947 v(2,i)=d(2,i)*facv
948 v(3,i)=d(3,i)*facv
949 END IF
950 END DO
951 DO j=1,nmn
952 i=msr(j)
953 IF (i>0) THEN
954 dx = d(1,i)*facd
955 dy = d(2,i)*facd
956 dz = d(3,i)*facd
957 x_tmp(1,i)=x(1,i) + dx
958 x_tmp(2,i)=x(2,i) + dy
959 x_tmp(3,i)=x(3,i) + dz
960 v(1,i)=d(1,i)*facv
961 v(2,i)=d(2,i)*facv
962 v(3,i)=d(3,i)*facv
963 END IF
964 END DO
965C
966 IF (iroddl/=0) THEN
967 DO j=1,nsn
968 i=nsv(j)
969 IF (i>0) THEN
970 vr(1,i)=dr(1,i)*facv
971 vr(2,i)=dr(2,i)*facv
972 vr(3,i)=dr(3,i)*facv
973 END IF
974 END DO
975 DO j=1,nmn
976 i=msr(j)
977 IF (i>0) THEN
978 vr(1,i)=dr(1,i)*facv
979 vr(2,i)=dr(2,i)*facv
980 vr(3,i)=dr(3,i)*facv
981 END IF
982 END DO
983 END IF
984C
985 RETURN
986 END
987!||====================================================================
988!|| imp_i7xv ../engine/source/implicit/imp_int_k.F
989!||--- called by ------------------------------------------------------
990!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
991!||====================================================================
992 SUBROUTINE imp_i7xv(
993 1 X ,NSV ,MSR ,NSN ,NMN ,
994 1 STFN ,X_TMP ,D ,DR ,V ,
995 3 VR ,FACD ,FACV )
996C-----------------------------------------------
997C I m p l i c i t T y p e s
998C-----------------------------------------------
999#include "implicit_f.inc"
1000C-----------------------------------------------
1001C C o m m o n B l o c k s
1002C-----------------------------------------------
1003#include "com01_c.inc"
1004C-----------------------------------------------
1005C D u m m y A r g u m e n t s
1006C-----------------------------------------------
1007 INTEGER NSN,NMN,NSV(*),MSR(*)
1008 my_real
1009 . x(3,*),v(3,*),vr(3,*),d(3,*),dr(3,*),
1010 . x_tmp(3,*),facd,facv,stfn(*)
1011C-----------------------------------------------
1012C L o c a l V a r i a b l e s
1013C-----------------------------------------------
1014 INTEGER I,J
1015C REAL
1016 my_real
1017 . dx,dy,dz
1018C------------------------------------
1019 DO j=1,nsn
1020 IF (stfn(j)/=zero) THEN
1021 i=nsv(j)
1022 dx = d(1,i)*facd
1023 dy = d(2,i)*facd
1024 dz = d(3,i)*facd
1025 x_tmp(1,i)=x(1,i) + dx
1026 x_tmp(2,i)=x(2,i) + dy
1027 x_tmp(3,i)=x(3,i) + dz
1028 v(1,i)=d(1,i)*facv
1029 v(2,i)=d(2,i)*facv
1030 v(3,i)=d(3,i)*facv
1031 END IF
1032 END DO
1033 DO j=1,nmn
1034 i=msr(j)
1035 IF (i>0) THEN
1036 dx = d(1,i)*facd
1037 dy = d(2,i)*facd
1038 dz = d(3,i)*facd
1039 x_tmp(1,i) = x(1,i) + dx
1040 x_tmp(2,i) = x(2,i) + dy
1041 x_tmp(3,i) = x(3,i) + dz
1042 v(1,i) = d(1,i)*facv
1043 v(2,i) = d(2,i)*facv
1044 v(3,i) = d(3,i)*facv
1045 END IF
1046 END DO
1047C
1048 IF (iroddl/=0) THEN
1049 DO j=1,nsn
1050 IF (stfn(j)/=zero) THEN
1051 i=nsv(j)
1052 vr(1,i)=dr(1,i)*facv
1053 vr(2,i)=dr(2,i)*facv
1054 vr(3,i)=dr(3,i)*facv
1055 END IF
1056 END DO
1057 DO j=1,nmn
1058 i=msr(j)
1059 IF (i>0) THEN
1060 vr(1,i)=dr(1,i)*facv
1061 vr(2,i)=dr(2,i)*facv
1062 vr(3,i)=dr(3,i)*facv
1063 END IF
1064 END DO
1065 END IF
1066C
1067 RETURN
1068 END
1069!||====================================================================
1070!|| imp_tripi ../engine/source/implicit/imp_int_k.F
1071!||--- called by ------------------------------------------------------
1072!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
1073!||--- calls -----------------------------------------------------
1074!|| i10main_opt_tri ../engine/source/interfaces/intsort/i10opt_opt_tri.F
1075!|| i10main_tri ../engine/source/interfaces/intsort/i10main_tri.F
1076!|| i11main_opt_tri ../engine/source/interfaces/intsort/i11main_opt_tri.F
1077!|| i11main_tri ../engine/source/interfaces/intsort/i11main_tri.F
1078!|| i20main_opt_tri ../engine/source/interfaces/intsort/i20main_opt_tri.F
1079!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
1080!|| i7main_opt_tri ../engine/source/interfaces/intsort/i7main_opt_tri.F
1081!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
1082!|| imp_i10mainf ../engine/source/interfaces/int10/i10ke3.F
1083!|| imp_i11mainf ../engine/source/interfaces/int11/i11ke3.F
1084!|| imp_i7mainf ../engine/source/interfaces/int07/i7ke3.F
1085!|| spmd_i7xvcom2 ../engine/source/mpi/interfaces/spmd_i7xvcom2.F
1086!|| spmd_ifront ../engine/source/mpi/interfaces/spmd_ifront.F
1087!|| spmd_sd_xv ../engine/source/mpi/nodes/spmd_sd_xv.F
1088!||--- uses -----------------------------------------------------
1089!|| element_mod ../common_source/modules/elements/element_mod.F90
1090!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
1091!|| groupdef_mod ../common_source/modules/groupdef_mod.F
1092!|| h3d_mod ../engine/share/modules/h3d_mod.F
1093!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1094!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.F90
1095!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
1096!|| output_mod ../common_source/modules/output/output_mod.F90
1097!|| sensor_mod ../common_source/modules/sensor_mod.F90
1098!|| timer_mod ../engine/source/system/timer_mod.F90
1099!||====================================================================
1100 SUBROUTINE imp_tripi(output, TIMERS,
1101 1 IPARI ,INTBUF_TAB ,X ,D ,
1102 2 V ,MS ,ITAB ,VR ,IN ,
1103 3 IMSCH ,I2MSCH ,ISIZXV,ILENXV ,IGRBRIC ,
1104 4 ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
1105 5 IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM,FR_ELEM ,
1106 6 NBINTC,INTLIST,ITASK ,KINET,NEWFRONT,
1107 7 NUM_IMP,NS_IMP,NE_IMP,IND_IMP,IAD ,
1108 8 ISENDTO ,IRECVFROM ,RETRI,WEIGHT,
1109 9 IXS ,TEMP ,DT2PREV,WAG ,N ,NTY ,
1110 A IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,IRLEN20E,
1111 B ISLEN20E,IKINE,DIAG_SMS,COUNT_REMSLV,COUNT_REMSLVE,
1112 C SENSOR_TAB,XDP,H3D_DATA,MULTI_FVM,FORNEQS,
1113 D INTERFACES,NSENSOR ,GLOB_THERM)
1114C-----------------------------------------------
1115C M o d u l e s
1116C-----------------------------------------------
1117 USE output_mod
1118 USE timer_mod
1119 USE intbufdef_mod
1120 USE h3d_mod
1121 USE multi_fvm_mod
1122 USE groupdef_mod
1123 USE sensor_mod
1124 USE interfaces_mod
1125 use glob_therm_mod
1126 use element_mod , only : nixs
1127C-----------------------------------------------
1128C I m p l i c i t T y p e s
1129C-----------------------------------------------
1130#include "implicit_f.inc"
1131C-----------------------------------------------
1132C C o m m o n B l o c k s
1133C-----------------------------------------------
1134#include "com01_c.inc"
1135#include "com04_c.inc"
1136#include "com08_c.inc"
1137#include "param_c.inc"
1138C-----------------------------------------------
1139C D u m m y A r g u m e n t s
1140C-----------------------------------------------
1141 TYPE(output_) :: output
1142 TYPE(TIMER_) :: TIMERS
1143 INTEGER ,INTENT(IN) :: NSENSOR
1144 INTEGER IPARI(NPARI,*), ITAB(*),
1145 . NEWFRONT(*),NBINTC,INTLIST(*),IKINE(*),
1146 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
1147 . ITASK,IMSCH ,I2MSCH ,ISIZXV,ILENXV,COUNT_REMSLV(*),
1148 . COUNT_REMSLVE(*)
1149 INTEGER ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
1150 . IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E,
1151 . IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM(*),FR_ELEM(*) ,
1152 . WEIGHT(*),IAD,N,IXS(*) ,
1153 . NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1154 . KINET(*),NTY
1155
1156 DOUBLE PRECISION XDP(3,*)
1157
1158 my_real
1159 . X(3,*), D(3,*),V(*),MS(*),WAG(*),
1160 . VR(3,*),DT2PREV, TEMP(*),IN(*), DIAG_SMS(*),FORNEQS(3,*)
1161
1162 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1163 TYPE(H3D_DATABASE) :: H3D_DATA
1164 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
1165!
1166 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
1167 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
1168 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
1169 type (glob_therm_), INTENT(IN) :: GLOB_THERM
1170C-----------------------------------------------
1171C L o c a l V a r i a b l e s
1172C-----------------------------------------------
1173 INTEGER KK,LL, RETRI, NBLIST, IFQ,
1174 . inacti, nsnrold, iad17, ign, ige, nme, nmes,
1175 . i,l1,l2,l3,jtask,lindmax,ibid ,ibidlen,nrtm_t,
1176 . eshift,renum(numnod), nsnfiold(nspmd), isens
1177 INTEGER INT24E2EUSE
1178 INTEGER LSKYI_SMS_NEW ! AMS Counter for Interface values. Not need in implicit but kept for compatibility
1179C REAL
1180 my_real
1181 . dti, ts
1182 my_real
1183 . rdum(3,1)
1184C------------ In Intri -------
1185 lskyi_sms_new = 0 ! Value is set to zero than ignored.
1186 int24e2euse=0
1187 rdum(1:3,1)=zero
1188 ibid =0
1189 jtask = itask + 1
1190 IF (nspmd>1) THEN
1191 IF(isizxv>0) CALL spmd_sd_xv(output,
1192 1 x ,d ,v ,vr ,ms ,
1193 2 in ,iad_elem,fr_elem,weight,imsch,
1194 3 d ,isizxv ,ilenxv ,xdp)
1195 l1 = 1+nixs*numels
1196 l2 = l1+6*numels10
1197 l3 = l2+12*numels20
1198 CALL spmd_i7xvcom2(
1199 1 ipari ,x ,v ,ms ,
1200 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
1201 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
1202 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
1203 5 igrbric ,temp ,1 ,irlen7t ,islen7t ,
1204 6 irlen20 ,islen20,irlen20t,islen20t,irlen20e,
1205 7 islen20e,ikine ,diag_sms,sensor_tab,intbuf_tab,int24e2euse,
1206 8 forneqs ,multi_fvm,interfaces,ibid)
1207 CALL spmd_i7xvcom2(
1208 1 ipari ,x ,v ,ms ,
1209 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
1210 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
1211 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
1212 5 igrbric ,temp ,2 ,irlen7t ,islen7t ,
1213 6 irlen20 ,islen20,irlen20t,islen20t,irlen20e,
1214 7 islen20e,ikine ,diag_sms,sensor_tab,intbuf_tab,int24e2euse,
1215 8 forneqs ,multi_fvm,interfaces,ibid)
1216 ENDIF
1217 nrtm_t = ipari(4,n)
1218 eshift = 0
1219 IF(nty==7.OR.nty==18)THEN
1220C
1221 isens = ipari(64,n)
1222 IF(isens/=0) THEN ! SENSOR
1223 ts = sensor_tab(isens)%TSTART
1224 ELSE
1225 ts = tt
1226 ENDIF
1227C
1228 IF(tt>=ts) THEN ! If interface is activated
1229 CALL i7main_tri(timers,
1230 1 ipari ,x ,v ,
1231 2 ms ,n ,itask ,weight ,
1232 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1233 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1234 5 nsnfiold,eshift ,ibid ,ibid ,ibid ,
1235 6 intbuf_tab,h3d_data,ixs,multi_fvm,glob_therm)
1236 ENDIF
1237 ELSEIF(nty==10)THEN
1238C
1239 CALL i10main_tri(timers,
1240 1 npari ,ipari(1,n),x ,v ,
1241 2 ms ,n ,itask ,wag ,weight ,
1242 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1243 4 nrtm_t ,renum ,nsnfiold ,eshift ,ibid ,
1244 5 ibid ,ibid ,itab ,intbuf_tab ,
1245 6 h3d_data ,glob_therm )
1246 ELSEIF(nty==11)THEN
1247C
1248 isens = ipari(64,n)
1249 IF(isens/=0) THEN ! SENSOR
1250 ts = sensor_tab(isens)%TSTART
1251 ELSE
1252 ts = tt
1253 ENDIF
1254C
1255 IF(tt>=ts) THEN ! If interface is activated
1256 CALL i11main_tri(timers,
1257 1 ipari ,x ,v ,
1258 2 ms ,n ,itask ,weight ,isendto ,
1259 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
1260 4 nrtm_t ,eshift ,ibid ,renum ,nsnfiold ,
1261 5 intbuf_tab ,ibid ,ibid)
1262 ENDIF
1263
1264 ELSEIF(nty == 20)THEN
1265C
1266 CALL i20main_tri(timers,
1267 1 ipari ,x ,v ,
1268 2 ms ,n ,itask ,wag ,weight ,
1269 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1270 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1271 5 nsnfiold,eshift ,ibid ,ibid ,diag_sms,
1272 5 ibid ,intbuf_tab ,h3d_data ,glob_therm)
1273 ENDIF
1274C
1275 IF (nspmd>1.AND.retri==1) THEN
1276C--------- to be modified by interface---
1277 CALL spmd_ifront(
1278 1 ipari ,newfront,isendto ,irecvfrom,
1279 2 nsensor,nbintc ,intlist ,ibidlen ,ibidlen ,
1280 3 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1281 4 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1282 5 ibidlen,ibidlen,sensor_tab,intbuf_tab, 1)
1283 CALL spmd_ifront(
1284 1 ipari ,newfront,isendto ,irecvfrom,
1285 2 nsensor,nbintc ,intlist ,ibidlen ,ibidlen ,
1286 3 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1287 4 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1288 5 ibidlen,ibidlen,sensor_tab,intbuf_tab, 2)
1289
1290
1291 ENDIF
1292C
1293 IF(nty==7)THEN
1294C
1295 isens = ipari(64,n)
1296 IF(isens/=0) THEN ! SENSOR
1297 ts = sensor_tab(isens)%TSTART
1298 ELSE
1299 ts = tt
1300 ENDIF
1301C
1302 IF(tt>=ts) THEN ! If interface is activated
1303 CALL i7main_opt_tri(
1304 1 ipari ,intbuf_tab(n),x ,v ,
1305 2 n ,itask ,count_remslv, lskyi_sms_new )
1306 ENDIF
1307 ELSEIF(nty==10)THEN
1308 CALL i10main_opt_tri(
1309 1 ipari(1,n),intbuf_tab(n),x ,v ,
1310 2 n ,itask ,count_remslv , lskyi_sms_new )
1311 ELSEIF(nty==11)THEN
1312C
1313 isens = ipari(64,n)
1314 IF(isens/=0) THEN ! SENSOR
1315 ts = sensor_tab(isens)%TSTART
1316 ELSE
1317 ts = tt
1318 ENDIF
1319C
1320 IF(tt>=ts) THEN ! If interface is activated
1321 CALL i11main_opt_tri(
1322 1 ipari ,intbuf_tab(n),x ,v ,
1323 2 n ,itask ,count_remslv , lskyi_sms_new )
1324 ENDIF
1325 ELSEIF(nty == 20)THEN
1326 CALL i20main_opt_tri(
1327 1 ipari ,intbuf_tab(n),x ,v ,
1328 2 n ,itask ,count_remslv ,count_remslve )
1329 ENDIF
1330C-------------in intfop2------
1331 lindmax = ipari(18,n)*ipari(23,n)
1332
1333C
1334 IF(nty==7)THEN
1335C
1336 isens = ipari(64,n)
1337 IF(isens/=0) THEN ! SENSOR
1338 ts = sensor_tab(isens)%TSTART
1339 ELSE
1340 ts = tt
1341 ENDIF
1342C
1343 IF(tt>=ts) THEN ! If interface is activated
1344 CALL imp_i7mainf(
1345 1 ipari ,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 ENDIF
1350 ELSEIF(nty==10)THEN
1351C
1352 CALL imp_i10mainf(
1353 1 ipari(1,n),intbuf_tab(n),x ,v ,
1354 2 ms ,n ,lindmax ,jtask ,
1355 3 num_imp(n),ns_imp(iad) ,ne_imp(iad) ,ind_imp(iad))
1356 iad=iad+num_imp(n)
1357 ELSEIF(nty==11)THEN
1358C
1359 isens = ipari(64,n)
1360 IF(isens/=0) THEN ! SENSOR
1361 ts = sensor_tab(isens)%TSTART
1362 ELSE
1363 ts = tt
1364 ENDIF
1365C
1366 IF(tt>=ts) THEN ! If interface is activated
1367 CALL imp_i11mainf(
1368 1 ipari(1,n),intbuf_tab(n),x ,v ,
1369 2 ms ,n ,lindmax ,jtask ,
1370 3 num_imp(n),ns_imp(iad) ,ne_imp(iad) ,itab)
1371 iad=iad+num_imp(n)
1372 ENDIF
1373 ENDIF
1374C
1375 RETURN
1376 END
1377!||====================================================================
1378!|| cp_inttd ../engine/source/implicit/imp_int_k.F
1379!||--- called by ------------------------------------------------------
1380!|| imp_inttd0 ../engine/source/implicit/imp_int_k.f
1381!||--- calls -----------------------------------------------------
1382!|| cp_int ../engine/source/implicit/produt_v.F
1383!||--- uses -----------------------------------------------------
1384!|| imp_inttd ../engine/share/modules/imp_mod_def.F90
1385!||====================================================================
1386 SUBROUTINE cp_inttd(NT_IMP1,NUMIMP ,NS_IMP,NE_IMP,IND_IMP,NUMIMP1)
1387C-----------------------------------------------
1388C M o d u l e s
1389C-----------------------------------------------
1390 USE imp_inttd
1391C-----------------------------------------------
1392C I m p l i c i t T y p e s
1393C-----------------------------------------------
1394#include "implicit_f.inc"
1395C-----------------------------------------------
1396C C o m m o n B l o c k s
1397C-----------------------------------------------
1398#include "com04_c.inc"
1399C-----------------------------------------------
1400C D u m m y A r g u m e n t s
1401C-----------------------------------------------
1402 INTEGER NUMIMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1403 . numimp1(*),nt_imp1
1404C-----------------------------------------------
1405C L o c a l V a r i a b l e s
1406C-----------------------------------------------
1407 INTEGER I,J,K,L,N,IAD,IAD1,IADT
1408 INTEGER IERROR1,IERROR2,IERROR3,IERROR4
1409C-----------------------------------------------
1410C S o u r c e L i n e s
1411C-----------------------------------------------
1412 IF(nt_imp1==0) RETURN
1413 IF(ALLOCATED(ns_imp1)) DEALLOCATE(ns_imp1)
1414 ALLOCATE(ns_imp1(nt_imp1),stat=ierror1)
1415 IF(ALLOCATED(ne_imp1)) DEALLOCATE(ne_imp1)
1416 ALLOCATE(ne_imp1(nt_imp1),stat=ierror2)
1417 IF(ALLOCATED(ind_imp1)) DEALLOCATE(ind_imp1)
1418 ALLOCATE(ind_imp1(nt_imp1),stat=ierror3)
1419 IF(ALLOCATED(iad1_nin)) DEALLOCATE(iad1_nin)
1420 ALLOCATE(iad1_nin(ninter),stat=ierror4)
1421C
1422 CALL cp_int(ninter,numimp,numimp1)
1423 CALL cp_int(nt_imp1,ns_imp,ns_imp1)
1424 CALL cp_int(nt_imp1,ne_imp,ne_imp1)
1425 CALL cp_int(nt_imp1,ind_imp,ind_imp1)
1426 iad1 = 0
1427 DO n = 1,ninter
1428 iad1_nin(n) =iad1
1429 iad1 =iad1 + numimp1(n)
1430 END DO
1431C
1432 RETURN
1433 END
1434!||====================================================================
1435!|| sav_inttd ../engine/source/implicit/imp_int_k.F
1436!||--- called by ------------------------------------------------------
1437!|| imp_solv ../engine/source/implicit/imp_solv.F
1438!||--- uses -----------------------------------------------------
1439!|| imp_inttd ../engine/share/modules/imp_mod_def.F90
1440!||====================================================================
1441 SUBROUTINE sav_inttd(NT_IMP,NUMIMP,NS_IMP,NE_IMP,IND_IMP,
1442 1 NUMIMP1)
1443C-----------------------------------------------
1444C M o d u l e s
1445C-----------------------------------------------
1446 USE imp_inttd
1447C-----------------------------------------------
1448C I m p l i c i t T y p e s
1449C-----------------------------------------------
1450#include "implicit_f.inc"
1451C-----------------------------------------------
1452C C o m m o n B l o c k s
1453C-----------------------------------------------
1454#include "com01_c.inc"
1455#include "com04_c.inc"
1456#include "impl1_c.inc"
1457C-----------------------------------------------
1458C D u m m y A r g u m e n t s
1459C-----------------------------------------------
1460 INTEGER NT_IMP,NUMIMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1461 . NUMIMP1(*)
1462C-----------------------------------------------
1463C L o c a l V a r i a b l e s
1464C-----------------------------------------------
1465 INTEGER I,J,K,L,N,IAD,IAD1,IADT
1466 INTEGER IERROR1,IERROR2,IERROR3,IERROR4
1467C-----------------------------------------------
1468C S o u r c e L i n e s
1469C-----------------------------------------------
1470 IF(nt_imp1==0) RETURN
1471C------in NS_IMP1 input: NT_IMP1 , output:d'abord NT_IMP1, + NT_IMP-NT_IMP1
1472C------in NS_IMP input:d'abord NT_IMP1, + NT_IMP-NT_IMP1, output: NT_IMP
1473 nt_imp = nt_imp + nt_imp1
1474 IF(nspmd>1) THEN
1475 iad1 = 0
1476 DO n = 1,ninter
1477 DO i = 1,numimp1(n)
1478 ns_imp(iad1+i)=ns_imp1(iad1+i)
1479 END DO
1480 iad1 =iad1 + numimp1(n)
1481 END DO
1482 ENDIF
1483C----
1484 IF(ALLOCATED(ns_imp1)) DEALLOCATE(ns_imp1)
1485 ALLOCATE(ns_imp1(nt_imp),stat=ierror1)
1486 IF(ALLOCATED(ne_imp1)) DEALLOCATE(ne_imp1)
1487 ALLOCATE(ne_imp1(nt_imp),stat=ierror2)
1488 IF(ALLOCATED(ind_imp1)) DEALLOCATE(ind_imp1)
1489 ALLOCATE(ind_imp1(nt_imp),stat=ierror3)
1490C
1491 iad1 = 0
1492 DO n = 1,ninter
1493 DO i = 1,numimp1(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 + numimp1(n)
1499 END DO
1500 DO n = 1,ninter
1501 DO i = 1,numimp(n)
1502 ns_imp1(iad1+i) = ns_imp(iad1+i)
1503 ne_imp1(iad1+i) = ne_imp(iad1+i)
1504 ind_imp1(iad1+i) = ind_imp(iad1+i)
1505 END DO
1506 iad1 =iad1 + numimp(n)
1507 END DO
1508C--------change ind for NS_IMP,INE_IMP,IND_IMP---
1509 iad = 0
1510 iad1 = 0
1511 DO n = 1,ninter
1512 DO i = 1,numimp1(n)
1513 ns_imp(iad+i) = ns_imp1(iad1+i)
1514 ne_imp(iad+i) = ne_imp1(iad1+i)
1515 ind_imp(iad+i) = ind_imp1(iad1+i)
1516 END DO
1517 iad =iad + numimp1(n) + numimp(n)
1518 iad1 = iad1 + numimp1(n)
1519 END DO
1520 iad = 0
1521 DO n = 1,ninter
1522 iadt =iad + numimp1(n)
1523 DO i = 1,numimp(n)
1524 ns_imp(iadt+i) = ns_imp1(iad1+i)
1525 ne_imp(iadt+i) = ne_imp1(iad1+i)
1526 ind_imp(iadt+i) = ind_imp1(iad1+i)
1527 END DO
1528 iad1 =iad1 + numimp(n)
1529 iad =iad + numimp1(n) + numimp(n)
1530 END DO
1531C--------change ind for NUM_IMP---
1532 DO n = 1,ninter
1533 numimp(n) = numimp1(n) + numimp(n)
1534 END DO
1535C
1536 RETURN
1537 END
1538!||====================================================================
1539!|| imp_rnumcd ../engine/source/implicit/imp_int_k.F
1540!||--- called by ------------------------------------------------------
1541!|| i10main_tri ../engine/source/interfaces/intsort/i10main_tri.F
1542!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
1543!|| i22main_tri ../engine/source/interfaces/intsort/i22main_tri.F
1544!|| i23main_tri ../engine/source/interfaces/intsort/i23main_tri.F
1545!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
1546!||--- uses -----------------------------------------------------
1547!|| imp_inttd ../engine/share/modules/imp_mod_def.F90
1548!||====================================================================
1549 SUBROUTINE imp_rnumcd(CAND_N ,NIN,NSN,NUM_IMP,INDEX )
1550C-----------------------------------------------
1551C M o d u l e s
1552C-----------------------------------------------
1553 USE imp_inttd
1554C-----------------------------------------------
1555C I m p l i c i t T y p e s
1556C-----------------------------------------------
1557#include "implicit_f.inc"
1558C-----------------------------------------------
1559C D u m m y A r g u m e n t s
1560C-----------------------------------------------
1561 INTEGER CAND_N(*) ,NIN,NSN,NUM_IMP,INDEX(*)
1562C-----------------------------------------------
1563C L o c a l V a r i a b l e s
1564C-----------------------------------------------
1565 INTEGER I, NI,IAD
1566C-----------------------------------------------
1567C S o u r c e L i n e s
1568C-----------------------------------------------
1569 iad = iad1_nin(nin)
1570 DO i = 1, num_imp
1571 ni = ns_imp1(iad+i)
1572 IF(ni>nsn) THEN
1573 ni = ni - nsn
1574 ns_imp1(iad+i) = cand_n(index(i))
1575 END IF
1576 END DO
1577C
1578 RETURN
1579 END
1580!||====================================================================
1581!|| imp_dtkin ../engine/source/implicit/imp_int_k.F
1582!||--- called by ------------------------------------------------------
1583!|| imp_solv ../engine/source/implicit/imp_solv.F
1584!||--- calls -----------------------------------------------------
1585!|| imp_intdt ../engine/source/implicit/imp_int_k.F
1586!||--- uses -----------------------------------------------------
1587!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1588!|| sensor_mod ../common_source/modules/sensor_mod.F90
1589!||====================================================================
1590 SUBROUTINE imp_dtkin(
1591 1 IPARI ,INTBUF_TAB ,X ,V ,
1592 2 VR ,ITAB ,D_IMP ,DR_IMP ,NBINTC ,
1593 3 INTLIST,ITASK ,NEWFRONT,ISENDTO ,IRECVFROM,
1594 4 IDDL ,NDOF ,IKC ,SCAL ,MS ,
1595 5 NSENSOR,SENSOR_TAB, MAXDGAP)
1596C-----------------------------------------------
1597C M o d u l e s
1598C-----------------------------------------------
1599 USE intbufdef_mod
1600 USE sensor_mod
1601C-----------------------------------------------
1602C I m p l i c i t T y p e s
1603C-----------------------------------------------
1604#include "implicit_f.inc"
1605C-----------------------------------------------
1606C C o m m o n B l o c k s
1607C-----------------------------------------------
1608#include "com01_c.inc"
1609#include "com04_c.inc"
1610#include "com08_c.inc"
1611#include "param_c.inc"
1612#include "impl1_c.inc"
1613#include "task_c.inc"
1614C-----------------------------------------------
1615C D u m m y A r g u m e n t s
1616C-----------------------------------------------
1617 INTEGER ,INTENT(IN) :: NSENSOR
1618 INTEGER IPARI(NPARI,*), ITAB(*),
1619 . NEWFRONT(*),NBINTC,INTLIST(*),
1620 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
1621 . ITASK
1622 INTEGER IDDL(*) ,NDOF(*),IKC(*)
1623 my_real
1624 . X(3,*), V(3,*),VR(3,*),
1625 . D_IMP(3,*),DR_IMP(3,*),SCAL,MS(*),
1626 . maxdgap(ninter)
1627
1628 TYPE(intbuf_struct_) INTBUF_TAB(*)
1629 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
1630C-----------------------------------------------
1631C L o c a l V a r i a b l e s
1632C-----------------------------------------------
1633 INTEGER N,I,J,ID,NTHR_CP
1634C REAL
1635 my_real
1636 . dtk(ninter),dti,dt_min
1637C-------------before inttri------
1638 scal = one
1639 IF (ittoff>0.OR.imconv==1.OR.imconv<=-2) RETURN
1640 nthr_cp = nthread
1641 IF (nthread>1) nthread = 1
1642 dti = one/dt2
1643 DO i=1,numnod
1644 v(1,i)=d_imp(1,i)*dti
1645 v(2,i)=d_imp(2,i)*dti
1646 v(3,i)=d_imp(3,i)*dti
1647 ENDDO
1648 IF (iroddl/=0) THEN
1649 DO i=1,numnod
1650 vr(1,i)=dr_imp(1,i)*dti
1651 vr(2,i)=dr_imp(2,i)*dti
1652 vr(3,i)=dr_imp(3,i)*dti
1653 ENDDO
1654 ENDIF
1655 CALL imp_intdt(
1656 1 ipari ,intbuf_tab ,x ,
1657 2 v ,vr ,isendto ,irecvfrom,
1658 4 newfront ,itask ,dtk ,itab ,
1659 5 intlist ,nbintc ,dt_min ,ms ,
1660 6 nsensor ,sensor_tab,maxdgap)
1661C
1662 scal = dt_min*dti
1663 IF (scal<one) THEN
1664 DO i=1,numnod
1665 d_imp(1,i)=d_imp(1,i)*scal
1666 d_imp(2,i)=d_imp(2,i)*scal
1667 d_imp(3,i)=d_imp(3,i)*scal
1668 ENDDO
1669 IF (iroddl/=0) THEN
1670 DO i=1,numnod
1671 dr_imp(1,i)=dr_imp(1,i)*scal
1672 dr_imp(2,i)=dr_imp(2,i)*scal
1673 dr_imp(3,i)=dr_imp(3,i)*scal
1674 ENDDO
1675 ENDIF
1676 ENDIF
1677C
1678 IF (nthr_cp>1) nthread = nthr_cp
1679C
1680 RETURN
1681 END
1682!||====================================================================
1683!|| kin_knl ../engine/source/implicit/imp_int_k.F
1684!||--- called by ------------------------------------------------------
1685!|| imp_solv ../engine/source/implicit/imp_solv.F
1686!||--- calls -----------------------------------------------------
1687!|| dim_kinkn ../engine/source/implicit/imp_int_k.F
1688!|| iddl_mint ../engine/source/implicit/imp_int_k.F
1689!|| ini_kinkn ../engine/source/implicit/imp_int_k.F
1690!|| rbe3_mint ../engine/source/implicit/imp_int_k.F
1691!||--- uses -----------------------------------------------------
1692!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
1693!|| imp_knon ../engine/share/modules/impbufdef_mod.F
1694!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1695!||====================================================================
1696 SUBROUTINE kin_knl(
1697 1 IPARI ,INTBUF_TAB ,NUM_IMP ,NS_IMP ,NE_IMP ,
1698 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
1699 3 NINT2 ,IINT2 ,IBFV ,LJ ,ISKEW ,
1700 4 ICODT ,NDOFI ,IDDL ,IKC ,NDOF ,
1701 5 INLOC ,IRBE3 ,LRBE3 ,FRBE3 ,X ,
1702 6 SKEW ,IRBE2 ,LRBE2 )
1703C-----------------------------------------------
1704C M o d u l e s
1705C-----------------------------------------------
1706 USE imp_knon
1707 USE imp_aspc
1708 USE intbufdef_mod
1709C-----------------------------------------------
1710C I m p l i c i t T y p e s
1711C-----------------------------------------------
1712#include "implicit_f.inc"
1713C-----------------------------------------------
1714C C o m m o n B l o c k s
1715C-----------------------------------------------
1716#include "com04_c.inc"
1717#include "param_c.inc"
1718C-----------------------------------------------
1719C D u m m y A r g u m e n t s
1720C-----------------------------------------------
1721 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
1722 . ne_imp(*),ndofi(*)
1723 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
1724 . NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
1725 . IBFV(*),LJ(*),ISKEW(*),ICODT(*),IRBE3(NRBE3L,*),LRBE3(*),
1726 . IRBE2(NRBE2L,*),LRBE2(*)
1727C REAL
1728 my_real
1729 . x(*),skew(*),frbe3(*)
1730 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1731C-----------------------------------------------
1732C L o c a l V a r i a b l e s
1733C-----------------------------------------------
1734 INTEGER I,J,N, IAD,NTY,NDOFII(NUMNOD),NKC,
1735 . ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,nd,nmt,irot,numn
1736C-----------------------------------------------
1737 DO n=1,numnod
1738 ndofii(n) = iabs(ndofi(n))
1739 ENDDO
1740 numn_kn = 0
1741 DO n=1,numnod
1742 IF (ndofii(n)>0) numn_kn = numn_kn + 1
1743 ENDDO
1744C--------allocation------
1745C
1746 ALLOCATE(in_kn(numn_kn),id_kn(3,numn_kn),stat=ierr1)
1747 IF (numn_kn > 0) THEN
1748 id_kn = -7
1749 n = 0
1750C------------negative value for nsl nodes-----
1751 DO i=1,numnod
1752 IF (ndofii(i)>0) THEN
1753 n = n + 1
1754 in_kn(n) = i
1755 ENDIF
1756 ENDDO
1757 END IF
1758 CALL dim_kinkn(
1759 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
1760 2 iint2 ,ipari ,intbuf_tab,ndofii ,ibfv ,
1761 3 lj ,iskew ,icodt ,nrb_kn ,ni2_kn ,
1762 4 nbc_kn ,nfx_kn ,nrw_kn ,irbe3 ,nrbe3_kn ,
1763 5 nspc_kn ,irbe2 ,lrbe2 ,nrbe2_kn )
1764 IF (ni2_kn>0) THEN
1765 ALLOCATE(ii2_kn(2,ni2_kn),id_knm2(6,4,ni2_kn),stat=ierr2)
1766 ENDIF
1767 IF (nrb_kn>0) THEN
1768 ALLOCATE(irb_kn(2,nrb_kn),id_knm(6,nrb_kn),stat=ierr3)
1769 ENDIF
1770 IF (nbc_kn>0) THEN
1771 IF(ALLOCATED(ibc_kn)) DEALLOCATE(ibc_kn)
1772 ALLOCATE(ibc_kn(3,nbc_kn),stat=ierr4)
1773 ENDIF
1774 IF (nspc_kn>0) THEN
1775 IF(ALLOCATED(ispc_kn)) DEALLOCATE(ispc_kn)
1776 ALLOCATE(ispc_kn(nspc_kn),stat=ierr4)
1777 ENDIF
1778C--
1779 IF (nfx_kn>0) THEN
1780 IF(ALLOCATED(ifx_kn)) DEALLOCATE(ifx_kn)
1781 ALLOCATE(ifx_kn(2,nfx_kn),stat=ierr5)
1782 ENDIF
1783C
1784 IF (nrw_kn>0) THEN
1785 IF(ALLOCATED(irw_kn)) DEALLOCATE(irw_kn)
1786 ALLOCATE(irw_kn(nrw_kn),stat=ierr6)
1787 ENDIF
1788C
1789 IF (nrbe3_kn>0) THEN
1790 ALLOCATE(irbe3_kn(nrbe3_kn),stat=ierr6)
1791 ENDIF
1792C
1793 IF (nrbe2_kn>0) THEN
1794 ALLOCATE(irbe2_kn(2,nrbe2_kn),id_knm4(6,nrbe2_kn),stat=ierr3)
1795 ENDIF
1796C
1797 CALL ini_kinkn(
1798 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
1799 2 iint2 ,ipari ,intbuf_tab,ndofii ,ibfv ,
1800 3 lj ,iskew ,icodt ,nrb_kn ,irb_kn ,
1801 3 ni2_kn ,ii2_kn ,nbc_kn ,ibc_kn ,nfx_kn ,
1802 4 ifx_kn ,nrw_kn ,irw_kn ,irbe3 ,nrbe3_kn ,
1803 5 irbe3_kn ,nspc_kn ,ispc_kn ,irbe2 ,lrbe2 ,
1804 6 nrbe2_kn ,irbe2_kn )
1805C ------ini RBE3---
1806 IF (nrbe3_kn>0) THEN
1807 iad=0
1808 nmt = 0
1809 irot=0
1810 DO i=1,nrbe3_kn
1811 n=irbe3_kn(i)
1812 numn = irbe3(5,n)
1813 iad=max(iad,numn)
1814 nmt = nmt + numn
1815 irot=max(irot,irbe3(6,n))
1816 ENDDO
1817 ALLOCATE(id_knm3(6,iad,nrbe3_kn),stat=ierr3)
1818 id_knm3=0
1819 rkn_max=iad
1820 ALLOCATE(fcdi_kn(18*nmt),stat=ierr5)
1821 fcdi_kn=zero
1822 IF (irot>0) THEN
1823 ALLOCATE(mcdi_kn(18*nmt),stat=ierr5)
1824 mcdi_kn=zero
1825 ENDIF
1826 CALL rbe3_mint(irbe3 ,lrbe3 ,frbe3 ,x ,skew ,
1827 . nrbe3_kn,irbe3_kn ,fcdi_kn,mcdi_kn)
1828 ENDIF
1829C--------- use NDOFII(I)--as IDDLM ------------
1830 IF (numn_kn == 0) RETURN
1831 nkc=0
1832 DO n =1,numnod
1833 i=inloc(n)
1834 ndofii(i)=iddl(i)-nkc
1835 DO j=1,ndof(i)
1836 nd = iddl(i)+j
1837 IF (ikc(nd)/=0) nkc = nkc + 1
1838 ENDDO
1839 ENDDO
1840 CALL iddl_mint(numn_kn,in_kn ,iddl ,ikc ,ndof ,
1841 . ndofii ,ipari ,intbuf_tab,id_kn ,nrb_kn ,
1842 . irb_kn ,id_knm ,ni2_kn ,ii2_kn ,id_knm2 ,
1843 . irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,id_knm3 ,
1844 . rkn_max ,irbe2 ,nrbe2_kn,irbe2_kn,id_knm4 )
1845C------------return origine NDOFI(I)----
1846 DO i=1,numnod
1847 IF (ndofi(i)<0) ndofi(i) = 0
1848 ENDDO
1849 RETURN
1850 END
1851!||====================================================================
1852!|| dim_kinkn ../engine/source/implicit/imp_int_k.F
1853!||--- called by ------------------------------------------------------
1854!|| kin_knl ../engine/source/implicit/imp_int_k.F
1855!||--- uses -----------------------------------------------------
1856!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
1857!|| imp_rwl ../engine/share/modules/impbufdef_mod.F
1858!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1859!||====================================================================
1860 SUBROUTINE dim_kinkn(
1861 1 NPBY ,LPBY ,NRBYAC ,IRBYAC ,NINT2 ,
1862 2 IINT2 ,IPARI ,INTBUF_TAB,INLOC ,IBFV ,
1863 3 LJ ,ISKEW ,ICODT ,LNS ,LNS2 ,
1864 4 LBCL ,LFXL ,LRW ,IRBE3 ,LNS3 ,
1865 5 LSPCL ,IRBE2 ,LRBE2 ,LNS4 )
1866C-----------------------------------------------
1867C M o d u l e s
1868C-----------------------------------------------
1869 USE imp_rwl
1870 USE imp_aspc
1871 USE intbufdef_mod
1872C-----------------------------------------------
1873C I m p l i c i t T y p e s
1874C-----------------------------------------------
1875#include "implicit_f.inc"
1876C-----------------------------------------------
1877C C o m m o n B l o c k s
1878C-----------------------------------------------
1879#include "com04_c.inc"
1880#include "param_c.inc"
1881C-----------------------------------------------
1882C D u m m y A r g u m e n t s
1883C-----------------------------------------------
1884 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
1885 . nint2,iint2(*),ipari(npari,*)
1886 INTEGER IBFV(NIFV,*),LJ(*),ISKEW(*) ,ICODT(*),LSPCL
1887 INTEGER INLOC(*),LNS ,LNS2,LBCL ,LFXL ,LRW,IRBE3(NRBE3L,*),LNS3,
1888 . irbe2(nrbe2l,*),lrbe2(*),lns4
1889C REAL
1890
1891 TYPE(intbuf_struct_) INTBUF_TAB(*)
1892C-----------------------------------------------
1893C L o c a l V a r i a b l e s
1894C-----------------------------------------------
1895 INTEGER
1896 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,
1897 . ji,k10,k11,k12,k13,k14,kfi,ns
1898C----------------------------
1899 lns2=0
1900 DO j=1,nint2
1901 n=iint2(j)
1902 nsn = ipari(5,n)
1903 ji=ipari(1,n)
1904 k10=ji-1
1905 k11=k10+4*ipari(3,n)
1906C------IRECT(4,NSN)-----
1907 k12=k11+4*ipari(4,n)
1908C------NSV(NSN)--node number---
1909 k13=k12+nsn
1910C------MSR(NMN)-----
1911 k14=k13+ipari(6,n)
1912C------IRTL(NSN)--main el number---
1913 kfi=k14+nsn
1914 DO i=1,nsn
1915 ni=intbuf_tab(n)%NSV(i)
1916 IF (inloc(ni)>0) THEN
1917 lns2=lns2+1
1918 ENDIF
1919 ENDDO
1920 ENDDO
1921C--------RBE3--------------------
1922 lns3=0
1923 DO n=1,nrbe3
1924 ni = irbe3(3,n)
1925 IF (ni==0) cycle
1926 IF (inloc(ni)>0) THEN
1927 lns3=lns3+1
1928 ENDIF
1929 ENDDO
1930C-----active rigid body main nodes------
1931 lns=0
1932 DO j=1,nrbyac
1933 n=irbyac(j)
1934 k=irbyac(j+nrbykin)
1935 m =npby(1,n)
1936 nsn =npby(2,n)
1937 DO i=1,nsn
1938 id = i+k
1939 ni=lpby(id)
1940 IF (inloc(ni)>0) THEN
1941 lns=lns+1
1942 IF (inloc(m)==0) inloc(m) = 1
1943 ENDIF
1944 ENDDO
1945 ENDDO
1946C
1947 lbcl = 0
1948 DO n=1,numnod
1949 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
1950 IF (inloc(n)>0)lbcl = lbcl + 1
1951 ENDIF
1952 ENDDO
1953 lspcl = 0
1954 DO n=1,nspcl
1955 IF (inloc(n)>0.AND.ic_spc(n)<=3)lspcl = lspcl + 1
1956 ENDDO
1957C ---
1958 lfxl = 0
1959 DO j=1,nfxvel
1960 IF (lj(j)>0.AND.lj(j)<=3) THEN
1961 n=iabs(ibfv(1,j))
1962 IF (inloc(n)>0)lfxl = lfxl + 1
1963 ENDIF
1964 ENDDO
1965C
1966 lrw = 0
1967 DO j=1,n_rwl
1968 n=in_rwl(j)
1969 IF (inloc(n)>0) lrw = lrw + 1
1970 ENDDO
1971C-----Rbe2------
1972 lns4=0
1973 DO n=1,nrbe2
1974 k=irbe2(1,n)
1975 m =irbe2(3,n)
1976 nsn =irbe2(5,n)
1977 DO i=1,nsn
1978 id = i+k
1979 ni=lrbe2(id)
1980 IF (inloc(ni)>0) THEN
1981 lns4=lns4+1
1982 IF (inloc(m)==0) inloc(m) = 2
1983 ENDIF
1984 ENDDO
1985 ENDDO
1986C----6---------------------------------------------------------------7---------8
1987 RETURN
1988 END
1989!||====================================================================
1990!|| ini_kinkn ../engine/source/implicit/imp_int_k.F
1991!||--- called by ------------------------------------------------------
1992!|| kin_knl ../engine/source/implicit/imp_int_k.F
1993!||--- uses -----------------------------------------------------
1994!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
1995!|| imp_rwl ../engine/share/modules/impbufdef_mod.f
1996!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1997!||====================================================================
1998 SUBROUTINE ini_kinkn(
1999 1 NPBY ,LPBY ,NRBYAC ,IRBYAC ,NINT2 ,
2000 2 IINT2 ,IPARI ,INTBUF_TAB,INLOC ,IBFV ,
2001 3 LJ ,ISKEW ,ICODT ,NRB_MV ,IRB_MV ,
2002 3 NI2_MV ,II2_MV ,NBC_MV ,IBC_MV ,NFX_MV ,
2003 4 IFX_MV ,NRW_MV ,IRW_MV ,IRBE3 ,NRBE3_MV ,
2004 5 IRBE3_MV ,NSPC_MV ,ISPC_MV ,IRBE2 ,LRBE2 ,
2005 6 NRBE2_MV ,IRBE2_MV )
2006C-----------------------------------------------
2007C M o d u l e s
2008C-----------------------------------------------
2009 USE imp_rwl
2010 USE imp_aspc
2011 USE intbufdef_mod
2012C-----------------------------------------------
2013C I m p l i c i t T y p e s
2014C-----------------------------------------------
2015#include "implicit_f.inc"
2016C-----------------------------------------------
2017C C o m m o n B l o c k s
2018C-----------------------------------------------
2019#include "com04_c.inc"
2020#include "param_c.inc"
2021C-----------------------------------------------
2022C D u m m y A r g u m e n t s
2023C-----------------------------------------------
2024 INTEGER IBFV(NIFV,*),LJ(*),ISKEW(*) ,ICODT(*)
2025 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
2026 . nint2,iint2(*),ipari(npari,*),irbe3(nrbe3l,*),
2027 . irbe2(nrbe2l,*),lrbe2(*)
2028 INTEGER
2029 . inloc(*),nrb_mv,ni2_mv,irb_mv(2,*),ii2_mv(2,*),
2030 . nbc_mv,ibc_mv(3,*) ,nfx_mv,ifx_mv(2,*),nrw_mv,irw_mv(*),
2031 . nrbe3_mv,irbe3_mv(*),nspc_mv,ispc_mv(*),nrbe2_mv,irbe2_mv(*)
2032C REAL
2033
2034 TYPE(intbuf_struct_) INTBUF_TAB(*)
2035C-----------------------------------------------
2036C L o c a l V a r i a b l e s
2037C-----------------------------------------------
2038 INTEGER
2039 . i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,nr3,nr4,
2040 . ji,k10,k11,k12,k13,k14,kfi,ni2,nrb,nbc,nfx,nrw,nspc
2041c----------------------
2042 ni2=0
2043 IF (ni2_mv>0) THEN
2044 DO j=1,nint2
2045 n=iint2(j)
2046 nsn = ipari(5,n)
2047 ji=ipari(1,n)
2048 k10=ji-1
2049 k11=k10+4*ipari(3,n)
2050C------IRECT(4,NSN)-----
2051 k12=k11+4*ipari(4,n)
2052C------NSV(NSN)--node number---
2053 k13=k12+nsn
2054C------MSR(NMN)-----
2055 k14=k13+ipari(6,n)
2056C------IRTL(NSN)--main el number---
2057 kfi=k14+nsn
2058 DO i=1,nsn
2059 ni=intbuf_tab(n)%NSV(i)
2060 IF (inloc(ni)>0) THEN
2061 ni2=ni2+1
2062 ii2_mv(1,ni2)=n
2063 ii2_mv(2,ni2)=i
2064 ENDIF
2065 ENDDO
2066 ENDDO
2067 IF (ni2/=ni2_mv) WRITE(*,*)'pb cal ni2_m'
2068 ENDIF
2069C--------RBE3--------------------
2070 IF (NRBE3_MV>0) THEN
2071 NR3=0
2072 DO N=1,NRBE3
2073 NI = IRBE3(3,N)
2074 IF (NI==0) CYCLE
2075 IF (INLOC(NI)>0) THEN
2076 NR3=NR3+1
2077 IRBE3_MV(NR3)=N
2078 ENDIF
2079 ENDDO
2080 IF (NR3/=NRBE3_MV) WRITE(*,*)'pb cal nrbe3_m'
2081 ENDIF
2082C-----active rigid body main nodes------
2083 NRB=0
2084 IF (NRB_MV>0) THEN
2085 DO J=1,NRBYAC
2086 N=IRBYAC(J)
2087 K=IRBYAC(J+NRBYKIN)
2088 M =NPBY(1,N)
2089 IF (INLOC(M)>0) THEN
2090 NSN =NPBY(2,N)
2091 DO I=1,NSN
2092 ID = I+K
2093 NI=LPBY(ID)
2094 IF (INLOC(NI)>0) THEN
2095 NRB=NRB+1
2096 IRB_MV(1,NRB)=M
2097 IRB_MV(2,NRB)=NI
2098 ENDIF
2099 ENDDO
2100 ENDIF
2101 ENDDO
2102 IF (NRB/=NRB_MV) WRITE(*,*)'pb cal nrb_m'
2103 ENDIF
2104C +++
2105 IF (NBC_MV>0) THEN
2106 NBC = 0
2107 DO N=1,NUMNOD
2108.AND. IF (ISKEW(N)>1ICODT(N)/=7) THEN
2109 IF (INLOC(N)>0) THEN
2110 NBC = NBC + 1
2111 IBC_MV(1,NBC) = N
2112 IBC_MV(2,NBC) = ISKEW(N)
2113 IBC_MV(3,NBC) = ICODT(N)
2114 ENDIF
2115 ENDIF
2116 ENDDO
2117 IF (NBC/=NBC_MV) WRITE(*,*)'pb cal nbc_m'
2118 ENDIF
2119C-
2120 IF (NSPC_MV>0) THEN
2121 NSPC = 0
2122 DO N=1,NSPCL
2123.AND. IF (INLOC(N)>0IC_SPC(N)<=3)THEN
2124 NSPC = NSPC + 1
2125 ISPC_MV(NSPC) = N
2126 ENDIF
2127 ENDDO
2128 IF (NSPC/=NSPC_MV) WRITE(*,*)'pb cal nspc_m'
2129 ENDIF
2130C---
2131 IF (NFX_MV>0) THEN
2132 NFX = 0
2133 DO J=1,NFXVEL
2134.AND. IF (LJ(J)>0LJ(J)<=3) THEN
2135 N=IABS(IBFV(1,J))
2136 IF (INLOC(N)>0) THEN
2137 NFX = NFX + 1
2138 IFX_MV(1,NFX) = J
2139 IFX_MV(2,NFX) = LJ(J)
2140 ENDIF
2141 ENDIF
2142 ENDDO
2143 IF (NFX/=NFX_MV) WRITE(*,*)'pb cal nfx_m'
2144 ENDIF
2145C
2146 IF (NRW_MV>0) THEN
2147 NRW = 0
2148 DO J=1,N_RWL
2149 N=IN_RWL(J)
2150 IF (INLOC(N)>0) THEN
2151 NRW = NRW + 1
2152 IRW_MV(NRW) = J
2153 ENDIF
2154 ENDDO
2155 IF (NRW/=NRW_MV) WRITE(*,*)'pb cal nrw_m'
2156 ENDIF
2157C-----RBE2------
2158 NR4=0
2159 IF (NRBE2_MV>0) THEN
2160 DO N=1,NRBE2
2161 K=IRBE2(1,N)
2162 M =IRBE2(3,N)
2163 IF (INLOC(M)>0) THEN
2164 NSN =IRBE2(5,N)
2165 DO I=1,NSN
2166 ID = I+K
2167 NI=LRBE2(ID)
2168 IF (INLOC(NI)>0) THEN
2169 NR4=NR4+1
2170 IRB_MV(1,NR4)=N
2171 IRB_MV(2,NR4)=NI
2172 ENDIF
2173 ENDDO
2174 ENDIF
2175 ENDDO
2176 IF (NR4/=NRBE2_MV) WRITE(*,*)'pb cal nrbe2'
2177 ENDIF
2178C ---
2179C----6---------------------------------------------------------------7---------8
2180 RETURN
2181 END
2182!||====================================================================
2183!|| iddl_mint ../engine/source/implicit/imp_int_k.F
2184!||--- called by ------------------------------------------------------
2185!|| kin_knl ../engine/source/implicit/imp_int_k.F
2186!||--- uses -----------------------------------------------------
2187!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2188!||====================================================================
2189 SUBROUTINE IDDL_MINT(NML ,IML ,IDDL ,IKC ,NDOF ,
2190 . IDDLM ,IPARI ,INTBUF_TAB,IDDML ,NRB_FR ,
2191 . IFRSR ,IDDMR ,NI2_FR ,IFRS2 ,IDDMI2 ,
2192 . IRBE3 ,LRBE3 ,NRBE3_FR,IFRS3 ,IDDMI3 ,
2193 . M_MAX ,IRBE2 ,NRBE2_FR,IFRS4 ,IDDMI4 )
2194C-----------------------------------------------
2195C M o d u l e s
2196C-----------------------------------------------
2197 USE INTBUFDEF_MOD
2198C-----------------------------------------------
2199C I m p l i c i t T y p e s
2200C-----------------------------------------------
2201#include "implicit_f.inc"
2202C-----------------------------------------------
2203C C o m m o n B l o c k s
2204C-----------------------------------------------
2205#include "param_c.inc"
2206C-----------------------------------------------
2207C D u m m y A r g u m e n t s
2208C-----------------------------------------------
2209 INTEGER NML,IML(*),IDDL(*) ,IKC(*) ,NDOF(*) ,IDDLM(*),M_MAX
2210 INTEGER IPARI(NPARI,*),IDDML(3,*),NRB_FR ,
2211 . IDDMR(6,*) ,NI2_FR ,IDDMI2(6,4,*) ,IFRSR(2,*),
2212 . IFRS2(2,*),IRBE3(NRBE3L,*),LRBE3(*),NRBE3_FR,IFRS3(*),
2213 . IDDMI3(6,M_MAX,*),IRBE2(NRBE2L,*),NRBE2_FR,IFRS4(*),
2214 . IDDMI4(6,*)
2215
2216 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2217C-----------------------------------------------
2218C L o c a l V a r i a b l e s
2219C-----------------------------------------------
2220 INTEGER I,ID,N,J,NDD,I1
2221 INTEGER M,NSN,JI,K10,K11,K12,K13,K14,L,NNOD,NJ,NL,NI,IAD
2222 INTEGER IERROR1,IERROR2,IERROR3,IERROR4,IERROR5,IERROR6
2223C-----------------------------------------------
2224C S o u r c e L i n e s
2225C-----------------------------------------------
2226C
2227 IF (NML>0) THEN
2228C--------initialization for ndof=0---
2229 DO I = 1, NML
2230 N = IML(I)
2231 NDD = 0
2232 DO J = 1 , MIN(3,NDOF(N))
2233 ID = IDDL(N) + J
2234 IF (IKC(ID)<1) THEN
2235 NDD = NDD + 1
2236 IDDML(J,I) = IDDLM(N) + NDD
2237 ELSE
2238 IDDML(J,I) = -IKC(ID)
2239 ENDIF
2240 ENDDO
2241 ENDDO
2242 ENDIF
2243C
2244 IF (NRB_FR>0) THEN
2245 DO I = 1, NRB_FR
2246 N = IFRSR(1,I)
2247 NDD = 0
2248 DO J = 1 , NDOF(N)
2249 ID = IDDL(N) + J
2250 IF (IKC(ID)<1) THEN
2251 NDD = NDD + 1
2252 IDDMR(J,I) = IDDLM(N) + NDD
2253 ELSE
2254 IDDMR(J,I) = -IKC(ID)
2255 ENDIF
2256 ENDDO
2257 ENDDO
2258 ENDIF
2259C
2260 IF (NI2_FR>0) THEN
2261 DO I=1,NI2_FR
2262 N=IFRS2(1,I)
2263 NI=IFRS2(2,I)
2264 JI=IPARI(1,N)
2265 NSN=IPARI(5,N)
2266 K10=JI-1
2267 K11=K10+4*IPARI(3,N)
2268C------IRECT(4,NSN)-----
2269 K12=K11+4*IPARI(4,N)
2270C------NSV(NSN)--node number---
2271 K13=K12+NSN
2272C------MSR(NMN)-----
2273 K14=K13+IPARI(6,N)
2274 L=INTBUF_TAB(N)%IRTLM(NI)
2275 NL=4*(L-1)
2276 IF (INTBUF_TAB(N)%IRECTM(NL+3)==INTBUF_TAB(N)%IRECTM(NL+4)) THEN
2277 NNOD=3
2278 ELSE
2279 NNOD=4
2280 ENDIF
2281C------ SI Main node is also dependent -----
2282 DO M=1,NNOD
2283 NJ=INTBUF_TAB(N)%IRECTM(NL+M)
2284 NDD = 0
2285 DO J = 1 , NDOF(NJ)
2286 ID = IDDL(NJ) + J
2287 IF (IKC(ID)<1) THEN
2288 NDD = NDD + 1
2289 IDDMI2(J,M,I) = IDDLM(NJ) + NDD
2290 ELSE
2291 IDDMI2(J,M,I) = -IKC(ID)
2292 ENDIF
2293 ENDDO
2294 ENDDO
2295 ENDDO
2296 ENDIF
2297C-------RBE3-----------
2298 IF (NRBE3_FR>0) THEN
2299 DO I=1,NRBE3_FR
2300 N=IFRS3(I)
2301 NI=IRBE3(3,N)
2302 NNOD=IRBE3(5,N)
2303 IAD=IRBE3(1,N)
2304C-------
2305 DO M=1,NNOD
2306 NJ=LRBE3(IAD+M)
2307 NDD = 0
2308 DO J = 1 , NDOF(NJ)
2309 ID = IDDL(NJ) + J
2310 IF (IKC(ID)<1) THEN
2311 NDD = NDD + 1
2312 IDDMI3(J,M,I) = IDDLM(NJ) + NDD
2313 ELSE
2314 IDDMI3(J,M,I) = -IKC(ID)
2315 ENDIF
2316 ENDDO
2317 ENDDO
2318 ENDDO
2319 ENDIF
2320C------RBE2
2321 IF (NRBE2_FR>0) THEN
2322 DO I = 1, NRBE2_FR
2323 N = IFRSR(1,I)
2324 M = IRBE2(3,N)
2325 NDD = 0
2326 DO J = 1 , NDOF(M)
2327 ID = IDDL(M) + J
2328 IF (IKC(ID)<1) THEN
2329 NDD = NDD + 1
2330 IDDMI4(J,I) = IDDLM(M) + NDD
2331 ELSE
2332 IDDMI4(J,I) = -IKC(ID)
2333 ENDIF
2334 ENDDO
2335 ENDDO
2336 ENDIF
2337C
2338 RETURN
2339 END
2340!||====================================================================
2341!|| rbe3_mint ../engine/source/implicit/imp_int_k.F
2342!||--- called by ------------------------------------------------------
2343!|| kin_knl ../engine/source/implicit/imp_int_k.F
2344!||--- calls -----------------------------------------------------
2345!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
2346!||====================================================================
2347 SUBROUTINE RBE3_MINT(IRBE3 ,LRBE3 ,FRBE3 ,X ,SKEW,
2348 . NRBE3_KN,IRBE3_KN ,FRCDI ,MRCDI )
2349C-----------------------------------------------
2350C I m p l i c i t T y p e s
2351C-----------------------------------------------
2352#include "implicit_f.inc"
2353C-----------------------------------------------
2354C C o m m o n B l o c k s
2355C-----------------------------------------------
2356#include "param_c.inc"
2357#include "tabsiz_c.inc"
2358C-----------------------------------------------
2359C D u m m y A r g u m e n t s
2360C-----------------------------------------------
2361 INTEGER IRBE3(NRBE3L,*),LRBE3(*) ,NRBE3_KN,IRBE3_KN(*)
2362 my_real
2363 . FRBE3(*),X(*),SKEW(*),FRCDI(*),MRCDI(*)
2364C-----------------------------------------------
2365C L o c a l V a r i a b l e s
2366C-----------------------------------------------
2367 INTEGER I,ID,N,J,NDD,I1,IAD,NMT,IROTG,IADS
2368 INTEGER M,NNOD,NJ,NL,NI
2369C-----------------------------------------------
2370C S o u r c e L i n e s
2371C-----------------------------------------------
2372 IF (NRBE3_KN>0) THEN
2373C------- init FRCDI,MRCDI
2374 NMT = SLRBE3/2
2375 IADS =1
2376 DO I=1,NRBE3_KN
2377 N=IRBE3_KN(I)
2378 NI=IRBE3(3,N)
2379 NNOD=IRBE3(5,N)
2380 IAD=IRBE3(1,N)
2381 IROTG =IRBE3(6,N)
2382 CALL RBE3CL(LRBE3(IAD+1),LRBE3(NMT+IAD+1),NI ,X ,
2383 . FRBE3(IAD+1),SKEW ,NNOD ,IROTG ,FRCDI(IADS),
2384 . MRCDI(IADS) ,IRBE3(2,N))
2385C-------
2386 IADS = IADS + NNOD
2387 ENDDO
2388 ENDIF
2389C
2390 RETURN
2391 END
2392!||====================================================================
2393!|| int_matv ../engine/source/implicit/imp_int_k.F
2394!||--- called by ------------------------------------------------------
2395!|| mav_lt2 ../engine/source/implicit/produt_v.F
2396!||--- calls -----------------------------------------------------
2397!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
2398!|| imp3_u2x ../engine/source/airbag/monv_imp0.F
2399!|| int_fku3 ../engine/source/implicit/imp_int_k.F
2400!|| zeror ../engine/source/system/zero.F
2401!||--- uses -----------------------------------------------------
2402!|| imp_knon ../engine/share/modules/impbufdef_mod.F
2403!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2404!||====================================================================
2405 SUBROUTINE INT_MATV(IPARI ,INTBUF_TAB ,NDOF ,NUM_IMP,
2406 1 NS_IMP ,NE_IMP ,INDEX2 ,A ,AR ,
2407 2 V ,X ,MS ,X_IMP ,IBFV ,
2408 3 SKEW ,XFRAME ,U ,F ,IUPD ,
2409 4 IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
2410C-----------------------------------------------
2411C M o d u l e s
2412C-----------------------------------------------
2413 USE IMP_KNON
2414 USE INTBUFDEF_MOD
2415C-----------------------------------------------
2416C I m p l i c i t T y p e s
2417C-----------------------------------------------
2418#include "implicit_f.inc"
2419C-----------------------------------------------
2420C C o m m o n B l o c k s
2421C-----------------------------------------------
2422#include "com04_c.inc"
2423#include "param_c.inc"
2424C-----------------------------------------------
2425C D u m m y A r g u m e n t s
2426C-----------------------------------------------
2427 INTEGER IPARI(NPARI,*), INDEX2(*),NDOF(*)
2428 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IBFV(*),IUPD,
2429 . IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
2430 my_real
2431 . X(3,*),A(3,*),AR(3,*), F(*), U(*),
2432 . X_IMP(3,*),V(3,*),SKEW(*) ,XFRAME(*),MS(*)
2433
2434 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2435C-----------------------------------------------
2436C L o c a l V a r i a b l e s
2437C-----------------------------------------------
2438 INTEGER I, J,N,K,K1,KK1,N1,N2,N3,N4,ID,IAD,IS,NN,NTY
2439 my_real
2440 . D(3,NUMNOD)
2441C----------------actualise D,X_IMP---------------------
2442 CALL IMP3_U2X(X ,IPARI ,INTBUF_TAB ,NDOF ,
2443 . U ,D ,AR ,X_IMP ,NUMN_KN,
2444 . IN_KN ,ID_KN ,NRB_KN ,IRB_KN,ID_KNM ,
2445 . NI2_KN,II2_KN ,ID_KNM2,NFX_KN,IFX_KN ,
2446 . NBC_KN,IBC_KN ,NRW_KN,IRW_KN ,IBFV ,
2447 . SKEW ,XFRAME ,IRBE3 ,LRBE3 ,NRBE3_KN,
2448 . IRBE3_KN,ID_KNM3,RKN_MAX,FCDI_KN,MCDI_KN,
2449 . NSPC_KN,ISPC_KN ,IRBE2 ,LRBE2 ,NRBE2_KN,
2450 . IRBE2_KN,ID_KNM4)
2451 CALL ZEROR(A,NUMNOD)
2452 IF ((NRB_KN+NI2_KN+NRBE3_KN)>0) CALL ZEROR(AR,NUMNOD)
2453C----------------
2454 IF (IUPD>0) THEN
2455 CALL INT_FKU3(A ,V ,MS ,D ,
2456 1 IPARI ,INTBUF_TAB ,X_IMP,NUM_IMP,
2457 2 NS_IMP ,NE_IMP ,INDEX2,IUPD )
2458 CALL IMP3_A2B(IPARI ,INTBUF_TAB ,NDOF ,X_IMP ,
2459 1 A ,AR ,NUMN_KN,IN_KN,ID_KN ,
2460 2 NRB_KN ,IRB_KN ,ID_KNM ,NI2_KN,II2_KN,
2461 3 ID_KNM2,NFX_KN ,IFX_KN ,NBC_KN,IBC_KN,
2462 4 NRW_KN ,IRW_KN ,IBFV ,SKEW ,XFRAME,
2463 5 F ,IRBE3 ,LRBE3 ,NRBE3_KN,IRBE3_KN,
2464 6 ID_KNM3,RKN_MAX,FCDI_KN,MCDI_KN,NSPC_KN,
2465 7 ISPC_KN,IRBE2 ,LRBE2 ,NRBE2_KN,IRBE2_KN,
2466 . ID_KNM4)
2467 ELSE
2468 CALL INT_FKU3(A ,V ,MS ,D ,
2469 1 IPARI ,INTBUF_TAB ,X ,NUM_IMP,
2470 2 NS_IMP ,NE_IMP ,INDEX2 ,IUPD )
2471 CALL IMP3_A2B(IPARI ,INTBUF_TAB ,NDOF ,X ,
2472 1 A ,AR ,NUMN_KN,IN_KN,ID_KN ,
2473 2 NRB_KN ,IRB_KN ,ID_KNM ,NI2_KN,II2_KN,
2474 3 ID_KNM2,NFX_KN ,IFX_KN ,NBC_KN,IBC_KN,
2475 4 NRW_KN ,IRW_KN ,IBFV ,SKEW ,XFRAME,
2476 5 F ,IRBE3 ,LRBE3 ,NRBE3_KN,IRBE3_KN,
2477 6 ID_KNM3,RKN_MAX,FCDI_KN,MCDI_KN,NSPC_KN,
2478 7 ISPC_KN,IRBE2 ,LRBE2 ,NRBE2_KN,IRBE2_KN,
2479 . ID_KNM4)
2480 ENDIF
2481 RETURN
2482 END
2483!||====================================================================
2484!|| int_matvp ../engine/source/implicit/imp_int_k.F
2485!||--- called by ------------------------------------------------------
2486!|| mav_lth ../engine/source/implicit/produt_v.F
2487!|| mav_lth0 ../engine/source/implicit/produt_v.F
2488!|| mav_ltp ../engine/source/implicit/produt_v.F
2489!||--- calls -----------------------------------------------------
2490!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
2491!|| imp3_u2x ../engine/source/airbag/monv_imp0.F
2492!|| int_fku3 ../engine/source/implicit/imp_int_k.F
2493!|| spmd_ifcd ../engine/source/mpi/implicit/imp_spmd.F
2494!|| spmd_ifcf ../engine/source/mpi/implicit/imp_spmd.F
2495!|| zeror ../engine/source/system/zero.F
2496!||--- uses -----------------------------------------------------
2497!|| imp_intm ../engine/share/modules/imp_intm.F
2498!|| imp_knon ../engine/share/modules/impbufdef_mod.F
2499!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2500!||====================================================================
2501 SUBROUTINE INT_MATVP(IPARI ,INTBUF_TAB ,NDOF ,NUM_IMP,
2502 1 NS_IMP ,NE_IMP ,INDEX2 ,A ,AR ,
2503 2 V ,X ,MS ,X_IMP ,IBFV ,
2504 3 SKEW ,XFRAME ,U ,F ,DR ,
2505 4 NSREM ,NSL ,IUPD ,IRBE3 ,LRBE3 ,
2506 5 IRBE2 ,LRBE2 )
2507C-----------------------------------------------
2508C M o d u l e s
2509C-----------------------------------------------
2510 USE IMP_KNON
2511 USE IMP_INTM
2512 USE INTBUFDEF_MOD
2513C-----------------------------------------------
2514C I m p l i c i t T y p e s
2515C-----------------------------------------------
2516#include "implicit_f.inc"
2517C-----------------------------------------------
2518C C o m m o n B l o c k s
2519C-----------------------------------------------
2520#include "com04_c.inc"
2521#include "param_c.inc"
2522C-----------------------------------------------
2523C D u m m y A r g u m e n t s
2524C-----------------------------------------------
2525 INTEGER IPARI(NPARI,*), INDEX2(*),NSREM ,NSL
2526 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IBFV(*),IUPD,NDOF(*),
2527 . IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
2528 my_real
2529 . X(3,*),A(3,*),AR(3,*), F(*), U(*),
2530 . X_IMP(3,*),SKEW(*) ,XFRAME(*),DR(3,*),V(3,*),MS(*)
2531
2532 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2533C-----------------------------------------------
2534C L o c a l V a r i a b l e s
2535C-----------------------------------------------
2536 INTEGER I, J,N,K,K1,KK1,N1,N2,N3,N4,ID,IAD,IS,NN,NTY
2537 my_real
2538 . D(3,NUMNOD)
2539C----------------actualise D,X_IMP---------------------
2540 CALL IMP3_U2X(X ,IPARI ,INTBUF_TAB ,NDOF ,
2541 . U ,D ,AR ,X_IMP ,NUMN_KN,
2542 . IN_KN ,ID_KN ,NRB_KN ,IRB_KN,ID_KNM ,
2543 . NI2_KN,II2_KN ,ID_KNM2,NFX_KN,IFX_KN ,
2544 . NBC_KN,IBC_KN ,NRW_KN,IRW_KN ,IBFV ,
2545 . SKEW ,XFRAME ,IRBE3 ,LRBE3 ,NRBE3_KN,
2546 . IRBE3_KN,ID_KNM3,RKN_MAX,FCDI_KN,MCDI_KN,
2547 . NSPC_KN,ISPC_KN ,IRBE2 ,LRBE2 ,NRBE2_KN,
2548 . IRBE2_KN,ID_KNM4)
2549 CALL ZEROR(A,NUMNOD)
2550 IF ((NRB_KN+NI2_KN+NRBE3_KN)>0) CALL ZEROR(AR,NUMNOD)
2551C----- Return of (nsl) and Receive DFI (nsrem) ------
2552 IF ((NSREM+NSL)>0) THEN
2553 CALL SPMD_IFCD(D ,NSL, NSREM)
2554 IF (NSREM>0) CALL ZEROR(FFI,NSREM)
2555 ENDIF
2556C----------------
2557 IF (IUPD>0) THEN
2558 CALL INT_FKU3(A ,V ,MS ,D ,
2559 1 IPARI ,INTBUF_TAB,X_IMP,NUM_IMP,
2560 2 NS_IMP ,NE_IMP ,INDEX2,IUPD )
2561 IF ((NSREM+NSL)>0) CALL SPMD_IFCF(A, NSREM ,NSL)
2562 CALL IMP3_A2B(IPARI ,INTBUF_TAB ,NDOF ,X_IMP ,
2563 1 A ,AR ,NUMN_KN,IN_KN,ID_KN ,
2564 2 NRB_KN ,IRB_KN ,ID_KNM ,NI2_KN,II2_KN,
2565 3 ID_KNM2,NFX_KN ,IFX_KN ,NBC_KN,IBC_KN,
2566 4 NRW_KN ,IRW_KN ,IBFV ,SKEW ,XFRAME,
2567 5 F ,IRBE3 ,LRBE3 ,NRBE3_KN,IRBE3_KN,
2568 6 ID_KNM3,RKN_MAX,FCDI_KN,MCDI_KN,NSPC_KN,
2569 7 ISPC_KN,IRBE2 ,LRBE2 ,NRBE2_KN,IRBE2_KN,
2570 . ID_KNM4)
2571 ELSE
2572 CALL INT_FKU3(A ,V ,MS ,D ,
2573 1 IPARI ,INTBUF_TAB ,X ,NUM_IMP,
2574 2 NS_IMP ,NE_IMP ,INDEX2 ,IUPD )
2575 IF ((NSREM+NSL)>0) CALL SPMD_IFCF(A, NSREM ,NSL)
2576 CALL IMP3_A2B(IPARI ,INTBUF_TAB ,NDOF ,X ,
2577 1 A ,AR ,NUMN_KN,IN_KN,ID_KN ,
2578 2 NRB_KN ,IRB_KN ,ID_KNM ,NI2_KN,II2_KN,
2579 3 ID_KNM2,NFX_KN ,IFX_KN ,NBC_KN,IBC_KN,
2580 4 NRW_KN ,IRW_KN ,IBFV ,SKEW ,XFRAME,
2581 5 F ,IRBE3 ,LRBE3 ,NRBE3_KN,IRBE3_KN,
2582 6 ID_KNM3,RKN_MAX,FCDI_KN,MCDI_KN,NSPC_KN,
2583 7 ISPC_KN,IRBE2 ,LRBE2 ,NRBE2_KN,IRBE2_KN,
2584 . ID_KNM4)
2585 ENDIF
2586 RETURN
2587 END
2588!||====================================================================
2589!|| int_fku3 ../engine/source/implicit/imp_int_k.F
2590!||--- called by ------------------------------------------------------
2591!|| int_matv ../engine/source/implicit/imp_int_k.F
2592!|| int_matvp ../engine/source/implicit/imp_int_k.F
2593!||--- calls -----------------------------------------------------
2594!|| i10fku3 ../engine/source/interfaces/int10/i10ke3.F
2595!|| i11fku3 ../engine/source/interfaces/int11/i11ke3.F
2596!|| i7fku3 ../engine/source/interfaces/int07/i7ke3.F
2597!||--- uses -----------------------------------------------------
2598!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2599!||====================================================================
2600 SUBROUTINE INT_FKU3(A ,V ,MS ,D ,IPARI ,
2601 1 INTBUF_TAB ,X ,NUM_IMP,NS_IMP ,
2602 1 NE_IMP ,INDEX2 ,IUPD )
2603C-----------------------------------------------
2604C M o d u l e s
2605C-----------------------------------------------
2606 USE INTBUFDEF_MOD
2607C-----------------------------------------------
2608C I m p l i c i t T y p e s
2609C-----------------------------------------------
2610#include "implicit_f.inc"
2611C-----------------------------------------------
2612C C o m m o n B l o c k s
2613C-----------------------------------------------
2614#include "com04_c.inc"
2615#include "param_c.inc"
2616C-----------------------------------------------
2617C D u m m y A r g u m e n t s
2618C-----------------------------------------------
2619 INTEGER IPARI(NPARI,*), INDEX2(*)
2620 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IUPD
2621 my_real
2622 . X(3,*),A(3,*),D(3,*), MS(*),V(3,*)
2623
2624 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2625C-----------------------------------------------
2626C L o c a l V a r i a b l e s
2627C-----------------------------------------------
2628 INTEGER I, J,N,K,K1,ID,IAD,IS,NN,NTY,I_INT7
2629C
2630 IAD = 1
2631C-----------int5 first-------------
2632 DO N=1,NINTER
2633 NTY =IPARI(7,N)
2634 IF(NTY==7) THEN
2635 CALL I7FKU3( A ,V ,MS ,D ,
2636 1 IPARI ,INTBUF_TAB(N),X ,N ,
2637 2 NUM_IMP(N),NS_IMP(IAD),NE_IMP(IAD) ,INDEX2(IAD),IUPD )
2638 IAD=IAD+NUM_IMP(N)
2639 ELSEIF(NTY==10)THEN
2640 CALL I10FKU3( A ,V ,MS ,D ,
2641 1 IPARI(1,N),INTBUF_TAB(N) ,X ,N ,
2642 2 NUM_IMP(N),NS_IMP(IAD),NE_IMP(IAD) ,INDEX2(IAD),IUPD )
2643 IAD=IAD+NUM_IMP(N)
2644 ELSEIF(NTY==11)THEN
2645 CALL I11FKU3( A ,V ,MS ,D ,
2646 1 IPARI(1,N),INTBUF_TAB(N) ,X ,N ,
2647 2 NUM_IMP(N),NS_IMP(IAD),NE_IMP(IAD) ,IUPD )
2648 IAD=IAD+NUM_IMP(N)
2649 ENDIF
2650 ENDDO
2651c IMP_INT7 = I_INT7
2652C
2653 RETURN
2654 END
2655!||====================================================================
2656!|| pr_kint ../engine/source/implicit/imp_int_k.F
2657!||====================================================================
2658 SUBROUTINE PR_KINT(NDDLI ,IMCONV,
2659 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I )
2660C-----------------------------------------------
2661C I m p l i c i t T y p e s
2662C-----------------------------------------------
2663#include "implicit_f.inc"
2664C-----------------------------------------------
2665C C o m m o n B l o c k s
2666C-----------------------------------------------
2667#include "task_c.inc"
2668C-----------------------------------------------
2669C D u m m y A r g u m e n t s
2670C-----------------------------------------------
2671C REAL
2672 INTEGER
2673 . NDDLI,IADI(*),JDII(*),ITOK(*),IMCONV
2674 my_real
2675 . DIAG_I(*),LT_I(*)
2676C-----------------------------------------------
2677C L o c a l V a r i a b l e s
2678C-----------------------------------------------
2679Ctmp +3
2680 INTEGER i,j,N,ID,ND,NKC,IDF,nnod,nk,iad,iad2,id2
2681 CHARACTER CHIF
2682 CHARACTER*10 FILNAME
2683C------
2684 IDF = ispmd+13
2685 WRITE(CHIF,'(i1)')ispmd
2686 FILNAME='kint'//CHIF//'.tmp'
2687 OPEN(UNIT=IDF,FILE=FILNAME,STATUS='unknown',FORM='formatted')
2688 write(IDF,*)'nddli,=', NDDLI
2689 if (IMCONV<0) return
2690 write(IDF,*)'[ki]=',NDDLI
2691 DO I =1,NDDLI
2692 write(IDF,*)'diag_i,itok=',DIAG_I(I),ITOK(I)
2693 ENDDO
2694 DO I =1,NDDLI
2695 write(IDF,*)'nr,i=',IADI(I+1)-IADI(I),I
2696 DO J=IADI(I),IADI(I+1)-1
2697 write(IDF,*)'lt_i,nj,j=',LT_I(J),ITOK(JDII(J)),J
2698 ENDDO
2699 ENDDO
2700C------------------------------------------
2701 RETURN
2702 END
my_real
#define my_real
Definition cppsort.cpp:32
imp_i10mainf
subroutine imp_i10mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, ind_imp)
Definition i10ke3.F:435
i10ke3
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
i10main_tri
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
i10main_opt_tri
subroutine i10main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
Definition i10opt_opt_tri.F:36
imp_i11mainf
subroutine imp_i11mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, itab)
Definition i11ke3.F:309
i11ke3
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
i11main_crit_tri
subroutine i11main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
Definition i11main_crit_tri.F:37
i11main_opt_tri
subroutine i11main_opt_tri(ipari, intbuf_tab, x, v, nin, itask, count_remslv, lskyi_sms_new)
Definition i11main_opt_tri.F:37
i11main_tri
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
i20main_opt_tri
subroutine i20main_opt_tri(ipari, x, v, nin, itask, count_remslv, count_remslve, intbuf_tab)
Definition i20main_opt_tri.F:38
i20main_tri
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
i24ke3
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
i5ke3
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
i7ke3
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
imp_i7mainf
subroutine imp_i7mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, ind_imp)
Definition i7ke3.F:403
i7main_crit_tri
subroutine i7main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
Definition i7main_crit_tri.F:37
i7main_opt_tri
subroutine i7main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
Definition i7main_opt_tri.F:37
i7main_tri
subroutine i7main_tri(timers, ipari, x, v, ms, nin, itask, 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:67
iddl_mint
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:2194
imp_rnumcd
subroutine imp_rnumcd(cand_n, nin, nsn, num_imp, index)
Definition imp_int_k.F:1550
cp_inttd
subroutine cp_inttd(nt_imp1, numimp, ns_imp, ne_imp, ind_imp, numimp1)
Definition imp_int_k.F:1387
imp_icomcrit
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
imp_intdt
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
imp_i7xv
subroutine imp_i7xv(x, nsv, msr, nsn, nmn, stfn, x_tmp, d, dr, v, vr, facd, facv)
Definition imp_int_k.F:996
imp_inttd0
subroutine imp_inttd0(output, 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:732
rbe3_mint
subroutine rbe3_mint(irbe3, lrbe3, frbe3, x, skew, nrbe3_kn, irbe3_kn, frcdi, mrcdi)
Definition imp_int_k.F:2349
sav_inttd
subroutine sav_inttd(nt_imp, numimp, ns_imp, ne_imp, ind_imp, numimp1)
Definition imp_int_k.F:1443
imp_tripi
subroutine imp_tripi(output, 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:1114
kin_knl
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:1703
dim_kinkn
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:1866
imp_dtkin
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:1596
ini_kinkn
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:2006
imp_i11xv
subroutine imp_i11xv(x, nsv, msr, nsn, nmn, x_tmp, d, dr, v, vr, facd, facv)
Definition imp_int_k.F:914
imp_int_k
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
spmd_min_s
subroutine spmd_min_s(s)
Definition imp_spmd.F:1273
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311
imp_aspc
Definition impbufdef_mod.F:526
imp_aspc::ic_spc
integer, dimension(:), allocatable ic_spc
Definition impbufdef_mod.F:529
imp_aspc::nspcl
integer nspcl
Definition impbufdef_mod.F:527
imp_knon
Definition impbufdef_mod.F:488
imp_knon::nbc_kn
integer nbc_kn
Definition impbufdef_mod.F:490
imp_knon::rkn_max
integer rkn_max
Definition impbufdef_mod.F:490
imp_knon::numn_kn
integer numn_kn
Definition impbufdef_mod.F:490
imp_knon::nrbe3_kn
integer nrbe3_kn
Definition impbufdef_mod.F:490
imp_knon::id_knm4
integer, dimension(:,:), allocatable id_knm4
Definition impbufdef_mod.F:493
imp_knon::irb_kn
integer, dimension(:,:), allocatable irb_kn
Definition impbufdef_mod.F:495
imp_knon::id_knm2
integer, dimension(:,:,:), allocatable id_knm2
Definition impbufdef_mod.F:494
imp_knon::ispc_kn
integer, dimension(:), allocatable ispc_kn
Definition impbufdef_mod.F:497
imp_knon::irw_kn
integer, dimension(:), allocatable irw_kn
Definition impbufdef_mod.F:497
imp_knon::id_kn
integer, dimension(:,:), allocatable id_kn
Definition impbufdef_mod.F:493
imp_knon::in_kn
integer, dimension(:), allocatable in_kn
Definition impbufdef_mod.F:492
imp_knon::ibc_kn
integer, dimension(:,:), allocatable ibc_kn
Definition impbufdef_mod.F:496
imp_knon::irbe2_kn
integer, dimension(:,:), allocatable irbe2_kn
Definition impbufdef_mod.F:495
imp_knon::ii2_kn
integer, dimension(:,:), allocatable ii2_kn
Definition impbufdef_mod.F:495
imp_knon::id_knm
integer, dimension(:,:), allocatable id_knm
Definition impbufdef_mod.F:493
imp_knon::nspc_kn
integer nspc_kn
Definition impbufdef_mod.F:490
imp_knon::ni2_kn
integer ni2_kn
Definition impbufdef_mod.F:490
imp_knon::nrw_kn
integer nrw_kn
Definition impbufdef_mod.F:490
imp_knon::id_knm3
integer, dimension(:,:,:), allocatable id_knm3
Definition impbufdef_mod.F:494
imp_knon::nfx_kn
integer nfx_kn
Definition impbufdef_mod.F:490
imp_knon::nrbe2_kn
integer nrbe2_kn
Definition impbufdef_mod.F:490
imp_knon::ifx_kn
integer, dimension(:,:), allocatable ifx_kn
Definition impbufdef_mod.F:496
imp_knon::irbe3_kn
integer, dimension(:), allocatable irbe3_kn
Definition impbufdef_mod.F:497
imp_knon::nrb_kn
integer nrb_kn
Definition impbufdef_mod.F:490
imp_rwl
Definition impbufdef_mod.F:387
imp_rwl::in_rwl
integer, dimension(:), allocatable in_rwl
Definition impbufdef_mod.F:391
imp_rwl::n_rwl
integer n_rwl
Definition impbufdef_mod.F:389
impbufdef_mod
Definition impbufdef_mod.F:36
cp_int
subroutine cp_int(n, x, xc)
Definition produt_v.F:916
spmd_get_stif11
subroutine spmd_get_stif11(newfront, i_stok, cand_s, stfs, nrts, nin, isendto, ircvfrom, irects, itab)
Definition send_cand.F:566
spmd_get_stif
subroutine spmd_get_stif(newfront, i_stok, cand_n, stfn, nsn, nin, isendto, ircvfrom, nsv, itab)
Definition send_cand.F:156
spmd_i7xvcom2
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, ish_offset)
Definition spmd_i7xvcom2.F:57
spmd_ifront
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
spmd_sd_xv
subroutine spmd_sd_xv(output, x, d, v, vr, ms, in, iad_elem, fr_elem, weight, imsch, w, isizxv, ilenxv, xdp)
Definition spmd_sd_xv.F:42
spmd_sync_mmx
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)
Definition spmd_sync_mmx.F:36
nl
character *2 function nl()
Definition message.F:2360
upd_int_k
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