OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25for3_e2s.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!|| i25for3_e2s ../engine/source/interfaces/int25/i25for3_e2s.F
25!||--- called by ------------------------------------------------------
26!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
27!||--- calls -----------------------------------------------------
28!|| bitget ../engine/source/interfaces/intsort/i20sto.F
29!|| i25asse05_e2s ../engine/source/interfaces/int25/i25ass_e2s.F
30!|| i25asse0_e2s ../engine/source/interfaces/int25/i25ass_e2s.F
31!|| i25asse25_e2s ../engine/source/interfaces/int25/i25ass_e2s.F
32!|| i25asse2_e2s ../engine/source/interfaces/int25/i25ass_e2s.F
33!|| i25sms_e2s ../engine/source/interfaces/int25/i25sms_e2s.F
34!||--- uses -----------------------------------------------------
35!|| h3d_mod ../engine/share/modules/h3d_mod.F
36!|| tri25ebox ../engine/share/modules/tri25ebox.F
37!|| tri7box ../engine/share/modules/tri7box.F
38!||====================================================================
39 SUBROUTINE i25for3_e2s(
40 1 JLT ,A ,V ,IBC ,ICODT ,
41 2 FSAV ,GAP ,FRIC ,MS ,VISC ,
42 3 VISCF ,NOINT ,ITAB ,CS_LOC ,CM_LOC ,
43 4 STIGLO ,STIFN ,STIF ,FSKYI ,ISKY ,
44 5 FCONT ,DT2T ,NRTM ,MSEGTYP ,HS1 ,
45 6 HS2 ,HM1 ,HM2 ,N1 ,N2 ,
46 7 M1 ,M2 ,IVIS2 ,NELTST ,ITYPTST,
47 8 NX ,NY ,NZ ,GAPVE ,INACTI ,
48 9 INDEX ,CAND_P ,NISKYFIE,NEWFRONT,ISECIN ,
49 A NSTRF ,SECFCUM,VISCN ,NEDGE ,MS1 ,
50 B MS2 ,MM1 ,MM2 ,VXS1 ,VYS1 ,
51 C VZS1 ,VXS2 ,VYS2 ,VZS2 ,VXM1 ,
52 D VYM1 ,VZM1 ,VXM2 ,VYM2 ,VZM2 ,
53 E NIN ,NISUB ,LISUB ,ADDSUBE ,ADDSUBM,
54 F LISUBE ,LISUBM ,INFLG_SUBE,INFLG_SUBM,FSAVSUB,
55 G MSKYI_SMS,ISKYI_SMS,NSMS ,JTASK ,ISENSINT,
56 H FSAVPARIT,NFT ,H3D_DATA,INDX1 ,INDX2 ,
57 I ILEV ,MBINFLG, EDGE_ID, NEDGE_REM ,FRICC ,
58 J IFQ ,CAND_FX, CAND_FY, CAND_FZ ,IFPEN ,
59 K TAGNCONT ,KLOADPINTER,LOADPINTER ,LOADP_HYD_INTER,
60 L TYPSUB ,STARTT,NINLOADP ,DGAPLOADINT,S_LOADPINTER)
61C-----------------------------------------------
62C M o d u l e s
63C-----------------------------------------------
64 USE tri7box
65 USE tri25ebox
66 USE h3d_mod
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71#include "comlock.inc"
72C-----------------------------------------------
73C G l o b a l P a r a m e t e r s
74C-----------------------------------------------
75#include "mvsiz_p.inc"
76#include "assert.inc"
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "com01_c.inc"
81#include "com04_c.inc"
82#include "com06_c.inc"
83#include "com08_c.inc"
84#include "scr05_c.inc"
85#include "scr11_c.inc"
86#include "scr14_c.inc"
87#include "scr16_c.inc"
88#include "scr18_c.inc"
89#include "param_c.inc"
90#include "parit_c.inc"
91#include "impl1_c.inc"
92#include "sms_c.inc"
93C-----------------------------------------------
94C D u m m y A r g u m e n t s
95C-----------------------------------------------
96 INTEGER :: EDGE_ID(2,4*MVSIZ),NEDGE_REM
97 INTEGER NELTST,ITYPTST,JLT,IBC,IVIS2,INACTI,NEDGE,NISKYFIE,NIN,NRTM,ILEV,
98 . IFQ
99 INTEGER ICODT(*), ITAB(*), ISKY(*),
100 . NOINT,NEWFRONT,ISECIN, NSTRF(*), ISKYI_SMS(*), MSEGTYP(*),
101 . NISUB, LISUB(*), ADDSUBE(*), ADDSUBM(*), LISUBE(*), LISUBM(*),
102 . INFLG_SUBE(*), INFLG_SUBM(*), MBINFLG(*), IFPEN(*),TYPSUB(*)
103 INTEGER N1(*), N2(*), M1(*), M2(*), NSMS(*),
104 . CS_LOC(4*MVSIZ), CM_LOC(4*MVSIZ), JTASK,
105 . ISENSINT(*),NFT,INDEX(*), INDX1(4*MVSIZ), INDX2(4*MVSIZ),
106 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD)
107 INTEGER , INTENT(IN) :: NINLOADP,S_LOADPINTER
108 INTEGER , INTENT(IN) :: KLOADPINTER(NINTER+1),LOADPINTER(S_LOADPINTER),
109 . LOADP_HYD_INTER(NLOADP_HYD)
110 my_real
111 . STIGLO,
112 . A(3,*), MS(*), V(3,*), FSAV(*),FCONT(3,*),
113 . STIFN(*),FSKYI(LSKYI,NFSKYI),FSAVSUB(NTHVKI,*),
114 . MSKYI_SMS(*), GAPVE(*), CAND_P(4,*),
115 . GAP,FRIC,VISC,VISCF,VIS,DT2T,STARTT
116 my_real
117 . hs1(*), hs2(*), hm1(*), hm2(*),
118 . nx(*), ny(*), nz(*), stif(*),
119 . secfcum(7,numnod,nsect), viscn(*),
120 . ms1(*),ms2(*),mm1(*),mm2(*),
121 . vxs1(*),vys1(*),vzs1(*),vxs2(*),vys2(*),
122 . vzs2(*),vxm1(*),vym1(*),vzm1(*),vxm2(*),
123 . vym2(*),vzm2(*),fsavparit(nisub+1,11,*),
124 . fricc(*),cand_fx(4,*),cand_fy(4,*),cand_fz(4,*)
125 my_real , INTENT(IN) :: dgaploadint(s_loadpinter)
126 TYPE(h3d_database) :: H3D_DATA
127C-----------------------------------------------
128C L o c a l V a r i a b l e s
129C-----------------------------------------------
130 INTEGER I, J, K0, NBINTER, K1S, K, NI, IL, IE, PP, PPL
131
132 INTEGER JSUB,KSUB,NSUB,JJ,KK,ISS1,ISS2,IMS1,IMS2,ITYPSUB,
133 . TAGIP(4*MVSIZ)
134 my_real
135 . VX(4*MVSIZ), VY(4*MVSIZ), VZ(4*MVSIZ), VN(4*MVSIZ),
136 . FXI(4*MVSIZ), FYI(4*MVSIZ), FZI(4*MVSIZ), FNI(4*MVSIZ),
137 . fx1(4*mvsiz), fx2(4*mvsiz), fx3(4*mvsiz), fx4(4*mvsiz),
138 . fy1(4*mvsiz), fy2(4*mvsiz), fy3(4*mvsiz), fy4(4*mvsiz),
139 . fz1(4*mvsiz), fz2(4*mvsiz), fz3(4*mvsiz), fz4(4*mvsiz),
140 . fxt(4*mvsiz), fyt(4*mvsiz), fzt(4*mvsiz),
141 . vis2(4*mvsiz),pene(4*mvsiz),dist(4*mvsiz),
142 . vmax,s2,
143 . dt1inv, fac, ff,
144 . fx, fy, fz, mas2,dti,
145 . econtt, econvt,masm,
146 . fsav1, fsav2, fsav3, fsav4, fsav5, fsav6, fsav8,
147 . fsav9, fsav10, fsav11, fsav12, fsav13, fsav14, fsav15,
148 . dgapload,
149 . fsavsub1(24,nisub), impx, impy, impz,ftn ,fn , ft,beta
150 my_real
151 . prec
152 my_real
153 . st1(4*mvsiz),st2(4*mvsiz),st3(4*mvsiz),st4(4*mvsiz),stif0(4*mvsiz),
154 . kt(4*mvsiz),c(4*mvsiz),cf(4*mvsiz),
155 . k1(4*mvsiz),k2(4*mvsiz),k3(4*mvsiz),k4(4*mvsiz),
156 . c1(4*mvsiz),c2(4*mvsiz),c3(4*mvsiz),c4(4*mvsiz),
157 . cx,cy,cfi,aux
158C
159 INTEGER BITGET
160 EXTERNAL BITGET
161C-----------------------------------------------
162
163 IF (IRESP == 1) then
164 prec = fiveem4
165 ELSE
166 prec = em10
167 ENDIF
168 IF(dt1>zero)THEN
169 dt1inv = one/dt1
170 ELSE
171 dt1inv =zero
172 ENDIF
173 econtt = zero
174 econvt = zero
175 DO i=1,jlt
176 stif0(i) = stif(i)
177 ENDDO
178C
179 DO i=1,jlt
180 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
181 dist(i)=s2
182 IF(gapve(i)/=zero)THEN
183 pene(i) = max(zero,gapve(i) - s2)
184 ELSE ! Solids
185 pene(i) = s2
186c print *,pene(i),itab(n1(i)),itab(n2(i)),itab(m1(i)),itab(m2(i))
187 END IF
188 s2 = one/max(em30,s2)
189 nx(i) = nx(i)*s2
190 ny(i) = ny(i)*s2
191 nz(i) = nz(i)*s2
192C WRITE(6,"(2I20,X,A,3Z20)") EDGE_ID(1,I),EDGE_ID(2,I),"NXYZ=",NX(I),NY(I),NZ(I)
193 ENDDO
194C
195 DO i=1,jlt
196 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,cand_p(indx2(i),indx1(i)))
197 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,pene(i))
198 IF(cand_p(indx2(i),indx1(i))==zero)cand_p(indx2(i),indx1(i))=pene(i) ! 1st impact
199 ENDDO
200C
201 IF(inacti/=-1)THEN ! INACTI=5 & INACTI=0 !
202 DO i=1,jlt
203
204 IF(cand_p(indx2(i),indx1(i))<zero) THEN ! Penetration coming from starter
205 IF(startt>zero) THEN ! If Tstart Peneinit = Pene_engine
206 cand_p(indx2(i),indx1(i))=pene(i) ! 1st impact
207 ELSE
208 cand_p(indx2(i),indx1(i))=-cand_p(indx2(i),indx1(i)) ! 1st impact
209 ENDIF
210 ENDIF
211
212C Reduce PENE
213 IF(pene(i)/=cand_p(indx2(i),indx1(i))) ! insures force == zero !
214 . cand_p(indx2(i),indx1(i))=min(cand_p(indx2(i),indx1(i)),
215 . ((one-fiveem2)*cand_p(indx2(i),indx1(i))+fiveem2*pene(i)) )
216
217 pene(i)=max(zero,pene(i)-cand_p(indx2(i),indx1(i)))
218 IF( pene(i)==zero ) stif(i) = zero
219 ENDDO
220 ELSE
221 DO i=1,jlt
222 IF(cand_p(indx2(i),indx1(i)) < zero)THEN
223C
224C CAND_P < 0 <=> Initial penetration computed into the Starter => Do not reduce PENE
225 cand_p(indx2(i),indx1(i)) = -cand_p(indx2(i),indx1(i))
226 IF(pene(i)/=cand_p(indx2(i),indx1(i))) ! insures no modification of CAND_P !
227 . cand_p(indx2(i),indx1(i)) = min(cand_p(indx2(i),indx1(i)),
228 . ((one-fiveem2)*cand_p(indx2(i),indx1(i))+fiveem2*pene(i)) )
229 cand_p(indx2(i),indx1(i)) = -cand_p(indx2(i),indx1(i)) ! back to negative value
230 IF( pene(i)==zero ) stif(i) = zero
231 ELSE
232C
233C New impact computed into the Engine => Reduce PENE
234 IF(pene(i)/=cand_p(indx2(i),indx1(i))) ! insures force == zero !
235 . cand_p(indx2(i),indx1(i))=min(cand_p(indx2(i),indx1(i)),
236 . ((one-fiveem2)*cand_p(indx2(i),indx1(i))+fiveem2*pene(i)) )
237C subtraction of the initial pene from the pene and the gap
238 pene(i)=max(zero,pene(i)-cand_p(indx2(i),indx1(i)))
239 IF( pene(i)==zero ) stif(i) = zero
240 END IF
241 ENDDO
242 ENDIF
243
244 vmax = zero
245 DO i=1,jlt
246 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
247 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
248 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
249 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
250 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
251 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
252 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
253 ENDDO
254C-------------------------------------------
255
256 DO i=1,jlt
257 stif(i)= half*stif(i)
258 fni(i) = -stif(i) * pene(i)
259 econvt = econvt+fni(i)*vn(i)*dt1
260 ENDDO
261C---------------------------------
262C DAMPING + FRIC
263C---------------------------------
264 IF(visc/=zero)THEN
265 IF(ivis2==-1)THEN
266 IF(kdtint==0.AND.(idtmins/=2.AND.idtmins_int==0))THEN
267 DO i=1,jlt
268 fac = stif(i) / max(em30,stif(i))
269 mas2 = ms1(i)*hs1(i)
270 . + ms2(i)*hs2(i)
271 masm = mm1(i)*hm1(i)
272 . + mm2(i)*hm2(i)
273 vis2(i) = two * stif(i) * min(mas2,masm)
274 vis = sqrt(vis2(i))
275 ff = fac * visc * vis
276 stif(i) = stif0(i) + ff * dt1inv
277 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
278 ff = ff * vn(i)
279 econvt = econvt + ff * vn(i) * dt1
280 fni(i) = fni(i) + ff
281 ENDDO
282
283 ELSE
284 DO i=1,jlt
285 fac = stif(i) / max(em30,stif(i))
286 mas2 = ms1(i)*hs1(i)
287 . + ms2(i)*hs2(i)
288 masm = mm1(i)*hm1(i)
289 . + mm2(i)*hm2(i)
290 vis2(i) = two * stif(i) * min(mas2,masm)
291 vis = sqrt(vis2(i))
292 c(i)= fac * visc * vis
293 kt(i)= stif0(i)
294 stif(i) = stif(i) + c(i) * dt1inv
295 ff = c(i) * vn(i)
296 econvt = econvt + ff * vn(i) * dt1
297 fni(i) = fni(i) + ff
298 cf(i) = fac*sqrt(viscf)*vis
299 stif(i) = max(stif(i) ,cf(i)*dt1inv)
300 ENDDO
301 ENDIF
302 ELSEIF(ivis2==1)THEN
303C---------------------------------
304 IF(kdtint==0.AND.(idtmins/=2.AND.idtmins_int==0))THEN
305 DO i=1,jlt
306 fac = stif(i) / max(em30,stif(i))
307 mas2 = ms1(i)*hs1(i)
308 . + ms2(i)*hs2(i)
309 masm = mm1(i)*hm1(i)
310 . + mm2(i)*hm2(i)
311C WRITE(6,"(2I20,3Z20)") EDGE_ID(1,I),EDGE_ID(2,I),STIF(I),MASM,MAS2
312c DEBUG_E2E(.TRUE.,STIF(I))
313c DEBUG_E2E(.TRUE.,MAS2)
314c DEBUG_E2E(.TRUE.,MASM)
315
316 vis2(i) = two* stif(i) * masm * mas2 /
317 . max(em30,masm+mas2)
318 vis = sqrt(vis2(i))
319 ff = fac * visc * vis
320 stif(i) = stif0(i) + ff * dt1inv
321 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
322 ff = ff * vn(i)
323 econvt = econvt + ff * vn(i) * dt1
324 fni(i) = fni(i) + ff
325 ENDDO
326
327 ELSE
328 DO i=1,jlt
329 fac = stif(i) / max(em30,stif(i))
330 mas2 = ms1(i)*hs1(i)
331 . + ms2(i)*hs2(i)
332 masm = mm1(i)*hm1(i)
333 . + mm2(i)*hm2(i)
334 vis2(i) = two* stif(i) * masm * mas2 /
335 . max(em30,masm+mas2)
336 vis = sqrt(vis2(i))
337 c(i)= fac * visc * vis
338 kt(i)= stif0(i)
339 stif(i) = stif(i) + c(i) * dt1inv
340 ff = c(i) * vn(i)
341 econvt = econvt + ff * vn(i) * dt1
342 fni(i) = fni(i) + ff
343 cf(i) = fac*sqrt(viscf)*vis
344 stif(i) = max(stif(i) ,cf(i)*dt1inv)
345 ENDDO
346 ENDIF
347
348 ELSEIF(ivis2==2)THEN
349C---------------------------------
350C VISC QUAD TYPE
351C---------------------------------
352 DO i=1,jlt
353 fac = stif(i) / max(em30,stif(i))
354 mas2 = ms1(i)*hs1(i)
355 . + ms2(i)*hs2(i)
356 masm = mm1(i)*hm1(i)
357 . + mm2(i)*hm2(i)
358 vis2(i) = two * stif(i) * min(mas2,masm)
359 vis = sqrt(vis2(i))
360 ff = fac * visc * vis
361 stif(i) = stif0(i) + two * ff * dt1inv
362 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
363 ff = ff * vn(i)
364 econvt = econvt + ff * vn(i) * dt1
365 fni(i) = fni(i) + ff
366 ENDDO
367 ELSEIF(ivis2==3)THEN
368C---------------------------------
369C VISC QUAD = 0
370C---------------------------------
371 DO i=1,jlt
372 fac = stif(i) / max(em30,stif(i))
373 mas2 = ms1(i)*hs1(i)
374 . + ms2(i)*hs2(i)
375 masm = mm1(i)*hm1(i)
376 . + mm2(i)*hm2(i)
377 vis2(i) = two * stif(i) * min(mas2,masm)
378 vis = sqrt(vis2(i))
379 ff = fac * visc * vis
380 stif(i) = stif0(i) + two* ff * dt1inv
381 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
382 ff = ff * vn(i)
383 econvt = econvt + ff * vn(i) * dt1
384 fni(i) = fni(i) + ff
385 ENDDO
386 ELSEIF(ivis2==4)THEN
387C---------------------------------
388C VISC = 0
389C---------------------------------
390 DO i=1,jlt
391 fac = stif(i) / max(em30,stif(i))
392 mas2 = ms1(i)*hs1(i)
393 . + ms2(i)*hs2(i)
394 masm = mm1(i)*hm1(i)
395 . + mm2(i)*hm2(i)
396 vis2(i) = two * stif(i) * min(mas2,masm)
397 vis = sqrt(vis2(i))
398 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
399 ENDDO
400 ELSEIF(ivis2==5)THEN
401C---------------------------------
402C Visc = 2m/dt => For visc <1, stable: Dt <2m/visc = Dt
403C M = m1*m2/m1+m2 for visc = 1, elastic shock
404C For visc = 0.5, elastic collision
405C---------------------------------
406 DO i=1,jlt
407 fac = stif(i) / max(em30,stif(i))
408 mas2 = ms1(i)*hs1(i)
409 . + ms2(i)*hs2(i)
410 masm = mm1(i)*hm1(i)
411 . + mm2(i)*hm2(i)
412 vis2(i) = two* stif(i) * masm * mas2 /
413 . max(em30,masm+mas2)
414 vis = 2. * visc * dt1inv * masm * mas2 /
415 . max(em30,masm+mas2)
416 stif(i) = max(stif0(i) ,fac*sqrt(viscf*vis2(i))*dt1inv)
417 ff = vis * vn(i)
418 econvt = econvt + ff * vn(i) * dt1
419 fni(i) = min(fni(i),ff)
420 ENDDO
421 ELSE
422 ENDIF
423 ELSE
424 ENDIF
425C---------------------------------
426C SAUVEGARDE DE L'IMPULSION NORMALE
427C---------------------------------
428 fsav1 = zero
429 fsav2 = zero
430 fsav3 = zero
431 fsav8 = zero
432 fsav9 = zero
433 fsav10= zero
434 fsav11= zero
435 IF(ilev==2)THEN
436 DO i=1,jlt
437 IF(pene(i) == zero)cycle
438 ie=cm_loc(i)
439 ims2 = bitget(mbinflg(ie),1)
440 fxi(i)=nx(i)*fni(i)
441 fyi(i)=ny(i)*fni(i)
442 fzi(i)=nz(i)*fni(i)
443 impx=fxi(i)*dt12
444 impy=fyi(i)*dt12
445 impz=fzi(i)*dt12
446 IF (ims2 > 0 ) THEN
447 fsav1 =fsav1 -impx
448 fsav2 =fsav2 -impy
449 fsav3 =fsav3 -impz
450 fsav11=fsav11-fni(i)*dt12
451 ELSE
452 fsav1 =fsav1 +impx
453 fsav2 =fsav2 +impy
454 fsav3 =fsav3 +impz
455 fsav11=fsav11+fni(i)*dt12
456 END IF
457 fsav8 =fsav8 +abs(impx)
458 fsav9 =fsav9 +abs(impy)
459 fsav10=fsav10+abs(impz)
460 IF(isensint(1)/=0) THEN
461 IF (ims2 >0 ) THEN
462 fsavparit(1,1,i) = -fxi(i)
463 fsavparit(1,2,i) = -fyi(i)
464 fsavparit(1,3,i) = -fzi(i)
465 ELSE
466 fsavparit(1,1,i) = fxi(i)
467 fsavparit(1,2,i) = fyi(i)
468 fsavparit(1,3,i) = fzi(i)
469 END IF
470 ENDIF
471 ENDDO
472 ELSE
473 DO i=1,jlt
474 IF(pene(i) == zero)cycle
475 fxi(i)=nx(i)*fni(i)
476 fyi(i)=ny(i)*fni(i)
477 fzi(i)=nz(i)*fni(i)
478 impx=fxi(i)*dt12
479 impy=fyi(i)*dt12
480 impz=fzi(i)*dt12
481 fsav1 =fsav1 -impx
482 fsav2 =fsav2 -impy
483 fsav3 =fsav3 -impz
484 fsav11=fsav11-fni(i)*dt12
485 fsav8 =fsav8 +abs(impx)
486 fsav9 =fsav9 +abs(impy)
487 fsav10=fsav10+abs(impz)
488 IF(isensint(1)/=0) THEN
489 fsavparit(1,1,i) = fxi(i)
490 fsavparit(1,2,i) = fyi(i)
491 fsavparit(1,3,i) = fzi(i)
492 ENDIF
493 ENDDO
494 END IF
495 IF (imconv==1) THEN
496#include "lockon.inc"
497 fsav(1)=fsav(1)+fsav1
498 fsav(2)=fsav(2)+fsav2
499 fsav(3)=fsav(3)+fsav3
500 fsav(8)=fsav(8)+fsav8
501 fsav(9)=fsav(9)+fsav9
502 fsav(10)=fsav(10)+fsav10
503 fsav(11)=fsav(11)+fsav11
504#include "lockoff.inc"
505 ENDIF
506C---------------------------------
507C SORTIES TH PAR SOUS INTERFACE
508C---------------------------------
509 IF(nisub/=0)THEN
510 DO jsub=1,nisub
511 DO j=1,24
512 fsavsub1(j,jsub)=zero
513 END DO
514 ENDDO
515 DO i=1,jlt
516
517 IF(pene(i) == zero)cycle
518
519 il = cs_loc(i)
520 IF(il<=nedge)THEN
521
522 IF (msegtyp(cm_loc(i)) < 0) THEN
523 ie= - msegtyp(cm_loc(i))
524 ELSE
525 ie = cm_loc(i)
526 ENDIF
527 IF(ie > nrtm) ie=ie-nrtm
528
529 jj =addsube(il)
530 kk =addsubm(ie)
531 DO WHILE(jj<addsube(il+1))
532 jsub=lisube(jj)
533 itypsub = typsub(jsub)
534
535 IF(itypsub == 1 ) THEN ! Defining specific inter
536
537 iss1 = bitget(inflg_sube(jj),0)
538 iss2 = bitget(inflg_sube(jj),1)
539 ksub=lisube(kk)
540 DO WHILE((ksub<=jsub).AND.(kk<addsube(ie+1)))
541 ims1 = bitget(inflg_subm(kk),0)
542 ims2 = bitget(inflg_subm(kk),1)
543 IF(ksub==jsub)THEN
544 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
545 . (ims2 == 1 .AND. iss1 == 1))) THEN
546 kk=kk+1
547 ksub=lisube(kk)
548 cycle
549 END IF
550 impx=fxi(i)*dt12
551 impy=fyi(i)*dt12
552 impz=fzi(i)*dt12
553
554 IF(ims2 > 0)THEN
555 fsavsub1(1,jsub)=fsavsub1(1,jsub)-impx
556 fsavsub1(2,jsub)=fsavsub1(2,jsub)-impy
557 fsavsub1(3,jsub)=fsavsub1(3,jsub)-impz
558 fsavsub1(11,jsub)=fsavsub1(11,jsub)-fni(i)*dt12
559 ELSE
560 fsavsub1(1,jsub)=fsavsub1(1,jsub)+impx
561 fsavsub1(2,jsub)=fsavsub1(2,jsub)+impy
562 fsavsub1(3,jsub)=fsavsub1(3,jsub)+impz
563 fsavsub1(11,jsub)=fsavsub1(11,jsub)+fni(i)*dt12
564 END IF
565C
566 IF(isensint(jsub+1)/=0) THEN
567 IF(ims2 > 0)THEN
568 fsavparit(jsub+1,1,i) = -fxi(i)
569 fsavparit(jsub+1,2,i) = -fyi(i)
570 fsavparit(jsub+1,3,i) = -fzi(i)
571 ELSE
572 fsavparit(jsub+1,1,i) = fxi(i)
573 fsavparit(jsub+1,2,i) = fyi(i)
574 fsavparit(jsub+1,3,i) = fzi(i)
575 END IF
576 ENDIF
577C
578 fsavsub1(8,jsub) =fsavsub1(8,jsub) +abs(impx)
579 fsavsub1(9,jsub) =fsavsub1(9,jsub) +abs(impy)
580 fsavsub1(10,jsub)=fsavsub1(10,jsub)+abs(impz)
581C
582 ENDIF
583 kk=kk+1
584 ksub=lisube(kk)
585 ENDDO
586 jj=jj+1
587
588 ELSEIF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only secnd surface
589
590 impx=fxi(i)*dt12
591 impy=fyi(i)*dt12
592 impz=fzi(i)*dt12
593
594
595 fsavsub1(1,jsub)=fsavsub1(1,jsub)+impx
596 fsavsub1(2,jsub)=fsavsub1(2,jsub)+impy
597 fsavsub1(3,jsub)=fsavsub1(3,jsub)+impz
598
599 fsavsub1(8,jsub) =fsavsub1(8,jsub) +abs(impx)
600 fsavsub1(9,jsub) =fsavsub1(9,jsub) +abs(impy)
601 fsavsub1(10,jsub)=fsavsub1(10,jsub)+abs(impz)
602
603 fsavsub1(11,jsub)=fsavsub1(11,jsub)+fni(i)*dt12
604
605 IF(isensint(jsub+1)/=0) THEN
606 fsavparit(jsub+1,1,i) = fxi(i)
607 fsavparit(jsub+1,2,i) = fyi(i)
608 fsavparit(jsub+1,3,i) = fzi(i)
609 ENDIF
610
611 jj=jj+1
612
613 ELSEIF(itypsub == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2 surfs
614
615 iss2 = bitget(inflg_sube(jj),0)
616 iss1 = bitget(inflg_sube(jj),1)
617 ksub=lisube(kk)
618 DO WHILE((ksub<=jsub).AND.(kk<addsube(ie+1)))
619 ims2 = bitget(inflg_subm(kk),0)
620 ims1 = bitget(inflg_subm(kk),1)
621 IF(ksub==jsub)THEN
622 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
623 . (ims2 == 1 .AND. iss1 == 1))) THEN
624 kk=kk+1
625 ksub=lisube(kk)
626 cycle
627 END IF
628
629 IF(ims2 > 0)THEN
630 fsavsub1(1,jsub)=fsavsub1(1,jsub)-impx
631 fsavsub1(2,jsub)=fsavsub1(2,jsub)-impy
632 fsavsub1(3,jsub)=fsavsub1(3,jsub)-impz
633 fsavsub1(11,jsub)=fsavsub1(11,jsub)-fni(i)*dt12
634 ELSE
635 fsavsub1(1,jsub)=fsavsub1(1,jsub)+impx
636 fsavsub1(2,jsub)=fsavsub1(2,jsub)+impy
637 fsavsub1(3,jsub)=fsavsub1(3,jsub)+impz
638 fsavsub1(11,jsub)=fsavsub1(11,jsub)+fni(i)*dt12
639 ENDIF
640
641 fsavsub1(8,jsub) =fsavsub1(8,jsub) +abs(impx)
642 fsavsub1(9,jsub) =fsavsub1(9,jsub) +abs(impy)
643 fsavsub1(10,jsub)=fsavsub1(10,jsub)+abs(impz)
644
645 IF(isensint(jsub+1)/=0) THEN
646 IF(ims2 > 0)THEN
647 fsavparit(jsub+1,1,i) = -fxi(i)
648 fsavparit(jsub+1,2,i) = -fyi(i)
649 fsavparit(jsub+1,3,i) = -fzi(i)
650 ELSE
651 fsavparit(jsub+1,1,i) = fxi(i)
652 fsavparit(jsub+1,2,i) = fyi(i)
653 fsavparit(jsub+1,3,i) = fzi(i)
654 END IF
655 ENDIF
656
657C
658 ENDIF
659 kk=kk+1
660 ksub=lisube(kk)
661 ENDDO
662 jj=jj+1
663
664 ENDIF
665
666 END DO
667 END IF
668
669
670 IF (msegtyp(cm_loc(i)) < 0) THEN
671 ie= - msegtyp(cm_loc(i))
672 ELSE
673 ie = cm_loc(i)
674 ENDIF
675 IF(ie > nrtm) ie=ie-nrtm
676
677 kk =addsubm(ie)
678 DO WHILE(kk<addsube(ie+1))
679 ksub=lisube(kk)
680 itypsub = typsub(ksub)
681 IF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : main side
682
683 impx=-fxi(i)*dt12
684 impy=-fyi(i)*dt12
685 impz=-fzi(i)*dt12
686
687 fsavsub1(1,ksub)=fsavsub1(1,ksub)+impx
688 fsavsub1(2,ksub)=fsavsub1(2,ksub)+impy
689 fsavsub1(3,ksub)=fsavsub1(3,ksub)+impz
690
691 fsavsub1(8,ksub) =fsavsub1(8,ksub) +abs(impx)
692 fsavsub1(9,ksub) =fsavsub1(9,ksub) +abs(impy)
693 fsavsub1(10,ksub)=fsavsub1(10,ksub)+abs(impz)
694
695 fsavsub1(11,ksub)=fsavsub1(11,ksub)-fni(i)*dt12
696
697 IF(isensint(ksub+1)/=0) THEN
698 fsavparit(ksub+1,1,i) = -fxi(i)
699 fsavparit(ksub+1,2,i) = -fyi(i)
700 fsavparit(ksub+1,3,i) = -fzi(i)
701 ENDIF
702
703 ENDIF
704 kk=kk+1
705 ENDDO
706
707 END DO
708 IF(nspmd > 1) THEN
709 DO i=1,jlt
710
711 IF(pene(i) == zero)cycle
712
713 il = cs_loc(i)
714 IF(il > nedge)THEN
715
716 IF (msegtyp(cm_loc(i)) < 0) THEN
717 ie= - msegtyp(cm_loc(i))
718 ELSE
719 ie = cm_loc(i)
720 ENDIF
721 IF(ie > nrtm) ie=ie-nrtm
722
723 il = il - nedge
724 jj =addsubsfie(nin)%P(il)
725 kk =addsubm(ie)
726 DO WHILE(jj<addsubsfie(nin)%P(il+1))
727 jsub = lisubsfie(nin)%P(jj)
728 itypsub = typsub(jsub)
729
730 IF(itypsub == 1 ) THEN ! Defining specific inter
731 iss1 = bitget(inflg_subsfie(nin)%P(jj),0)
732 iss2 = bitget(inflg_subsfie(nin)%P(jj),1)
733 ksub=lisube(kk)
734 DO WHILE((ksub<=jsub).AND.(kk<addsube(ie+1)))
735 ims1 = bitget(inflg_subm(kk),0)
736 ims2 = bitget(inflg_subm(kk),1)
737 IF(ksub==jsub)THEN
738 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
739 . (ims2 == 1 .AND. iss1 == 1))) THEN
740 kk=kk+1
741 ksub=lisube(kk)
742 cycle
743 END IF
744 impx=fxi(i)*dt12
745 impy=fyi(i)*dt12
746 impz=fzi(i)*dt12
747
748 IF(ims2 > 0)THEN
749 fsavsub1(1,jsub)=fsavsub1(1,jsub)-impx
750 fsavsub1(2,jsub)=fsavsub1(2,jsub)-impy
751 fsavsub1(3,jsub)=fsavsub1(3,jsub)-impz
752 fsavsub1(11,jsub)=fsavsub1(11,jsub)-fni(i)*dt12
753 ELSE
754 fsavsub1(1,jsub)=fsavsub1(1,jsub)+impx
755 fsavsub1(2,jsub)=fsavsub1(2,jsub)+impy
756 fsavsub1(3,jsub)=fsavsub1(3,jsub)+impz
757 fsavsub1(11,jsub)=fsavsub1(11,jsub)+fni(i)*dt12
758 END IF
759C
760 IF(isensint(jsub+1)/=0) THEN
761 IF(ims2 > 0)THEN
762 fsavparit(jsub+1,1,i) = -fxi(i)
763 fsavparit(jsub+1,2,i) = -fyi(i)
764 fsavparit(jsub+1,3,i) = -fzi(i)
765 ELSE
766 fsavparit(jsub+1,1,i) = fxi(i)
767 fsavparit(jsub+1,2,i) = fyi(i)
768 fsavparit(jsub+1,3,i) = fzi(i)
769 END IF
770 ENDIF
771C
772 fsavsub1(8,jsub) =fsavsub1(8,jsub) +abs(impx)
773 fsavsub1(9,jsub) =fsavsub1(9,jsub) +abs(impy)
774 fsavsub1(10,jsub)=fsavsub1(10,jsub)+abs(impz)
775C
776 ENDIF
777 kk=kk+1
778 ksub=lisube(kk)
779 ENDDO
780 jj=jj+1
781
782 ELSEIF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only secnd surface
783
784 impx=fxi(i)*dt12
785 impy=fyi(i)*dt12
786 impz=fzi(i)*dt12
787
788
789 fsavsub1(1,jsub)=fsavsub1(1,jsub)+impx
790 fsavsub1(2,jsub)=fsavsub1(2,jsub)+impy
791 fsavsub1(3,jsub)=fsavsub1(3,jsub)+impz
792
793 fsavsub1(8,jsub) =fsavsub1(8,jsub) +abs(impx)
794 fsavsub1(9,jsub) =fsavsub1(9,jsub) +abs(impy)
795 fsavsub1(10,jsub)=fsavsub1(10,jsub)+abs(impz)
796
797 fsavsub1(11,jsub)=fsavsub1(11,jsub)+fni(i)*dt12
798
799 IF(isensint(jsub+1)/=0) THEN
800 fsavparit(jsub+1,1,i) = fxi(i)
801 fsavparit(jsub+1,2,i) = fyi(i)
802 fsavparit(jsub+1,3,i) = fzi(i)
803 ENDIF
804
805 jj=jj+1
806
807 ELSEIF(itypsub == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2surfs
808
809 iss2 = bitget(inflg_subsfie(nin)%P(jj),0)
810 iss1 = bitget(inflg_subsfie(nin)%P(jj),1)
811 ksub=lisube(kk)
812 DO WHILE((ksub<=jsub).AND.(kk<addsube(ie+1)))
813 ims2 = bitget(inflg_subm(kk),0)
814 ims1 = bitget(inflg_subm(kk),1)
815 IF(ksub==jsub)THEN
816 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
817 . (ims2 == 1 .AND. iss1 == 1))) THEN
818 kk=kk+1
819 ksub=lisube(kk)
820 cycle
821 END IF
822
823 impx=fxi(i)*dt12
824 impy=fyi(i)*dt12
825 impz=fzi(i)*dt12
826
827 IF(ims2 > 0)THEN
828 fsavsub1(1,jsub)=fsavsub1(1,jsub)-impx
829 fsavsub1(2,jsub)=fsavsub1(2,jsub)-impy
830 fsavsub1(3,jsub)=fsavsub1(3,jsub)-impz
831 fsavsub1(11,jsub)=fsavsub1(11,jsub)-fni(i)*dt12
832 ELSE
833 fsavsub1(1,jsub)=fsavsub1(1,jsub)+impx
834 fsavsub1(2,jsub)=fsavsub1(2,jsub)+impy
835 fsavsub1(3,jsub)=fsavsub1(3,jsub)+impz
836 fsavsub1(11,jsub)=fsavsub1(11,jsub)+fni(i)*dt12
837 ENDIF
838
839 fsavsub1(8,jsub) =fsavsub1(8,jsub) +abs(impx)
840 fsavsub1(9,jsub) =fsavsub1(9,jsub) +abs(impy)
841 fsavsub1(10,jsub)=fsavsub1(10,jsub)+abs(impz)
842C
843 IF(isensint(jsub+1)/=0) THEN
844 IF(ims2 > 0)THEN
845 fsavparit(jsub+1,1,i) = -fxi(i)
846 fsavparit(jsub+1,2,i) = -fyi(i)
847 fsavparit(jsub+1,3,i) = -fzi(i)
848 ELSE
849 fsavparit(jsub+1,1,i) = fxi(i)
850 fsavparit(jsub+1,2,i) = fyi(i)
851 fsavparit(jsub+1,3,i) = fzi(i)
852 END IF
853 ENDIF
854C
855 ENDIF
856 kk=kk+1
857 ksub=lisube(kk)
858 ENDDO
859 jj=jj+1
860
861 ENDIF
862
863 END DO
864 END IF
865 END DO
866 ENDIF
867 END IF
868C---------------------------------
869C FRICTION
870C---------------------------------
871
872 fxt(1:jlt)=zero
873 fyt(1:jlt)=zero
874 fzt(1:jlt)=zero
875C
876 fsav4 = zero
877 fsav5 = zero
878 fsav6 = zero
879 fsav12= zero
880 fsav13= zero
881 fsav14= zero
882 fsav15= zero
883C
884 IF (ifq /= 0) THEN
885 DO i=1,jlt
886
887
888 IF(pene(i) == zero)cycle
889
890 fx = stif0(i)*vx(i)*dt12
891 fy = stif0(i)*vy(i)*dt12
892 fz = stif0(i)*vz(i)*dt12
893
894 fx = cand_fx(indx2(i),indx1(i)) + fx
895 fy = cand_fy(indx2(i),indx1(i)) + fy
896 fz = cand_fz(indx2(i),indx1(i)) + fz
897
898 ftn = fx*nx(i) + fy*ny(i) + fz*nz(i)
899 fx = fx - ftn*nx(i)
900 fy = fy - ftn*ny(i)
901 fz = fz - ftn*nz(i)
902 ft = fx*fx + fy*fy + fz*fz
903 ft = max(ft,em30)
904
905 fn = fxi(i)**2+fyi(i)**2+fzi(i)**2
906 beta = min(one,fricc(i)*sqrt(fn/ft))
907 fxt(i) = fx * beta
908 fyt(i) = fy * beta
909 fzt(i) = fz * beta
910
911 cand_fx(indx2(i),indx1(i)) = fxt(i)
912 cand_fy(indx2(i),indx1(i)) = fyt(i)
913 cand_fz(indx2(i),indx1(i)) = fzt(i)
914
915 fxi(i)=fxi(i) + fxt(i)
916 fyi(i)=fyi(i) + fyt(i)
917 fzi(i)=fzi(i) + fzt(i)
918
919 ifpen(indx1(i)) = 1
920
921 fsav4 = fsav4 + fxt(i)*dt12
922 fsav5 = fsav5 + fyt(i)*dt12
923 fsav6 = fsav6 + fzt(i)*dt12
924
925 fsav12 = fsav12 + abs(fxi(i)*dt12)
926 fsav13 = fsav13 + abs(fyi(i)*dt12)
927 fsav14 = fsav14 + abs(fzi(i)*dt12)
928 fsav15 = fsav15 + sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
929 econvt = econvt
930 . + dt1*(vx(i)*fxt(i)+vy(i)*fyt(i)+vz(i)*fzt(i))
931 ENDDO
932 ENDIF
933
934 IF (inconv==1) THEN
935#include "lockon.inc"
936 fsav(4) = fsav(4) + fsav4
937 fsav(5) = fsav(5) + fsav5
938 fsav(6) = fsav(6) + fsav6
939 fsav(12) = fsav(12) + fsav12
940 fsav(13) = fsav(13) + fsav13
941 fsav(14) = fsav(14) + fsav14
942 fsav(15) = fsav(15) + fsav15
943#include "lockoff.inc"
944 ENDIF
945
946C---------------------------------
947C SORTIES TH PAR SOUS INTERFACE
948C---------------------------------
949 IF(nisub/=0)THEN
950 DO i=1,jlt
951
952 IF(pene(i) == zero)cycle
953
954 il = cs_loc(i)
955 IF(il<=nedge)THEN
956
957 IF (msegtyp(cm_loc(i)) < 0) THEN
958 ie= - msegtyp(cm_loc(i))
959 ELSE
960 ie = cm_loc(i)
961 ENDIF
962 IF(ie > nrtm) ie=ie-nrtm
963
964 jj =addsube(il)
965 kk =addsubm(ie)
966 DO WHILE(jj<addsube(il+1))
967 jsub=lisube(jj)
968
969 itypsub = typsub(jsub)
970
971 IF(itypsub == 1 ) THEN ! Defining specific inter
972
973 iss1 = bitget(inflg_sube(jj),0)
974 iss2 = bitget(inflg_sube(jj),1)
975 ksub=lisube(kk)
976 DO WHILE((ksub<=jsub).AND.(kk<addsube(ie+1)))
977 ims1 = bitget(inflg_subm(kk),0)
978 ims2 = bitget(inflg_subm(kk),1)
979 IF(ksub==jsub)THEN
980 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
981 . (ims2 == 1 .AND. iss1 == 1))) THEN
982 kk=kk+1
983 ksub=lisube(kk)
984 cycle
985 END IF
986 impx=fxt(i)*dt12
987 impy=fyt(i)*dt12
988 impz=fzt(i)*dt12
989C main side :
990 fsavsub1(4,jsub)=fsavsub1(4,jsub)+impx
991 fsavsub1(5,jsub)=fsavsub1(5,jsub)+impy
992 fsavsub1(6,jsub)=fsavsub1(6,jsub)+impz
993C
994 impx=fxi(i)*dt12
995 impy=fyi(i)*dt12
996 impz=fzi(i)*dt12
997 fsavsub1(12,jsub)=fsavsub1(12,jsub)+abs(impx)
998 fsavsub1(13,jsub)=fsavsub1(13,jsub)+abs(impy)
999 fsavsub1(14,jsub)=fsavsub1(14,jsub)+abs(impz)
1000C
1001 IF(isensint(jsub+1)/=0) THEN
1002 fsavparit(jsub+1,4,i) = fxt(i)
1003 fsavparit(jsub+1,5,i) = fyt(i)
1004 fsavparit(jsub+1,6,i) = fzt(i)
1005 ENDIF
1006C
1007 fsavsub1(15,jsub)= fsavsub1(15,jsub)
1008 . +sqrt(impx*impx+impy*impy+impz*impz)
1009c FSAVSUB1(22,JSUB)=FSAVSUB1(22,JSUB)
1010c . +YP(I)*IMPZ-ZP(I)*IMPY
1011c FSAVSUB1(23,JSUB)=FSAVSUB1(23,JSUB)
1012c . +ZP(I)*IMPX-XP(I)*IMPZ
1013c FSAVSUB1(24,JSUB)=FSAVSUB1(24,JSUB)
1014c . +XP(I)*IMPY-YP(I)*IMPX
1015C
1016 ENDIF
1017 kk=kk+1
1018 ksub=lisube(kk)
1019 ENDDO
1020 jj=jj+1
1021
1022 ELSEIF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : second side
1023
1024 impx=fxt(i)*dt12
1025 impy=fyt(i)*dt12
1026 impz=fzt(i)*dt12
1027C main side :
1028 fsavsub1(4,jsub)=fsavsub1(4,jsub)+impx
1029 fsavsub1(5,jsub)=fsavsub1(5,jsub)+impy
1030 fsavsub1(6,jsub)=fsavsub1(6,jsub)+impz
1031C
1032 impx=fxi(i)*dt12
1033 impy=fyi(i)*dt12
1034 impz=fzi(i)*dt12
1035 fsavsub1(12,jsub)=fsavsub1(12,jsub)+abs(impx)
1036 fsavsub1(13,jsub)=fsavsub1(13,jsub)+abs(impy)
1037 fsavsub1(14,jsub)=fsavsub1(14,jsub)+abs(impz)
1038C
1039 IF(isensint(jsub+1)/=0) THEN
1040 fsavparit(jsub+1,4,i) = fxt(i)
1041 fsavparit(jsub+1,5,i) = fyt(i)
1042 fsavparit(jsub+1,6,i) = fzt(i)
1043 ENDIF
1044C
1045 fsavsub1(15,jsub)= fsavsub1(15,jsub)
1046 . +sqrt(impx*impx+impy*impy+impz*impz)
1047c . +XP(I)*IMPY-YP(I)*IMPX
1048
1049 jj=jj+1
1050
1051 ELSEIF(itypsub == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2surfs
1052
1053 iss2 = bitget(inflg_sube(jj),0)
1054 iss1 = bitget(inflg_sube(jj),1)
1055 ksub=lisube(kk)
1056 DO WHILE((ksub<=jsub).AND.(kk<addsube(ie+1)))
1057 ims2 = bitget(inflg_subm(kk),0)
1058 ims1 = bitget(inflg_subm(kk),1)
1059 IF(ksub==jsub)THEN
1060 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
1061 . (ims2 == 1 .AND. iss1 == 1))) THEN
1062 kk=kk+1
1063 ksub=lisube(kk)
1064 cycle
1065 END IF
1066
1067 impx=fxt(i)*dt12
1068 impy=fyt(i)*dt12
1069 impz=fzt(i)*dt12
1070
1071 IF(ims2 > 0) THEN
1072 fsavsub1(4,jsub)=fsavsub1(4,jsub)-impx
1073 fsavsub1(5,jsub)=fsavsub1(5,jsub)-impy
1074 fsavsub1(6,jsub)=fsavsub1(6,jsub)-impz
1075 ELSE
1076C main side :
1077 fsavsub1(4,jsub)=fsavsub1(4,jsub)+impx
1078 fsavsub1(5,jsub)=fsavsub1(5,jsub)+impy
1079 fsavsub1(6,jsub)=fsavsub1(6,jsub)+impz
1080 ENDIF
1081
1082C
1083 impx=fxi(i)*dt12
1084 impy=fyi(i)*dt12
1085 impz=fzi(i)*dt12
1086 fsavsub1(12,jsub)=fsavsub1(12,jsub)+abs(impx)
1087 fsavsub1(13,jsub)=fsavsub1(13,jsub)+abs(impy)
1088 fsavsub1(14,jsub)=fsavsub1(14,jsub)+abs(impz)
1089C
1090 IF(isensint(jsub+1)/=0) THEN
1091 IF(ims2 > 0) THEN
1092 fsavparit(jsub+1,4,i) = -fxt(i)
1093 fsavparit(jsub+1,5,i) = -fyt(i)
1094 fsavparit(jsub+1,6,i) = -fzt(i)
1095 ELSE
1096 fsavparit(jsub+1,4,i) = fxt(i)
1097 fsavparit(jsub+1,5,i) = fyt(i)
1098 fsavparit(jsub+1,6,i) = fzt(i)
1099 ENDIF
1100 ENDIF
1101C
1102 fsavsub1(15,jsub)= fsavsub1(15,jsub)
1103 . +sqrt(impx*impx+impy*impy+impz*impz)
1104c . +XP(I)*IMPY-YP(I)*IMPX
1105 ENDIF
1106 kk=kk+1
1107 ksub=lisube(kk)
1108 ENDDO
1109 jj=jj+1
1110
1111 ENDIF
1112
1113 END DO
1114 END IF
1115
1116 IF (msegtyp(cm_loc(i)) < 0) THEN
1117 ie= - msegtyp(cm_loc(i))
1118 ELSE
1119 ie = cm_loc(i)
1120 ENDIF
1121 IF(ie > nrtm) ie=ie-nrtm
1122
1123 kk =addsubm(ie)
1124 DO WHILE(kk<addsube(ie+1))
1125 ksub=lisube(kk)
1126 itypsub = typsub(ksub)
1127 IF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : main side
1128
1129 impx=-fxt(i)*dt12
1130 impy=-fyt(i)*dt12
1131 impz=-fzt(i)*dt12
1132C main side :
1133 fsavsub1(4,ksub)=fsavsub1(4,ksub)+impx
1134 fsavsub1(5,ksub)=fsavsub1(5,ksub)+impy
1135 fsavsub1(6,ksub)=fsavsub1(6,ksub)+impz
1136C
1137 impx=fxi(i)*dt12
1138 impy=fyi(i)*dt12
1139 impz=fzi(i)*dt12
1140 fsavsub1(12,ksub)=fsavsub1(12,jsub)+abs(impx)
1141 fsavsub1(13,ksub)=fsavsub1(13,jsub)+abs(impy)
1142 fsavsub1(14,ksub)=fsavsub1(14,jsub)+abs(impz)
1143C
1144 IF(isensint(ksub+1)/=0) THEN
1145 fsavparit(ksub+1,4,i) = -fxt(i)
1146 fsavparit(ksub+1,5,i) = -fyt(i)
1147 fsavparit(ksub+1,6,i) = -fzt(i)
1148 ENDIF
1149C
1150 fsavsub1(15,ksub)= fsavsub1(15,ksub)
1151 . +sqrt(impx*impx+impy*impy+impz*impz)
1152c . +XP(I)*IMPY-YP(I)*IMPX
1153 ENDIF
1154 kk=kk+1
1155 ENDDO
1156
1157 END DO ! do the spmd part
1158 IF(nspmd > 1) THEN
1159 DO i=1,jlt
1160
1161 IF(pene(i) == zero)cycle
1162
1163 il = cs_loc(i)
1164 IF(il>nedge)THEN
1165 il = il - nedge
1166 IF (msegtyp(cm_loc(i)) < 0) THEN
1167 ie= - msegtyp(cm_loc(i))
1168 ELSE
1169 ie = cm_loc(i)
1170 ENDIF
1171 IF(ie > nrtm) ie=ie-nrtm
1172
1173 jj =addsubsfie(nin)%P(il)
1174 kk =addsubm(ie)
1175 DO WHILE(jj<addsubsfie(nin)%P(il+1))
1176 jsub = lisubsfie(nin)%P(jj)
1177 itypsub = typsub(jsub)
1178
1179 IF(itypsub == 1 ) THEN ! Defining specific inter
1180
1181 iss1 = bitget(inflg_subsfie(nin)%P(jj),0)
1182 iss2 = bitget(inflg_subsfie(nin)%P(jj),1)
1183 ksub=lisube(kk)
1184 DO WHILE((ksub<=jsub).AND.(kk<addsube(ie+1)))
1185 ims1 = bitget(inflg_subm(kk),0)
1186 ims2 = bitget(inflg_subm(kk),1)
1187 IF(ksub==jsub)THEN
1188 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
1189 . (ims2 == 1 .AND. iss1 == 1))) THEN
1190 kk=kk+1
1191 ksub=lisube(kk)
1192 cycle
1193 END IF
1194 impx=fxt(i)*dt12
1195 impy=fyt(i)*dt12
1196 impz=fzt(i)*dt12
1197C main side :
1198 fsavsub1(4,jsub)=fsavsub1(4,jsub)+impx
1199 fsavsub1(5,jsub)=fsavsub1(5,jsub)+impy
1200 fsavsub1(6,jsub)=fsavsub1(6,jsub)+impz
1201C
1202 impx=fxi(i)*dt12
1203 impy=fyi(i)*dt12
1204 impz=fzi(i)*dt12
1205 fsavsub1(12,jsub)=fsavsub1(12,jsub)+abs(impx)
1206 fsavsub1(13,jsub)=fsavsub1(13,jsub)+abs(impy)
1207 fsavsub1(14,jsub)=fsavsub1(14,jsub)+abs(impz)
1208C
1209 IF(isensint(jsub+1)/=0) THEN
1210 fsavparit(jsub+1,4,i) = fxt(i)
1211 fsavparit(jsub+1,5,i) = fyt(i)
1212 fsavparit(jsub+1,6,i) = fzt(i)
1213 ENDIF
1214C
1215 fsavsub1(15,jsub)= fsavsub1(15,jsub)
1216 . +sqrt(impx*impx+impy*impy+impz*impz)
1217c FSAVSUB1(22,JSUB)=FSAVSUB1(22,JSUB)
1218c . +YP(I)*IMPZ-ZP(I)*IMPY
1219c FSAVSUB1(23,JSUB)=FSAVSUB1(23,JSUB)
1220c . +ZP(I)*IMPX-XP(I)*IMPZ
1221c FSAVSUB1(24,JSUB)=FSAVSUB1(24,JSUB)
1222c . +XP(I)*IMPY-YP(I)*IMPX
1223C
1224 ENDIF
1225 kk=kk+1
1226 ksub=lisube(kk)
1227 ENDDO
1228 jj=jj+1
1229
1230
1231 ELSEIF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface
1232
1233 impx=fxt(i)*dt12
1234 impy=fyt(i)*dt12
1235 impz=fzt(i)*dt12
1236C main side :
1237 fsavsub1(4,jsub)=fsavsub1(4,jsub)+impx
1238 fsavsub1(5,jsub)=fsavsub1(5,jsub)+impy
1239 fsavsub1(6,jsub)=fsavsub1(6,jsub)+impz
1240C
1241 impx=fxi(i)*dt12
1242 impy=fyi(i)*dt12
1243 impz=fzi(i)*dt12
1244 fsavsub1(12,jsub)=fsavsub1(12,jsub)+abs(impx)
1245 fsavsub1(13,jsub)=fsavsub1(13,jsub)+abs(impy)
1246 fsavsub1(14,jsub)=fsavsub1(14,jsub)+abs(impz)
1247C
1248 IF(isensint(jsub+1)/=0) THEN
1249 fsavparit(jsub+1,4,i) = fxt(i)
1250 fsavparit(jsub+1,5,i) = fyt(i)
1251 fsavparit(jsub+1,6,i) = fzt(i)
1252 ENDIF
1253C
1254 fsavsub1(15,jsub)= fsavsub1(15,jsub)
1255 . +sqrt(impx*impx+impy*impy+impz*impz)
1256c . +XP(I)*IMPY-YP(I)*IMPX
1257
1258 jj=jj+1
1259
1260 ELSEIF(itypsub == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2 surfs
1261
1262 iss2 = bitget(inflg_subsfie(nin)%P(jj),0)
1263 iss1 = bitget(inflg_subsfie(nin)%P(jj),1)
1264 ksub=lisube(kk)
1265 DO WHILE((ksub<=jsub).AND.(kk<addsube(ie+1)))
1266 ims2 = bitget(inflg_subm(kk),0)
1267 ims1 = bitget(inflg_subm(kk),1)
1268 IF(ksub==jsub)THEN
1269 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
1270 . (ims2 == 1 .AND. iss1 == 1))) THEN
1271 kk=kk+1
1272 ksub=lisube(kk)
1273 cycle
1274 END IF
1275
1276 impx=fxt(i)*dt12
1277 impy=fyt(i)*dt12
1278 impz=fzt(i)*dt12
1279 IF(ims2 > 0 ) THEN
1280C main side :
1281 fsavsub1(4,jsub)=fsavsub1(4,jsub)-impx
1282 fsavsub1(5,jsub)=fsavsub1(5,jsub)-impy
1283 fsavsub1(6,jsub)=fsavsub1(6,jsub)-impz
1284 ELSE
1285C main side :
1286 fsavsub1(4,jsub)=fsavsub1(4,jsub)+impx
1287 fsavsub1(5,jsub)=fsavsub1(5,jsub)+impy
1288 fsavsub1(6,jsub)=fsavsub1(6,jsub)+impz
1289 ENDIF
1290C
1291 impx=fxi(i)*dt12
1292 impy=fyi(i)*dt12
1293 impz=fzi(i)*dt12
1294 fsavsub1(12,jsub)=fsavsub1(12,jsub)+abs(impx)
1295 fsavsub1(13,jsub)=fsavsub1(13,jsub)+abs(impy)
1296 fsavsub1(14,jsub)=fsavsub1(14,jsub)+abs(impz)
1297C
1298 IF(isensint(jsub+1)/=0) THEN
1299 IF(ims2 > 0 ) THEN
1300 fsavparit(jsub+1,4,i) = -fxt(i)
1301 fsavparit(jsub+1,5,i) = -fyt(i)
1302 fsavparit(jsub+1,6,i) = -fzt(i)
1303 ELSE
1304 fsavparit(jsub+1,4,i) = fxt(i)
1305 fsavparit(jsub+1,5,i) = fyt(i)
1306 fsavparit(jsub+1,6,i) = fzt(i)
1307 ENDIF
1308 ENDIF
1309C
1310 fsavsub1(15,jsub)= fsavsub1(15,jsub)
1311 . +sqrt(impx*impx+impy*impy+impz*impz)
1312c . +XP(I)*IMPY-YP(I)*IMPX
1313C
1314 ENDIF
1315 kk=kk+1
1316 ksub=lisube(kk)
1317 ENDDO
1318 jj=jj+1
1319
1320 ENDIF
1321 END DO
1322 END IF
1323 END DO !SPMD
1324 ENDIF
1325#include "lockon.inc"
1326 DO jsub=1,nisub
1327 nsub=lisub(jsub)
1328 DO j=1,15
1329 fsavsub(j,nsub)=fsavsub(j,nsub)+fsavsub1(j,jsub)
1330 END DO
1331 fsavsub(22,nsub)=fsavsub(22,nsub)+fsavsub1(22,jsub)
1332 fsavsub(23,nsub)=fsavsub(23,nsub)+fsavsub1(23,jsub)
1333 fsavsub(24,nsub)=fsavsub(24,nsub)+fsavsub1(24,jsub)
1334 END DO
1335#include "lockoff.inc"
1336 END IF
1337C---------------------------------
1338 IF (imconv==1) THEN
1339#include "lockon.inc"
1340 econtv = econtv + econvt
1341 econt = econt + econtt
1342#include "lockoff.inc"
1343 ENDIF
1344C---------------------------------
1345 DO i=1,jlt
1346
1347 IF(pene(i) == zero)cycle
1348
1349 fx1(i)=-fxi(i)*hs1(i)
1350 fy1(i)=-fyi(i)*hs1(i)
1351 fz1(i)=-fzi(i)*hs1(i)
1352C
1353 fx2(i)=-fxi(i)*hs2(i)
1354 fy2(i)=-fyi(i)*hs2(i)
1355 fz2(i)=-fzi(i)*hs2(i)
1356C
1357 fx3(i)=fxi(i)*hm1(i)
1358 fy3(i)=fyi(i)*hm1(i)
1359 fz3(i)=fzi(i)*hm1(i)
1360C
1361 fx4(i)=fxi(i)*hm2(i)
1362 fy4(i)=fyi(i)*hm2(i)
1363 fz4(i)=fzi(i)*hm2(i)
1364C
1365 ENDDO
1366
1367 DO i=1,jlt
1368 stif(i) = two*stif(i)
1369 ENDDO
1370C
1371C---------------------------------
1372 IF(kdtint==1.OR.idtmins==2)THEN
1373 IF( (visc/=zero)
1374 . .AND.(ivis2==0.OR.ivis2==1))THEN
1375 DO i=1,jlt
1376 cx= c(i)*c(i)
1377C
1378 IF(ms1(i)==zero)THEN
1379 k1(i) =zero
1380 c1(i) =zero
1381 ELSE
1382 k1(i)=kt(i)*abs(hs1(i))
1383 c1(i)=c(i)*abs(hs1(i))
1384 cx =four*c1(i)*c1(i)
1385 cy =eight*ms1(i)*k1(i)
1386 aux = sqrt(cx+cy)+two*c1(i)
1387 st1(i)= k1(i)*aux*aux/max(cy,em30)
1388 cfi = cf(i)*abs(hs1(i))
1389 aux = two*cfi*cfi/max(ms1(i),em20)
1390 IF(aux>st1(i))THEN
1391 k1(i) =zero
1392 c1(i) =cfi
1393 ENDIF
1394 ENDIF
1395C
1396 IF(ms2(i)==zero)THEN
1397 k2(i) =zero
1398 c2(i) =zero
1399 ELSE
1400 k2(i)=kt(i)*abs(hs2(i))
1401 c2(i)=c(i)*abs(hs2(i))
1402 cx =four*c2(i)*c2(i)
1403 cy =eight*ms2(i)*k2(i)
1404 aux = sqrt(cx+cy)+two*c2(i)
1405 st2(i)= k2(i)*aux*aux/max(cy,em30)
1406 cfi = cf(i)*abs(hs2(i))
1407 aux = two*cfi*cfi/max(ms2(i),em20)
1408 IF(aux>st2(i))THEN
1409 k2(i) =zero
1410 c2(i) =cfi
1411 ENDIF
1412 ENDIF
1413C
1414 IF(mm1(i)==zero)THEN
1415 k3(i) =zero
1416 c3(i) =zero
1417 ELSE
1418 k3(i)=kt(i)*abs(hm1(i))
1419 c3(i)=c(i)*abs(hm1(i))
1420 cx =four*c3(i)*c3(i)
1421 cy =eight*mm1(i)*k3(i)
1422 aux = sqrt(cx+cy)+two*c3(i)
1423 st3(i)= k3(i)*aux*aux/max(cy,em30)
1424 cfi = cf(i)*abs(hm1(i))
1425 aux = two*cfi*cfi/max(mm1(i),em20)
1426 IF(aux>st3(i))THEN
1427 k3(i) =zero
1428 c3(i) =cfi
1429 ENDIF
1430 ENDIF
1431C
1432 IF(mm2(i)==zero)THEN
1433 k4(i) =zero
1434 c4(i) =zero
1435 ELSE
1436 k4(i)=kt(i)*abs(hm2(i))
1437 c4(i)=c(i)*abs(hm2(i))
1438 cx =four*c4(i)*c4(i)
1439 cy =eight*mm2(i)*k4(i)
1440 aux = sqrt(cx+cy)+two*c4(i)
1441 st4(i)= k4(i)*aux*aux/max(cy,em30)
1442 cfi = cf(i)*abs(hm2(i))
1443 aux = two*cfi*cfi/max(mm2(i),em20)
1444 IF(aux>st4(i))THEN
1445 k4(i) =zero
1446 c4(i) =cfi
1447 ENDIF
1448 ENDIF
1449 ENDDO
1450 ELSE
1451 DO i=1,jlt
1452 k1(i) =stif(i)*abs(hs1(i))
1453 c1(i) =zero
1454 k2(i) =stif(i)*abs(hs2(i))
1455 c2(i) =zero
1456 k3(i) =stif(i)*abs(hm1(i))
1457 c3(i) =zero
1458 k4(i) =stif(i)*abs(hm2(i))
1459 c4(i) =zero
1460 ENDDO
1461 ENDIF
1462 ENDIF
1463
1464C------------For /LOAD/PRESSURE tag nodes in contact-------------
1465 tagip(1:jlt) = 0
1466 IF(nintloadp > 0) THEN
1467 DO k = kloadpinter(nin)+1, kloadpinter(nin+1)
1468 pp = loadpinter(k)
1469 ppl = loadp_hyd_inter(pp)
1470 dgapload = dgaploadint(k)
1471 DO i=1,jlt
1472 IF(pene(i) > zero .OR.dist(i) <= dgapload) THEN
1473 tagip(i) = 1
1474 tagncont(ppl,m1(i)) = 1
1475 tagncont(ppl,m2(i)) = 1
1476 IF(cs_loc(i)<=nedge) THEN
1477C SPMD : do same after reception of forces for remote nodes
1478 tagncont(ppl,n1(i)) = 1
1479 tagncont(ppl,n2(i)) = 1
1480 ENDIF
1481 ENDIF
1482 ENDDO
1483 ENDDO
1484
1485 ENDIF
1486C
1487C=======================================================================
1488C forces on master and secondary nodes
1489C=======================================================================
1490 IF(iparit==0)THEN
1491 IF(kdtint==0)THEN
1492 CALL i25asse0_e2s(jlt ,cs_loc ,n1 ,n2 ,m1 ,
1493 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
1494 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
1495 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
1496 5 fy4 ,fz4 ,a ,stifn,stif ,
1497 6 nedge,nin ,jtask,pene )
1498 ELSE
1499 CALL i25asse05_e2s(jlt ,cs_loc ,n1 ,n2 ,m1 ,
1500 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
1501 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
1502 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
1503 5 fy4 ,fz4 ,a ,stifn,nedge,
1504 6 k1 ,k2 ,k3 ,k4 ,c1 ,
1505 7 c2 ,c3 ,c4 ,viscn,nin ,
1506 8 jtask ,pene )
1507 END IF
1508 ELSE
1509 IF(kdtint==0)THEN
1510 CALL i25asse2_e2s(jlt ,cs_loc ,n1 ,n2 ,m1 ,
1511 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
1512 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
1513 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
1514 5 fy4 ,fz4 ,fskyi ,isky ,niskyfie,
1515 6 stif ,nedge ,nin ,noint ,pene ,
1516 7 edge_id,tagip )
1517 ELSE
1518 CALL i25asse25_e2s(jlt ,cs_loc ,n1 ,n2 ,m1 ,
1519 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
1520 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
1521 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
1522 5 fy4 ,fz4 ,isky ,niskyfie,nedge ,
1523 6 k1 ,k2 ,k3 ,k4 ,c1 ,
1524 7 c2 ,c3 ,c4 ,nin , noint,
1525 8 pene ,tagip )
1526 END IF
1527 END IF
1528C
1529 IF(idtmins==2)THEN
1530 dti=dt2t
1531 CALL i25sms_e2s(jlt ,cs_loc ,n1 ,n2 ,m1 ,
1532 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
1533 3 stif ,nin ,noint ,mskyi_sms ,iskyi_sms,
1534 4 nsms ,k1 ,k2 ,k3 ,k4 ,
1535 5 c1 ,c2 ,c3 ,c4 ,nedge , edge_id)
1536 END IF
1537C
1538
1539 IF (nspmd>1) THEN
1540#include "mic_lockon.inc"
1541 DO i = 1,jlt
1542 assert(i > 0)
1543 assert(i <= 4*mvsiz)
1544 assert(cs_loc(i) > 0)
1545 printif(cs_loc(i) < 0,i)
1546 printif(cs_loc(i) < 0,cs_loc(i))
1547 IF(cs_loc(i)>nedge)THEN
1548 ni = cs_loc(i)-nedge
1549 assert(ni > 0)
1550C temporary tag of nsvfi a -
1551 IF(pene(i) /= 0.OR.tagip(i)==1) THEN
1552 nsvfie(nin)%P(ni) = -abs(nsvfie(nin)%P(ni))
1553 ENDIF
1554 ENDIF
1555 ENDDO
1556#include "mic_lockoff.inc"
1557 ENDIF
1558C
1559 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0)THEN
1560#include "lockon.inc"
1561c goto 1234
1562 DO i=1,jlt
1563C
1564 IF(pene(i) == zero)cycle
1565C
1566 IF(cs_loc(i)<=nedge) THEN
1567 fcont(1,n1(i)) =fcont(1,n1(i)) + fx1(i)
1568 fcont(2,n1(i)) =fcont(2,n1(i)) + fy1(i)
1569 fcont(3,n1(i)) =fcont(3,n1(i)) + fz1(i)
1570 fcont(1,n2(i)) =fcont(1,n2(i)) + fx2(i)
1571 fcont(2,n2(i)) =fcont(2,n2(i)) + fy2(i)
1572 fcont(3,n2(i)) =fcont(3,n2(i)) + fz2(i)
1573 END IF
1574 fcont(1,m1(i)) =fcont(1,m1(i)) + fx3(i)
1575 fcont(2,m1(i)) =fcont(2,m1(i)) + fy3(i)
1576 fcont(3,m1(i)) =fcont(3,m1(i)) + fz3(i)
1577 fcont(1,m2(i)) =fcont(1,m2(i)) + fx4(i)
1578 fcont(2,m2(i)) =fcont(2,m2(i)) + fy4(i)
1579 fcont(3,m2(i)) =fcont(3,m2(i)) + fz4(i)
1580 ENDDO
1581c 1234 continue
1582#include "lockoff.inc"
1583 ENDIF
1584
1585C
1586 IF(isecin>0)THEN
1587 k0=nstrf(25)
1588 IF(nstrf(1)+nstrf(2)/=0)THEN
1589 DO i=1,nsect
1590 nbinter=nstrf(k0+14)
1591 k1s=k0+30
1592 DO j=1,nbinter
1593 IF(nstrf(k1s)==noint)THEN
1594 IF(isecut/=0)THEN
1595#include "lockon.inc"
1596 DO k=1,jlt
1597C
1598 IF(pene(k) == zero)cycle
1599C
1600 IF(cs_loc(k)<=nedge) THEN
1601 IF(secfcum(4,n1(k),i)==1.)THEN
1602 secfcum(1,n1(k),i)=secfcum(1,n1(k),i)-fx1(k)
1603 secfcum(2,n1(k),i)=secfcum(2,n1(k),i)-fy1(k)
1604 secfcum(3,n1(k),i)=secfcum(3,n1(k),i)-fz1(k)
1605 ENDIF
1606 IF(secfcum(4,n2(k),i)==1.)THEN
1607 secfcum(1,n2(k),i)=secfcum(1,n2(k),i)-fx2(k)
1608 secfcum(2,n2(k),i)=secfcum(2,n2(k),i)-fy2(k)
1609 secfcum(3,n2(k),i)=secfcum(3,n2(k),i)-fz2(k)
1610 ENDIF
1611 END IF
1612 IF(secfcum(4,m1(k),i)==1.)THEN
1613 secfcum(1,m1(k),i)=secfcum(1,m1(k),i)-fx3(k)
1614 secfcum(2,m1(k),i)=secfcum(2,m1(k),i)-fy3(k)
1615 secfcum(3,m1(k),i)=secfcum(3,m1(k),i)-fz3(k)
1616 ENDIF
1617 IF(secfcum(4,m2(k),i)==1.)THEN
1618 secfcum(1,m2(k),i)=secfcum(1,m2(k),i)-fx4(k)
1619 secfcum(2,m2(k),i)=secfcum(2,m2(k),i)-fy4(k)
1620 secfcum(3,m2(k),i)=secfcum(3,m2(k),i)-fz4(k)
1621 ENDIF
1622 ENDDO
1623#include "lockoff.inc"
1624 ENDIF
1625C +fsav(section)
1626 ENDIF
1627 k1s=k1s+1
1628 ENDDO
1629 k0=nstrf(k0+24)
1630 ENDDO
1631 ENDIF
1632 ENDIF
1633C
1634 RETURN
1635 END
i25asse25_e2s
subroutine i25asse25_e2s(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, isky, niskyfie, nedge, k1, k2, k3, k4, c1, c2, c3, c4, nin, noint, pene, tagip)
Definition i25ass_e2s.F:401
i25asse0_e2s
subroutine i25asse0_e2s(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, a, stifn, stif, nedge, nin, jtask, pene)
Definition i25ass_e2s.F:36
i25asse2_e2s
subroutine i25asse2_e2s(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fskyi, isky, niskyfie, stif, nedge, nin, noint, pene, edge_id, tagip)
Definition i25ass_e2s.F:235
i25asse05_e2s
subroutine i25asse05_e2s(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, a, stifn, nedge, k1, k2, k3, k4, c1, c2, c3, c4, viscn, nin, jtask, pene)
Definition i25ass_e2s.F:130
i25for3_e2s
subroutine i25for3_e2s(jlt, a, v, ibc, icodt, fsav, gap, fric, ms, visc, viscf, noint, itab, cs_loc, cm_loc, stiglo, stifn, stif, fskyi, isky, fcont, dt2t, nrtm, msegtyp, hs1, hs2, hm1, hm2, n1, n2, m1, m2, ivis2, neltst, ityptst, nx, ny, nz, gapve, inacti, index, cand_p, niskyfie, newfront, isecin, nstrf, secfcum, viscn, nedge, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, nin, nisub, lisub, addsube, addsubm, lisube, lisubm, inflg_sube, inflg_subm, fsavsub, mskyi_sms, iskyi_sms, nsms, jtask, isensint, fsavparit, nft, h3d_data, indx1, indx2, ilev, mbinflg, edge_id, nedge_rem, fricc, ifq, cand_fx, cand_fy, cand_fz, ifpen, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, startt, ninloadp, dgaploadint, s_loadpinter)
Definition i25for3_e2s.F:61
i25sms_e2s
subroutine i25sms_e2s(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, stif, nin, noint, mskyi_sms, iskyi_sms, nsms, k1, k2, k3, k4, c1, c2, c3, c4, nedge, edge_id)
Definition i25sms_e2s.F:39
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:311
tri25ebox::inflg_subsfie
type(int_pointer), dimension(:), allocatable inflg_subsfie
Definition tri25ebox.F:111
tri25ebox::lisubsfie
type(int_pointer), dimension(:), allocatable lisubsfie
Definition tri25ebox.F:107
tri25ebox::addsubsfie
type(int_pointer), dimension(:), allocatable addsubsfie
Definition tri25ebox.F:115
tri7box::nsvfie
type(int_pointer), dimension(:), allocatable nsvfie
Definition tri7box.F:440
h3d_mod::h3d_database
Definition h3d_mod.F:438