OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11for3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr05_c.inc"
#include "scr07_c.inc"
#include "scr11_c.inc"
#include "scr18_c.inc"
#include "units_c.inc"
#include "impl1_c.inc"
#include "sms_c.inc"
#include "param_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i11for3 (jlt, fsav, gap, fric, ms, visc, viscf, noint, itab, cs_loc, cm_loc, stif, dt2t, hs1, hs2, hm1, hm2, n1, n2, m1, m2, ivis2, neltst, ityptst, nx, ny, nz, gapv, penis, penim, inacti, newfront, nrts, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, nin, dtmini, iform, cand_fx, cand_fy, cand_fz, index, ifpen, stfs, fni, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, k1, k2, k3, k4, c1, c2, c3, c4, intth, drad, penrad, isensint, fsavparit, nisub, nft, addsubs, addsubm, lisubs, lisubm, lisub, fsavsub, fricc, viscffric, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, inflg_subs, inflg_subm, ninloadp, dgaploadint, s_loadpinter)

Function/Subroutine Documentation

◆ i11for3()

subroutine i11for3 ( integer jlt,
fsav,
gap,
fric,
ms,
visc,
viscf,
integer noint,
integer, dimension(*) itab,
integer, dimension(mvsiz) cs_loc,
integer, dimension(mvsiz) cm_loc,
stif,
dt2t,
hs1,
hs2,
hm1,
hm2,
integer, dimension(mvsiz) n1,
integer, dimension(mvsiz) n2,
integer, dimension(mvsiz) m1,
integer, dimension(mvsiz) m2,
integer ivis2,
integer neltst,
integer ityptst,
nx,
ny,
nz,
gapv,
penis,
penim,
integer inacti,
integer newfront,
integer nrts,
ms1,
ms2,
mm1,
mm2,
vxs1,
vys1,
vzs1,
vxs2,
vys2,
vzs2,
vxm1,
vym1,
vzm1,
vxm2,
vym2,
vzm2,
integer nin,
dtmini,
integer iform,
cand_fx,
cand_fy,
cand_fz,
integer, dimension(*) index,
integer, dimension(*) ifpen,
stfs,
fni,
fx1,
fy1,
fz1,
fx2,
fy2,
fz2,
fx3,
fy3,
fz3,
fx4,
fy4,
fz4,
k1,
k2,
k3,
k4,
c1,
c2,
c3,
c4,
integer intth,
drad,
penrad,
integer, dimension(*) isensint,
fsavparit,
integer nisub,
integer nft,
integer, dimension(*) addsubs,
integer, dimension(*) addsubm,
integer, dimension(*) lisubs,
integer, dimension(*) lisubm,
integer, dimension(*) lisub,
fsavsub,
fricc,
viscffric,
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,
integer, dimension(*) inflg_subs,
integer, dimension(*) inflg_subm,
integer, intent(in) ninloadp,
dimension(s_loadpinter), intent(in) dgaploadint,
integer, intent(in) s_loadpinter )

Definition at line 32 of file i11for3.F.

