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