OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25for3_e2s.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "assert.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr05_c.inc"
#include "scr11_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr18_c.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "impl1_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i25for3_e2s()

subroutine i25for3_e2s ( integer jlt,
a,
v,
integer ibc,
integer, dimension(*) icodt,
fsav,
gap,
fric,
ms,
visc,
viscf,
integer noint,
integer, dimension(*) itab,
integer, dimension(4*mvsiz) cs_loc,
integer, dimension(4*mvsiz) cm_loc,
stiglo,
stifn,
stif,
fskyi,
integer, dimension(*) isky,
fcont,
dt2t,
integer nrtm,
integer, dimension(*) msegtyp,
hs1,
hs2,
hm1,
hm2,
integer, dimension(*) n1,
integer, dimension(*) n2,
integer, dimension(*) m1,
integer, dimension(*) m2,
integer ivis2,
integer neltst,
integer ityptst,
nx,
ny,
nz,
gapve,
integer inacti,
integer, dimension(*) index,
cand_p,
integer niskyfie,
integer newfront,
integer isecin,
integer, dimension(*) nstrf,
secfcum,
viscn,
integer nedge,
ms1,
ms2,
mm1,
mm2,
vxs1,
vys1,
vzs1,
vxs2,
vys2,
vzs2,
vxm1,
vym1,
vzm1,
vxm2,
vym2,
vzm2,
integer nin,
integer nisub,
integer, dimension(*) lisub,
integer, dimension(*) addsube,
integer, dimension(*) addsubm,
integer, dimension(*) lisube,
integer, dimension(*) lisubm,
integer, dimension(*) inflg_sube,
integer, dimension(*) inflg_subm,
fsavsub,
mskyi_sms,
integer, dimension(*) iskyi_sms,
integer, dimension(*) nsms,
integer jtask,
integer, dimension(*) isensint,
fsavparit,
integer nft,
type(h3d_database) h3d_data,
integer, dimension(4*mvsiz) indx1,
integer, dimension(4*mvsiz) indx2,
integer ilev,
integer, dimension(*) mbinflg,
integer, dimension(2,4*mvsiz) edge_id,
integer nedge_rem,
fricc,
integer ifq,
cand_fx,
cand_fy,
cand_fz,
integer, dimension(*) ifpen,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(ninter+1), intent(in) kloadpinter,
integer, dimension(s_loadpinter), intent(in) loadpinter,
integer, dimension(nloadp_hyd), intent(in) loadp_hyd_inter,
integer, dimension(*) typsub,
startt,
integer, intent(in) ninloadp,
dimension(s_loadpinter), intent(in) dgaploadint,
integer, intent(in) s_loadpinter )

Definition at line 39 of file i25for3_e2s.F.

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