55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE tri7box
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63#include "comlock.inc"
64C-----------------------------------------------
65C G l o b a l P a r a m e t e r s
66C-----------------------------------------------
67#include "mvsiz_p.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "com01_c.inc"
72#include "com04_c.inc"
73#include "com06_c.inc"
74#include "com08_c.inc"
75#include "scr05_c.inc"
76#include "scr07_c.inc"
77#include "scr11_c.inc"
78#include "scr18_c.inc"
79#include "units_c.inc"
80#include "impl1_c.inc"
81#include "sms_c.inc"
82#include "param_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER NELTST,ITYPTST,JLT,IBC,IVIS2,INACTI,NRTS,NIN,INTTH
87 INTEGER ITAB(*),
88 . NOINT,NEWFRONT,NISUB,NFT
89 INTEGER N1(MVSIZ), N2(MVSIZ), M1(MVSIZ), M2(MVSIZ),
90 . CS_LOC(MVSIZ), CM_LOC(MVSIZ),
91 . NSMS(MVSIZ),IFORM,INDEX(*),IFPEN(*), ISENSINT(*),
92 . ADDSUBS(*),ADDSUBM(*),LISUBS(*),LISUBM(*),LISUB(*),
93 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD),
94 . TYPSUB(*),INFLG_SUBS(*), INFLG_SUBM(*)
95 INTEGER , INTENT(IN) :: NINLOADP,S_LOADPINTER
96 INTEGER , INTENT(IN) :: KLOADPINTER(NINTER+1),LOADPINTER(S_LOADPINTER),
97 . LOADP_HYD_INTER(NLOADP_HYD)
98 my_real
99 . ms(*), fsav(*),
100 . stfs(*),gapv(*),
101 . penis(2,*), penim(2,*),
102 . gap, fric,visc,viscf,vis,dt2t,dtmini,drad
103 my_real
104 . hs1(mvsiz), hs2(mvsiz), hm1(mvsiz), hm2(mvsiz),
105 . nx(mvsiz), ny(mvsiz), nz(mvsiz), stif(mvsiz),
106 . ms1(mvsiz),ms2(mvsiz),mm1(mvsiz),mm2(mvsiz),
107 . vxs1(mvsiz),vys1(mvsiz),vzs1(mvsiz),vxs2(mvsiz),vys2(mvsiz),
108 . vzs2(mvsiz),vxm1(mvsiz),vym1(mvsiz),vzm1(mvsiz),vxm2(mvsiz),
109 . vym2(mvsiz),vzm2(mvsiz),cand_fx(*),cand_fy(*),
110 . cand_fz(*),fni(*),
111 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
112 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
113 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
114 . k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
115 . c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),penrad(mvsiz),
116 . fsavparit(nisub+1,11,*),fsavsub(nthvki,*),fricc(mvsiz),
117 . viscffric(mvsiz)
118 my_real , INTENT(IN) :: dgaploadint(s_loadpinter)
119 INTEGER BITGET
120 EXTERNAL bitget
121C-----------------------------------------------
122C L o c a l V a r i a b l e s
123C-----------------------------------------------
124 INTEGER I, J1, J , K0,NBINTER,K1S,K, NI
125 INTEGER NISKYL,NISKYL1,IDTM,IM,IS,JSUB,KSUB,JJ,KK,NSUB,PP,PPL,
126 . ITYPSUB,ISS1,ISS2,IMS1,IMS2
127 my_real
128 . vx(mvsiz), vy(mvsiz), vz(mvsiz), vn(mvsiz),
129 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz),
130
131 . pene(mvsiz),masmin(mvsiz),
132 . vis2(mvsiz), dtmi(mvsiz),
133 . vnx, vny, vnz, aa, vmax,s2,dist,rdist,
134 . v2, fm2, dt1inv, visca, fac, ff,
135 . fx, fy, fz, f2, mas2, dti,
136 . facm1, econtt, econvt, a2,masm,econtdt,
137 . fsav1, fsav2, fsav3, fsav4, fsav5, fsav6,
138 . fsav8, fsav9, fsav10, fsav11, fsav12,
139 . fsav13, fsav14, fsav15, dti2, pplus,dtmi0
140 my_real prec,beta,dgapload,gapp
141 my_real
142 . st1(mvsiz),st2(mvsiz),st3(mvsiz),st4(mvsiz),
143 . kt(mvsiz),c(mvsiz),cf(mvsiz),
144 . cx,cy,cfi,aux,dtm,ft,fn,ftn,fxt(mvsiz),fyt(mvsiz),
145 . fzt(mvsiz)
146C-----------------------------------------------
147 IF (iresp == 1) THEN
148 prec = fiveem4
149 ELSE
150 prec = em10
151 ENDIF
152 IF(dt1>zero)THEN
153 dt1inv = one/dt1
154 ELSE
155 dt1inv =zero
156 ENDIF
157 econtt = zero
158 econvt = zero
159 econtdt = zero
160C
161 IF(intth/=0.OR.ninloadp/=0 )THEN
162 DO i=1,jlt
163C RADIATION DISTANCE
164 dist = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
165 penrad(i)=dist-gapv(i)
166 ENDDO
167 ENDIF
168C
169 DO i=1,jlt
170 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
171 pene(i) = max(zero,gapv(i) - s2)
172 s2 = one/max(em30,s2)
173 nx(i) = nx(i)*s2
174 ny(i) = ny(i)*s2
175 nz(i) = nz(i)*s2
176 ENDDO
177C
178 IF(inacti==5)THEN
179#include "lockon.inc"
180 DO i=1,jlt
181 IF(cs_loc(i)<=nrts) THEN
182 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),half*pene(i))
183 ELSE
184 ni = cs_loc(i)-nrts
185 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),half*pene(i))
186 END IF
187 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),half*pene(i))
188 ENDDO
189#include "lockoff.inc"
190 DO i=1,jlt
191 IF(cs_loc(i)<=nrts) THEN
192 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
193 pene(i) = max(pene(i),zero)
194 IF(pene(i)==zero)stif(i)=zero
195 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
196 ELSE
197 ni = cs_loc(i)-nrts
198 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
199 pene(i) = max(pene(i),zero)
200 IF(pene(i)==zero)stif(i)=zero
201 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
202 END IF
203 END DO
204 ELSE IF(inacti==6)THEN
205#include "lockon.inc"
206 DO i=1,jlt
207 pplus=half*(pene(i)+fiveem2*(gapv(i)-pene(i)))
208 IF(cs_loc(i)<=nrts) THEN
209 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),pplus)
210 ELSE
211 ni = cs_loc(i)-nrts
212 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),pplus)
213 END IF
214 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),pplus)
215 ENDDO
216#include "lockoff.inc"
217 DO i=1,jlt
218 IF(cs_loc(i)<=nrts) THEN
219 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
220 pene(i) = max(pene(i),zero)
221 IF(pene(i)==zero)stif(i)=zero
222 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
223 ELSE
224 ni = cs_loc(i)-nrts
225 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
226 pene(i) = max(pene(i),zero)
227 IF(pene(i)==zero)stif(i)=zero
228 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
229 END IF
230 END DO
231 ELSE
232 DO i=1,jlt
233 IF( pene(i)==zero ) stif(i) = zero
234 ENDDO
235 ENDIF
236
237 vmax = zero
238 DO i=1,jlt
239 gapv(i) = zep9*gapv(i)
240 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
241 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
242 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
243 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
244 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
245 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
246 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
247 ENDDO
248C-------------------------------------------
249 DO i=1,jlt
250 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
251 facm1 = one/fac
252 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
253 . stif(i)>zero ) THEN
254 stif(i) = zero
255 IF (impl_s==0) THEN
256 newfront = -1
257#include "lockon.inc"
258 IF(cs_loc(i)<=nrts)THEN
259 stfs(cs_loc(i)) = -abs(stfs(cs_loc(i)))
260 WRITE(istdo,*)'WARNING INTERFACE NB',noint
261 WRITE(istdo,*)'LINE ',itab(n1(i)),
262 . itab(n2(i)),'DE-ACTIVATED FROM','INTERFACE'
263 WRITE(iout,*)'WARNING INTERFACE NB',noint
264 WRITE(iout,*)'GAP=',gapv(i),'PENE=',pene(i)
265 WRITE(iout,*)'LINE ',itab(n1(i)),
266 . itab(n2(i)),'DE-ACTIVATED FROM','INTERFACE'
267 ELSE
268 ni = cs_loc(i)-nrts
269 stifi(nin)%P(ni) = -abs(stifi(nin)%P(ni))
270 WRITE(istdo,*)'WARNING INTERFACE NB',noint
271 WRITE(istdo,*)'LINE ',itafi(nin)%P(n1(i)),
272 . itafi(nin)%P(n2(i)),'DE-ACTIVATED FROM','INTERFACE'
273 WRITE(iout,*)'WARNING INTERFACE NB',noint
274 WRITE(iout,*)'GAP=',gapv(i),'PENE=',pene(i)
275 WRITE(iout,*)'LINE ',itafi(nin)%P(n1(i)),
276 . itafi(nin)%P(n2(i)),'DE-ACTIVATED FROM','INTERFACE'
277 END IF
278#include "lockoff.inc"
279 ENDIF
280 pene(i)= zero
281 ENDIF
282 econtt = econtt + half*stif(i)*gapv(i)**2 *( facm1 - one -
283 . log(facm1) )
284 stif(i) = half*stif(i) * fac
285 fni(i)= -stif(i) * pene(i)
286 ENDDO
287
288 dti = ep20
289C
290 DO i=1,jlt
291 dist=gapv(i)-pene(i)
292 rdist = half*dist / max(em30,-vn(i))
293 dti = min(rdist,dti)
294 ENDDO
295
296C Mix with global settings
297C IF (IDTMIN(10)==0) THEN
298C IDTM=2
299C ELSE
300C IDTM=IDTMIN(10)
301C END IF
302C IF (DTMINI>ZERO) THEN
303C DTM=DTMINI
304C ELSE
305C DTM=DTMIN1(10)
306C END IF
307
308C Force to DEL
309 IF (dtmini>zero) THEN
310 dtm=dtmini
311 idtm=2
312 ELSE
313 dtm=dtmin1(10)
314 idtm=idtmin(10)
315 END IF
316C
317 IF(dti<=dtm)THEN
318 DO i=1,jlt
319 dist=gapv(i)-pene(i)
320 dti2 = half*dist / max(em30,-vn(i))
321 IF(dti2<=dtm)THEN
322#include "lockon.inc"
323 IF(cs_loc(i)<=nrts)THEN
324 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
325 . ' **WARNING MINIMUM TIME STEP ',dti2,
326 . 'IN INTERFACE NB',noint,'(DTMIN=',dtm,')'
327 WRITE(iout,*)'SECONDARY NODES NB',itab(n1(i)),
328 . itab(n2(i))
329 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
330 . itab(m2(i))
331 ELSE
332 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
333 . ' **WARNING MINIMUM TIME STEP ',dti2,
334 . 'IN INTERFACE NB',noint,'(DTMIN=',dtm,')'
335 WRITE(iout,*)'SECONDARY NODES NB',itafi(nin)%P(n1(i)),
336 . itafi(nin)%P(n2(i))
337 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
338 . itab(m2(i))
339 END IF
340#include "lockoff.inc"
341 IF(idtm==1)THEN
342 tstop = tt
343 ELSEIF(idtm==2)THEN
344#include "lockon.inc"
345 WRITE(iout,*)'REMOVE SECONDARY LINE FROM INTERFACE'
346 IF(cs_loc(i)<=nrts)THEN
347 stfs(cs_loc(i)) = -abs(stfs(cs_loc(i)))
348 ELSE
349 ni = cs_loc(i)-nrts
350 stifi(nin)%P(ni) = -abs(stifi(nin)%P(ni))
351 END IF
352#include "lockoff.inc"
353 newfront = -1
354 stif(i) = zero
355 dti = dtm
356 ELSEIF(idtm==5)THEN
357 mstop = 2
358 ENDIF
359 ENDIF
360 ENDDO
361 ENDIF
362C
363 IF(dti<dt2t)THEN
364 dt2t = dti
365 neltst = noint
366 ityptst = 10
367 ENDIF
368C---------------------------------
369C DAMPING + FRIC
370C---------------------------------
371 IF(visc/=zero)THEN
372 DO i=1,jlt
373 mas2 = ms1(i)*hs1(i)
374 . + ms2(i)*hs2(i)
375 masm = mm1(i)*hm1(i)
376 . + mm2(i)*hm2(i)
377 masmin(i) = min(mas2,masm)
378 vis2(i) = two * stif(i) * min(mas2,masm)
379 ENDDO
380 ELSE
381 DO i=1,jlt
382 IF(viscffric(i)/=zero) THEN
383 mas2 = ms1(i)*hs1(i)
384 . + ms2(i)*hs2(i)
385 masm = mm1(i)*hm1(i)
386 . + mm2(i)*hm2(i)
387 masmin(i) = min(mas2,masm)
388 vis2(i) = two * stif(i) * min(mas2,masm)
389 ENDIF
390 ENDDO
391 ENDIF
392
393C---------------------------------
394 IF(visc/=zero)THEN
395 IF(ivis2==0.OR.ivis2==1)THEN
396C---------------------------------
397C VISC QUAD TYPE V227
398C---------------------------------
399 DO i=1,jlt
400 IF(vn(i)<zero)
401 . vis2(i) = vis2(i)/(max(em10,(gapv(i)-pene(i))/gapv(i)))
402 ENDDO
403C---------------------------------
404 visca = zep4
405 IF(kdtint==0.AND.(idtmins/=2.AND.idtmins_int==0))THEN
406 DO i=1,jlt
407 fac = stif(i) / max(em30,stif(i))
408 vis = sqrt(vis2(i))
409 ff = fac * (
410 . visc * vis +
411 . visca**2 * two * masmin(i) * max(zero,-vn(i)) /
412 . max((gapv(i) - pene(i)),em10) )
413 stif(i) = stif(i) * gapv(i)/max((gapv(i)-pene(i)),em10)
414 stif(i) = stif(i) + ff * dt1inv
415 stif(i) = max(stif(i) ,fac*sqrt(viscffric(i))*vis*dt1inv)
416 ff = min(ff * vn(i),-fni(i))
417c FF = MIN(FF * VN(I),ZERO)
418 fni(i) = fni(i) + ff
419cc ECONVT = ECONVT + FF * VN(I) * DT1
420 ENDDO
421
422 ELSE
423 DO i=1,jlt
424 fac = stif(i) / max(em30,stif(i))
425 vis = sqrt(vis2(i))
426 c(i)= fac * (
427 . visc * vis +
428 . visca**2 * two * masmin(i) * max(zero,-vn(i)) /
429 . max((gapv(i) - pene(i)),em10) )
430 stif(i) = stif(i) * gapv(i) / max((gapv(i) - pene(i)),em10)
431 kt(i) = stif(i)
432 stif(i) = stif(i) + c(i) * dt1inv
433 ff = min(c(i) * vn(i),-fni(i))
434c FF = MIN(FF * VN(I),ZERO)
435 fni(i) = fni(i) + ff
436 cf(i) = fac*sqrt(viscffric(i))*vis
437 stif(i) = max(stif(i) ,cf(i)*dt1inv)
438cc ECONVT = ECONVT + C(I) * VN(I) * DT1
439 ENDDO
440 ENDIF
441
442 ELSEIF(ivis2==2)THEN
443C---------------------------------
444C VISC QUAD TYPE
445C---------------------------------
446 DO i=1,jlt
447 vis2(i) = vis2(i)/( max(em10,(gapv(i)-pene(i))/gapv(i)))
448 ENDDO
449C---------------------------------
450 visca = half
451 DO i=1,jlt
452 fac = stif(i) / max(em30,stif(i))
453 vis = sqrt(vis2(i))
454 ff = fac * (
455 . visc * vis +
456 . visca**2 * two * masmin(i) * abs(vn(i)) /
457 . max((gapv(i) - pene(i)),em10) )
458 stif(i) = stif(i) * gapv(i) / max((gapv(i)-pene(i)),em10)
459 stif(i) = stif(i) + two * ff * dt1inv
460 stif(i) = max(stif(i) ,fac*sqrt(viscffric(i))*vis*dt1inv)
461 ff = min(ff * vn(i),-fni(i))
462 fni(i) = fni(i) + ff
463 ENDDO
464 ELSEIF(ivis2==3)THEN
465C---------------------------------
466C VISC QUAD = 0
467C---------------------------------
468 DO i=1,jlt
469 fac = stif(i) / max(em30,stif(i))
470 vis = sqrt(vis2(i))
471 ff = fac * ( visc * vis ) /
472 . max((gapv(i) - pene(i)),em10)
473 stif(i) = stif(i) * gapv(i) / max((gapv(i)-pene(i)),em10)
474 stif(i) = stif(i) + two * ff * dt1inv
475 stif(i) = max(stif(i) ,fac*sqrt(viscffric(i))*vis*dt1inv)
476 ff = min(ff * vn(i),-fni(i))
477 fni(i) = fni(i) + ff
478 ENDDO
479 ELSEIF(ivis2==4)THEN
480C---------------------------------
481C VISC = 0
482C---------------------------------
483 DO i=1,jlt
484 vis = sqrt(vis2(i))
485 stif(i) = stif(i) * gapv(i) / max((gapv(i)-pene(i)),em10)
486 stif(i) = max(stif(i) ,fac*sqrt(viscffric(i))*vis*dt1inv)
487 ENDDO
488 ELSEIF(ivis2==5)THEN
489C---------------------------------
490C VISC = 2M/dt => pour visc < 1 , stable : dt < 2M/visc = dt
491C M=M1*M2/M1+M2 pour visc = 1 , choc elastique
492C pour visc = 0.5 , choc mou
493C---------------------------------
494 DO i=1,jlt
495 mas2 = ms1(i)*hs1(i)
496 . + ms2(i)*hs2(i)
497 masm = mm1(i)*hm1(i)
498 . + mm2(i)*hm2(i)
499 vis = 2. * visc * dt1inv * masm * mas2 /
500 . max(em30,masm+mas2)
501 stif(i) = stif(i) * gapv(i) / max((gapv(i) -pene(i)),em10)
502 stif(i) = max(stif(i) ,fac*sqrt(viscffric(i)*vis2(i))*dt1inv)
503 ff = vis * vn(i)
504 econtdt = econtdt + min(zero,ff-fni(i)) * vn(i) * dt1
505 fni(i) = min(fni(i),ff)
506 ENDDO
507 ELSE
508 ENDIF
509 ELSE
510 DO i=1,jlt
511 stif(i) = stif(i) * gapv(i) / max((gapv(i) - pene(i)),em10)
512 ENDDO
513 ENDIF
514C---------------------------------
515C SAUVEGARDE DE L'IMPULSION NORMALE
516C---------------------------------
517 fsav1 = zero
518 fsav2 = zero
519 fsav3 = zero
520 fsav8 = zero
521 fsav9 = zero
522 fsav10= zero
523 fsav11= zero
524 DO i=1,jlt
525 fxi(i)=nx(i)*fni(i)
526 fyi(i)=ny(i)*fni(i)
527 fzi(i)=nz(i)*fni(i)
528 fsav1=fsav1+fxi(i)*dt12
529 fsav2=fsav2+fyi(i)*dt12
530 fsav3=fsav3+fzi(i)*dt12
531 fsav8=fsav8+abs(fxi(i)*dt12)
532 fsav9=fsav9+abs(fyi(i)*dt12)
533 fsav10=fsav10+abs(fzi(i)*dt12)
534 fsav11=fsav11+abs(fni(i))*dt12
535 ENDDO
536 IF (inconv==1) THEN
537#include "lockon.inc"
538 fsav(1)=fsav(1)+fsav1
539 fsav(2)=fsav(2)+fsav2
540 fsav(3)=fsav(3)+fsav3
541 fsav(8)=fsav(8)+fsav8
542 fsav(9)=fsav(9)+fsav9
543 fsav(10)=fsav(10)+fsav10
544 fsav(11)=fsav(11)+fsav11
545#include "lockoff.inc"
546 ENDIF
547C
548 IF(isensint(1)/=0) THEN
549 DO i=1,jlt
550 fsavparit(1,1,i+nft) = fxi(i)
551 fsavparit(1,2,i+nft) = fyi(i)
552 fsavparit(1,3,i+nft) = fzi(i)
553 ENDDO
554 ENDIF
555C
556C impulsion normale pour les sous-interfaces
557C
558 IF (nisub > 0) THEN
559C
560 DO i=1,jlt
561 im=cm_loc(i)
562 kk =addsubm(im)
563 IF (cs_loc(i)<=nrts) THEN
564C-- SECONDARY line on the proc
565 is=cs_loc(i)
566 jj =addsubs(is)
567 DO WHILE(jj<addsubs(is+1))
568 jsub=lisubs(jj)
569 itypsub = typsub(jsub)
570
571 IF(itypsub == 1 ) THEN ! Defining specific inter
572
573 ksub=lisubm(kk)
574
575 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
576C
577 IF(ksub==jsub)THEN
578C
579 fsav1=fxi(i)*dt12
580 fsav2=fyi(i)*dt12
581 fsav3=fzi(i)*dt12
582 fsav8=abs(fxi(i)*dt12)
583 fsav9=abs(fyi(i)*dt12)
584 fsav10=abs(fzi(i)*dt12)
585 fsav11=abs(fni(i))*dt12
586C
587 nsub=lisub(jsub)
588 fsavsub(1,nsub)=fsavsub(1,nsub)+fsav1
589 fsavsub(2,nsub)=fsavsub(2,nsub)+fsav2
590 fsavsub(3,nsub)=fsavsub(3,nsub)+fsav3
591 fsavsub(8,nsub)=fsavsub(8,nsub)+fsav8
592 fsavsub(9,nsub)=fsavsub(9,nsub)+fsav9
593 fsavsub(10,nsub)=fsavsub(10,nsub)+fsav10
594 fsavsub(11,nsub)=fsavsub(11,nsub)+fsav11
595C
596 IF(isensint(jsub+1)/=0) THEN
597 fsavparit(jsub+1,1,i+nft) = fxi(i)
598 fsavparit(jsub+1,2,i+nft) = fyi(i)
599 fsavparit(jsub+1,3,i+nft) = fzi(i)
600 ENDIF
601C
602 END IF
603
604 kk=kk+1
605 ksub=lisubm(kk)
606 ENDDO
607 jj=jj+1
608
609 ELSEIF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : secondary side
610C
611 fsav1=fxi(i)*dt12
612 fsav2=fyi(i)*dt12
613 fsav3=fzi(i)*dt12
614 fsav8=abs(fxi(i)*dt12)
615 fsav9=abs(fyi(i)*dt12)
616 fsav10=abs(fzi(i)*dt12)
617 fsav11=abs(fni(i))*dt12
618C
619 nsub=lisub(jsub)
620 fsavsub(1,nsub)=fsavsub(1,nsub)+fsav1
621 fsavsub(2,nsub)=fsavsub(2,nsub)+fsav2
622 fsavsub(3,nsub)=fsavsub(3,nsub)+fsav3
623 fsavsub(8,nsub)=fsavsub(8,nsub)+fsav8
624 fsavsub(9,nsub)=fsavsub(9,nsub)+fsav9
625 fsavsub(10,nsub)=fsavsub(10,nsub)+fsav10
626 fsavsub(11,nsub)=fsavsub(11,nsub)+fsav11
627C
628 IF(isensint(jsub+1)/=0) THEN
629 fsavparit(jsub+1,1,i+nft) = fxi(i)
630 fsavparit(jsub+1,2,i+nft) = fyi(i)
631 fsavparit(jsub+1,3,i+nft) = fzi(i)
632 ENDIF
633C
634
635 jj=jj+1
636 ELSEIF(itypsub == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2 surfacec
637
638 iss2 = bitget(inflg_subs(jj),0)
639 iss1 = bitget(inflg_subs(jj),1)
640 ksub=lisubm(kk)
641 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
642 ims2 = bitget(inflg_subm(kk),0)
643 ims1 = bitget(inflg_subm(kk),1)
644 IF(ksub==jsub)THEN
645 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
646 . (ims2 == 1 .AND. iss1 == 1))) THEN
647 kk=kk+1
648 ksub=lisubm(kk)
649 cycle
650 END IF
651C
652 fsav1=fxi(i)*dt12
653 fsav2=fyi(i)*dt12
654 fsav3=fzi(i)*dt12
655 fsav8=abs(fxi(i)*dt12)
656 fsav9=abs(fyi(i)*dt12)
657 fsav10=abs(fzi(i)*dt12)
658 fsav11=abs(fni(i))*dt12
659C
660 nsub=lisub(jsub)
661 IF(ims2 > 0)THEN
662 fsavsub(1,nsub)=fsavsub(1,nsub)-fsav1
663 fsavsub(2,nsub)=fsavsub(2,nsub)-fsav2
664 fsavsub(3,nsub)=fsavsub(3,nsub)-fsav3
665
666 ELSE
667 fsavsub(1,nsub)=fsavsub(1,nsub)+fsav1
668 fsavsub(2,nsub)=fsavsub(2,nsub)+fsav2
669 fsavsub(3,nsub)=fsavsub(3,nsub)+fsav3
670 ENDIF
671 fsavsub(8,nsub)=fsavsub(8,nsub)+fsav8
672 fsavsub(9,nsub)=fsavsub(9,nsub)+fsav9
673 fsavsub(10,nsub)=fsavsub(10,nsub)+fsav10
674 fsavsub(11,nsub)=fsavsub(11,nsub)+fsav11
675C
676 IF(isensint(jsub+1)/=0) THEN
677 IF(ims2 > 0)THEN
678 fsavparit(jsub+1,1,i+nft) = -fxi(i)
679 fsavparit(jsub+1,2,i+nft) = -fyi(i)
680 fsavparit(jsub+1,3,i+nft) = -fzi(i)
681 ELSE
682 fsavparit(jsub+1,1,i+nft) = fxi(i)
683 fsavparit(jsub+1,2,i+nft) = fyi(i)
684 fsavparit(jsub+1,3,i+nft) = fzi(i)
685 ENDIF
686 ENDIF
687C
688 END IF
689
690 kk=kk+1
691 ksub=lisubm(kk)
692 ENDDO
693 jj=jj+1
694
695 ENDIF
696
697 ENDDO
698
699 DO WHILE(kk<addsubm(im+1))
700 ksub=lisubm(kk)
701
702 itypsub = typsub(ksub)
703 IF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : main side
704C
705 fsav1=fxi(i)*dt12
706 fsav2=fyi(i)*dt12
707 fsav3=fzi(i)*dt12
708 fsav8=abs(fxi(i)*dt12)
709 fsav9=abs(fyi(i)*dt12)
710 fsav10=abs(fzi(i)*dt12)
711 fsav11=abs(fni(i))*dt12
712C
713 nsub=lisub(ksub)
714 fsavsub(1,nsub)=fsavsub(1,nsub)-fsav1
715 fsavsub(2,nsub)=fsavsub(2,nsub)-fsav2
716 fsavsub(3,nsub)=fsavsub(3,nsub)-fsav3
717 fsavsub(8,nsub)=fsavsub(8,nsub)+fsav8
718 fsavsub(9,nsub)=fsavsub(9,nsub)+fsav9
719 fsavsub(10,nsub)=fsavsub(10,nsub)+fsav10
720 fsavsub(11,nsub)=fsavsub(11,nsub)+fsav11
721C
722 IF(isensint(jsub+1)/=0) THEN
723 fsavparit(jsub+1,1,i+nft) = -fxi(i)
724 fsavparit(jsub+1,2,i+nft) = -fyi(i)
725 fsavparit(jsub+1,3,i+nft) = -fzi(i)
726 ENDIF
727C
728
729 ENDIF
730 kk=kk+1
731 ENDDO
732
733
734
735 ELSE
736C-- Remote SECONDARY line
737 is=cs_loc(i)-nrts
738 jj =addsubsfi(nin)%P(is)
739 DO WHILE(jj<addsubsfi(nin)%P(is+1))
740 jsub=lisubsfi(nin)%P(jj)
741 itypsub = typsub(jsub)
742
743 IF(itypsub == 1 ) THEN ! Defining specific inter
744
745 ksub=lisubm(kk)
746 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
747C
748 IF(ksub==jsub)THEN
749C
750 fsav1=fxi(i)*dt12
751 fsav2=fyi(i)*dt12
752 fsav3=fzi(i)*dt12
753 fsav8=abs(fxi(i)*dt12)
754 fsav9=abs(fyi(i)*dt12)
755 fsav10=abs(fzi(i)*dt12)
756 fsav11=abs(fni(i))*dt12
757C
758 nsub=lisub(jsub)
759 fsavsub(1,nsub)=fsavsub(1,nsub)+fsav1
760 fsavsub(2,nsub)=fsavsub(2,nsub)+fsav2
761 fsavsub(3,nsub)=fsavsub(3,nsub)+fsav3
762 fsavsub(8,nsub)=fsavsub(8,nsub)+fsav8
763 fsavsub(9,nsub)=fsavsub(9,nsub)+fsav9
764 fsavsub(10,nsub)=fsavsub(10,nsub)+fsav10
765 fsavsub(11,nsub)=fsavsub(11,nsub)+fsav11
766C
767 IF(isensint(jsub+1)/=0) THEN
768 fsavparit(jsub+1,1,i+nft) = fxi(i)
769 fsavparit(jsub+1,2,i+nft) = fyi(i)
770 fsavparit(jsub+1,3,i+nft) = fzi(i)
771 ENDIF
772C
773 END IF
774
775 kk=kk+1
776 ksub=lisubm(kk)
777 ENDDO
778 jj=jj+1
779
780 ELSEIF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface
781C
782 fsav1=fxi(i)*dt12
783 fsav2=fyi(i)*dt12
784 fsav3=fzi(i)*dt12
785 fsav8=abs(fxi(i)*dt12)
786 fsav9=abs(fyi(i)*dt12)
787 fsav10=abs(fzi(i)*dt12)
788 fsav11=abs(fni(i))*dt12
789C
790 nsub=lisub(jsub)
791 fsavsub(1,nsub)=fsavsub(1,nsub)+fsav1
792 fsavsub(2,nsub)=fsavsub(2,nsub)+fsav2
793 fsavsub(3,nsub)=fsavsub(3,nsub)+fsav3
794 fsavsub(8,nsub)=fsavsub(8,nsub)+fsav8
795 fsavsub(9,nsub)=fsavsub(9,nsub)+fsav9
796 fsavsub(10,nsub)=fsavsub(10,nsub)+fsav10
797 fsavsub(11,nsub)=fsavsub(11,nsub)+fsav11
798C
799 IF(isensint(jsub+1)/=0) THEN
800 fsavparit(jsub+1,1,i+nft) = fxi(i)
801 fsavparit(jsub+1,2,i+nft) = fyi(i)
802 fsavparit(jsub+1,3,i+nft) = fzi(i)
803 ENDIF
804C
805
806 jj=jj+1
807
808 ELSEIF(itypsub == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2 surfacec
809
810 iss2 = bitget(inflg_subsfi(nin)%P(jj),0)
811 iss1 = bitget(inflg_subsfi(nin)%P(jj),1)
812 ksub=lisubm(kk)
813 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
814 ims2 = bitget(inflg_subm(kk),0)
815 ims1 = bitget(inflg_subm(kk),1)
816 IF(ksub==jsub)THEN
817 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
818 . (ims2 == 1 .AND. iss1 == 1))) THEN
819 kk=kk+1
820 ksub=lisubm(kk)
821 cycle
822 END IF
823C
824 fsav1=fxi(i)*dt12
825 fsav2=fyi(i)*dt12
826 fsav3=fzi(i)*dt12
827 fsav8=abs(fxi(i)*dt12)
828 fsav9=abs(fyi(i)*dt12)
829 fsav10=abs(fzi(i)*dt12)
830 fsav11=abs(fni(i))*dt12
831C
832 nsub=lisub(jsub)
833 IF(ims2 > 0)THEN
834 fsavsub(1,nsub)=fsavsub(1,nsub)-fsav1
835 fsavsub(2,nsub)=fsavsub(2,nsub)-fsav2
836 fsavsub(3,nsub)=fsavsub(3,nsub)-fsav3
837
838 ELSE
839 fsavsub(1,nsub)=fsavsub(1,nsub)+fsav1
840 fsavsub(2,nsub)=fsavsub(2,nsub)+fsav2
841 fsavsub(3,nsub)=fsavsub(3,nsub)+fsav3
842 ENDIF
843 fsavsub(8,nsub)=fsavsub(8,nsub)+fsav8
844 fsavsub(9,nsub)=fsavsub(9,nsub)+fsav9
845 fsavsub(10,nsub)=fsavsub(10,nsub)+fsav10
846 fsavsub(11,nsub)=fsavsub(11,nsub)+fsav11
847C
848 IF(isensint(jsub+1)/=0) THEN
849 IF(ims2 > 0)THEN
850 fsavparit(jsub+1,1,i+nft) = -fxi(i)
851 fsavparit(jsub+1,2,i+nft) = -fyi(i)
852 fsavparit(jsub+1,3,i+nft) = -fzi(i)
853 ELSE
854 fsavparit(jsub+1,1,i+nft) = fxi(i)
855 fsavparit(jsub+1,2,i+nft) = fyi(i)
856 fsavparit(jsub+1,3,i+nft) = fzi(i)
857 ENDIF
858 ENDIF
859C
860 END IF
861
862 kk=kk+1
863 ksub=lisubm(kk)
864 ENDDO
865 jj=jj+1
866
867 ENDIF
868
869 ENDDO
870 ENDIF
871
872 ENDDO
873C
874 ENDIF
875
876C------------For /LOAD/PRESSURE tag nodes in contact-------------
877 IF(ninloadp > 0) THEN
878 DO k = kloadpinter(nin)+1, kloadpinter(nin+1)
879 pp = loadpinter(k)
880 ppl = loadp_hyd_inter(pp)
881 dgapload = dgaploadint(k)
882 DO i=1,jlt
883 dist = penrad(i) + gapv(i)
884 gapp= gapv(i) + dgapload
885 IF(pene(i) > zero .OR.dist <= gapp) THEN
886 tagncont(ppl,m1(i)) = 1
887 tagncont(ppl,m2(i)) = 1
888 IF(cs_loc(i)<=nrts) THEN
889C SPMD : do same after reception of forces for remote nodes
890 tagncont(ppl,n1(i)) = 1
891 tagncont(ppl,n2(i)) = 1
892 ENDIF
893 ENDIF
894 ENDDO
895 ENDDO
896 ENDIF
897C
898C---------------------------------
899C FRICTION
900C---------------------------------
901 IF(iform==1)THEN
902 fsav4 = zero
903 fsav5 = zero
904 fsav6 = zero
905 fsav12 = zero
906 fsav13 = zero
907 fsav14 = zero
908 fsav15 = zero
909 DO i=1,jlt
910 IF(fricc(i)*viscffric(i)/=0.)THEN
911 vnx = nx(i)*vn(i)
912 vny = ny(i)*vn(i)
913 vnz = nz(i)*vn(i)
914 vx(i) = vx(i) - vnx
915 vy(i) = vy(i) - vny
916 vz(i) = vz(i) - vnz
917 v2 = vx(i)**2 + vy(i)**2 + vz(i)**2
918 vis2(i) = viscffric(i) * vis2(i)
919 fm2 = (fricc(i)*fni(i))**2
920 f2 = vis2(i) * v2
921 a2 = min(f2,fm2) / max(em30,f2)
922 aa = sqrt(a2 * vis2(i))
923 fxt(i) = aa * vx(i)
924 fyt(i) = aa * vy(i)
925 fzt(i) = aa * vz(i)
926 fsav4 = fsav4 + fxt(i)*dt12
927 fsav5 = fsav5 + fyt(i)*dt12
928 fsav6 = fsav6 + fzt(i)*dt12
929 fxi(i)=fxi(i) + fxt(i)
930 fyi(i)=fyi(i) + fyt(i)
931 fzi(i)=fzi(i) + fzt(i)
932 fsav12 = fsav12 + abs(fxi(i)*dt12)
933 fsav13 = fsav13 + abs(fyi(i)*dt12)
934 fsav14 = fsav14 + abs(fzi(i)*dt12)
935 fsav15 = fsav15 + sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
936 econvt = econvt + aa * v2 * dt1
937 ENDIF
938 ENDDO
939 IF (inconv==1) THEN
940#include "lockon.inc"
941 fsav(4) = fsav(4) + fsav4
942 fsav(5) = fsav(5) + fsav5
943 fsav(6) = fsav(6) + fsav6
944 fsav(12) = fsav(12) + fsav12
945 fsav(13) = fsav(13) + fsav13
946 fsav(14) = fsav(14) + fsav14
947 fsav(15) = fsav(15) + fsav15
948#include "lockoff.inc"
949 ENDIF
950 ELSEIF(iform==2)THEN
951C---------------------------------
952C INCREMENTAL (STIFFNESS) FORMULATION
953C---------------------------------
954 fsav4 = zero
955 fsav5 = zero
956 fsav6 = zero
957 fsav12 = zero
958 fsav13 = zero
959 fsav14 = zero
960 fsav15 = zero
961 DO i=1,jlt
962 fx = stif(i)*vx(i)*dt12
963 fy = stif(i)*vy(i)*dt12
964 fz = stif(i)*vz(i)*dt12
965 fx = cand_fx(index(i)) + fx
966 fy = cand_fy(index(i)) + fy
967 fz = cand_fz(index(i)) + fz
968 ftn = fx*nx(i) + fy*ny(i) + fz*nz(i)
969 fx = fx - ftn*nx(i)
970 fy = fy - ftn*ny(i)
971 fz = fz - ftn*nz(i)
972 ft = fx*fx + fy*fy + fz*fz
973 ft = max(ft,em30)
974 fn = fxi(i)**2+fyi(i)**2+fzi(i)**2
975 beta = min(one,fricc(i)*sqrt(fn/ft))
976 fxt(i) = fx * beta
977 fyt(i) = fy * beta
978 fzt(i) = fz * beta
979 fsav4 = fsav4 + fxt(i)*dt12
980 fsav5 = fsav5 + fyt(i)*dt12
981 fsav6 = fsav6 + fzt(i)*dt12
982 cand_fx(index(i)) = fxt(i)
983 cand_fy(index(i)) = fyt(i)
984 cand_fz(index(i)) = fzt(i)
985 ifpen(index(i)) = 1
986 fxi(i)=fxi(i) + fxt(i)
987 fyi(i)=fyi(i) + fyt(i)
988 fzi(i)=fzi(i) + fzt(i)
989 fsav12 = fsav12 + abs(fxi(i)*dt12)
990 fsav13 = fsav13 + abs(fyi(i)*dt12)
991 fsav14 = fsav14 + abs(fzi(i)*dt12)
992 fsav15 = fsav15 + sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
993 econvt = econvt
994 . + dt1*(vx(i)*fxt(i)+vy(i)*fyt(i)+vz(i)*fzt(i))
995 ENDDO
996 IF (inconv==1) THEN
997#include "lockon.inc"
998 fsav(4) = fsav(4) + fsav4
999 fsav(5) = fsav(5) + fsav5
1000 fsav(6) = fsav(6) + fsav6
1001 fsav(12) = fsav(12) + fsav12
1002 fsav(13) = fsav(13) + fsav13
1003 fsav(14) = fsav(14) + fsav14
1004 fsav(15) = fsav(15) + fsav15
1005#include "lockoff.inc"
1006 ENDIF
1007
1008 ENDIF
1009C
1010 IF(isensint(1)/=0) THEN
1011 DO i=1,jlt
1012 fsavparit(1,4,i+nft) = fxt(i)
1013 fsavparit(1,5,i+nft) = fyt(i)
1014 fsavparit(1,6,i+nft) = fzt(i)
1015 ENDDO
1016 ENDIF
1017C
1018C
1019C impulsion tangentielle dans les sous-interfaces
1020C
1021 IF (nisub > 0) THEN
1022C
1023 DO i=1,jlt
1024 im=cm_loc(i)
1025 kk =addsubm(im)
1026 IF (cs_loc(i)<=nrts) THEN
1027C-- SECONDARY line on the proc
1028 is=cs_loc(i)
1029 jj =addsubs(is)
1030
1031 DO WHILE(jj<addsubs(is+1))
1032 jsub=lisubs(jj)
1033 itypsub = typsub(jsub)
1034 IF(itypsub == 1 ) THEN ! Defining specific inter
1035
1036 ksub=lisubm(kk)
1037 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
1038 IF(ksub==jsub)THEN
1039C
1040 fsav4=fxt(i)*dt12
1041 fsav5=fyt(i)*dt12
1042 fsav6=fzt(i)*dt12
1043 fsav12 = abs(fxi(i)*dt12)
1044 fsav13 = abs(fyi(i)*dt12)
1045 fsav14 = abs(fzi(i)*dt12)
1046 fsav15 = sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
1047C
1048 nsub=lisub(jsub)
1049 fsavsub(4,nsub)=fsavsub(4,nsub)+fsav4
1050 fsavsub(5,nsub)=fsavsub(5,nsub)+fsav5
1051 fsavsub(6,nsub)=fsavsub(6,nsub)+fsav6
1052 fsavsub(12,nsub)=fsavsub(12,nsub)+fsav12
1053 fsavsub(13,nsub)=fsavsub(13,nsub)+fsav13
1054 fsavsub(14,nsub)=fsavsub(14,nsub)+fsav14
1055 fsavsub(15,nsub)=fsavsub(15,nsub)+fsav15
1056C
1057 IF(isensint(jsub+1)/=0) THEN
1058 fsavparit(jsub+1,4,i+nft) = fxt(i)
1059 fsavparit(jsub+1,5,i+nft) = fyt(i)
1060 fsavparit(jsub+1,6,i+nft) = fzt(i)
1061 ENDIF
1062 END IF
1063
1064 kk=kk+1
1065 ksub=lisubm(kk)
1066 ENDDO
1067 jj=jj+1
1068
1069 ELSEIF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface
1070C
1071 fsav4=fxt(i)*dt12
1072 fsav5=fyt(i)*dt12
1073 fsav6=fzt(i)*dt12
1074 fsav12 = abs(fxi(i)*dt12)
1075 fsav13 = abs(fyi(i)*dt12)
1076 fsav14 = abs(fzi(i)*dt12)
1077 fsav15 = sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
1078C
1079 nsub=lisub(jsub)
1080 fsavsub(4,nsub)=fsavsub(4,nsub)+fsav4
1081 fsavsub(5,nsub)=fsavsub(5,nsub)+fsav5
1082 fsavsub(6,nsub)=fsavsub(6,nsub)+fsav6
1083 fsavsub(12,nsub)=fsavsub(12,nsub)+fsav12
1084 fsavsub(13,nsub)=fsavsub(13,nsub)+fsav13
1085 fsavsub(14,nsub)=fsavsub(14,nsub)+fsav14
1086 fsavsub(15,nsub)=fsavsub(15,nsub)+fsav15
1087C
1088 IF(isensint(jsub+1)/=0) THEN
1089 fsavparit(jsub+1,4,i+nft) = fxt(i)
1090 fsavparit(jsub+1,5,i+nft) = fyt(i)
1091 fsavparit(jsub+1,6,i+nft) = fzt(i)
1092 ENDIF
1093C
1094 jj = jj + 1
1095 ELSEIF(itypsub == 3) THEN
1096
1097 iss2 = bitget(inflg_subs(jj),0)
1098 iss1 = bitget(inflg_subs(jj),1)
1099 ksub=lisubm(kk)
1100 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
1101 ims2 = bitget(inflg_subm(kk),0)
1102 ims1 = bitget(inflg_subm(kk),1)
1103 IF(ksub==jsub)THEN
1104 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
1105 . (ims2 == 1 .AND. iss1 == 1))) THEN
1106 kk=kk+1
1107 ksub=lisubm(kk)
1108 cycle
1109 END IF
1110C
1111 fsav4=fxt(i)*dt12
1112 fsav5=fyt(i)*dt12
1113 fsav6=fzt(i)*dt12
1114 fsav12 = abs(fxi(i)*dt12)
1115 fsav13 = abs(fyi(i)*dt12)
1116 fsav14 = abs(fzi(i)*dt12)
1117 fsav15 = sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
1118C
1119 nsub=lisub(jsub)
1120 IF(ims2 > 0 ) THEN
1121 fsavsub(4,nsub)=fsavsub(4,nsub)-fsav4
1122 fsavsub(5,nsub)=fsavsub(5,nsub)-fsav5
1123 fsavsub(6,nsub)=fsavsub(6,nsub)-fsav6
1124 ELSE
1125 fsavsub(4,nsub)=fsavsub(4,nsub)+fsav4
1126 fsavsub(5,nsub)=fsavsub(5,nsub)+fsav5
1127 fsavsub(6,nsub)=fsavsub(6,nsub)+fsav6
1128 ENDIF
1129 fsavsub(12,nsub)=fsavsub(12,nsub)+fsav12
1130 fsavsub(13,nsub)=fsavsub(13,nsub)+fsav13
1131 fsavsub(14,nsub)=fsavsub(14,nsub)+fsav14
1132 fsavsub(15,nsub)=fsavsub(15,nsub)+fsav15
1133C
1134 IF(isensint(jsub+1)/=0) THEN
1135 IF(ims2 > 0 ) THEN
1136 fsavparit(jsub+1,4,i+nft) = fxt(i)
1137 fsavparit(jsub+1,5,i+nft) = fyt(i)
1138 fsavparit(jsub+1,6,i+nft) = fzt(i)
1139 ELSE
1140 fsavparit(jsub+1,4,i+nft) = -fxt(i)
1141 fsavparit(jsub+1,5,i+nft) = -fyt(i)
1142 fsavparit(jsub+1,6,i+nft) = -fzt(i)
1143 ENDIF
1144 ENDIF
1145 END IF
1146
1147 kk=kk+1
1148 ksub=lisubm(kk)
1149 ENDDO
1150 jj=jj+1
1151
1152 ENDIF
1153 ENDDO
1154
1155 DO WHILE(kk<addsubm(im+1))
1156 ksub=lisubm(kk)
1157
1158 itypsub = typsub(ksub)
1159 IF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : main side
1160C
1161 fsav4=-fxt(i)*dt12
1162 fsav5=-fyt(i)*dt12
1163 fsav6=-fzt(i)*dt12
1164 fsav12 = abs(fxi(i)*dt12)
1165 fsav13 = abs(fyi(i)*dt12)
1166 fsav14 = abs(fzi(i)*dt12)
1167 fsav15 = sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
1168C
1169 nsub=lisub(jsub)
1170 fsavsub(4,nsub)=fsavsub(4,nsub)+fsav4
1171 fsavsub(5,nsub)=fsavsub(5,nsub)+fsav5
1172 fsavsub(6,nsub)=fsavsub(6,nsub)+fsav6
1173 fsavsub(12,nsub)=fsavsub(12,nsub)+fsav12
1174 fsavsub(13,nsub)=fsavsub(13,nsub)+fsav13
1175 fsavsub(14,nsub)=fsavsub(14,nsub)+fsav14
1176 fsavsub(15,nsub)=fsavsub(15,nsub)+fsav15
1177C
1178 IF(isensint(jsub+1)/=0) THEN
1179 fsavparit(jsub+1,4,i+nft) = -fxt(i)
1180 fsavparit(jsub+1,5,i+nft) = -fyt(i)
1181 fsavparit(jsub+1,6,i+nft) = -fzt(i)
1182 ENDIF
1183C
1184 jj = jj + 1
1185
1186 ENDIF
1187 kk=kk+1
1188 ENDDO
1189 ELSE
1190C-- Remote SECONDARY line
1191 is=cs_loc(i)-nrts
1192 jj =addsubsfi(nin)%P(is)
1193 DO WHILE(jj<addsubsfi(nin)%P(is+1))
1194 jsub=lisubsfi(nin)%P(jj)
1195 itypsub = typsub(jsub)
1196
1197 IF(itypsub == 1 ) THEN ! Defining specific inter
1198
1199 ksub=lisubm(kk)
1200 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
1201 IF(ksub==jsub)THEN
1202C
1203 fsav4=fxt(i)*dt12
1204 fsav5=fyt(i)*dt12
1205 fsav6=fzt(i)*dt12
1206 fsav12 = abs(fxi(i)*dt12)
1207 fsav13 = abs(fyi(i)*dt12)
1208 fsav14 = abs(fzi(i)*dt12)
1209 fsav15 = sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
1210C
1211 nsub=lisub(jsub)
1212 fsavsub(4,nsub)=fsavsub(4,nsub)+fsav4
1213 fsavsub(5,nsub)=fsavsub(5,nsub)+fsav5
1214 fsavsub(6,nsub)=fsavsub(6,nsub)+fsav6
1215 fsavsub(12,nsub)=fsavsub(12,nsub)+fsav12
1216 fsavsub(13,nsub)=fsavsub(13,nsub)+fsav13
1217 fsavsub(14,nsub)=fsavsub(14,nsub)+fsav14
1218 fsavsub(15,nsub)=fsavsub(15,nsub)+fsav15
1219C
1220 IF(isensint(jsub+1)/=0) THEN
1221 fsavparit(jsub+1,4,i+nft) = fxt(i)
1222 fsavparit(jsub+1,5,i+nft) = fyt(i)
1223 fsavparit(jsub+1,6,i+nft) = fzt(i)
1224 ENDIF
1225 END IF
1226
1227 kk=kk+1
1228 ksub=lisubm(kk)
1229 ENDDO
1230 jj=jj+1
1231
1232 ELSEIF(itypsub == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surf
1233C
1234 fsav4=fxt(i)*dt12
1235 fsav5=fyt(i)*dt12
1236 fsav6=fzt(i)*dt12
1237 fsav12 = abs(fxi(i)*dt12)
1238 fsav13 = abs(fyi(i)*dt12)
1239 fsav14 = abs(fzi(i)*dt12)
1240 fsav15 = sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
1241C
1242 nsub=lisub(jsub)
1243 fsavsub(4,nsub)=fsavsub(4,nsub)+fsav4
1244 fsavsub(5,nsub)=fsavsub(5,nsub)+fsav5
1245 fsavsub(6,nsub)=fsavsub(6,nsub)+fsav6
1246 fsavsub(12,nsub)=fsavsub(12,nsub)+fsav12
1247 fsavsub(13,nsub)=fsavsub(13,nsub)+fsav13
1248 fsavsub(14,nsub)=fsavsub(14,nsub)+fsav14
1249 fsavsub(15,nsub)=fsavsub(15,nsub)+fsav15
1250C
1251 IF(isensint(jsub+1)/=0) THEN
1252 fsavparit(jsub+1,4,i+nft) = fxt(i)
1253 fsavparit(jsub+1,5,i+nft) = fyt(i)
1254 fsavparit(jsub+1,6,i+nft) = fzt(i)
1255 ENDIF
1256C
1257 jj = jj + 1
1258
1259 ELSEIF(itypsub == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2 Surfs
1260
1261 iss2 = bitget(inflg_subsfi(nin)%P(jj),0)
1262 iss1 = bitget(inflg_subsfi(nin)%P(jj),1)
1263 ksub=lisubm(kk)
1264 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
1265 ims2 = bitget(inflg_subm(kk),0)
1266 ims1 = bitget(inflg_subm(kk),1)
1267 IF(ksub==jsub)THEN
1268 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
1269 . (ims2 == 1 .AND. iss1 == 1))) THEN
1270 kk=kk+1
1271 ksub=lisubm(kk)
1272 cycle
1273 END IF
1274C
1275 fsav4=fxt(i)*dt12
1276 fsav5=fyt(i)*dt12
1277 fsav6=fzt(i)*dt12
1278 fsav12 = abs(fxi(i)*dt12)
1279 fsav13 = abs(fyi(i)*dt12)
1280 fsav14 = abs(fzi(i)*dt12)
1281 fsav15 = sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
1282C
1283 nsub=lisub(jsub)
1284 IF(ims2 > 0) THEN
1285 fsavsub(4,nsub)=fsavsub(4,nsub)-fsav4
1286 fsavsub(5,nsub)=fsavsub(5,nsub)-fsav5
1287 fsavsub(6,nsub)=fsavsub(6,nsub)-fsav6
1288 ELSE
1289 fsavsub(4,nsub)=fsavsub(4,nsub)+fsav4
1290 fsavsub(5,nsub)=fsavsub(5,nsub)+fsav5
1291 fsavsub(6,nsub)=fsavsub(6,nsub)+fsav6
1292 ENDIF
1293 fsavsub(12,nsub)=fsavsub(12,nsub)+fsav12
1294 fsavsub(13,nsub)=fsavsub(13,nsub)+fsav13
1295 fsavsub(14,nsub)=fsavsub(14,nsub)+fsav14
1296 fsavsub(15,nsub)=fsavsub(15,nsub)+fsav15
1297C
1298 IF(isensint(jsub+1)/=0) THEN
1299 IF(ims2 > 0) THEN
1300 fsavparit(jsub+1,4,i+nft) = -fxt(i)
1301 fsavparit(jsub+1,5,i+nft) = -fyt(i)
1302 fsavparit(jsub+1,6,i+nft) = -fzt(i)
1303 ELSE
1304 fsavparit(jsub+1,4,i+nft) = fxt(i)
1305 fsavparit(jsub+1,5,i+nft) = fyt(i)
1306 fsavparit(jsub+1,6,i+nft) = fzt(i)
1307 ENDIF
1308 ENDIF
1309 END IF
1310
1311 kk=kk+1
1312 ksub=lisubm(kk)
1313 ENDDO
1314 jj=jj+1
1315
1316 ENDIF
1317 ENDDO
1318 ENDIF
1319
1320 ENDDO
1321C
1322 ENDIF
1323C
1324 IF (inconv==1) THEN
1325#include "lockon.inc"
1326 econtv = econtv + econvt ! Frictional Energy
1327 econt = econt + econtt ! Elastic Energy
1328 econtd = econtd + econtdt ! Damping Energy
1329 fsav(26) = fsav(26) + econtt
1330 fsav(27) = fsav(27) + econvt
1331 fsav(28) = fsav(28) + econtdt
1332#include "lockoff.inc"
1333 ENDIF
1334C---------------------------------
1335 DO i=1,jlt
1336 fx1(i)=-fxi(i)*hs1(i)
1337 fy1(i)=-fyi(i)*hs1(i)
1338 fz1(i)=-fzi(i)*hs1(i)
1339C
1340 fx2(i)=-fxi(i)*hs2(i)
1341 fy2(i)=-fyi(i)*hs2(i)
1342 fz2(i)=-fzi(i)*hs2(i)
1343C
1344 fx3(i)=fxi(i)*hm1(i)
1345 fy3(i)=fyi(i)*hm1(i)
1346 fz3(i)=fzi(i)*hm1(i)
1347C
1348 fx4(i)=fxi(i)*hm2(i)
1349 fy4(i)=fyi(i)*hm2(i)
1350 fz4(i)=fzi(i)*hm2(i)
1351C
1352 ENDDO
1353C
1354 IF (nspmd>1) THEN
1355ctmp+1 mic only
1356#include "mic_lockon.inc"
1357 DO i = 1,jlt
1358 IF(cs_loc(i)>nrts)THEN
1359 ni = cs_loc(i)-nrts
1360C tag temporaire de NSVFI a -
1361 nsvfi(nin)%P(ni) = -abs(nsvfi(nin)%P(ni))
1362 ENDIF
1363 ENDDO
1364ctmp+1 mic only
1365#include "mic_lockoff.inc"
1366 ENDIF
1367C
1368 DO i=1,jlt
1369 stif(i) = two*stif(i)
1370 ENDDO
1371C
1372C---------------------------------
1373 IF(kdtint==1.OR.idtmins==2.OR.idtmins_int/=0)THEN
1374 IF( (visc/=zero)
1375 . .AND.(ivis2==0.OR.ivis2==1))THEN
1376 DO i=1,jlt
1377 cx= c(i)*c(i)
1378C
1379 IF(ms1(i)==zero)THEN
1380 k1(i) =zero
1381 c1(i) =zero
1382 ELSE
1383 k1(i)=kt(i)*abs(hs1(i))
1384 c1(i)=c(i)*abs(hs1(i))
1385 cx =four*c1(i)*c1(i)
1386 cy =eight*ms1(i)*k1(i)
1387 aux = sqrt(cx+cy)+two*c1(i)
1388 st1(i)= k1(i)*aux*aux/max(cy,em30)
1389 cfi = cf(i)*abs(hs1(i))
1390 aux = two*cfi*cfi/max(ms1(i),em20)
1391 IF(aux>st1(i))THEN
1392 k1(i) =zero
1393 c1(i) =cfi
1394 ENDIF
1395 ENDIF
1396C
1397 IF(ms2(i)==zero)THEN
1398 k2(i) =zero
1399 c2(i) =zero
1400 ELSE
1401 k2(i)=kt(i)*abs(hs2(i))
1402 c2(i)=c(i)*abs(hs2(i))
1403 cx =four*c2(i)*c2(i)
1404 cy =eight*ms2(i)*k2(i)
1405 aux = sqrt(cx+cy)+two*c2(i)
1406 st2(i)= k2(i)*aux*aux/max(cy,em30)
1407 cfi = cf(i)*abs(hs2(i))
1408 aux = two*cfi*cfi/max(ms2(i),em20)
1409 IF(aux>st2(i))THEN
1410 k2(i) =zero
1411 c2(i) =cfi
1412 ENDIF
1413 ENDIF
1414C
1415 IF(mm1(i)==zero)THEN
1416 k3(i) =zero
1417 c3(i) =zero
1418 ELSE
1419 k3(i)=kt(i)*abs(hm1(i))
1420 c3(i)=c(i)*abs(hm1(i))
1421 cx =four*c3(i)*c3(i)
1422 cy =eight*mm1(i)*k3(i)
1423 aux = sqrt(cx+cy)+two*c3(i)
1424 st3(i)= k3(i)*aux*aux/max(cy,em30)
1425 cfi = cf(i)*abs(hm1(i))
1426 aux = two*cfi*cfi/max(mm1(i),em20)
1427 IF(aux>st3(i))THEN
1428 k3(i) =zero
1429 c3(i) =cfi
1430 ENDIF
1431 ENDIF
1432C
1433 IF(mm2(i)==zero)THEN
1434 k4(i) =zero
1435 c4(i) =zero
1436 ELSE
1437 k4(i)=kt(i)*abs(hm2(i))
1438 c4(i)=c(i)*abs(hm2(i))
1439 cx =four*c4(i)*c4(i)
1440 cy =eight*mm2(i)*k4(i)
1441 aux = sqrt(cx+cy)+two*c4(i)
1442 st4(i)= k4(i)*aux*aux/max(cy,em30)
1443 cfi = cf(i)*abs(hm2(i))
1444 aux = two*cfi*cfi/max(mm2(i),em20)
1445 IF(aux>st4(i))THEN
1446 k4(i) =zero
1447 c4(i) =cfi
1448 ENDIF
1449 ENDIF
1450 ENDDO
1451 ELSE
1452 DO i=1,jlt
1453 k1(i) =stif(i)*abs(hs1(i))
1454 c1(i) =zero
1455 k2(i) =stif(i)*abs(hs2(i))
1456 c2(i) =zero
1457 k3(i) =stif(i)*abs(hm1(i))
1458 c3(i) =zero
1459 k4(i) =stif(i)*abs(hm2(i))
1460 c4(i) =zero
1461 ENDDO
1462 ENDIF
1463 ENDIF
1464C
1465C
1466 IF(idtm==1.OR.idtm==2)THEN
1467 dtmi0 = ep20
1468 DO i=1,jlt
1469 dtmi(i) = ep20
1470 mas2 = two * masmin(i)
1471 IF(mas2>zero.AND.stif(i)>zero)THEN
1472 dtmi(i) = min(dtmi(i),dtfac1(10)*sqrt(mas2/stif(i)))
1473 ENDIF
1474 dtmi0 = min(dtmi0,dtmi(i))
1475 ENDDO
1476 IF(dtmi0<=dtm)THEN
1477 DO i=1,jlt
1478 IF(dtmi(i)<=dtm)THEN
1479 IF(idtm==1)THEN
1480#include "lockon.inc"
1481 IF(cs_loc(i)<=nrts) THEN
1482 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
1483 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
1484 . ' IN INTERFACE NB',noint,'(DTMIN=',dtm,')'
1485 WRITE(iout,*)'SECONDARY NODES NB',itab(n1(i)),
1486 . itab(n2(i))
1487 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
1488 . itab(m2(i))
1489 ELSE
1490 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
1491 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
1492 . ' IN INTERFACE NB',noint,'(DTMIN=',dtm,')'
1493 WRITE(iout,*)'SECONDARY NODES NB',itafi(nin)%P(n1(i)),
1494 . itafi(nin)%P(n2(i))
1495 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
1496 . itab(m2(i))
1497 END IF
1498#include "lockoff.inc"
1499 tstop = tt
1500 ELSEIF(idtm==2)THEN
1501#include "lockon.inc"
1502 IF(cs_loc(i)<=nrts) THEN
1503 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
1504 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
1505 . ' IN INTERFACE NB',noint,'(DTMIN=',dtm,')'
1506 WRITE(iout,*)'SECONDARY NODES NB',itab(n1(i)),
1507 . itab(n2(i))
1508 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
1509 . itab(m2(i))
1510 WRITE(iout,*)'DELETE SECONDARY LINE FROM INTERFACE'
1511 stfs(cs_loc(i)) = -abs(stfs(cs_loc(i)))
1512 ELSE
1513 ni = cs_loc(i)-nrts
1514 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
1515 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
1516 . ' IN INTERFACE NB',noint,'(DTMIN=',dtm,')'
1517 WRITE(iout,*)'SECONDARY NODES NB',itafi(nin)%P(n1(i)),
1518 . itafi(nin)%P(n2(i))
1519 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
1520 . itab(m2(i))
1521 WRITE(iout,*)'delete secondary line from interface'
1522 STIFI(NIN)%P(NI) = -ABS(STIFI(NIN)%P(NI))
1523 END IF
1524#include "lockoff.inc"
1525 NEWFRONT = -1
1526 ELSEIF(IDTM==5)THEN
1527#include "lockon.inc"
1528 IF(CS_LOC(I)<=NRTS) THEN
1529 WRITE(IOUT,'(a,e12.4,a,i10,a,e12.4,a)')
1530 . ' **warning minimum time step ',DTMI(I),
1531 . ' in INTERFACE nb',NOINT,'(dtmin=',DTM,')'
1532 WRITE(IOUT,*)'secondary nodes nb',ITAB(N1(I)),
1533 . ITAB(N2(I))
1534 WRITE(IOUT,*)'main nodes nb',ITAB(M1(I)),
1535 . ITAB(M2(I))
1536 ELSE
1537 WRITE(IOUT,'(a,e12.4,a,i10,a,e12.4,a)')
1538 . ' **warning minimum time step ',DTMI(I),
1539 . ' in INTERFACE nb',noint,'(DTMIN=',dtm,')'
1540 WRITE(iout,*)'SECONDARY NODES NB',itafi(nin)%P(n1(i)),
1541 . itafi(nin)%P(n2(i))
1542 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
1543 . itab(m2(i))
1544 END IF
1545#include "lockoff.inc"
1546 mstop = 2
1547 ENDIF
1548 ENDIF
1549 ENDDO
1550 ENDIF
1551 ENDIF
1552C
1553 RETURN
bitget
integer function bitget(i, n)
Definition bitget.F:37
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tri7box::inflg_subsfi
type(int_pointer), dimension(:), allocatable inflg_subsfi
Definition tri7box.F:505
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::penfi
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459
tri7box::lisubsfi
type(int_pointer), dimension(:), allocatable lisubsfi
Definition tri7box.F:501
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::addsubsfi
type(int_pointer), dimension(:), allocatable addsubsfi
Definition tri7box.F:509
tri7box::itafi
type(int_pointer), dimension(:), allocatable itafi
Definition tri7box.F:440
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841