OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i18main_kine.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!|| i18main_kine_1 ../engine/source/interfaces/int18/i18main_kine.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| i18_kine_m ../engine/source/interfaces/int18/i18main_kine.F
29!|| i18main_kine_f ../engine/source/interfaces/int18/i18main_kine.F
30!|| i18main_kine_i ../engine/source/interfaces/int18/i18main_kine.F
31!|| my_barrier ../engine/source/system/machine.F
32!|| spmd_i18kine_com_acc ../engine/source/mpi/interfaces/spmd_i18kine_com_acc.F
33!|| spmd_i18kine_com_ms ../engine/source/mpi/interfaces/spmd_i18kine_com_ms.F
34!|| spmd_i18kine_macc_com_poff ../engine/source/mpi/interfaces/spmd_i18kine_macc_com_poff.F
35!|| spmd_i18kine_msf_com_poff ../engine/source/mpi/interfaces/spmd_i18kine_msf_com_poff.F
36!|| spmd_i18kine_pene_com_poff ../engine/source/mpi/interfaces/spmd_i18kine_pene_com_poff.F
37!||--- uses -----------------------------------------------------
38!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
39!|| array_mod ../common_source/modules/array_mod.f
40!|| h3d_mod ../engine/share/modules/h3d_mod.F
41!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
42!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
43!|| output_mod ../common_source/modules/output/output_mod.F90
44!|| tri7box ../engine/share/modules/tri7box.F
45!||====================================================================
46 SUBROUTINE i18main_kine_1(output, IPARI ,INTBUF_TAB ,X ,V ,
47 2 A ,ISKEW ,SKEW ,LCOD ,WA ,
48 3 MS ,ITAB ,JTASK ,KINET ,STIFN ,
49 4 MTF ,CAND_SAV ,INT18ADD ,IAD_ELEM ,FR_ELEM ,
50 5 TAGPENE ,H3D_DATA ,MULTI_FVM,ALE_NE_CONNECT,XCELL,XCELL_REMOTE)
51C-----------------------------------------------
52C D e s c r i p t i o n
53C-----------------------------------------------
54C This subroutine is a 'kinematic version' of coupling interface type 18
55C It is an old and experimental version which has never been released (abandoned)
56C Principle : Structural velocity is imposing fluid velocity
57C Starter Keyword : /INTER/TYPE18/KINE
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE tri7box
62 USE intbufdef_mod
63 USE h3d_mod
64 USE multi_fvm_mod
65 USE ale_connectivity_mod
66 USE output_mod
67 USE array_mod
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "com01_c.inc"
76#include "com04_c.inc"
77#include "com08_c.inc"
78#include "param_c.inc"
79#include "task_c.inc"
80#include "warn_c.inc"
81#include "tabsiz_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 type(output_), intent(inout) :: output
86 INTEGER IPARI(NPARI,*), ISKEW(*), LCOD(*), ITAB(*),
87 . KINET(*),INT18ADD(*),JTASK,IAD_ELEM(2,*),FR_ELEM(*),TAGPENE(*)
88 my_real
89 . x(*), v(*), a(3,*), skew(*), wa(*), ms(*),
90 . mtf(14,*),cand_sav(*),stifn(*),xcell(3,sxcell)
91 TYPE(intbuf_struct_) INTBUF_TAB(*)
92 TYPE(h3d_database) :: H3D_DATA
93 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
94 TYPE(t_connectivity), INTENT(IN) :: ALE_NE_CONNECT
95 TYPE(array_type), DIMENSION(NINTER), INTENT(in) :: XCELL_REMOTE !< remote data structure for interface 18
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 INTEGER I,NODF,NODL,NRTMDIM
100 INTEGER N, NTY, NMN, INACTI,LINDMAX
101 INTEGER NB_JLT(PARASIZ),NB_JLT_NEW(PARASIZ),NB_STOK_N(PARASIZ),
102 * P,NODFI,IERROR1,IERROR2,IERROR3,IERROR4
103 my_real
104 . startt,stopt,bid,vbid
105 SAVE nb_jlt,nb_jlt_new,nb_stok_n
106C=======================================================================
107C initialisation MTF(1:14,1:NUMNOD)
108C=======================================================================
109C
110c
111c To be reached on mains only
112 nodf = 1 + (jtask-1)*numnod / nthread
113 nodl = jtask*numnod / nthread
114 DO i = nodf,nodl
115 mtf(1,i) = zero ! Mxx mains
116 mtf(2,i) = zero ! Mxy mains
117 mtf(3,i) = zero ! Mxz mains
118 mtf(4,i) = zero ! Myy mains
119 mtf(5,i) = zero ! Myz mains
120 mtf(6,i) = zero ! Mzz mains
121 mtf(7,i) = zero ! Fx mains
122 mtf(8,i) = zero ! Fy mains
123 mtf(9,i) = zero ! Fz mains
124 mtf(10,i)= zero ! cumulative penetration on second
125c MTF(11,I)= EP30 ! Distance relative min
126 mtf(11,i)= zero ! pene max
127 mtf(12,i) = zero ! Nx second
128 mtf(13,i) = zero ! Ny second
129 mtf(14,i) = zero ! Nz second
130 ENDDO
131
132 IF (nspmd > 1)THEN
133c
134 DO n=1,ninter
135 nty=ipari(7,n)
136 inacti =ipari(22,n)
137C
138 IF (nty==7.AND.inacti==7.AND.ipari(34,n)==-2)THEN
139 nodfi=0
140 DO p = 1, nspmd
141 nodfi = nodfi + nsnfi(n)%P(p)
142 END DO
143
144 IF(nodfi > 0)THEN
145 IF(ASSOCIATED(mtfi_pene(n)%P)) DEALLOCATE(mtfi_pene(n)%P)
146 ALLOCATE(mtfi_pene(n)%P(nodfi),stat=ierror1)
147 mtfi_pene(n)%P(1:nodfi)=zero
148c
149 IF(ASSOCIATED(mtfi_penemin(n)%P))
150 * DEALLOCATE(mtfi_penemin(n)%P)
151 ALLOCATE(mtfi_penemin(n)%P(nodfi),stat=ierror2)
152 mtfi_penemin(n)%P(1:nodfi)=zero
153
154 IF(ASSOCIATED(mtfi_v(n)%P)) DEALLOCATE(mtfi_v(n)%P)
155 ALLOCATE(mtfi_v(n)%P(6,nodfi),stat=ierror3)
156 mtfi_v(n)%P(1,1:nodfi)=zero
157 mtfi_v(n)%P(2,1:nodfi)=zero
158 mtfi_v(n)%P(3,1:nodfi)=zero
159 mtfi_v(n)%P(4,1:nodfi)=zero
160 mtfi_v(n)%P(5,1:nodfi)=zero
161 mtfi_v(n)%P(6,1:nodfi)=zero
162
163 IF(ASSOCIATED(mtfi_a(n)%P)) DEALLOCATE(mtfi_a(n)%P)
164 ALLOCATE(mtfi_a(n)%P(7,nodfi),stat=ierror4)
165 mtfi_a(n)%P(1,1:nodfi)=zero
166 mtfi_a(n)%P(2,1:nodfi)=zero
167 mtfi_a(n)%P(3,1:nodfi)=zero
168 mtfi_a(n)%P(4,1:nodfi)=zero
169 mtfi_a(n)%P(5,1:nodfi)=zero
170 mtfi_a(n)%P(6,1:nodfi)=zero
171 mtfi_a(n)%P(7,1:nodfi)=zero
172
173 IF(ASSOCIATED(mtfi_n(n)%P)) DEALLOCATE(mtfi_n(n)%P)
174 ALLOCATE(mtfi_n(n)%P(3,nodfi),stat=ierror4)
175 mtfi_n(n)%P(1,1:nodfi)=zero
176 mtfi_n(n)%P(2,1:nodfi)=zero
177 mtfi_n(n)%P(3,1:nodfi)=zero
178
179 IF(ASSOCIATED(i18kafi(n)%P)) DEALLOCATE(i18kafi(n)%P)
180 ALLOCATE(i18kafi(n)%P(3,nodfi),stat=ierror4)
181 i18kafi(n)%P(1,1:nodfi)=zero
182 i18kafi(n)%P(2,1:nodfi)=zero
183 i18kafi(n)%P(3,1:nodfi)=zero
184 ENDIF
185 ENDIF
186 ENDDO
187 tagpene(1:numnod)=0
188 ENDIF
189C -------------------
190 CALL my_barrier
191C -------------------
192 IF (nspmd > 1)THEN
193C MSFI (mass of second nodes is not updated
194C mass is needed for subsequent calculations
195 CALL spmd_i18kine_com_ms(ipari,intbuf_tab,mtf,ms,itab)
196 ENDIF
197C-----------------------------------------------
198C Interface Statistics
199 IF (debug(3) >= 1.AND.ncycle == 0) THEN
200 nb_jlt(jtask) = 0
201 nb_jlt_new(jtask) = 0
202 nb_stok_n(jtask) = 0
203 ENDIF
204C=======================================================================
205C calculation of cumulative penetrations ...
206C MTF(10,i) pene cumulee
207C MTF(11,i) dist min relative
208C MTF(12:14,i) normales cumulee
209C=======================================================================
210 DO n=1,ninter
211 nty =ipari(7,n)
212 inacti =ipari(22,n)
213C LINDMAX = NCONT*MULTIMP
214 lindmax = ipari(18,n)*ipari(23,n)
215 IF(nty==7.and.ipari(34,n)==-2.and.inacti==7)THEN
216 nrtmdim=ipari(4,n)
217 nmn =ipari(6,n)
218 CALL i18main_kine_i(
219 1 n ,ipari(1,n) ,intbuf_tab(n) ,x ,
220 2 stifn ,v ,a ,ms , nmn ,
221 3 itab ,lindmax ,cand_sav(int18add(n)) ,mtf , ale_ne_connect ,
222 4 nrtmdim ,jtask ,nb_jlt(jtask) ,nb_jlt_new(jtask),n b_stok_n(jtask),
223 5 kinet ,multi_fvm ,xcell,xcell_remote(n)%SIZE_MY_REAL_ARRAY_1D,
224 . xcell_remote(n)%MY_REAL_ARRAY_1D)
225 ENDIF
226 ENDDO
227C=======================================================================
228!$OMP SINGLE
229
230C Comm spmd: mtf (10,*) = sum of the pene
231C Comm spmd: mtf (11,*) = min relative distances
232C Comm SPMD: MTF (12:14,*) = IS NORMALS
233c 1: send to the proc that owns the node
234c 2: accumulate (or min) on secondary 18 boundary nodes
235c 2: accumulate on secondary 18 boundary nodes
236 IF (nspmd > 1)THEN
237 CALL spmd_i18kine_pene_com_poff(output, ipari,intbuf_tab,vbid,
238 * mtf,a,iad_elem,fr_elem,1,bid,tagpene,itab,
239 . h3d_data )
240
241c need accelerations for the second node
242c quand on a surface main, node second. distant
243c in the same case, return MTF_PENE+MTF_PENEMIN for
244c calculs suivants.
245
246 CALL spmd_i18kine_com_acc(ipari,intbuf_tab,mtf,a,itab,tagpene)
247 ENDIF
248!$OMP END SINGLE
249C=======================================================================
250C calculation of forces and masses to be transmitted to the mains
251c ponderation en pene/somme(pene)
252C=======================================================================
253C -------------------
254 CALL my_barrier
255C -------------------
256 DO n=1,ninter
257 nty =ipari(7,n)
258 inacti =ipari(22,n)
259 IF(nty==7.and.ipari(34,n)==-2.and.inacti==7)THEN
260 CALL i18main_kine_f( n,
261 1 ipari(1,n) ,intbuf_tab(n) ,x ,stifn ,
262 2 v ,a ,ms ,itab ,lindmax ,
263 3 cand_sav(int18add(n)),mtf ,jtask ,nb_jlt(jtask) ,nb_jlt_new(jtask),
264 4 nb_stok_n(jtask) )
265 ENDIF
266 ENDDO
267C=======================================================================
268C Comm spmd: mtf (1: 9,*) = masses and main forces
269C comm on main int 18 boundary nodes
270!$OMP SINGLE
271 IF (nspmd > 1)THEN
272 CALL spmd_i18kine_msf_com_poff(mtf,iad_elem,fr_elem,itab)
273 ENDIF
274!$OMP END SINGLE
275C=======================================================================
276C calculation of new accelerations of the mains
277C=======================================================================
278C -------------------
279 CALL my_barrier
280C -------------------
281 DO n=1,ninter
282 nty =ipari(7,n)
283 inacti =ipari(22,n)
284 IF(nty==7.and.ipari(34,n)==-2.and.inacti==7)THEN
285 nmn =ipari(6,n)
286 startt=intbuf_tab(n)%VARIABLES(3)
287 stopt =intbuf_tab(n)%VARIABLES(11)
288 IF(tt >= startt .and. tt <= stopt)THEN
289 CALL i18_kine_m(
290 1 jtask-1 ,nmn ,intbuf_tab(n)%MSR,v ,a ,ms ,
291 2 mtf ,iskew ,skew ,lcod ,itab )
292 ENDIF
293 ENDIF
294 ENDDO
295C=======================================================================
296c if MTF(1,*) /= 0 the node is main int 18 on this proc
297c and maybe used as flag
298
299c => send MTF(1,*) and A(1:3,*) for ALL boundary nodes
300c in reception if mtf (received) is not zero
301c => ecraser A(local) par A(recu)
302!$OMP SINGLE
303 IF(nspmd > 1) CALL spmd_i18kine_macc_com_poff(mtf,a,iad_elem,fr_elem,itab)
304!$OMP END SINGLE
305C=======================================================================
306
307 RETURN
308C
309 END
310!||====================================================================
311!|| i18main_kine_2 ../engine/source/interfaces/int18/i18main_kine.F
312!||--- called by ------------------------------------------------------
313!|| resol ../engine/source/engine/resol.F
314!||--- calls -----------------------------------------------------
315!|| i18main_kine_s ../engine/source/interfaces/int18/i18main_kine.F
316!|| i18main_kine_v ../engine/source/interfaces/int18/i18main_kine.F
317!|| my_barrier ../engine/source/system/machine.F
318!|| spmd_i18kine_com_a ../engine/source/mpi/interfaces/spmd_i18kine_com_a.F
319!|| spmd_i18kine_com_v ../engine/source/mpi/interfaces/spmd_i18kine_com_v.F
320!|| spmd_i18kine_pene_com_poff ../engine/source/mpi/interfaces/spmd_i18kine_pene_com_poff.F
321!||--- uses -----------------------------------------------------
322!|| h3d_mod ../engine/share/modules/h3d_mod.F
323!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
324!|| output_mod ../common_source/modules/output/output_mod.F90
325!|| tri7box ../engine/share/modules/tri7box.F
326!||====================================================================
327 SUBROUTINE i18main_kine_2(output,IPARI,INTBUF_TAB ,X ,V ,
328 2 A ,ISKEW ,SKEW ,LCOD ,WA ,
329 3 MS ,ITAB ,FSAV ,JTASK ,KINET ,
330 4 STIFN,MTF ,CAND_SAV,FCONT ,INT18ADD,
331 5 IAD_ELEM,FR_ELEM,H3D_DATA)
332C-----------------------------------------------
333C M o d u l e s
334C-----------------------------------------------
335 use output_mod
336 USE tri7box
337 USE intbufdef_mod
338 USE h3d_mod
339C-----------------------------------------------
340C I m p l i c i t T y p e s
341C-----------------------------------------------
342#include "implicit_f.inc"
343C-----------------------------------------------
344C C o m m o n B l o c k s
345C-----------------------------------------------
346#include "com01_c.inc"
347#include "com04_c.inc"
348#include "param_c.inc"
349#include "task_c.inc"
350C-----------------------------------------------
351C D u m m y A r g u m e n t s
352C-----------------------------------------------
353 type(output_), intent(inout) :: output
354 INTEGER IPARI(NPARI,*), ISKEW(*), LCOD(*), ITAB(*),
355 . KINET(*),INT18ADD(*),JTASK,IAD_ELEM(2,*),FR_ELEM(*)
356 my_real
357 . X(*), V(*), A(3,*), SKEW(*), WA(*), MS(*),
358 . FSAV(NTHVKI,*),MTF(14,*),CAND_SAV(*),STIFN(*),
359 . FCONT(3,*)
360 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
361 TYPE(h3d_database) :: H3D_DATA
362C-----------------------------------------------
363C L o c a l V a r i a b l e s
364C-----------------------------------------------
365 INTEGER I,NODF,NODL
366 INTEGER N, NTY, INACTI
367 INTEGER NB_JLT(PARASIZ),NB_JLT_NEW(PARASIZ),NB_STOK_N(PARASIZ),
368 * p,nodfi,ibid
369 SAVE nb_jlt,nb_jlt_new,nb_stok_n
370 INTEGER, DIMENSION(:), ALLOCATABLE :: SLVNDTAG
371C=======================================================================
372C initialisation MTF(1:14,1:NUMNOD)
373C=======================================================================
374 IF (nspmd > 1)THEN
375 ALLOCATE(slvndtag(numnod))
376 slvndtag = 0
377 ELSE
378 ALLOCATE(slvndtag(1))
379 slvndtag = 0
380 ENDIF
381C=======================================================================
382C velocity calculation to be imposed on the second
383c ponderation en pene/somme(pene)
384C=======================================================================
385C -------------------
386 CALL my_barrier
387C -------------------
388 nodf = 1 + (jtask-1)*numnod / nthread
389 nodl = jtask*numnod / nthread
390 DO i = nodf,nodl
391 mtf(1,i) = zero ! VX Second.main
392 mtf(2,i) = zero ! Vy second.main
393 mtf(3,i) = zero ! Vz second.main
394 mtf(4,i) = zero ! vxp second. old (v+a*dt)
395 mtf(5,i) = zero ! vyp second. old (v+a*dt)
396 mtf(6,i) = zero ! vzp second. old (v+a*dt)
397 ENDDO
398
399!$OMP SINGLE
400 IF (nspmd > 1)THEN
401 DO n=1,ninter
402 nty=ipari(7,n)
403 inacti =ipari(22,n)
404C
405 IF (nty==7.AND.inacti==7.AND.ipari(34,n)==-2)THEN
406 nodfi=0
407 DO p = 1, nspmd
408 nodfi = nodfi + nsnfi(n)%P(p)
409 END DO
410
411 IF(nodfi > 0)THEN
412 mtfi_v(n)%P(1,1:nodfi)=zero
413 mtfi_v(n)%P(2,1:nodfi)=zero
414 mtfi_v(n)%P(3,1:nodfi)=zero
415 mtfi_v(n)%P(4,1:nodfi)=zero
416 mtfi_v(n)%P(5,1:nodfi)=zero
417 mtfi_v(n)%P(6,1:nodfi)=zero
418 ENDIF
419
420 ENDIF
421 ENDDO
422
423 ENDIF
424
425 IF (nspmd > 1)
426 * CALL spmd_i18kine_com_a(ipari,intbuf_tab,a,itab)
427!$OMP END SINGLE
428C -------------------
429 CALL my_barrier
430C -------------------
431 DO n=1,ninter
432 nty =ipari(7,n)
433 inacti =ipari(22,n)
434 IF(nty==7.and.ipari(34,n)==-2.and.inacti==7)THEN
435 CALL i18main_kine_v(n,
436 1 ipari(1,n) ,intbuf_tab(n) ,x ,stifn ,
437 2 v ,a ,ms ,jtask ,itab ,
438 3 cand_sav(int18add(n)),mtf ,iskew ,skew ,lcod ,
439 4 nb_jlt(jtask) ,nb_jlt_new(jtask),nb_stok_n(jtask))
440 ENDIF
441 ENDDO
442C=======================================================================
443
444C a to perform:
445C COMM SPMD : MTF(1:6,*)= velocities
446
447c 1: send to proc which contain the fluid node
448c 2: cumul on boundary fluid nodes
449!$OMP SINGLE
450 IF (nspmd > 1)THEN
451 CALL spmd_i18kine_pene_com_poff(output, ipari,intbuf_tab,fcont,
452 * mtf,a,iad_elem,fr_elem,2,slvndtag,ibid,itab,
453 . h3d_data )
454C reset MTF_V on procs which do not have fluid node but have it as candidate
455 CALL spmd_i18kine_com_v(ipari,intbuf_tab,mtf,a,itab)
456 ENDIF
457!$OMP END SINGLE
458
459C=======================================================================
460C=======================================================================
461C structural velocity imposed to fluid nodes
462C (corresponding acceleration)
463C=======================================================================
464C -------------------
465 CALL my_barrier
466C -------------------
467 DO n=1,ninter
468 nty =ipari(7,n)
469 inacti =ipari(22,n)
470 IF(nty==7.and.ipari(34,n)==-2.and.inacti==7)THEN
471 CALL i18main_kine_s(output, n,
472 1 ipari(1,n) ,intbuf_tab(n) ,x ,stifn ,
473 2 v ,a ,ms ,fsav(1,n) ,fcont ,
474 3 jtask ,itab ,cand_sav(int18add(n)),mtf ,
475 4 nb_jlt(jtask),nb_jlt_new(jtask),nb_stok_n(jtask) ,iskew ,skew ,
476 5 lcod ,slvndtag ,h3d_data )
477 ENDIF
478 ENDDO
479C=======================================================================
480!$OMP SINGLE
481C COMM SPMD : A(1:3,*)= acceleration des seconds
482
483c 1: send to the proc that owns the node that overwrites the acceleration
484 IF (nspmd > 1)THEN
485 CALL spmd_i18kine_pene_com_poff(output,ipari,intbuf_tab,fcont,
486 * mtf,a,iad_elem,fr_elem,3,slvndtag,ibid,itab,
487 . h3d_data)
488 ENDIF
489
490C=======================================================================
491
492 DEALLOCATE(slvndtag)
493!$OMP END SINGLE
494
495 RETURN
496C
497 END
498!||====================================================================
499!|| i18main_kine_i ../engine/source/interfaces/int18/i18main_kine.F
500!||--- called by ------------------------------------------------------
501!|| i18main_kine_1 ../engine/source/interfaces/int18/i18main_kine.F
502!||--- calls -----------------------------------------------------
503!|| ancmsg ../engine/source/output/message/message.F
504!|| arret ../engine/source/system/arret.F
505!|| i18dst3 ../engine/source/interfaces/int18/i18dst3.F
506!|| i18kine_i ../engine/source/interfaces/int18/i18main_kine.F
507!|| i7cdcor3 ../engine/source/interfaces/int07/i7cdcor3.F
508!|| i7cor3 ../engine/source/interfaces/int07/i7cor3.F
509!|| my_barrier ../engine/source/system/machine.F
510!||--- uses -----------------------------------------------------
511!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
512!|| i18dst3_mod ../engine/source/interfaces/int18/i18dst3.F
513!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
514!|| message_mod ../engine/share/message_module/message_mod.F
515!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
516!||====================================================================
517 SUBROUTINE i18main_kine_i(NIN,IPARI,INTBUF_TAB ,X ,
518 2 STIFN ,V ,A ,MS ,NMN ,
519 3 ITAB ,LINDMAX ,CAND_SAV ,MTF ,ALE_NE_CONNECT,
520 4 NRTMDIM ,JTASK ,NB_JLT ,NB_JLT_NEW ,NB_STOK_N,
521 5 KINET ,MULTI_FVM ,XCELL,S_XCELL_REMOTE,XCELL_REMOTE)
522C-----------------------------------------------
523C M o d u l e s
524C-----------------------------------------------
525 USE message_mod
526 USE intbufdef_mod
527 USE multi_fvm_mod
528 USE ale_connectivity_mod
529 USE i18dst3_mod , ONLY : i18dst3
530C-----------------------------------------------
531C D u m m y A r g u m e n t s
532C-------------------------------------------------------------------------------
533C NOM DIMENSION DESCRIPTION E/S
534C-------------------------------------------------------------------------------
535C NIN 1 INTERFACE NUMBER E
536C IPARI NPARI,NINTER PARAMETRES D'INTERFACE E
537C X 3,NUMNOD COORDONNEES E
538C V 3,NUMNOD VELOCITIES E
539C EMINX 6*NME<6*NUMELS MIN MAX DE CHAQUE ELEMENT TMP_GLOBAL
540C
541C-----------------------------------------------
542C I m p l i c i t T y p e s
543C-----------------------------------------------
544#include "implicit_f.inc"
545C-----------------------------------------------
546C G l o b a l P a r a m e t e r s
547C-----------------------------------------------
548#include "mvsiz_p.inc"
549#include "comlock.inc"
550C-----------------------------------------------
551C C o m m o n B l o c k s
552C-----------------------------------------------
553#include "com04_c.inc"
554#include "com08_c.inc"
555#include "param_c.inc"
556#include "task_c.inc"
557#include "warn_c.inc"
558#include "tabsiz_c.inc"
559C-----------------------------------------------
560C D u m m y A r g u m e n t s
561C-----------------------------------------------
562 INTEGER NIN,JTASK ,LINDMAX,NMN ,
563 . NB_JLT,NB_JLT_NEW,NB_STOK_N,NRTMDIM
564 INTEGER IPARI(NPARI), KINET(*),ITAB(*)
565 my_real :: STIFN(*)
566 INTEGER, INTENT(in) :: S_XCELL_REMOTE
567 my_real, DIMENSION(S_XCELL_REMOTE), INTENT(in) :: XCELL_REMOTE
568 my_real
569 . X(3,*), V(3,*), A(3,*), MS(*),
570 . MTF(14,*),CAND_SAV(8,*),XCELL(3,SXCELL)
571 TYPE(INTBUF_STRUCT_) INTBUF_TAB
572 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
573 TYPE(t_connectivity), INTENT(IN) :: ALE_NE_CONNECT
574C-----------------------------------------------
575C L o c a l V a r i a b l e s
576C-----------------------------------------------
577 INTEGER I, NSN,
578 . noint,nty,ivis2,
579 . igap,inacti,ibag,i_stok, i_stok_loc, jlt_new,
580 . jlt, nft,debut,nbid,nb_loc,igsti,icurv,iadm
581 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
582 . NSVG(MVSIZ), CN_LOC(MVSIZ),CE_LOC(MVSIZ),INDEX2(LINDMAX),
583 . cand_n_n(mvsiz),cand_e_n(mvsiz),kini(mvsiz),ibid
584 my_real
585 . startt, stopt,gap,gapmin,maxbox,minbox,bid,
586 . kmin, kmax, gapmax
587 my_real
588 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
589 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
590 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
591 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
592 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
593 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz),
594 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
595 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
596 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
597 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
598 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
599C-----------------------------------------------
600C S o u r c e L i n e s
601C-----------------------------------------------
602 inacti=ipari(22)
603 IF(inacti /= 7 .or. ipari(34) == 0)RETURN
604C
605C -------------------
606 CALL my_barrier
607C -------------------
608
609C=======================================================================
610C calculation des pene,normale,Hi...
611C and calculation of cumulative penetration for each second. MTF(10,i)
612C=======================================================================
613 nbid=0
614 bid=zero
615 ibid = 0
616C
617 nsn =ipari(5)
618 nty =ipari(7)
619 ivis2 =ipari(14)
620 noint =ipari(15)
621 igap =ipari(21)
622 inacti=ipari(22)
623 ibag =ipari(32)
624 igsti=ipari(34)
625 icurv =0
626 iadm =ipari(44)
627 startt=intbuf_tab%VARIABLES(3)
628 stopt =intbuf_tab%VARIABLES(11)
629 IF(startt > tt) RETURN
630 IF(tt > stopt) RETURN
631 gap =intbuf_tab%VARIABLES(2)
632 gapmin=intbuf_tab%VARIABLES(13)
633C
634 i_stok = intbuf_tab%I_STOK(1)
635 maxbox = intbuf_tab%VARIABLES(9)
636 minbox = intbuf_tab%VARIABLES(12)
637 gapmax=intbuf_tab%VARIABLES(16)
638 kmin =intbuf_tab%VARIABLES(17)
639 kmax =intbuf_tab%VARIABLES(18)
640
641C parallel part after elem forces
642C static cutting
643 nb_loc = i_stok / nthread
644 IF (jtask == nthread) THEN
645 i_stok_loc = i_stok-nb_loc*(nthread-1)
646 ELSE
647 i_stok_loc = nb_loc
648 ENDIF
649 debut = (jtask-1)*nb_loc
650 i_stok = 0
651C ristock updated
652 DO i = debut+1, debut+i_stok_loc
653 IF(intbuf_tab%CAND_N(i) < 0) THEN
654 IF(i_stok + 1 > 4*numnod) THEN
655 CALL ancmsg(msgid=94,anmode=aninfo)
656 CALL arret(2)
657 ENDIF
658 i_stok = i_stok + 1
659 index2(i_stok) = i
660C inbuf == cand_n
661 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
662 ENDIF
663c zeroing penetration
664 cand_sav(8,i) = zero
665 ENDDO
666C
667 IF (debug(3) >= 1) THEN
668 nb_jlt = nb_jlt + i_stok_loc
669 nb_stok_n = nb_stok_n + i_stok
670 ENDIF
671C
672 DO nft = 0 , i_stok - 1 , nvsiz
673 jlt = min( nvsiz, i_stok - nft )
674C preparing retained candidates
675 CALL i7cdcor3(
676 1 jlt,index2(nft+1),intbuf_tab%CAND_E,intbuf_tab%CAND_N,
677 2 cand_e_n,cand_n_n)
678C cand_n and cand_e replaced with cand_n_n and cand_e_n
679 CALL i7cor3(
680 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV,cand_e_n,
681 2 cand_n_n ,intbuf_tab%STFM ,intbuf_tab%STFNS ,x1 ,x2 ,
682 3 x3 ,x4 ,y1 ,y2 ,y3 ,
683 4 y4 ,z1 ,z2 ,z3 ,z4 ,
684 5 xi ,yi ,zi ,stif ,ix1 ,
685 6 ix2 ,ix3 ,ix4 ,nsvg ,igap ,
686 7 gap ,intbuf_tab%GAP_S ,intbuf_tab%GAP_M ,gapv ,
687 9 ms ,vxi ,vyi ,
688 a vzi ,msi ,nsn ,v ,kinet ,
689 b kini ,nty ,nin ,igsti ,kmin ,
690 c kmax ,gapmax ,gapmin ,iadm ,bid ,
691 d bid ,bid ,bid ,ibid ,bid ,
692 e bid ,bid ,bid ,ibid ,bid ,
693 f ibid ,ibid ,ibid ,bid ,bid ,
694 g ibid ,ibid ,ibid ,ibid ,ibid ,
695 h ibid ,ibid ,bid ,ibid ,bid )
696
697 jlt_new = 0
698 CALL i18dst3(
699 1 jlt ,cand_n_n ,cand_e_n ,cn_loc ,ce_loc ,
700 2 x1 ,x2 ,x3 ,x4 ,y1 ,
701 3 y2 ,y3 ,y4 ,z1 ,z2 ,
702 4 z3 ,z4 ,xi ,yi ,zi ,
703 5 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
704 6 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
705 7 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
706 8 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
707 9 p1 ,p2 ,p3 ,p4 ,ix1 ,
708 a ix2 ,ix3 ,ix4 ,nsvg ,stif ,
709 b jlt_new ,gapv ,intbuf_tab%CAND_P ,ale_ne_connect,
710 c index2(nft+1) ,vxi ,vyi ,itab ,xcell ,
711 d vzi ,msi ,kini ,
712 e igap ,multi_fvm ,s_xcell_remote ,xcell_remote)
713 jlt = jlt_new
714 IF(jlt_new /= 0) THEN
715 ipari(29) = 1
716 IF (debug(3) >= 1) nb_jlt_new = nb_jlt_new + jlt_new
717 CALL i18kine_i(
718 1 jlt ,a ,v ,
719 2 gap ,ms ,noint ,intbuf_tab%STFNS ,itab ,
720 3 stifn ,stif ,x ,intbuf_tab%IRECTM ,
721 4 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
722 5 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
723 6 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
724 7 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
725 8 p1 ,p2 ,p3 ,p4 ,nin ,
726 9 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
727 a gapv ,inacti ,vxi ,vyi ,vzi ,
728 b msi ,mtf ,index2(nft+1),cand_sav)
729 ENDIF
730 ENDDO
731
732 RETURN
733 END
734!||====================================================================
735!|| i18main_kine_f ../engine/source/interfaces/int18/i18main_kine.f
736!||--- called by ------------------------------------------------------
737!|| i18main_kine_1 ../engine/source/interfaces/int18/i18main_kine.F
738!||--- calls -----------------------------------------------------
739!|| i18kine_f ../engine/source/interfaces/int18/i18main_kine.F
740!||--- uses -----------------------------------------------------
741!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
742!||====================================================================
743 SUBROUTINE i18main_kine_f(NIN,
744 1 IPARI ,INTBUF_TAB ,X ,STIFN ,
745 2 V ,A ,MS ,ITAB ,LINDMAX ,
746 3 CAND_SAV ,MTF ,JTASK ,NB_JLT ,NB_JLT_NEW,
747 4 NB_STOK_N )
748C-----------------------------------------------
749C M o d u l e s
750C-----------------------------------------------
751 USE intbufdef_mod
752C-----------------------------------------------
753C D u m m y A r g u m e n t s
754C
755C-------------------------------------------------------------------------------
756C NOM DIMENSION DESCRIPTION E/S
757C-------------------------------------------------------------------------------
758C
759C NIN 1 INTERFACE NUMBER E
760C
761C IPARI NPARI,NINTER PARAMETRES D'INTERFACE E
762C
763C X 3,NUMNOD COORDONNEES E
764C
765C V 3,NUMNOD VELOCITIES E
766C
767C EMINX 6*NME<6*NUMELS MIN MAX DE CHAQUE ELEMENT TMP_GLOBAL
768C
769C
770C-----------------------------------------------
771C I m p l i c i t T y p e s
772C-----------------------------------------------
773#include "implicit_f.inc"
774C-----------------------------------------------
775C G l o b a l P a r a m e t e r s
776C-----------------------------------------------
777#include "mvsiz_p.inc"
778C-----------------------------------------------
779C C o m m o n B l o c k s
780C-----------------------------------------------
781#include "com08_c.inc"
782#include "param_c.inc"
783#include "task_c.inc"
784C-----------------------------------------------
785C D u m m y A r g u m e n t s
786C-----------------------------------------------
787 INTEGER NIN,JTASK ,LINDMAX,
788 . NB_JLT,NB_JLT_NEW,NB_STOK_N
789 INTEGER IPARI(NPARI),
790 . ITAB(*)
791 my_real
792 . X(3,*), V(3,*), A(3,*), MS(*),
793 . MTF(14,*),CAND_SAV(8,*),STIFN(*)
794 TYPE(INTBUF_STRUCT_) INTBUF_TAB
795C-----------------------------------------------
796C L o c a l V a r i a b l e s
797C-----------------------------------------------
798 INTEGER NSN,
799 . NME_TGNGE,NOINT,NTY,IVIS2,
800 . IGAP,INACTI,IBAG,I_STOK, I_STOK_LOC,
801 . JLT, NFT,DEBUT,NB_LOC,IGSTI,ICURV,IADM
802 my_real
803 . startt, stopt,gap,gapmin,maxbox,minbox,
804 . kmin, kmax, gapmax
805 my_real
806 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
807 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
808 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
809 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
810 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
811 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz),
812 . stif(mvsiz),
813 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
814C-----------------------------------------------
815C S o u r c e L i n e s
816C-----------------------------------------------
817 inacti=ipari(22)
818 IF(inacti/=7.or.ipari(34)==0)RETURN
819C
820C=======================================================================
821C calculation des pene,normale,Hi...
822C and calculation of cumulative penetration for each second. MTF(10,i)
823C=======================================================================
824 nsn =ipari(5)
825 nty =ipari(7)
826 ivis2 =ipari(14)
827 noint =ipari(15)
828 igap =ipari(21)
829 inacti=ipari(22)
830 ibag =ipari(32)
831 igsti=ipari(34)
832 icurv =0
833 iadm =ipari(44)
834 startt=intbuf_tab%VARIABLES(3)
835 stopt =intbuf_tab%VARIABLES(11)
836 IF(startt > tt) RETURN
837 IF(tt > stopt) RETURN
838 gap =intbuf_tab%VARIABLES(2)
839 gapmin=intbuf_tab%VARIABLES(13)
840C
841 i_stok = intbuf_tab%I_STOK(1)
842 maxbox = intbuf_tab%VARIABLES(9)
843 minbox = intbuf_tab%VARIABLES(12)
844 gapmax=intbuf_tab%VARIABLES(16)
845 kmin =intbuf_tab%VARIABLES(17)
846 kmax =intbuf_tab%VARIABLES(18)
847C this part is done in parallel after the calculation of element forces
848C static decoupage
849 nb_loc = i_stok / nthread
850 IF (jtask == nthread) THEN
851 i_stok_loc = i_stok-nb_loc*(nthread-1)
852 ELSE
853 i_stok_loc = nb_loc
854 ENDIF
855 debut = nb_loc*(jtask-1)
856C=======================================================================
857C calculation of the forces and masses to be transmitted to the mains
858c ponderation en pene/somme(pene)
859C=======================================================================
860c DO NFT = DEBUT , DEBUT + I_STOK_LOC - 1 , NVSIZ
861c JLT = MIN( NVSIZ, I_STOK_LOC - NFT )
862 if(jtask/=1)return
863 DO nft = 0 , i_stok - 1 , nvsiz
864 jlt = min( nvsiz, i_stok - nft )
865 CALL i18kine_f(
866 1 jlt ,a ,v ,intbuf_tab%CAND_E(1+nft) ,intbuf_tab%CAND_N(1+nft) ,
867 2 gap ,ms ,noint ,intbuf_tab%STFNS,itab ,
868 3 stifn ,stif ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV,
869 4 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
870 5 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
871 6 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
872 7 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
873 8 p1 ,p2 ,p3 ,p4 ,nin ,
874 9 gapv ,inacti ,vxi ,vyi ,vzi ,
875 a msi ,mtf ,cand_sav(1,1+nft) ,nsn)
876 ENDDO
877C
878 RETURN
879 END
880!||====================================================================
881!|| i18_kine_m ../engine/source/interfaces/int18/i18main_kine.F
882!||--- called by ------------------------------------------------------
883!|| i18main_kine_1 ../engine/source/interfaces/int18/i18main_kine.F
884!||====================================================================
885 SUBROUTINE i18_kine_m(
886 1 ITASK ,NMN ,MSR ,V ,A ,MS ,
887 2 MTF ,ISKEW ,SKEW ,LCOD ,ITAB )
888C-----------------------------------------------
889C I m p l i c i t T y p e s
890C-----------------------------------------------
891#include "implicit_f.inc"
892C-----------------------------------------------
893C C o m m o n B l o c k s
894C-----------------------------------------------
895#include "task_c.inc"
896#include "param_c.inc"
897C-----------------------------------------------
898C D u m m y A r g u m e n t s
899C-----------------------------------------------
900 INTEGER NMN,ITASK,MSR(*), ISKEW(*), LCOD(*) , ITAB(*)
901 my_real
902 . A(3,*), V(3,*), MS(*),MTF(14,*), SKEW(LSKEW,*)
903C-----------------------------------------------
904C L o c a l V a r i a b l e s
905C-----------------------------------------------
906 INTEGER NMNF, NMNL, I, J
907 my_real
908 . A11,A12,A13,A22,A23,A33,B11,B12,B13,B22,B23,B33,
909 . USDET,FX ,FY ,FZ
910C-----------------------------------------------
911C S o u r c e L i n e s
912C-----------------------------------------------
913 NMNF = 1 + itask*nmn / nthread
914 nmnl = (itask+1)*nmn / nthread
915
916#include "vectorize.inc"
917 DO i=nmnf,nmnl
918 j=msr(i)
919 IF(j > 0) THEN
920
921c inversion of symmetric 3x3 matrix and multiplication by a vector
922c
923c B = A^-1
924c
925c a = B f
926c
927c optimisation : 27* 1/
928
929 a11 = mtf(1,j) + ms(j)
930 a12 = mtf(2,j)
931 a13 = mtf(3,j)
932 a22 = mtf(4,j) + ms(j)
933 a23 = mtf(5,j)
934 a33 = mtf(6,j) + ms(j)
935 fx = mtf(7,j) + a(1,j)
936 fy = mtf(8,j) + a(2,j)
937 fz = mtf(9,j) + a(3,j)
938
939 b11 = (a22*a33 - a23*a23)
940 b22 = (a33*a11 - a13*a13)
941 b33 = (a11*a22 - a12*a12)
942
943 b12 = (a23*a13 - a33*a12)
944 b23 = (a13*a12 - a11*a23)
945 b13 = (a12*a23 - a22*a13)
946
947 usdet = ms(j) / ( a11*b11 + a12*b12 + a13*b13)
948
949c a = [B] f
950 a(1,j) = (b11*fx + b12*fy + b13*fz)*usdet
951 a(2,j) = (b12*fx + b22*fy + b23*fz)*usdet
952 a(3,j) = (b13*fx + b23*fy + b33*fz)*usdet
953
954 ENDIF
955 ENDDO
956
957
958 RETURN
959 END
960!||====================================================================
961!|| i18main_kine_v ../engine/source/interfaces/int18/i18main_kine.F
962!||--- called by ------------------------------------------------------
963!|| i18main_kine_2 ../engine/source/interfaces/int18/i18main_kine.F
964!||--- calls -----------------------------------------------------
965!|| i18kine_v ../engine/source/interfaces/int18/i18main_kine.F
966!|| my_barrier ../engine/source/system/machine.F
967!||--- uses -----------------------------------------------------
968!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
969!||====================================================================
970 SUBROUTINE i18main_kine_v(NIN,
971 1 IPARI ,INTBUF_TAB ,X ,STIFN ,
972 2 V ,A ,MS ,JTASK ,ITAB ,
973 3 CAND_SAV ,MTF ,ISKEW ,SKEW ,LCOD ,
974 4 NB_JLT ,NB_JLT_NEW,NB_STOK_N)
975C-----------------------------------------------
976C M o d u l e s
977C-----------------------------------------------
978 USE intbufdef_mod
979C-----------------------------------------------
980C D u m m y A r g u m e n t s
981C
982C-------------------------------------------------------------------------------
983C NOM DIMENSION DESCRIPTION E/S
984C-------------------------------------------------------------------------------
985C
986C NIN 1 INTERFACE NUMBER E
987C
988C IPARI NPARI,NINTER PARAMETRES D'INTERFACE E
989C
990C X 3,NUMNOD COORDONNEES E
991C
992C V 3,NUMNOD VELOCITIES E
993C
994C EMINX 6*NME<6*NUMELS MIN MAX DE CHAQUE ELEMENT TMP_GLOBAL
995C
996C
997C-----------------------------------------------
998C I m p l i c i t T y p e s
999C-----------------------------------------------
1000#include "implicit_f.inc"
1001C-----------------------------------------------
1002C G l o b a l P a r a m e t e r s
1003C-----------------------------------------------
1004#include "mvsiz_p.inc"
1005C-----------------------------------------------
1006C C o m m o n B l o c k s
1007C-----------------------------------------------
1008#include "com08_c.inc"
1009#include "param_c.inc"
1010#include "task_c.inc"
1011C-----------------------------------------------
1012C D u m m y A r g u m e n t s
1013C-----------------------------------------------
1014 INTEGER NIN,JTASK ,
1015 . NB_JLT,NB_JLT_NEW,NB_STOK_N
1016 INTEGER IPARI(NPARI),
1017 . ITAB(*), ISKEW(*), LCOD(*)
1018 my_real
1019 . X(3,*), V(3,*), A(3,*), MS(*),
1020 . MTF(14,*),CAND_SAV(8,*), SKEW(*), STIFN(*)
1021 TYPE(INTBUF_STRUCT_) INTBUF_TAB
1022C-----------------------------------------------
1023C L o c a l V a r i a b l e s
1024C-----------------------------------------------
1025 INTEGER NSN,
1026 . NME_TGNGE,NOINT,NTY,IVIS2,
1027 . IGAP,INACTI,IBAG,I_STOK, I_STOK_LOC,DEBUT,
1028 . JLT, NFT,NB_LOC,IADM
1029 my_real
1030 . STARTT, STOPT,GAP,GAPMIN,MAXBOX,MINBOX,
1031 . KMIN, KMAX, GAPMAX
1032 my_real
1033 . NX1(MVSIZ), NX2(MVSIZ), NX3(MVSIZ), NX4(MVSIZ),
1034 . NY1(MVSIZ), NY2(MVSIZ), NY3(MVSIZ), NY4(MVSIZ),
1035 . NZ1(MVSIZ), NZ2(MVSIZ), NZ3(MVSIZ), NZ4(MVSIZ),
1036 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
1037 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
1038 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz),stif(mvsiz),
1039 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
1040C-----------------------------------------------
1041C S o u r c e L i n e s
1042C-----------------------------------------------
1043C -------------------
1044 CALL my_barrier
1045C -------------------
1046 nsn =ipari(5)
1047 nty =ipari(7)
1048 ivis2 =ipari(14)
1049 noint =ipari(15)
1050 igap =ipari(21)
1051 inacti=ipari(22)
1052 ibag =ipari(32)
1053 iadm =ipari(44)
1054 startt=intbuf_tab%VARIABLES(3)
1055 stopt =intbuf_tab%VARIABLES(11)
1056 IF(startt > tt) RETURN
1057 IF(tt > stopt) RETURN
1058 gap =intbuf_tab%VARIABLES(2)
1059 gapmin=intbuf_tab%VARIABLES(13)
1060C
1061 i_stok = intbuf_tab%I_STOK(1)
1062 maxbox = intbuf_tab%VARIABLES(9)
1063 minbox = intbuf_tab%VARIABLES(12)
1064 gapmax=intbuf_tab%VARIABLES(16)
1065 kmin =intbuf_tab%VARIABLES(17)
1066 kmax =intbuf_tab%VARIABLES(18)
1067C this part is performed in parallel after the calculation of the forces of the elements
1068C static decoupage
1069 nb_loc = i_stok / nthread
1070 IF (jtask == nthread) THEN
1071 i_stok_loc = i_stok-nb_loc*(nthread-1)
1072 ELSE
1073 i_stok_loc = nb_loc
1074 ENDIF
1075 debut = nb_loc*(jtask-1)
1076C=======================================================================
1077C velocity calculation to be imposed on the second
1078c ponderation en pene/somme(pene)
1079C=======================================================================
1080c DO NFT = DEBUT , DEBUT + I_STOK_LOC - 1 , NVSIZ
1081c JLT = MIN( NVSIZ, I_STOK_LOC - NFT )
1082 if(jtask/=1)return
1083 DO nft = 0 , i_stok - 1 , nvsiz
1084 jlt = min( nvsiz, i_stok - nft )
1085 CALL i18kine_v(
1086 1 jlt ,a ,v ,intbuf_tab%CAND_E(1+nft) ,intbuf_tab%CAND_N(1+nft) ,
1087 2 gap ,ms ,noint ,intbuf_tab%STFNS,itab ,
1088 3 stifn ,stif ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV,
1089 4 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
1090 5 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
1091 6 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
1092 7 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
1093 8 p1 ,p2 ,p3 ,p4 ,nin ,
1094 9 gapv ,inacti ,vxi ,vyi ,vzi ,
1095 a msi ,mtf ,cand_sav(1,1+nft) ,nsn)
1096 ENDDO
1097C
1098 RETURN
1099 END
1100!||====================================================================
1101!|| i18main_kine_s ../engine/source/interfaces/int18/i18main_kine.F
1102!||--- called by ------------------------------------------------------
1103!|| i18main_kine_2 ../engine/source/interfaces/int18/i18main_kine.F
1104!||--- calls -----------------------------------------------------
1105!|| i18kine_s ../engine/source/interfaces/int18/i18main_kine.F
1106!|| my_barrier ../engine/source/system/machine.F
1107!||--- uses -----------------------------------------------------
1108!|| h3d_mod ../engine/share/modules/h3d_mod.F
1109!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1110!|| output_mod ../common_source/modules/output/output_mod.F90
1111!||====================================================================
1112 SUBROUTINE i18main_kine_s(output, NIN,
1113 1 IPARI ,INTBUF_TAB ,X ,STIFN ,
1114 2 V ,A ,MS ,FSAV ,FCONT ,
1115 3 JTASK ,ITAB ,CAND_SAV,MTF ,
1116 4 NB_JLT ,NB_JLT_NEW,NB_STOK_N,ISKEW ,SKEW ,
1117 5 LCOD ,SLVNDTAG, H3D_DATA )
1118C-----------------------------------------------
1119C M o d u l e s
1120C-----------------------------------------------
1121 USE intbufdef_mod
1122 USE h3d_mod
1123 use output_mod
1124C-----------------------------------------------
1125C D u m m y A r g u m e n t s
1126C
1127C-------------------------------------------------------------------------------
1128C NOM DIMENSION DESCRIPTION E/S
1129C-------------------------------------------------------------------------------
1130C
1131C NIN 1 INTERFACE NUMBER E
1132C
1133C IPARI NPARI,NINTER PARAMETRES D'INTERFACE E
1134C
1135C X 3,NUMNOD COORDONNEES E
1136C
1137C V 3,NUMNOD VELOCITIES E
1138C
1139C EMINX 6*NME<6*NUMELS MIN MAX DE CHAQUE ELEMENT TMP_GLOBAL
1140C
1141C
1142C-----------------------------------------------
1143C I m p l i c i t T y p e s
1144C-----------------------------------------------
1145#include "implicit_f.inc"
1146C-----------------------------------------------
1147C G l o b a l P a r a m e t e r s
1148C-----------------------------------------------
1149#include "mvsiz_p.inc"
1150C-----------------------------------------------
1151C C o m m o n B l o c k s
1152C-----------------------------------------------
1153#include "com08_c.inc"
1154#include "param_c.inc"
1155#include "task_c.inc"
1156C-----------------------------------------------
1157C D u m m y A r g u m e n t s
1158C-----------------------------------------------
1159 type(output_), intent(inout) :: output
1160 INTEGER NIN,JTASK
1161 INTEGER IPARI(NPARI),NB_JLT_NEW,NB_STOK_N, NB_JLT,
1162 . ITAB(*), ISKEW(*), LCOD(*) ,SLVNDTAG(*)
1163 my_real
1164 . X(3,*), V(3,*), A(3,*), MS(*), STIFN(*),
1165 . MTF(14,*),CAND_SAV(8,*), FSAV(*),FCONT(3,*), SKEW(*)
1166 TYPE(INTBUF_STRUCT_) INTBUF_TAB
1167 TYPE(H3D_DATABASE) :: H3D_DATA
1168C-----------------------------------------------
1169C L o c a l V a r i a b l e s
1170C-----------------------------------------------
1171 INTEGER NSN,
1172 . NOINT,NTY,IVIS2,
1173 . IGAP,INACTI,IBAG,I_STOK, I_STOK_LOC, DEBUT,
1174 . JLT, NFT,NBID,NB_LOC, IADM
1175 my_real
1176 . STARTT, STOPT,GAP,GAPMIN,MAXBOX,MINBOX,BID,
1177 . KMIN, KMAX, GAPMAX
1178 my_real
1179 . NX1(MVSIZ), NX2(MVSIZ), NX3(MVSIZ), NX4(MVSIZ),
1180 . NY1(MVSIZ), NY2(MVSIZ), NY3(MVSIZ), NY4(MVSIZ),
1181 . NZ1(MVSIZ), NZ2(MVSIZ), NZ3(MVSIZ), NZ4(MVSIZ),
1182 . LB1(MVSIZ), LB2(MVSIZ), LB3(MVSIZ), LB4(MVSIZ),
1183 . LC1(MVSIZ), LC2(MVSIZ), LC3(MVSIZ), LC4(MVSIZ),
1184 . P1(MVSIZ), P2(MVSIZ), P3(MVSIZ), P4(MVSIZ),
1185 . GAPV(MVSIZ),VXI(MVSIZ),VYI(MVSIZ),VZI(MVSIZ),MSI(MVSIZ),
1186 . stif(mvsiz)
1187C-----------------------------------------------
1188C S o u r c e L i n e s
1189C-----------------------------------------------
1190C -------------------
1191 CALL my_barrier
1192C -------------------
1193 nbid=0
1194 bid=zero
1195C
1196 nsn =ipari(5)
1197 nty =ipari(7)
1198 ivis2 =ipari(14)
1199 noint =ipari(15)
1200 igap =ipari(21)
1201 inacti=ipari(22)
1202 ibag =ipari(32)
1203 iadm =ipari(44)
1204 startt=intbuf_tab%VARIABLES(3)
1205 stopt =intbuf_tab%VARIABLES(11)
1206 IF(startt > tt) RETURN
1207 IF(tt > stopt) RETURN
1208 gap =intbuf_tab%VARIABLES(2)
1209 gapmin=intbuf_tab%VARIABLES(13)
1210C
1211 i_stok = intbuf_tab%I_STOK(1)
1212 maxbox = intbuf_tab%VARIABLES(9)
1213 minbox = intbuf_tab%VARIABLES(12)
1214 gapmax=intbuf_tab%VARIABLES(16)
1215 kmin =intbuf_tab%VARIABLES(17)
1216 kmax =intbuf_tab%VARIABLES(18)
1217C parallel part after elem forces
1218C static cutting
1219 nb_loc = i_stok / nthread
1220 IF (jtask == nthread) THEN
1221 i_stok_loc = i_stok-nb_loc*(nthread-1)
1222 ELSE
1223 i_stok_loc = nb_loc
1224 ENDIF
1225 debut = nb_loc*(jtask-1)
1226C=======================================================================
1227C velocity are imposed to fluid nodes
1228C (acceleration)
1229C computing reaction forces
1230C=======================================================================
1231
1232 if(jtask/=1)return
1233 DO nft = 0 , i_stok - 1 , nvsiz
1234 jlt = min( nvsiz, i_stok - nft )
1235 CALL i18kine_s(output,
1236 1 jlt ,a ,v ,intbuf_tab%CAND_E(1+nft) ,intbuf_tab%CAND_N(1+nft) ,
1237 2 gap ,ms ,noint ,intbuf_tab%STFNS,itab ,
1238 3 stifn ,stif ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV,
1239 4 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
1240 5 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
1241 6 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
1242 7 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
1243 8 p1 ,p2 ,p3 ,p4 ,nin ,
1244 9 gapv ,inacti ,vxi ,vyi ,vzi ,
1245 a msi ,mtf ,cand_sav(1,1+nft),fcont ,fsav ,
1246 b nsn ,slvndtag ,h3d_data )
1247 ENDDO
1248C
1249 RETURN
1250 END
1251!||====================================================================
1252!|| i18kine_i ../engine/source/interfaces/int18/i18main_kine.f
1253!||--- called by ------------------------------------------------------
1254!|| i18main_kine_i ../engine/source/interfaces/int18/i18main_kine.F
1255!||--- uses -----------------------------------------------------
1256!|| tri7box ../engine/share/modules/tri7box.F
1257!||====================================================================
1258 SUBROUTINE i18kine_i(JLT ,A ,V ,
1259 2 GAP ,MS ,NOINT ,STFN ,ITAB ,
1260 3 STIFN ,STIF ,X ,IRECT ,
1261 4 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
1262 5 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
1263 6 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
1264 7 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
1265 8 P1 ,P2 ,P3 ,P4 ,NIN ,
1266 9 IX1 ,IX2 ,IX3 ,IX4 ,NSVG ,
1267 A GAPV ,INACTI ,VXI ,VYI ,VZI ,
1268 B MSI ,MTF ,INDEX ,CAND_SAV)
1269C-----------------------------------------------
1270C M o d u l e s
1271C-----------------------------------------------
1272 USE tri7box
1273C-----------------------------------------------
1274C I m p l i c i t T y p e s
1275C-----------------------------------------------
1276#include "implicit_f.inc"
1277#include "comlock.inc"
1278C-----------------------------------------------
1279C G l o b a l P a r a m e t e r s
1280C-----------------------------------------------
1281#include "mvsiz_p.inc"
1282C-----------------------------------------------
1283C C o m m o n B l o c k s
1284C-----------------------------------------------
1285#include "com08_c.inc"
1286#include "scr05_c.inc"
1287C-----------------------------------------------
1288C D u m m y A r g u m e n t s
1289C-----------------------------------------------
1290 INTEGER JLT,INACTI,NIN,
1291 . ITAB(*),INDEX(*),
1292 . NOINT,IRECT(4,*)
1293 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
1294 . NSVG(MVSIZ)
1295 my_real
1296 . x(3,*),a(3,*), ms(*), v(3,*), mtf(14,*),
1297 . gap, stfn(*),stifn(*),cand_sav(8,*)
1298 my_real
1299 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
1300 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
1301 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
1302 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
1303 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
1304 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz), stif(mvsiz),
1305 . gapv(mvsiz),
1306 . vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
1307C-----------------------------------------------
1308C L o c a l V a r i a b l e s
1309C-----------------------------------------------
1310 INTEGER I, IG, NN
1311 my_real
1312 . N1(MVSIZ), N2(MVSIZ), N3(MVSIZ), PENE(MVSIZ),
1313 . H1(MVSIZ), H2(MVSIZ), H3(MVSIZ), H4(MVSIZ),
1314 . S2,
1315 . DT1INV,
1316 . H0, LA1, LA2, LA3, LA4,
1317 . D1,D2,D3,D4,
1318 . H00
1319 my_real
1320 . PREC
1321 INTEGER IBID
1322 my_real
1323 . PP1,PP2,PP3,PP4,BID
1324C
1325C-----------------------------------------------
1326 IF (IRESP == 1) then
1327 prec = fiveem4
1328 ELSE
1329 prec = em10
1330 ENDIF
1331 IF(dt1 > zero)THEN
1332 dt1inv = one/dt1
1333 ELSE
1334 dt1inv =zero
1335 ENDIF
1336C--------------------------------------------------------
1337C MIXED PACKAGES
1338C--------------------------------------------------------
1339 bid = zero
1340 ibid = 0
1341C
1342 DO i=1,jlt
1343 IF(ix3(i) /= ix4(i))THEN
1344C
1345 d1 = sqrt(p1(i))
1346 pp1 = max(zero, gapv(i) - d1)
1347C
1348 d2 = sqrt(p2(i))
1349 pp2 = max(zero, gapv(i) - d2)
1350C
1351 d3 = sqrt(p3(i))
1352 pp3 = max(zero, gapv(i) - d3)
1353C
1354 d4 = sqrt(p4(i))
1355 pp4 = max(zero, gapv(i) - d4)
1356C
1357 pene(i) = max(pp1,pp2,pp3,pp4)
1358 la1 = one - lb1(i) - lc1(i)
1359 la2 = one - lb2(i) - lc2(i)
1360 la3 = one - lb3(i) - lc3(i)
1361 la4 = one - lb4(i) - lc4(i)
1362 IF(pene(i) == pp1)THEN
1363 n1(i) = nx1(i)
1364 n2(i) = ny1(i)
1365 n3(i) = nz1(i)
1366 h0 = fourth * la1
1367 h1(i) = h0 + lb1(i)
1368 h2(i) = h0 + lc1(i)
1369 h3(i) = h0
1370 h4(i) = h0
1371 ELSEIF(pene(i) == pp2)THEN
1372 n1(i) = nx2(i)
1373 n2(i) = ny2(i)
1374 n3(i) = nz2(i)
1375 h0 = fourth * la2
1376 h1(i) = h0
1377 h2(i) = h0 + lb2(i)
1378 h3(i) = h0 + lc2(i)
1379 h4(i) = h0
1380 ELSEIF(pene(i) == pp3)THEN
1381 n1(i) = nx3(i)
1382 n2(i) = ny3(i)
1383 n3(i) = nz3(i)
1384 h0 = fourth * la3
1385 h1(i) = h0
1386 h2(i) = h0
1387 h3(i) = h0 + lb3(i)
1388 h4(i) = h0 + lc3(i)
1389 ELSEIF(pene(i) == pp4)THEN
1390 n1(i) = nx4(i)
1391 n2(i) = ny4(i)
1392 n3(i) = nz4(i)
1393 h0 = fourth * la4
1394 h1(i) = h0 + lc4(i)
1395 h2(i) = h0
1396 h3(i) = h0
1397 h4(i) = h0 + lb4(i)
1398 ENDIF
1399
1400 h00 = one/max(em20,h1(i) + h2(i) + h3(i) + h4(i))
1401 h1(i) = h1(i) * h00
1402 h2(i) = h2(i) * h00
1403 h3(i) = h3(i) * h00
1404 h4(i) = h4(i) * h00
1405C
1406 ELSE
1407C
1408 d1 = sqrt(p1(i))
1409 pp1 = max(zero, gapv(i) - d1)
1410 pene(i) = pp1
1411 n1(i) = nx1(i)
1412 n2(i) = ny1(i)
1413 n3(i) = nz1(i)
1414 h1(i) = lb1(i)
1415 h2(i) = lc1(i)
1416 h3(i) = one - lb1(i) - lc1(i)
1417 h4(i) = zero
1418 ENDIF
1419 ENDDO
1420C---------------------
1421C NORMAL VECTOR
1422C---------------------
1423 DO i=1,jlt
1424 s2 = one/max(em30,sqrt(n1(i)**2 + n2(i)**2 + n3(i)**2))
1425 n1(i) = n1(i)*s2
1426 n2(i) = n2(i)*s2
1427 n3(i) = n3(i)*s2
1428 ENDDO
1429C---------------------
1430C PENETRATION
1431C---------------------
1432 DO i=1,jlt
1433 ig=nsvg(i)
1434 IF(ig > 0)THEN
1435#include "lockon.inc"
1436 IF(pene(i) > mtf(11,ig))THEN
1437 mtf(11,ig) = pene(i)
1438 ELSEIF(pene(i) == mtf(11,ig))THEN
1439 pene(i) = pene(i)*(one-em6)
1440 ENDIF
1441 mtf(10,ig) = mtf(10,ig) + pene(i)
1442 mtf(12,ig) = mtf(12,ig) + pene(i)*n1(i)
1443 mtf(13,ig) = mtf(13,ig) + pene(i)*n2(i)
1444 mtf(14,ig) = mtf(14,ig) + pene(i)*n3(i)
1445#include "lockoff.inc"
1446 ELSE
1447 nn=-ig
1448#include "lockon.inc"
1449 IF(pene(i) > mtfi_penemin(nin)%P(nn))THEN
1450 mtfi_penemin(nin)%P(nn) = pene(i)
1451 ELSEIF(pene(i) == mtfi_penemin(nin)%P(nn))THEN
1452 pene(i) = pene(i)*(one-em6)
1453 ENDIF
1454 mtfi_pene(nin)%P(nn) = mtfi_pene(nin)%P(nn) + pene(i)
1455 mtfi_n(nin)%P(1,nn) = mtfi_n(nin)%P(1,nn) + pene(i)*n1(i)
1456 mtfi_n(nin)%P(2,nn) = mtfi_n(nin)%P(2,nn) + pene(i)*n2(i)
1457 mtfi_n(nin)%P(3,nn) = mtfi_n(nin)%P(3,nn) + pene(i)*n3(i)
1458#include "lockoff.inc"
1459 ENDIF
1460 cand_sav(1,index(i)) = h1(i)
1461 cand_sav(2,index(i)) = h2(i)
1462 cand_sav(3,index(i)) = h3(i)
1463 cand_sav(4,index(i)) = h4(i)
1464 cand_sav(5,index(i)) = n1(i)
1465 cand_sav(6,index(i)) = n2(i)
1466 cand_sav(7,index(i)) = n3(i)
1467 cand_sav(8,index(i)) = pene(i)
1468 ENDDO
1469C-----------------------------------------------------
1470 RETURN
1471 END
1472!||====================================================================
1473!|| i18kine_f ../engine/source/interfaces/int18/i18main_kine.F
1474!||--- called by ------------------------------------------------------
1475!|| i18main_kine_f ../engine/source/interfaces/int18/i18main_kine.F
1476!||--- uses -----------------------------------------------------
1477!|| tri7box ../engine/share/modules/tri7box.F
1478!||====================================================================
1479 SUBROUTINE i18kine_f(JLT ,A ,V ,CAND_E,CAND_N ,
1480 2 GAP ,MS ,NOINT ,STFN ,ITAB ,
1481 3 STIFN ,STIF ,X ,IRECT ,NSV ,
1482 4 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
1483 5 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
1484 6 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
1485 7 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
1486 8 P1 ,P2 ,P3 ,P4 ,NIN ,
1487 A GAPV ,INACTI ,VXI ,VYI ,VZI ,
1488 B MSI ,MTF ,CAND_SAV,NSN)
1489C-----------------------------------------------
1490C M o d u l e s
1491C-----------------------------------------------
1492 USE tri7box
1493C-----------------------------------------------
1494C I m p l i c i t T y p e s
1495C-----------------------------------------------
1496#include "implicit_f.inc"
1497#include "comlock.inc"
1498C-----------------------------------------------
1499C G l o b a l P a r a m e t e r s
1500C-----------------------------------------------
1501#include "mvsiz_p.inc"
1502C-----------------------------------------------
1503C D u m m y A r g u m e n t s
1504C-----------------------------------------------
1505 INTEGER JLT,INACTI,NIN,
1506 . itab(*),cand_n(*),cand_e(*), nsv(*),
1507 . noint,irect(4,*),
1508 . nsn
1509 my_real
1510 . x(3,*),a(3,*), ms(*), v(3,*), mtf(14,*),
1511 . gap, stfn(*),stifn(*),cand_sav(8,*)
1512 my_real
1513 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
1514 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
1515 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
1516 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
1517 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
1518 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz), stif(mvsiz),
1519 . gapv(mvsiz),
1520 . vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
1521C-----------------------------------------------
1522C L o c a l V a r i a b l e s
1523C-----------------------------------------------
1524 INTEGER I, IG, NN, NI,
1525 . l
1526 INTEGER IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ)
1527 my_real
1528 . FXI(MVSIZ), FYI(MVSIZ), FZI(MVSIZ), FNI(MVSIZ),
1529 . FX1(MVSIZ), FX2(MVSIZ), FX3(MVSIZ), FX4(MVSIZ),
1530 . FY1(MVSIZ), FY2(MVSIZ), FY3(MVSIZ), FY4(MVSIZ),
1531 . FZ1(MVSIZ), FZ2(MVSIZ), FZ3(MVSIZ), FZ4(MVSIZ),
1532 . N1(MVSIZ), N2(MVSIZ), N3(MVSIZ), PENE(MVSIZ),
1533 . H1(MVSIZ), H2(MVSIZ), H3(MVSIZ), H4(MVSIZ),
1534 . MT1XX(MVSIZ), MT1XY(MVSIZ), MT1XZ(MVSIZ),
1535 . MT1YY(MVSIZ), MT1YZ(MVSIZ), MT1ZZ(MVSIZ),
1536 . MT2XX(MVSIZ), MT2XY(MVSIZ), MT2XZ(MVSIZ),
1537 . MT2YY(MVSIZ), MT2YZ(MVSIZ), MT2ZZ(MVSIZ),
1538 . mt3xx(mvsiz), mt3xy(mvsiz), mt3xz(mvsiz),
1539 . mt3yy(mvsiz), mt3yz(mvsiz), mt3zz(mvsiz),
1540 . mt4xx(mvsiz), mt4xy(mvsiz), mt4xz(mvsiz),
1541 . mt4yy(mvsiz), mt4yz(mvsiz), mt4zz(mvsiz),
1542 . aaa
1543 my_real
1544 .
1545 . mtxx,mtxy,mtxz,mtyy,mtyz,mtzz
1546C-----------------------------------------------
1547C S o u r c e L i n e s
1548C-----------------------------------------------
1549C
1550 DO i=1,jlt
1551 h1(i) = cand_sav(1,i)
1552 h2(i) = cand_sav(2,i)
1553 h3(i) = cand_sav(3,i)
1554 h4(i) = cand_sav(4,i)
1555 n1(i) = cand_sav(5,i)
1556 n2(i) = cand_sav(6,i)
1557 n3(i) = cand_sav(7,i)
1558 pene(i) = cand_sav(8,i)
1559 l = cand_e(i)
1560 ix1(i) = irect(1,l)
1561 ix2(i) = irect(2,l)
1562 ix3(i) = irect(3,l)
1563 ix4(i) = irect(4,l)
1564 ni = cand_n(i)
1565 IF(ni <= nsn)THEN
1566 ig = nsv(ni)
1567 nsvg(i) = ig
1568 ELSE
1569 nn = ni - nsn
1570 nsvg(i) = -nn
1571 ENDIF
1572 ENDDO
1573C
1574 DO i=1,jlt
1575 msi(i) = zero
1576 fxi(i) = zero
1577 fyi(i) = zero
1578 fzi(i) = zero
1579 IF(pene(i) > zero)THEN
1580 ig=nsvg(i)
1581 IF(ig > 0)THEN
1582 IF(pene(i) == mtf(11,ig))THEN
1583
1584 msi(i) = ms(ig)
1585 fni(i) = n1(i) * a(1,ig)
1586 . + n2(i) * a(2,ig)
1587 . + n3(i) * a(3,ig)
1588
1589 aaa = one/max(em30,n1(i)**2 + n2(i)**2 + n3(i)**2)
1590 msi(i) = msi(i) * aaa
1591 aaa = fni(i) * aaa
1592 fxi(i) = n1(i) * aaa
1593 fyi(i) = n2(i) * aaa
1594 fzi(i) = n3(i) * aaa
1595 ELSE
1596 pene(i) = zero
1597 ENDIF
1598 ELSE
1599 IF(pene(i) == mtfi_penemin(nin)%P(-ig))THEN
1600 nn=-ig
1601
1602 msi(i)= msfi(nin)%P(nn)
1603 fni(i) = n1(i) * i18kafi(nin)%P(1,nn)
1604 . + n2(i) * i18kafi(nin)%P(2,nn)
1605 . + n3(i) * i18kafi(nin)%P(3,nn)
1606
1607 aaa = one/max(em30,n1(i)**2 + n2(i)**2 + n3(i)**2)
1608 msi(i) = msi(i) * aaa
1609 aaa = fni(i) * aaa
1610 fxi(i) = n1(i) * aaa
1611 fyi(i) = n2(i) * aaa
1612 fzi(i) = n3(i) * aaa
1613 ELSE
1614 pene(i) = zero
1615 ENDIF
1616 ENDIF
1617 cand_sav(8,i) = pene(i)
1618 ENDIF
1619C
1620 ENDDO
1621C---------------------------------
1622C transferring fluid force to structure nodes
1623C---------------------------------
1624 DO i=1,jlt
1625 IF(pene(i) > zero)THEN
1626 fx1(i)=fxi(i)*h1(i)
1627 fy1(i)=fyi(i)*h1(i)
1628 fz1(i)=fzi(i)*h1(i)
1629C
1630 fx2(i)=fxi(i)*h2(i)
1631 fy2(i)=fyi(i)*h2(i)
1632 fz2(i)=fzi(i)*h2(i)
1633C
1634 fx3(i)=fxi(i)*h3(i)
1635 fy3(i)=fyi(i)*h3(i)
1636 fz3(i)=fzi(i)*h3(i)
1637C
1638 fx4(i)=fxi(i)*h4(i)
1639 fy4(i)=fyi(i)*h4(i)
1640 fz4(i)=fzi(i)*h4(i)
1641C---------------------------------
1642c transferring fluid tensorial mass to structural nodes
1643C---------------------------------
1644c
1645c | nx*nx nx*ny nx*nz |
1646c Mt = | ny*ny ny*nz | ms
1647c | nz*nz |
1648c
1649C---------------------------------
1650
1651 mtxx = msi(i)*n1(i)*n1(i)
1652 mtxy = msi(i)*n1(i)*n2(i)
1653 mtxz = msi(i)*n1(i)*n3(i)
1654 mtyy = msi(i)*n2(i)*n2(i)
1655 mtyz = msi(i)*n2(i)*n3(i)
1656 mtzz = msi(i)*n3(i)*n3(i)
1657
1658 mt1xx(i) = h1(i)*mtxx
1659 mt1xy(i) = h1(i)*mtxy
1660 mt1xz(i) = h1(i)*mtxz
1661 mt1yy(i) = h1(i)*mtyy
1662 mt1yz(i) = h1(i)*mtyz
1663 mt1zz(i) = h1(i)*mtzz
1664
1665 mt2xx(i) = h2(i)*mtxx
1666 mt2xy(i) = h2(i)*mtxy
1667 mt2xz(i) = h2(i)*mtxz
1668 mt2yy(i) = h2(i)*mtyy
1669 mt2yz(i) = h2(i)*mtyz
1670 mt2zz(i) = h2(i)*mtzz
1671
1672 mt3xx(i) = h3(i)*mtxx
1673 mt3xy(i) = h3(i)*mtxy
1674 mt3xz(i) = h3(i)*mtxz
1675 mt3yy(i) = h3(i)*mtyy
1676 mt3yz(i) = h3(i)*mtyz
1677 mt3zz(i) = h3(i)*mtzz
1678
1679 mt4xx(i) = h4(i)*mtxx
1680 mt4xy(i) = h4(i)*mtxy
1681 mt4xz(i) = h4(i)*mtxz
1682 mt4yy(i) = h4(i)*mtyy
1683 mt4yz(i) = h4(i)*mtyz
1684 mt4zz(i) = h4(i)*mtzz
1685 ENDIF
1686 ENDDO
1687c
1688c temporaty : not PARITH/ON !
1689C
1690 DO i=1,jlt
1691 ig=nsvg(i)
1692 IF(pene(i) > zero)THEN
1693#include "lockon.inc"
1694 mtf(1,ix1(i)) = mtf(1,ix1(i)) + mt1xx(i)
1695 mtf(2,ix1(i)) = mtf(2,ix1(i)) + mt1xy(i)
1696 mtf(3,ix1(i)) = mtf(3,ix1(i)) + mt1xz(i)
1697 mtf(4,ix1(i)) = mtf(4,ix1(i)) + mt1yy(i)
1698 mtf(5,ix1(i)) = mtf(5,ix1(i)) + mt1yz(i)
1699 mtf(6,ix1(i)) = mtf(6,ix1(i)) + mt1zz(i)
1700 mtf(7,ix1(i)) = mtf(7,ix1(i)) + fx1(i)
1701 mtf(8,ix1(i)) = mtf(8,ix1(i)) + fy1(i)
1702 mtf(9,ix1(i)) = mtf(9,ix1(i)) + fz1(i)
1703
1704 mtf(1,ix2(i)) = mtf(1,ix2(i)) + mt2xx(i)
1705 mtf(2,ix2(i)) = mtf(2,ix2(i)) + mt2xy(i)
1706 mtf(3,ix2(i)) = mtf(3,ix2(i)) + mt2xz(i)
1707 mtf(4,ix2(i)) = mtf(4,ix2(i)) + mt2yy(i)
1708 mtf(5,ix2(i)) = mtf(5,ix2(i)) + mt2yz(i)
1709 mtf(6,ix2(i)) = mtf(6,ix2(i)) + mt2zz(i)
1710 mtf(7,ix2(i)) = mtf(7,ix2(i)) + fx2(i)
1711 mtf(8,ix2(i)) = mtf(8,ix2(i)) + fy2(i)
1712 mtf(9,ix2(i)) = mtf(9,ix2(i)) + fz2(i)
1713
1714 mtf(1,ix3(i)) = mtf(1,ix3(i)) + mt3xx(i)
1715 mtf(2,ix3(i)) = mtf(2,ix3(i)) + mt3xy(i)
1716 mtf(3,ix3(i)) = mtf(3,ix3(i)) + mt3xz(i)
1717 mtf(4,ix3(i)) = mtf(4,ix3(i)) + mt3yy(i)
1718 mtf(5,ix3(i)) = mtf(5,ix3(i)) + mt3yz(i)
1719 mtf(6,ix3(i)) = mtf(6,ix3(i)) + mt3zz(i)
1720 mtf(7,ix3(i)) = mtf(7,ix3(i)) + fx3(i)
1721 mtf(8,ix3(i)) = mtf(8,ix3(i)) + fy3(i)
1722 mtf(9,ix3(i)) = mtf(9,ix3(i)) + fz3(i)
1723
1724 mtf(1,ix4(i)) = mtf(1,ix4(i)) + mt4xx(i)
1725 mtf(2,ix4(i)) = mtf(2,ix4(i)) + mt4xy(i)
1726 mtf(3,ix4(i)) = mtf(3,ix4(i)) + mt4xz(i)
1727 mtf(4,ix4(i)) = mtf(4,ix4(i)) + mt4yy(i)
1728 mtf(5,ix4(i)) = mtf(5,ix4(i)) + mt4yz(i)
1729 mtf(6,ix4(i)) = mtf(6,ix4(i)) + mt4zz(i)
1730 mtf(7,ix4(i)) = mtf(7,ix4(i)) + fx4(i)
1731 mtf(8,ix4(i)) = mtf(8,ix4(i)) + fy4(i)
1732 mtf(9,ix4(i)) = mtf(9,ix4(i)) + fz4(i)
1733#include "lockoff.inc"
1734 ENDIF
1735 ENDDO
1736C-----------------------------------------------------
1737 RETURN
1738 END
1739!||====================================================================
1740!|| i18kine_v ../engine/source/interfaces/int18/i18main_kine.F
1741!||--- called by ------------------------------------------------------
1742!|| i18main_kine_v ../engine/source/interfaces/int18/i18main_kine.F
1743!||--- uses -----------------------------------------------------
1744!|| tri7box ../engine/share/modules/tri7box.F
1745!||====================================================================
1746 SUBROUTINE i18kine_v(JLT ,A ,V ,CAND_E ,CAND_N ,
1747 2 GAP ,MS ,NOINT ,STFN ,ITAB ,
1748 3 STIFN ,STIF ,X ,IRECT ,NSV ,
1749 4 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
1750 5 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
1751 6 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
1752 7 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
1753 8 P1 ,P2 ,P3 ,P4 ,NIN ,
1754 9 GAPV ,INACTI ,VXI ,VYI ,VZI ,
1755 A MSI ,MTF ,CAND_SAV,NSN)
1756C-----------------------------------------------
1757C M o d u l e s
1758C-----------------------------------------------
1759 USE tri7box
1760C-----------------------------------------------
1761C I m p l i c i t T y p e s
1762C-----------------------------------------------
1763#include "implicit_f.inc"
1764#include "comlock.inc"
1765C-----------------------------------------------
1766C G l o b a l P a r a m e t e r s
1767C-----------------------------------------------
1768#include "mvsiz_p.inc"
1769C-----------------------------------------------
1770C C o m m o n B l o c k s
1771C-----------------------------------------------
1772#include "com08_c.inc"
1773ctmp+1
1774C-----------------------------------------------
1775C D u m m y A r g u m e n t s
1776C-----------------------------------------------
1777 INTEGER JLT,INACTI,NIN,
1778 . ITAB(*),NOINT,IRECT(4,*),CAND_N(*),CAND_E(*),
1779 . nsn
1780 INTEGER NSV(*)
1781 my_real
1782 . x(3,*),
1783 . a(3,*), ms(*), v(3,*), gap, stfn(*),stifn(*)
1784 my_real
1785 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
1786 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
1787 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
1788 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
1789 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
1790 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz), stif(mvsiz),
1791 . gapv(mvsiz), mtf(14,*),cand_sav(8,*),
1792 . vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
1793C-----------------------------------------------
1794C L o c a l V a r i a b l e s
1795C-----------------------------------------------
1796 INTEGER I, IG, NN, NI,
1797 . L
1798 INTEGER IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ)
1799 my_real
1800 . N1(MVSIZ), N2(MVSIZ), N3(MVSIZ), PENE(MVSIZ),
1801 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
1802 . fac,
1803 . aaa
1804 my_real
1805 . v1,v2,v3,v4,vsx,vsy,vsz
1806C
1807C-----------------------------------------------
1808 DO i=1,jlt
1809 h1(i) = cand_sav(1,i)
1810 h2(i) = cand_sav(2,i)
1811 h3(i) = cand_sav(3,i)
1812 h4(i) = cand_sav(4,i)
1813 n1(i) = cand_sav(5,i)
1814 n2(i) = cand_sav(6,i)
1815 n3(i) = cand_sav(7,i)
1816 pene(i) = cand_sav(8,i)
1817 l = cand_e(i)
1818 ix1(i) = irect(1,l)
1819 ix2(i) = irect(2,l)
1820 ix3(i) = irect(3,l)
1821 ix4(i) = irect(4,l)
1822c NSVG(I) = NSV(CAND_N(I))
1823 ni = cand_n(i)
1824 IF(ni <= nsn)THEN
1825 ig = nsv(ni)
1826 nsvg(i) = ig
1827 ELSE
1828 nn = ni - nsn
1829 nsvg(i) = -nn
1830 ENDIF
1831
1832 ENDDO
1833C---------------------------------
1834C structural node imposed its velocity to fluid node
1835C + force calculation( POST-TREATMENT)
1836C---------------------------------
1837 DO i=1,jlt
1838 IF(pene(i) > zero)THEN
1839 ig=nsvg(i)
1840 fac = one
1841c warning normal is not normalized
1842 v1 = n1(i) * (v(1,ix1(i))+dt12*a(1,ix1(i)))
1843 . + n2(i) * (v(2,ix1(i))+dt12*a(2,ix1(i)))
1844 . + n3(i) * (v(3,ix1(i))+dt12*a(3,ix1(i)))
1845 v2 = n1(i) * (v(1,ix2(i))+dt12*a(1,ix2(i)))
1846 . + n2(i) * (v(2,ix2(i))+dt12*a(2,ix2(i)))
1847 . + n3(i) * (v(3,ix2(i))+dt12*a(3,ix2(i)))
1848 v3 = n1(i) * (v(1,ix3(i))+dt12*a(1,ix3(i)))
1849 . + n2(i) * (v(2,ix3(i))+dt12*a(2,ix3(i)))
1850 . + n3(i) * (v(3,ix3(i))+dt12*a(3,ix3(i)))
1851 v4 = n1(i) * (v(1,ix4(i))+dt12*a(1,ix4(i)))
1852 . + n2(i) * (v(2,ix4(i))+dt12*a(2,ix4(i)))
1853 . + n3(i) * (v(3,ix4(i))+dt12*a(3,ix4(i)))
1854 aaa = max(em30,n1(i)**2 + n2(i)**2 + n3(i)**2)
1855 aaa = fac*(h1(i)*v1 + h2(i)*v2 + h3(i)*v3 + h4(i)*v4)/aaa
1856c divide by square of normal vecotor Vs = (n.Vm).n / n.n
1857 vsx = n1(i) * aaa
1858 vsy = n2(i) * aaa
1859 vsz = n3(i) * aaa
1860 IF(ig > 0)THEN
1861#include "lockon.inc"
1862 mtf(1,ig) = mtf(1,ig)+vsx
1863 mtf(2,ig) = mtf(2,ig)+vsy
1864 mtf(3,ig) = mtf(3,ig)+vsz
1865 mtf(4,ig) = v(1,ig) + dt12*a(1,ig)
1866 mtf(5,ig) = v(2,ig) + dt12*a(2,ig)
1867 mtf(6,ig) = v(3,ig) + dt12*a(3,ig)
1868#include "lockoff.inc"
1869 ELSE
1870 nn=-ig
1871 mtfi_v(nin)%P(1,nn) = mtfi_v(nin)%P(1,nn)+vsx
1872 mtfi_v(nin)%P(2,nn) = mtfi_v(nin)%P(2,nn)+vsy
1873 mtfi_v(nin)%P(3,nn) = mtfi_v(nin)%P(3,nn)+vsz
1874 mtfi_v(nin)%P(4,nn) = vfi(nin)%P(1,nn)+dt12*i18kafi(nin)%P(1,nn)
1875 mtfi_v(nin)%P(5,nn) = vfi(nin)%P(2,nn)+dt12*i18kafi(nin)%P(2,nn)
1876 mtfi_v(nin)%P(6,nn) = vfi(nin)%P(3,nn)+dt12*i18kafi(nin)%P(3,nn)
1877 ENDIF
1878
1879 ENDIF
1880C
1881C
1882 ENDDO
1883
1884C-----------------------------------------------------
1885C not useful so far
1886C-----------------------------------------------------
1887CC'espMD: Identification of interf nodes.useful to send
1888C IF (NSPMD > 1) THEN
1889C DO I = 1,JLT
1890C IF(PENE(I) > ZERO)THEN
1891C NN = NSVG(I)
1892C IF(NN < 0)THEN
1893C temporary tag of nsvfi a -
1894C NSVFI(NIN)%P(-NN) = -ABS(NSVFI(NIN)%P(-NN))
1895C ENDIF
1896C ENDIF
1897C ENDDO
1898C ENDIF
1899C-----------------------------------------------------
1900C
1901 RETURN
1902 END
1903!||====================================================================
1904!|| i18kine_s ../engine/source/interfaces/int18/i18main_kine.F
1905!||--- called by ------------------------------------------------------
1906!|| i18main_kine_s ../engine/source/interfaces/int18/i18main_kine.F
1907!||--- uses -----------------------------------------------------
1908!|| h3d_mod ../engine/share/modules/h3d_mod.F
1909!|| output_mod ../common_source/modules/output/output_mod.F90
1910!|| tri7box ../engine/share/modules/tri7box.F
1911!||====================================================================
1912 SUBROUTINE i18kine_s(OUTPUT,JLT ,A ,V ,CAND_E,CAND_N ,
1913 2 GAP ,MS ,NOINT ,STFN ,ITAB ,
1914 3 STIFN ,STIF ,X ,IRECT ,NSV ,
1915 4 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
1916 5 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
1917 6 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
1918 7 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
1919 8 P1 ,P2 ,P3 ,P4 ,NIN ,
1920 9 GAPV ,INACTI ,VXI ,VYI ,VZI ,
1921 A MSI ,MTF ,CAND_SAV,FCONT,FSAV ,
1922 B NSN ,SLVNDTAG,H3D_DATA )
1923C-----------------------------------------------
1924C M o d u l e s
1925C-----------------------------------------------
1926 USE tri7box
1927 USE h3d_mod
1928 USE output_mod
1929C-----------------------------------------------
1930C I m p l i c i t T y p e s
1931C-----------------------------------------------
1932#include "implicit_f.inc"
1933#include "comlock.inc"
1934C-----------------------------------------------
1935C G l o b a l P a r a m e t e r s
1936C-----------------------------------------------
1937#include "mvsiz_p.inc"
1938C-----------------------------------------------
1939C C o m m o n B l o c k s
1940C-----------------------------------------------
1941#include "com01_c.inc"
1942#include "com06_c.inc"
1943#include "com08_c.inc"
1944#include "scr07_c.inc"
1945#include "scr14_c.inc"
1946#include "scr16_c.inc"
1947C-----------------------------------------------
1948C D u m m y A r g u m e n t s
1949C-----------------------------------------------
1950 TYPE(output_), INTENT(IN) :: OUTPUT
1951 INTEGER JLT,INACTI,NIN,
1952 . ITAB(*), NOINT, IRECT(4,*),CAND_N(*),CAND_E(*),
1953 . NSN
1954 INTEGER NSV(*) ,SLVNDTAG(*)
1955 my_real X(3,*), A(3,*), MS(*), V(3,*), FSAV(*),FCONT(3,*), GAP, STFN(*),STIFN(*), MTF(14,*),CAND_SAV(8,*)
1956 my_real NX1(MVSIZ), NX2(MVSIZ), NX3(MVSIZ), NX4(MVSIZ),
1957 . NY1(MVSIZ), NY2(MVSIZ), NY3(MVSIZ), NY4(MVSIZ),
1958 . NZ1(MVSIZ), NZ2(MVSIZ), NZ3(MVSIZ), NZ4(MVSIZ),
1959 . LB1(MVSIZ), LB2(MVSIZ), LB3(MVSIZ), LB4(MVSIZ),
1960 . LC1(MVSIZ), LC2(MVSIZ), LC3(MVSIZ), LC4(MVSIZ),
1961 . P1(MVSIZ), P2(MVSIZ), P3(MVSIZ), P4(MVSIZ), STIF(MVSIZ),
1962 . GAPV(MVSIZ),VXI(MVSIZ),VYI(MVSIZ),VZI(MVSIZ),MSI(MVSIZ)
1963 TYPE(H3D_DATABASE) :: H3D_DATA
1964C-----------------------------------------------
1965C L o c a l V a r i a b l e s
1966C-----------------------------------------------
1967 INTEGER I, IG, JG, NN, NI,
1968 . L
1969 INTEGER IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ)
1970 my_real FXI(MVSIZ), FYI(MVSIZ), FZI(MVSIZ), FNI(MVSIZ),
1971 . FX1(MVSIZ), FX2(MVSIZ), FX3(MVSIZ), FX4(MVSIZ),
1972 . FY1(MVSIZ), FY2(MVSIZ), FY3(MVSIZ), FY4(MVSIZ),
1973 . FZ1(MVSIZ), FZ2(MVSIZ), FZ3(MVSIZ), FZ4(MVSIZ),
1974 . PENE(MVSIZ),
1975 . H1(MVSIZ), H2(MVSIZ), H3(MVSIZ), H4(MVSIZ),
1976 . DT12INV, FAC, FAC2,
1977 . fsav1, fsav2, fsav3, fsav8,
1978 . fsav9, fsav10, fsav11,
1979 . aaa
1980 my_real impx,impy,impz,bbb,
1981 . vsx,vsy,vsz,dvsx,dvsy,dvsz,vsxp,vsyp,vszp
1982C
1983C-----------------------------------------------
1984 IF(dt12 > zero)THEN
1985 dt12inv = one/dt12
1986 ELSE
1987 dt12inv =zero
1988 ENDIF
1989C--------------------------------------------------------
1990 DO i=1,jlt
1991 h1(i) = cand_sav(1,i)
1992 h2(i) = cand_sav(2,i)
1993 h3(i) = cand_sav(3,i)
1994 h4(i) = cand_sav(4,i)
1995 pene(i) = cand_sav(8,i)
1996 l = cand_e(i)
1997 ix1(i) = irect(1,l)
1998 ix2(i) = irect(2,l)
1999 ix3(i) = irect(3,l)
2000 ix4(i) = irect(4,l)
2001 ni = cand_n(i)
2002 IF(ni <= nsn)THEN
2003 ig = nsv(ni)
2004 nsvg(i) = ig
2005 ELSE
2006 nn = ni - nsn
2007 nsvg(i) = -nn
2008 ENDIF
2009
2010 ENDDO
2011C---------------------------------
2012C structural node imposes its velocity to fluid node
2013C + force calculation (POST-TREATMENT)
2014C---------------------------------
2015 DO i=1,jlt
2016 IF(pene(i) > zero)THEN
2017c if a fluid node is treated several times, same velocity will be defined.
2018c force is ponderated with FAC
2019 ig=nsvg(i)
2020 IF(ig > 0)THEN
2021 vsx = mtf(1,ig)
2022 vsy = mtf(2,ig)
2023 vsz = mtf(3,ig)
2024 vsxp = mtf(4,ig)
2025 vsyp = mtf(5,ig)
2026 vszp = mtf(6,ig)
2027 fac = one
2028 fac2 = one
2029 msi(i) = ms(ig)
2030 vxi(i) = v(1,ig)
2031 vyi(i) = v(2,ig)
2032 vzi(i) = v(3,ig)
2033 ELSE
2034 nn=-ig
2035 vsx = mtfi_v(nin)%P(1,nn)
2036 vsy = mtfi_v(nin)%P(2,nn)
2037 vsz = mtfi_v(nin)%P(3,nn)
2038 vsxp = mtfi_v(nin)%P(4,nn)
2039 vsyp = mtfi_v(nin)%P(5,nn)
2040 vszp = mtfi_v(nin)%P(6,nn)
2041 fac = one
2042 fac2 = one
2043 msi(i) = msfi(nin)%P(nn)
2044 vxi(i) = vfi(nin)%P(1,nn)
2045 vyi(i) = vfi(nin)%P(2,nn)
2046 vzi(i) = vfi(nin)%P(3,nn)
2047 ENDIF
2048 aaa = vsx*vsx + vsy*vsy + vsz*vsz
2049 bbb = max(aaa,em30)
2050 aaa = (vxi(i)*vsx + vyi(i)*vsy + vzi(i)*vsz)/bbb
2051 aaa = (one-aaa)*fac2
2052 dvsx = aaa * vsx
2053 dvsy = aaa * vsy
2054 dvsz = aaa * vsz
2055c VSX = DVSX + VXI(I)
2056c VSY = DVSY + VYI(I)
2057c VSZ = DVSZ + VZI(I)
2058C=======================================================================
2059c made several time in case of multiple impacts
2060c but result is the same one
2061C=======================================================================
2062 IF(ig > 0)THEN
2063 a(1,ig) = dvsx*dt12inv
2064 a(2,ig) = dvsy*dt12inv
2065 a(3,ig) = dvsz*dt12inv
2066 IF(nspmd > 1)slvndtag(ig)=1
2067 ELSE
2068 nn=-ig
2069 mtfi_a(nin)%P(1,nn) = dvsx*dt12inv
2070 mtfi_a(nin)%P(2,nn) = dvsy*dt12inv
2071 mtfi_a(nin)%P(3,nn) = dvsz*dt12inv
2072C backup penetration as a tag if we need to update acceleration on domain which contains the node
2073 mtfi_a(nin)%P(7,nn) = pene(i)
2074 ENDIF
2075
2076c interface forces
2077
2078 aaa = (vsxp*vsx + vsyp*vsy + vszp*vsz)/bbb
2079 aaa = (one-aaa)*fac2
2080 aaa = aaa*fac*msi(i)*dt12inv
2081
2082 fxi(i) = -aaa * vsx
2083 fyi(i) = -aaa * vsy
2084 fzi(i) = -aaa * vsz
2085
2086c FNI(I) = N1(I) * FXI(I) + N2(I) * FYI(I) + N3(I) * FZI(I)
2087 fni(i) = sqrt(
2088 . fxi(i) * fxi(i) + fyi(i) * fyi(i) + fzi(i) * fzi(i))
2089
2090 fx1(i)=fxi(i)*h1(i)
2091 fy1(i)=fyi(i)*h1(i)
2092 fz1(i)=fzi(i)*h1(i)
2093
2094 fx2(i)=fxi(i)*h2(i)
2095 fy2(i)=fyi(i)*h2(i)
2096 fz2(i)=fzi(i)*h2(i)
2097
2098 fx3(i)=fxi(i)*h3(i)
2099 fy3(i)=fyi(i)*h3(i)
2100 fz3(i)=fzi(i)*h3(i)
2101
2102 fx4(i)=fxi(i)*h4(i)
2103 fy4(i)=fyi(i)*h4(i)
2104 fz4(i)=fzi(i)*h4(i)
2105 ENDIF
2106C
2107 ENDDO
2108
2109C---------------------------------
2110C BACKUP NORMAL IMPULSE
2111C---------------------------------
2112 fsav1 = zero
2113 fsav2 = zero
2114 fsav3 = zero
2115 fsav8 = zero
2116 fsav9 = zero
2117 fsav10= zero
2118 fsav11= zero
2119 DO i=1,jlt
2120 IF(pene(i) > zero)THEN
2121 impx=fxi(i)*dt12
2122 impy=fyi(i)*dt12
2123 impz=fzi(i)*dt12
2124 fsav1 =fsav1 +impx
2125 fsav2 =fsav2 +impy
2126 fsav3 =fsav3 +impz
2127 fsav8 =fsav8 +abs(impx)
2128 fsav9 =fsav9 +abs(impy)
2129 fsav10=fsav10+abs(impz)
2130 fsav11=fsav11+fni(i)*dt12
2131 ENDIF
2132 ENDDO
2133#include "lockon.inc"
2134 fsav(1)=fsav(1)+fsav1
2135 fsav(2)=fsav(2)+fsav2
2136 fsav(3)=fsav(3)+fsav3
2137 fsav(8)=fsav(8)+fsav8
2138 fsav(9)=fsav(9)+fsav9
2139 fsav(10)=fsav(10)+fsav10
2140 fsav(11)=fsav(11)+fsav11
2141#include "lockoff.inc"
2142C
2143 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT > 0.AND.
2144 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt >= toutp.OR.tt >= h3d_data%TH3D.OR.
2145 . (manim >= 4.AND.manim <= 15).OR. h3d_data%MH3D /= 0))THEN
2146#include "lockon.inc"
2147 DO i=1,jlt
2148 IF(pene(i) > zero)THEN
2149 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
2150 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
2151 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
2152 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
2153 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
2154 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
2155 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
2156 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
2157 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
2158 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
2159 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
2160 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
2161 jg = nsvg(i)
2162 IF(jg > 0) THEN
2163 fcont(1,jg)=fcont(1,jg)- fxi(i)
2164 fcont(2,jg)=fcont(2,jg)- fyi(i)
2165 fcont(3,jg)=fcont(3,jg)- fzi(i)
2166 ELSE
2167 nn=-jg
2168 mtfi_a(nin)%P(4,nn) = mtfi_a(nin)%P(4,nn) - fxi(i)
2169 mtfi_a(nin)%P(5,nn) = mtfi_a(nin)%P(5,nn) - fyi(i)
2170 mtfi_a(nin)%P(6,nn) = mtfi_a(nin)%P(6,nn) - fzi(i)
2171 ENDIF
2172 ENDIF
2173 ENDDO
2174#include "lockoff.inc"
2175 ENDIF
2176C-----------------------------------------------------
2177C
2178 RETURN
2179 END
my_real
#define my_real
Definition cppsort.cpp:32
i18main_kine_f
subroutine i18main_kine_f(nin, ipari, intbuf_tab, x, stifn, v, a, ms, itab, lindmax, cand_sav, mtf, jtask, nb_jlt, nb_jlt_new, nb_stok_n)
Definition i18main_kine.F:748
i18kine_f
subroutine i18kine_f(jlt, a, v, cand_e, cand_n, gap, ms, noint, stfn, itab, stifn, stif, x, irect, nsv, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, nin, gapv, inacti, vxi, vyi, vzi, msi, mtf, cand_sav, nsn)
Definition i18main_kine.F:1489
i18_kine_m
subroutine i18_kine_m(itask, nmn, msr, v, a, ms, mtf, iskew, skew, lcod, itab)
Definition i18main_kine.F:888
i18kine_i
subroutine i18kine_i(jlt, a, v, gap, ms, noint, stfn, itab, stifn, stif, x, irect, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, nin, ix1, ix2, ix3, ix4, nsvg, gapv, inacti, vxi, vyi, vzi, msi, mtf, index, cand_sav)
Definition i18main_kine.F:1269
i18kine_s
subroutine i18kine_s(output, jlt, a, v, cand_e, cand_n, gap, ms, noint, stfn, itab, stifn, stif, x, irect, nsv, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, nin, gapv, inacti, vxi, vyi, vzi, msi, mtf, cand_sav, fcont, fsav, nsn, slvndtag, h3d_data)
Definition i18main_kine.F:1923
i18main_kine_s
subroutine i18main_kine_s(output, nin, ipari, intbuf_tab, x, stifn, v, a, ms, fsav, fcont, jtask, itab, cand_sav, mtf, nb_jlt, nb_jlt_new, nb_stok_n, iskew, skew, lcod, slvndtag, h3d_data)
Definition i18main_kine.F:1118
i18main_kine_2
subroutine i18main_kine_2(output, ipari, intbuf_tab, x, v, a, iskew, skew, lcod, wa, ms, itab, fsav, jtask, kinet, stifn, mtf, cand_sav, fcont, int18add, iad_elem, fr_elem, h3d_data)
Definition i18main_kine.F:332
i18main_kine_i
subroutine i18main_kine_i(nin, ipari, intbuf_tab, x, stifn, v, a, ms, nmn, itab, lindmax, cand_sav, mtf, ale_ne_connect, nrtmdim, jtask, nb_jlt, nb_jlt_new, nb_stok_n, kinet, multi_fvm, xcell, s_xcell_remote, xcell_remote)
Definition i18main_kine.F:522
i18main_kine_1
subroutine i18main_kine_1(output, ipari, intbuf_tab, x, v, a, iskew, skew, lcod, wa, ms, itab, jtask, kinet, stifn, mtf, cand_sav, int18add, iad_elem, fr_elem, tagpene, h3d_data, multi_fvm, ale_ne_connect, xcell, xcell_remote)
Definition i18main_kine.F:51
i18kine_v
subroutine i18kine_v(jlt, a, v, cand_e, cand_n, gap, ms, noint, stfn, itab, stifn, stif, x, irect, nsv, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, nin, gapv, inacti, vxi, vyi, vzi, msi, mtf, cand_sav, nsn)
Definition i18main_kine.F:1756
i18main_kine_v
subroutine i18main_kine_v(nin, ipari, intbuf_tab, x, stifn, v, a, ms, jtask, itab, cand_sav, mtf, iskew, skew, lcod, nb_jlt, nb_jlt_new, nb_stok_n)
Definition i18main_kine.F:975
i7cdcor3
subroutine i7cdcor3(jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)
Definition i7cdcor3.F:38
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
array_mod
Definition array_mod.F:51
h3d_mod
Definition h3d_mod.F:311
i18dst3_mod
Definition i18dst3.F:29
i18dst3_mod::i18dst3
subroutine i18dst3(jlt, cand_n, cand_e, cn_loc, ce_loc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, ix1, ix2, ix3, ix4, nsvg, stif, jlt_new, gapv, cand_p, ale_ne_connect, index, vxi, vyi, itab, xcell, vzi, msi, kini, igap, multi_fvm, s_xcell_remote, xcell_remote)
Definition i18dst3.F:56
message_mod
Definition message_mod.F:1257
tri7box::i18kafi
type(real_pointer2), dimension(:), allocatable i18kafi
Definition tri7box.F:459
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::mtfi_a
type(real_pointer2), dimension(:), allocatable mtfi_a
Definition tri7box.F:459
tri7box::mtfi_pene
type(real_pointer), dimension(:), allocatable mtfi_pene
Definition tri7box.F:449
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::mtfi_n
type(real_pointer2), dimension(:), allocatable mtfi_n
Definition tri7box.F:459
tri7box::mtfi_penemin
type(real_pointer), dimension(:), allocatable mtfi_penemin
Definition tri7box.F:449
tri7box::mtfi_v
type(real_pointer2), dimension(:), allocatable mtfi_v
Definition tri7box.F:459
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_i18kine_com_a
subroutine spmd_i18kine_com_a(ipari, intbuf_tab, a, itab)
Definition spmd_i18kine_com_a.F:38
spmd_i18kine_com_acc
subroutine spmd_i18kine_com_acc(ipari, intbuf_tab, mtf, a, itab, tagpene)
Definition spmd_i18kine_com_acc.F:38
spmd_i18kine_com_ms
subroutine spmd_i18kine_com_ms(ipari, intbuf_tab, mtf, ms, itab)
Definition spmd_i18kine_com_ms.F:38
spmd_i18kine_com_v
subroutine spmd_i18kine_com_v(ipari, intbuf_tab, mtf, a, itab)
Definition spmd_i18kine_com_v.F:38
spmd_i18kine_macc_com_poff
subroutine spmd_i18kine_macc_com_poff(mtf, a, iad_elem, fr_elem, itab)
Definition spmd_i18kine_macc_com_poff.F:35
spmd_i18kine_msf_com_poff
subroutine spmd_i18kine_msf_com_poff(mtf, iad_elem, fr_elem, itab)
Definition spmd_i18kine_msf_com_poff.F:33
spmd_i18kine_pene_com_poff
subroutine spmd_i18kine_pene_com_poff(output, ipari, intbuf_tab, fcont, mtf, a, iad_elem, fr_elem, mode, slvndtag, tagpene, itab, h3d_data)
Definition spmd_i18kine_pene_com_poff.F:43
i7cor3
subroutine i7cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m, istf, gapmin, gapmax, gap_s_l, gap_m_l, drad, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, dgapload, last)
Definition i7cor3.F:43
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86
my_barrier
subroutine my_barrier
Definition machine.F:31
array_mod::array_type
Definition array_mod.F:61
h3d_mod::h3d_database
Definition h3d_mod.F:438