OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25cor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i25cor3_1 (jlt, x, irect, nsv, cand_e, cand_n, irtlm, stf, stfn, stif, igap, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, nsn, nin, gap_s, gaps, admsr, nod_normal, xx, yy, zz, nnx, nny, nnz, gap_m, gapm, gapn_m, gapnm, subtria, mvoisin, mvoisn, gap_s_l, gap_m_l, gapmxl, lbound, ibound)
subroutine i25cor3_21 (jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, igap, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, nsn, msegtyp, etyp, nin, gap_s, gaps, admsr, nod_normal, xx, yy, zz, nnx, nny, nnz, gap_m, gapm, gapn_m, gapnm, islide, kslide, mvoisin, mvoisn, gap_s_l, gap_m_l, gapmxl, lbound, ibound)
subroutine i25cor3_22 (jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, igap, xi, yi, zi, vxi, vyi, vzi, ix1, ix2, ix3, ix4, nsvg, nsn, v, nin, gap_s, gaps, admsr, nod_normal, xx, yy, zz, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, nax, nay, naz, nbx, nby, nbz, gap_m, gapm, gapn_m, gapnm, mvoisin, nrtm, msegtyp, ishel, mvoisa, mvoisb, gap_s_l, gap_m_l, gapmxl, lbound, ibounda, iboundb)
subroutine i25cor3_3 (jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, nod_normal, igsti, kmin, kmax, ms, msi, xi, yi, zi, vxi, vyi, vzi, ix1, ix2, ix3, ix4, nsvg, nsn, v, kinet, kini, nin, admsr, irtlm, subtria, xx, yy, zz, lbound, ibound, nnx, nny, nnz, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, nodnx_sms, nsms, index, penm, lbm, lcm, pene, lb, lc, gapn_m, gapnm, gap_s, gaps, igap, gap_s_l, gap_m_l, gapmxl, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi, areas, areasi, ivis2, mvoisin, mvoisn, iorthfric, irep_fricm, dir_fricm, irep_fricmi, dir_fricmi, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, intth, temp, tempi, ieles, ielesi, ielem, ielemi, istif_msdt, dtstif, stifmsdt_s, stifmsdt_m, nrtm, parameters)

Function/Subroutine Documentation

◆ i25cor3_1()

subroutine i25cor3_1 ( integer jlt,
x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer, dimension(4,nsn) irtlm,
stf,
stfn,
stif,
integer igap,
xi,
yi,
zi,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
integer nsn,
integer nin,
gap_s,
gaps,
integer, dimension(4,*) admsr,
real*4, dimension(3,4,*) nod_normal,
xx,
yy,
zz,
nnx,
nny,
nnz,
gap_m,
gapm,
gapn_m,
gapnm,
integer, dimension(mvsiz) subtria,
integer, dimension(4,*) mvoisin,
integer, dimension(mvsiz,4) mvoisn,
gap_s_l,
gap_m_l,
gapmxl,
integer, dimension(*) lbound,
integer, dimension(4,mvsiz) ibound )

Definition at line 30 of file i25cor3.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE tri7box
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER JLT, NSN, NIN, IGAP,
58 . IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*), IRTLM(4,NSN)
59 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
60 . NSVG(MVSIZ), ADMSR(4,*), SUBTRIA(MVSIZ),
61 . MVOISIN(4,*), MVOISN(MVSIZ,4), LBOUND(*), IBOUND(4,MVSIZ)
62C REAL
63 my_real
64 . x(3,*), stf(*), stfn(*), gap_s(*),
65 . gaps(mvsiz), gap_m(*), gapm(*), gapn_m(4,*), gapnm(4,*),
66 . gap_s_l(*), gap_m_l(*), gapmxl(*)
67C REAL
68 my_real
69 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
70 . xx(mvsiz,5), yy(mvsiz,5), zz(mvsiz,5),
71 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5)
72 real*4 nod_normal(3,4,*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I ,J , L, NN, IG, JFT, IX, NI, I1, I2, I3, I4
77 my_real
78 . xn
79C-----------------------------------------------
80 DO i=1,jlt
81 ni = cand_n(i)
82 IF(ni<=nsn)THEN
83 ig = nsv(ni)
84 nsvg(i) = ig
85 xi(i) = x(1,ig)
86 yi(i) = x(2,ig)
87 zi(i) = x(3,ig)
88 gaps(i) = gap_s(ni)
89 ELSE
90 nn = ni - nsn
91 nsvg(i) = -nn
92 xi(i) = xfi(nin)%P(1,nn)
93 yi(i) = xfi(nin)%P(2,nn)
94 zi(i) = xfi(nin)%P(3,nn)
95 gaps(i) = gapfi(nin)%P(nn)
96 END IF
97 END DO
98C
99 DO i=1,jlt
100C
101 l = cand_e(i)
102C
103 ix=irect(1,l)
104 ix1(i)=ix
105 xx(i,1)=x(1,ix)
106 yy(i,1)=x(2,ix)
107 zz(i,1)=x(3,ix)
108C
109 ix=irect(2,l)
110 ix2(i)=ix
111 xx(i,2)=x(1,ix)
112 yy(i,2)=x(2,ix)
113 zz(i,2)=x(3,ix)
114C
115 ix=irect(3,l)
116 ix3(i)=ix
117 xx(i,3)=x(1,ix)
118 yy(i,3)=x(2,ix)
119 zz(i,3)=x(3,ix)
120C
121 ix=irect(4,l)
122 ix4(i)=ix
123 xx(i,4)=x(1,ix)
124 yy(i,4)=x(2,ix)
125 zz(i,4)=x(3,ix)
126C
127 gapm(i) =gap_m(l)
128 gapnm(1:4,i)=gapn_m(1:4,l)
129C
130 END DO
131C
132 IF(igap/=3)THEN
133 gapmxl(1:jlt)=ep30
134 ELSE
135 DO i=1,jlt
136 ni = cand_n(i)
137 l = cand_e(i)
138 IF(ni<=nsn)THEN
139 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
140 ELSE
141 gapmxl(i)=gap_lfi(nin)%P(ni-nsn)+gap_m_l(l)
142 END IF
143 END DO
144 END IF
145C
146 DO i=1,jlt
147C
148 IF(ix3(i) /= ix4(i))THEN
149 xx(i,5)= fourth*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
150 yy(i,5)= fourth*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
151 zz(i,5)= fourth*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
152 ELSE
153 xx(i,5)= xx(i,3)
154 yy(i,5)= yy(i,3)
155 zz(i,5)= zz(i,3)
156 ENDIF
157C
158 END DO
159C
160 DO i=1,jlt
161C
162 l = cand_e(i)
163C
164 nnx(i,1)=nod_normal(1,1,l)
165 nny(i,1)=nod_normal(2,1,l)
166 nnz(i,1)=nod_normal(3,1,l)
167C
168 nnx(i,2)=nod_normal(1,2,l)
169 nny(i,2)=nod_normal(2,2,l)
170 nnz(i,2)=nod_normal(3,2,l)
171C
172 nnx(i,3)=nod_normal(1,3,l)
173 nny(i,3)=nod_normal(2,3,l)
174 nnz(i,3)=nod_normal(3,3,l)
175C
176 nnx(i,4)=nod_normal(1,4,l)
177 nny(i,4)=nod_normal(2,4,l)
178 nnz(i,4)=nod_normal(3,4,l)
179C
180 END DO
181C
182 DO i=1,jlt
183 IF(ix3(i)/=ix4(i))THEN
184 nnx(i,5)=fourth*(nnx(i,1)+nnx(i,2)+nnx(i,3)+nnx(i,4))
185 nny(i,5)=fourth*(nny(i,1)+nny(i,2)+nny(i,3)+nny(i,4))
186 nnz(i,5)=fourth*(nnz(i,1)+nnz(i,2)+nnz(i,3)+nnz(i,4))
187 ELSE
188 nnx(i,5)=nnx(i,4)
189 nny(i,5)=nny(i,4)
190 nnz(i,5)=nnz(i,4)
191 ENDIF
192 xn=one/max(em20,sqrt(nnx(i,5)*nnx(i,5)+nny(i,5)*nny(i,5)+nnz(i,5)*nnz(i,5)))
193 nnx(i,5)=xn*nnx(i,5)
194 nny(i,5)=xn*nny(i,5)
195 nnz(i,5)=xn*nnz(i,5)
196 END DO
197C
198 DO i=1,jlt
199 l = cand_e(i)
200 ni = cand_n(i)
201 IF(ni<=nsn)THEN
202 stif(i)=stf(l)*abs(stfn(ni))
203 ELSE
204 nn = ni - nsn
205 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
206 END IF
207C
208 IF(ni <= nsn)THEN
209 subtria(i) = mod(irtlm(2,ni),5)
210 ELSE
211 subtria(i) = mod(irtlm_fi(nin)%P(2,ni-nsn),5)
212 END IF
213 IF(subtria(i) < 0) subtria(i)=-subtria(i)
214 ENDDO
215C
216 ibound(1:4,1:jlt)=0
217 DO i=1,jlt
218 l = cand_e(i)
219 DO j=1,4
220 mvoisn(i,j)=mvoisin(j,l)
221 IF(lbound(admsr(j,l))/=0)ibound(j,i)=admsr(j,l)
222 END DO
223 END DO
224C
225 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::gap_lfi
type(real_pointer), dimension(:), allocatable gap_lfi
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459

◆ i25cor3_21()

subroutine i25cor3_21 ( integer jlt,
x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stf,
stfn,
stif,
integer igap,
xi,
yi,
zi,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
integer nsn,
integer, dimension(*) msegtyp,
integer, dimension(mvsiz) etyp,
integer nin,
gap_s,
gaps,
integer, dimension(4,*) admsr,
real*4, dimension(3,4,*) nod_normal,
xx,
yy,
zz,
nnx,
nny,
nnz,
gap_m,
gapm,
gapn_m,
gapnm,
integer, dimension(4,*) islide,
integer, dimension(mvsiz,4) kslide,
integer, dimension(4,*) mvoisin,
integer, dimension(mvsiz,4) mvoisn,
gap_s_l,
gap_m_l,
gapmxl,
integer, dimension(*) lbound,
integer, dimension(4,mvsiz) ibound )

Definition at line 234 of file i25cor3.F.

244C-----------------------------------------------
245C M o d u l e s
246C-----------------------------------------------
247 USE tri7box
248C-----------------------------------------------
249C I m p l i c i t T y p e s
250C-----------------------------------------------
251#include "implicit_f.inc"
252C-----------------------------------------------
253C G l o b a l P a r a m e t e r s
254C-----------------------------------------------
255#include "mvsiz_p.inc"
256C-----------------------------------------------
257C D u m m y A r g u m e n t s
258C-----------------------------------------------
259 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*), MSEGTYP(*),
260 . JLT, NSN, NIN, IGAP
261 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
262 . NSVG(MVSIZ), ADMSR(4,*), ISLIDE(4,*), KSLIDE(MVSIZ,4),
263 . MVOISIN(4,*), MVOISN(MVSIZ,4), LBOUND(*), IBOUND(4,MVSIZ), ETYP(MVSIZ)
264C REAL
265 my_real
266 . x(3,*), stf(*), stfn(*), gap_s(*),
267 . gaps(mvsiz), gap_m(*), gapm(*), gapn_m(4,*), gapnm(4,*),
268 . gap_s_l(*), gap_m_l(*), gapmxl(*)
269C REAL
270 my_real
271 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
272 . xx(mvsiz,5), yy(mvsiz,5), zz(mvsiz,5),
273 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5)
274 real*4 nod_normal(3,4,*)
275C-----------------------------------------------
276C L o c a l V a r i a b l e s
277C-----------------------------------------------
278 INTEGER I ,J , K, L, NN, IG, JFT, IX, NI, I1, I2, I3, I4, NOR, II(4)
279 my_real
280 . xn
281C-----------------------------------------------
282 DO i=1,jlt
283 ni = cand_n(i)
284 IF(ni<=nsn)THEN
285 ig = nsv(ni)
286 nsvg(i) = ig
287 xi(i) = x(1,ig)
288 yi(i) = x(2,ig)
289 zi(i) = x(3,ig)
290 gaps(i) = gap_s(ni)
291 ELSE
292 nn = ni - nsn
293 nsvg(i) = -nn
294 xi(i) = xfi(nin)%P(1,nn)
295 yi(i) = xfi(nin)%P(2,nn)
296 zi(i) = xfi(nin)%P(3,nn)
297 gaps(i) = gapfi(nin)%P(nn)
298 END IF
299 END DO
300C
301 DO i=1,jlt
302C
303 l = cand_e(i)
304 etyp(i) =msegtyp(l)
305C
306 ix=irect(1,l)
307 ix1(i)=ix
308 xx(i,1)=x(1,ix)
309 yy(i,1)=x(2,ix)
310 zz(i,1)=x(3,ix)
311C
312 ix=irect(2,l)
313 ix2(i)=ix
314 xx(i,2)=x(1,ix)
315 yy(i,2)=x(2,ix)
316 zz(i,2)=x(3,ix)
317C
318 ix=irect(3,l)
319 ix3(i)=ix
320 xx(i,3)=x(1,ix)
321 yy(i,3)=x(2,ix)
322 zz(i,3)=x(3,ix)
323C
324 ix=irect(4,l)
325 ix4(i)=ix
326 xx(i,4)=x(1,ix)
327 yy(i,4)=x(2,ix)
328 zz(i,4)=x(3,ix)
329C
330 gapm(i) =gap_m(l)
331 gapnm(1:4,i)=gapn_m(1:4,l)
332C
333 END DO
334C
335 IF(igap/=3)THEN
336 gapmxl(1:jlt)=ep30
337 ELSE
338 DO i=1,jlt
339 ni = cand_n(i)
340 l = cand_e(i)
341 IF(ni<=nsn)THEN
342 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
343 ELSE
344 gapmxl(i)=gap_lfi(nin)%P(ni-nsn)+gap_m_l(l)
345 END IF
346 END DO
347 END IF
348C
349 DO i=1,jlt
350C
351 IF(ix3(i) /= ix4(i))THEN
352 xx(i,5)= fourth*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
353 yy(i,5)= fourth*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
354 zz(i,5)= fourth*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
355 ELSE
356 xx(i,5)= xx(i,3)
357 yy(i,5)= yy(i,3)
358 zz(i,5)= zz(i,3)
359 ENDIF
360C
361 END DO
362C
363 DO i=1,jlt
364C
365 l = cand_e(i)
366C
367 nnx(i,1)=nod_normal(1,1,l)
368 nny(i,1)=nod_normal(2,1,l)
369 nnz(i,1)=nod_normal(3,1,l)
370C
371 nnx(i,2)=nod_normal(1,2,l)
372 nny(i,2)=nod_normal(2,2,l)
373 nnz(i,2)=nod_normal(3,2,l)
374C
375 nnx(i,3)=nod_normal(1,3,l)
376 nny(i,3)=nod_normal(2,3,l)
377 nnz(i,3)=nod_normal(3,3,l)
378C
379 nnx(i,4)=nod_normal(1,4,l)
380 nny(i,4)=nod_normal(2,4,l)
381 nnz(i,4)=nod_normal(3,4,l)
382C
383 END DO
384C
385 DO i=1,jlt
386 IF(ix3(i)/=ix4(i))THEN
387 nnx(i,5)=fourth*(nnx(i,1)+nnx(i,2)+nnx(i,3)+nnx(i,4))
388 nny(i,5)=fourth*(nny(i,1)+nny(i,2)+nny(i,3)+nny(i,4))
389 nnz(i,5)=fourth*(nnz(i,1)+nnz(i,2)+nnz(i,3)+nnz(i,4))
390 ELSE
391 nnx(i,5)=nnx(i,4)
392 nny(i,5)=nny(i,4)
393 nnz(i,5)=nnz(i,4)
394 ENDIF
395 xn=one/max(em20,sqrt(nnx(i,5)*nnx(i,5)+nny(i,5)*nny(i,5)+nnz(i,5)*nnz(i,5)))
396 nnx(i,5)=xn*nnx(i,5)
397 nny(i,5)=xn*nny(i,5)
398 nnz(i,5)=xn*nnz(i,5)
399 END DO
400C
401 DO i=1,jlt
402 l = cand_e(i)
403 ni = cand_n(i)
404 IF(ni<=nsn)THEN
405 stif(i)=stf(l)*abs(stfn(ni))
406 ELSE
407 nn = ni - nsn
408 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
409 END IF
410 ENDDO
411C
412 kslide(1:mvsiz,1:4)=0
413 ibound(1:4,1:jlt)=0
414 DO i=1,jlt
415C
416 ni = cand_n(i)
417 l = cand_e(i)
418 ii(1)=abs(admsr(1,l))
419 ii(2)=abs(admsr(2,l))
420 ii(3)=abs(admsr(3,l))
421 ii(4)=abs(admsr(4,l))
422 DO j=1,4
423 mvoisn(i,j)=mvoisin(j,l)
424
425 IF(ni<=nsn)THEN
426 nor=islide(j,ni)
427 ELSE
428 nn = ni - nsn
429 nor=islide_fi(nin)%P(j,nn)
430 END IF
431
432 if(nor < 0) print *,'i25cor3-2 internal error'
433
434 IF(nor/=0)THEN
435 DO k=1,4
436 IF(nor==ii(k))THEN
437 kslide(i,k)=1
438 EXIT
439 END IF
440 END DO
441 END IF
442
443 IF(lbound(admsr(j,l))/=0)ibound(j,i)=admsr(j,l)
444 END DO
445 END DO
446C
447 RETURN
tri7box::islide_fi
type(int_pointer2), dimension(:), allocatable islide_fi
Definition tri7box.F:547

◆ i25cor3_22()

subroutine i25cor3_22 ( integer jlt,
x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stf,
stfn,
stif,
integer igap,
xi,
yi,
zi,
vxi,
vyi,
vzi,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
integer nsn,
v,
integer nin,
gap_s,
gaps,
integer, dimension(4,*) admsr,
real*4, dimension(3,4,*) nod_normal,
xx,
yy,
zz,
vx1,
vx2,
vx3,
vx4,
vy1,
vy2,
vy3,
vy4,
vz1,
vz2,
vz3,
vz4,
nax,
nay,
naz,
nbx,
nby,
nbz,
gap_m,
gapm,
gapn_m,
gapnm,
integer, dimension(4,*) mvoisin,
integer nrtm,
integer, dimension(*) msegtyp,
integer, dimension(mvsiz) ishel,
integer, dimension(mvsiz,4) mvoisa,
integer, dimension(mvsiz,4) mvoisb,
gap_s_l,
gap_m_l,
gapmxl,
integer, dimension(*) lbound,
integer, dimension(4,mvsiz) ibounda,
integer, dimension(4,mvsiz) iboundb )

Definition at line 456 of file i25cor3.F.

473C-----------------------------------------------
474C M o d u l e s
475C-----------------------------------------------
476 USE tri7box
477C-----------------------------------------------
478C I m p l i c i t T y p e s
479C-----------------------------------------------
480#include "implicit_f.inc"
481C-----------------------------------------------
482C G l o b a l P a r a m e t e r s
483C-----------------------------------------------
484#include "mvsiz_p.inc"
485C-----------------------------------------------
486C D u m m y A r g u m e n t s
487C-----------------------------------------------
488 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
489 . JLT, NSN, NIN, NRTM, IGAP, MSEGTYP(*), ISHEL(MVSIZ)
490 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
491 . NSVG(MVSIZ), ADMSR(4,*),
492 . MVOISIN(4,*), MVOISA(MVSIZ,4), MVOISB(MVSIZ,4),
493 . LBOUND(*),IBOUNDA(4,MVSIZ),IBOUNDB(4,MVSIZ)
494C REAL
495 my_real
496 . x(3,*), stf(*), stfn(*), v(3,*), gap_s(*),
497 . gaps(mvsiz), gap_m(*), gapm(*), gapn_m(4,*), gapnm(4,*),
498 . gap_s_l(*), gap_m_l(*), gapmxl(*)
499C REAL
500 my_real
501 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
502 . xx(mvsiz,5), yy(mvsiz,5), zz(mvsiz,5),
503 . vx1(mvsiz),vy1(mvsiz),vz1(mvsiz),
504 . vx2(mvsiz),vy2(mvsiz),vz2(mvsiz),
505 . vx3(mvsiz),vy3(mvsiz),vz3(mvsiz),
506 . vx4(mvsiz),vy4(mvsiz),vz4(mvsiz),
507 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
508 . nax(mvsiz,5), nay(mvsiz,5), naz(mvsiz,5),
509 . nbx(mvsiz,5), nby(mvsiz,5), nbz(mvsiz,5)
510 real*4 nod_normal(3,4,*)
511C-----------------------------------------------
512C L o c a l V a r i a b l e s
513C-----------------------------------------------
514 INTEGER I ,J , K, L, NN, IG, JFT, IX, NI, I1, I2, I3, I4, NOR, II(4), ISH
515 my_real
516 . xn
517C-----------------------------------------------
518 DO i=1,jlt
519 ni = cand_n(i)
520 IF(ni<=nsn)THEN
521 ig = nsv(ni)
522 nsvg(i) = ig
523 xi(i) = x(1,ig)
524 yi(i) = x(2,ig)
525 zi(i) = x(3,ig)
526 vxi(i) = v(1,ig)
527 vyi(i) = v(2,ig)
528 vzi(i) = v(3,ig)
529 gaps(i) = gap_s(ni)
530 ELSE
531 nn = ni - nsn
532 nsvg(i) = -nn
533 xi(i) = xfi(nin)%P(1,nn)
534 yi(i) = xfi(nin)%P(2,nn)
535 zi(i) = xfi(nin)%P(3,nn)
536 vxi(i)= vfi(nin)%P(1,nn)
537 vyi(i)= vfi(nin)%P(2,nn)
538 vzi(i)= vfi(nin)%P(3,nn)
539 gaps(i) = gapfi(nin)%P(nn)
540 END IF
541 END DO
542C
543 ishel(1:mvsiz)=0
544 DO i=1,jlt
545C
546 l = cand_e(i)
547C
548 ix=irect(1,l)
549 ix1(i)=ix
550 xx(i,1)=x(1,ix)
551 yy(i,1)=x(2,ix)
552 zz(i,1)=x(3,ix)
553 vx1(i)=v(1,ix)
554 vy1(i)=v(2,ix)
555 vz1(i)=v(3,ix)
556C
557 ix=irect(2,l)
558 ix2(i)=ix
559 xx(i,2)=x(1,ix)
560 yy(i,2)=x(2,ix)
561 zz(i,2)=x(3,ix)
562 vx2(i)=v(1,ix)
563 vy2(i)=v(2,ix)
564 vz2(i)=v(3,ix)
565C
566 ix=irect(3,l)
567 ix3(i)=ix
568 xx(i,3)=x(1,ix)
569 yy(i,3)=x(2,ix)
570 zz(i,3)=x(3,ix)
571 vx3(i)=v(1,ix)
572 vy3(i)=v(2,ix)
573 vz3(i)=v(3,ix)
574C
575 ix=irect(4,l)
576 ix4(i)=ix
577 xx(i,4)=x(1,ix)
578 yy(i,4)=x(2,ix)
579 zz(i,4)=x(3,ix)
580 vx4(i)=v(1,ix)
581 vy4(i)=v(2,ix)
582 vz4(i)=v(3,ix)
583C
584 gapm(i) =gap_m(l)
585 gapnm(1:4,i)=gapn_m(1:4,l)
586C
587 ish=msegtyp(l)
588 IF(ish > 0) THEN
589 IF(ish > nrtm)ish=ish-nrtm
590 ishel(i)=ish
591 END IF
592C
593 END DO
594C
595 IF(igap/=3)THEN
596 gapmxl(1:jlt)=ep30
597 ELSE
598 DO i=1,jlt
599 ni = cand_n(i)
600 l = cand_e(i)
601 IF(ni<=nsn)THEN
602 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
603 ELSE
604 gapmxl(i)=gap_lfi(nin)%P(ni-nsn)+gap_m_l(l)
605 END IF
606 END DO
607 END IF
608C
609 DO i=1,jlt
610C
611 IF(ix3(i) /= ix4(i))THEN
612 xx(i,5)= fourth*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
613 yy(i,5)= fourth*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
614 zz(i,5)= fourth*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
615 ELSE
616 xx(i,5)= xx(i,3)
617 yy(i,5)= yy(i,3)
618 zz(i,5)= zz(i,3)
619 ENDIF
620C
621 END DO
622C
623 DO i=1,jlt
624C
625 l = cand_e(i)
626C
627 nax(i,1)=nod_normal(1,1,l)
628 nay(i,1)=nod_normal(2,1,l)
629 naz(i,1)=nod_normal(3,1,l)
630C
631 nax(i,2)=nod_normal(1,2,l)
632 nay(i,2)=nod_normal(2,2,l)
633 naz(i,2)=nod_normal(3,2,l)
634C
635 nax(i,3)=nod_normal(1,3,l)
636 nay(i,3)=nod_normal(2,3,l)
637 naz(i,3)=nod_normal(3,3,l)
638C
639 nax(i,4)=nod_normal(1,4,l)
640 nay(i,4)=nod_normal(2,4,l)
641 naz(i,4)=nod_normal(3,4,l)
642C
643 END DO
644C
645 DO i=1,jlt
646 IF(ix3(i)/=ix4(i))THEN
647 nax(i,5)= fourth*(nax(i,1)+nax(i,2)+nax(i,3)+nax(i,4))
648 nay(i,5)= fourth*(nay(i,1)+nay(i,2)+nay(i,3)+nay(i,4))
649 naz(i,5)= fourth*(naz(i,1)+naz(i,2)+naz(i,3)+naz(i,4))
650 ELSE
651 nax(i,5)= nax(i,4)
652 nay(i,5)= nay(i,4)
653 naz(i,5)= naz(i,4)
654 ENDIF
655 xn=one/max(em20,sqrt(nax(i,5)*nax(i,5)+nay(i,5)*nay(i,5)+naz(i,5)*naz(i,5)))
656 nax(i,5)=xn*nax(i,5)
657 nay(i,5)=xn*nay(i,5)
658 naz(i,5)=xn*naz(i,5)
659 END DO
660C
661 DO i=1,jlt
662C
663 l = ishel(i)
664 IF(l==0) cycle
665C
666 IF(ix3(i)/=ix4(i))THEN
667C
668 nbx(i,1)=nod_normal(1,1,l)
669 nby(i,1)=nod_normal(2,1,l)
670 nbz(i,1)=nod_normal(3,1,l)
671C
672 nbx(i,2)=nod_normal(1,4,l)
673 nby(i,2)=nod_normal(2,4,l)
674 nbz(i,2)=nod_normal(3,4,l)
675C
676 nbx(i,3)=nod_normal(1,3,l)
677 nby(i,3)=nod_normal(2,3,l)
678 nbz(i,3)=nod_normal(3,3,l)
679C
680 nbx(i,4)=nod_normal(1,2,l)
681 nby(i,4)=nod_normal(2,2,l)
682 nbz(i,4)=nod_normal(3,2,l)
683C
684 ELSE
685C
686 nbx(i,1)=nod_normal(1,1,l)
687 nby(i,1)=nod_normal(2,1,l)
688 nbz(i,1)=nod_normal(3,1,l)
689C
690 nbx(i,2)=nod_normal(1,4,l)
691 nby(i,2)=nod_normal(2,4,l)
692 nbz(i,2)=nod_normal(3,4,l)
693C
694 nbx(i,4)=nod_normal(1,2,l)
695 nby(i,4)=nod_normal(2,2,l)
696 nbz(i,4)=nod_normal(3,2,l)
697C
698 ENDIF
699C
700 END DO
701C
702 DO i=1,jlt
703C
704 l = ishel(i)
705 IF(l==0) cycle
706C
707 IF(ix3(i)/=ix4(i))THEN
708 nbx(i,5)= fourth*(nbx(i,1)+nbx(i,2)+nbx(i,3)+nbx(i,4))
709 nby(i,5)= fourth*(nby(i,1)+nby(i,2)+nby(i,3)+nby(i,4))
710 nbz(i,5)= fourth*(nbz(i,1)+nbz(i,2)+nbz(i,3)+nbz(i,4))
711 ELSE
712 nbx(i,5)= nbx(i,4)
713 nby(i,5)= nby(i,4)
714 nbz(i,5)= nbz(i,4)
715 ENDIF
716 xn=one/max(em20,sqrt(nbx(i,5)*nbx(i,5)+nby(i,5)*nby(i,5)+nbz(i,5)*nbz(i,5)))
717 nbx(i,5)=xn*nbx(i,5)
718 nby(i,5)=xn*nby(i,5)
719 nbz(i,5)=xn*nbz(i,5)
720 END DO
721C
722 DO i=1,jlt
723 l = cand_e(i)
724 ni = cand_n(i)
725 IF(ni<=nsn)THEN
726 stif(i)=stf(l)*abs(stfn(ni))
727 ELSE
728 nn = ni - nsn
729 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
730 END IF
731 ENDDO
732C
733 ibounda(1:4,1:jlt)=0
734 DO i=1,jlt
735 l = cand_e(i)
736 DO j=1,4
737 mvoisa(i,j) =mvoisin(j,l)
738 IF(lbound(admsr(j,l))/=0)ibounda(j,i)=admsr(j,l)
739 END DO
740 END DO
741C
742 iboundb(1:4,1:jlt)=0
743 DO i=1,jlt
744 l = ishel(i)
745 IF(l==0) cycle
746
747 mvoisb(i,1)=mvoisin(1,l)
748 mvoisb(i,2)=mvoisin(4,l)
749 mvoisb(i,3)=mvoisin(3,l)
750 mvoisb(i,4)=mvoisin(2,l)
751
752 IF(lbound(admsr(2,l))/=0)iboundb(1,i)=admsr(2,l)
753 IF(lbound(admsr(1,l))/=0)iboundb(2,i)=admsr(1,l)
754 IF(lbound(admsr(4,l))/=0)iboundb(3,i)=admsr(4,l)
755 IF(lbound(admsr(3,l))/=0)iboundb(4,i)=admsr(3,l)
756 END DO
757C
758 RETURN
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459

◆ i25cor3_3()

subroutine i25cor3_3 ( integer jlt,
x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stf,
stfn,
stif,
real*4, dimension(3,4,*) nod_normal,
integer igsti,
kmin,
kmax,
ms,
msi,
xi,
yi,
zi,
vxi,
vyi,
vzi,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
integer nsn,
v,
integer, dimension(*) kinet,
integer, dimension(*) kini,
integer nin,
integer, dimension(4,*) admsr,
integer, dimension(4,*) irtlm,
integer, dimension(mvsiz) subtria,
xx,
yy,
zz,
integer, dimension(*) lbound,
integer, dimension(4,*) ibound,
nnx,
nny,
nnz,
vx1,
vx2,
vx3,
vx4,
vy1,
vy2,
vy3,
vy4,
vz1,
vz2,
vz3,
vz4,
integer, dimension(*) nodnx_sms,
integer, dimension(mvsiz) nsms,
integer, dimension(*) index,
penm,
lbm,
lcm,
pene,
lb,
lc,
gapn_m,
gapnm,
gap_s,
gaps,
integer igap,
gap_s_l,
gap_m_l,
gapmxl,
integer intfric,
integer, dimension(*) ipartfrics,
integer, dimension(mvsiz) ipartfricsi,
integer, dimension(*) ipartfricm,
integer, dimension(mvsiz) ipartfricmi,
areas,
areasi,
integer ivis2,
integer, dimension(4,*) mvoisin,
integer, dimension(mvsiz,4) mvoisn,
integer iorthfric,
integer, dimension(*) irep_fricm,
dir_fricm,
integer, dimension(mvsiz) irep_fricmi,
dir_fricmi,
x1,
y1,
z1,
x2,
y2,
z2,
x3,
y3,
z3,
x4,
y4,
z4,
integer intth,
temp,
tempi,
integer, dimension(*) ieles,
integer, dimension(mvsiz) ielesi,
integer, dimension(*) ielem,
integer, dimension(mvsiz) ielemi,
integer, intent(in) istif_msdt,
intent(in) dtstif,
dimension(nsn), intent(in) stifmsdt_s,
dimension(nrtm), intent(in) stifmsdt_m,
integer, intent(in) nrtm,
type (parameters_), intent(inout) parameters )

Definition at line 768 of file i25cor3.F.

793C-----------------------------------------------
794C M o d u l e s
795C-----------------------------------------------
796 USE tri7box
797 USE parameters_mod
798C-----------------------------------------------
799C I m p l i c i t T y p e s
800C-----------------------------------------------
801#include "implicit_f.inc"
802C-----------------------------------------------
803C G l o b a l P a r a m e t e r s
804C-----------------------------------------------
805#include "mvsiz_p.inc"
806C-----------------------------------------------
807C C o m m o n B l o c k s
808C-----------------------------------------------
809#include "sms_c.inc"
810C-----------------------------------------------
811C D u m m y A r g u m e n t s
812C-----------------------------------------------
813 INTEGER INTTH ,JLT, NSN, NIN, IGSTI, IGAP,INTFRIC, IVIS2, IORTHFRIC
814 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*), KINET(*), KINI(*),
815 . NODNX_SMS(*), INDEX(*), ADMSR(4,*),
816 . LBOUND(*), IBOUND(4,*), MVOISIN(4,*), MVOISN(MVSIZ,4),IELES(*),
817 . IELEM(*)
818 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
819 . NSVG(MVSIZ), NSMS(MVSIZ), IRTLM(4,*), SUBTRIA(MVSIZ),
820 . IPARTFRICS(*),IPARTFRICSI(MVSIZ),IPARTFRICM(*),IPARTFRICMI(MVSIZ),
821 . IREP_FRICM(*),IREP_FRICMI(MVSIZ),IELESI(MVSIZ),IELEMI(MVSIZ)
822 INTEGER , INTENT(IN) :: ISTIF_MSDT
823 INTEGER , INTENT(IN) :: NRTM
824C REAL
825 my_real
826 . x(3,*), stf(*), stfn(*), ms(*), v(3,*),
827 . penm(4,*), lbm(4,*), lcm(4,*),
828 . gapn_m(4,*), gap_s(*),
829 . gap_s_l(*), gap_m_l(*), gapmxl(*), areas(*),temp(*)
830C REAL
831 my_real
832 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz), kmin, kmax,
833 . xx(mvsiz,5),yy(mvsiz,5),zz(mvsiz,5),
834 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5),
835 . vx1(mvsiz),vy1(mvsiz),vz1(mvsiz),
836 . vx2(mvsiz),vy2(mvsiz),vz2(mvsiz),
837 . vx3(mvsiz),vy3(mvsiz),vz3(mvsiz),
838 . vx4(mvsiz),vy4(mvsiz),vz4(mvsiz),
839 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
840 . msi(mvsiz), lb(mvsiz), lc(mvsiz), pene(mvsiz),
841 . gapnm(4,mvsiz), gaps(mvsiz),areasi(mvsiz),
842 . dir_fricm(2,*) ,dir_fricmi(mvsiz,2),
843 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
844 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
845 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
846 . tempi(mvsiz)
847 real*4 nod_normal(3,4,*)
848 my_real , INTENT(IN) :: dtstif
849 my_real , INTENT(IN) :: stifmsdt_s(nsn) ,stifmsdt_m(nrtm)
850 TYPE (PARAMETERS_) ,INTENT(INOUT):: PARAMETERS
851C-----------------------------------------------
852C L o c a l V a r i a b l e s
853C-----------------------------------------------
854 INTEGER I ,J , L, NN, IG, JFT, IX, NI, I1, I2, I3, I4, IT
855 my_real
856 . xn,dts,stif_msdt(mvsiz)
857C-----------------------------------------------
858 ibound(1:4,1:jlt)=0
859 DO i=1,jlt
860 ni = cand_n(i)
861 IF(ni<=nsn)THEN
862 ig = nsv(ni)
863 nsvg(i) = ig
864C---------------voir quand KINET(IG) est utilise
865 kini(i) = kinet(ig)
866 xi(i) = x(1,ig)
867 yi(i) = x(2,ig)
868 zi(i) = x(3,ig)
869 vxi(i) = v(1,ig)
870 vyi(i) = v(2,ig)
871 vzi(i) = v(3,ig)
872 msi(i)= ms(ig)
873 gaps(i) = gap_s(ni)
874
875 subtria(i)=mod(irtlm(2,ni),5)
876 ELSE
877 nn = ni - nsn
878 nsvg(i) = -nn
879 kini(i) = kinfi(nin)%P(nn)
880 xi(i) = xfi(nin)%P(1,nn)
881 yi(i) = xfi(nin)%P(2,nn)
882 zi(i) = xfi(nin)%P(3,nn)
883 vxi(i)= vfi(nin)%P(1,nn)
884 vyi(i)= vfi(nin)%P(2,nn)
885 vzi(i)= vfi(nin)%P(3,nn)
886 msi(i)= msfi(nin)%P(nn)
887 gaps(i) = gapfi(nin)%P(nn)
888
889 subtria(i)=mod(irtlm_fi(nin)%P(2,nn),5)
890 END IF
891C
892 IF(subtria(i) < 0)subtria(i)=-subtria(i)
893C
894 l = cand_e(i)
895C
896 ix=irect(1,l)
897 ix1(i)=ix
898 xx(i,1)=x(1,ix)
899 yy(i,1)=x(2,ix)
900 zz(i,1)=x(3,ix)
901 vx1(i)=v(1,ix)
902 vy1(i)=v(2,ix)
903 vz1(i)=v(3,ix)
904C
905 ix=irect(2,l)
906 ix2(i)=ix
907 xx(i,2)=x(1,ix)
908 yy(i,2)=x(2,ix)
909 zz(i,2)=x(3,ix)
910 vx2(i)=v(1,ix)
911 vy2(i)=v(2,ix)
912 vz2(i)=v(3,ix)
913C
914 ix=irect(3,l)
915 ix3(i)=ix
916 xx(i,3)=x(1,ix)
917 yy(i,3)=x(2,ix)
918 zz(i,3)=x(3,ix)
919 vx3(i)=v(1,ix)
920 vy3(i)=v(2,ix)
921 vz3(i)=v(3,ix)
922C
923 ix=irect(4,l)
924 ix4(i)=ix
925 xx(i,4)=x(1,ix)
926 yy(i,4)=x(2,ix)
927 zz(i,4)=x(3,ix)
928 vx4(i)=v(1,ix)
929 vy4(i)=v(2,ix)
930 vz4(i)=v(3,ix)
931C
932 IF(ix3(i) /= ix4(i))THEN
933 xx(i,5)= fourth*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
934 yy(i,5)= fourth*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
935 zz(i,5)= fourth*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
936 ELSE
937 xx(i,5)= xx(i,3)
938 yy(i,5)= yy(i,3)
939 zz(i,5)= zz(i,3)
940 ENDIF
941C
942 gapnm(1:4,i)=gapn_m(1:4,l)
943C
944 DO j=1,4
945 mvoisn(i,j) =mvoisin(j,l)
946 IF(lbound(admsr(j,l))/=0)ibound(j,i)=admsr(j,l)
947 END DO
948C
949 END DO
950C
951 IF(igap/=3)THEN
952 gapmxl(1:jlt)=ep30
953 ELSE
954 DO i=1,jlt
955 ni = cand_n(i)
956 l = cand_e(i)
957 IF(ni<=nsn)THEN
958 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
959 ELSE
960 gapmxl(i)=gap_lfi(nin)%P(ni-nsn)+gap_m_l(l)
961 END IF
962 END DO
963 END IF
964C
965 DO i=1,jlt
966C
967 l = cand_e(i)
968C
969 nnx(i,1)=nod_normal(1,1,l)
970 nny(i,1)=nod_normal(2,1,l)
971 nnz(i,1)=nod_normal(3,1,l)
972C
973 nnx(i,2)=nod_normal(1,2,l)
974 nny(i,2)=nod_normal(2,2,l)
975 nnz(i,2)=nod_normal(3,2,l)
976C
977 nnx(i,3)=nod_normal(1,3,l)
978 nny(i,3)=nod_normal(2,3,l)
979 nnz(i,3)=nod_normal(3,3,l)
980C
981 nnx(i,4)=nod_normal(1,4,l)
982 nny(i,4)=nod_normal(2,4,l)
983 nnz(i,4)=nod_normal(3,4,l)
984C
985 END DO
986C
987 DO i=1,jlt
988 IF(ix3(i)/=ix4(i))THEN
989 nnx(i,5)=fourth*(nnx(i,1)+nnx(i,2)+nnx(i,3)+nnx(i,4))
990 nny(i,5)=fourth*(nny(i,1)+nny(i,2)+nny(i,3)+nny(i,4))
991 nnz(i,5)=fourth*(nnz(i,1)+nnz(i,2)+nnz(i,3)+nnz(i,4))
992 ELSE
993 nnx(i,5)=nnx(i,4)
994 nny(i,5)=nny(i,4)
995 nnz(i,5)=nnz(i,4)
996 ENDIF
997 xn=one/max(em20,sqrt(nnx(i,5)*nnx(i,5)+nny(i,5)*nny(i,5)+nnz(i,5)*nnz(i,5)))
998 nnx(i,5)=xn*nnx(i,5)
999 nny(i,5)=xn*nny(i,5)
1000 nnz(i,5)=xn*nnz(i,5)
1001 END DO
1002C
1003 IF(igsti<=1)THEN
1004 DO i=1,jlt
1005 l = cand_e(i)
1006 ni = cand_n(i)
1007 IF(ni<=nsn)THEN
1008 stif(i)=stf(l)*abs(stfn(ni))
1009 ELSE
1010 nn = ni - nsn
1011 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
1012 END IF
1013c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1014 ENDDO
1015 ELSEIF(igsti==2)THEN
1016 DO i=1,jlt
1017 l = cand_e(i)
1018 ni = cand_n(i)
1019 IF(ni<=nsn)THEN
1020 stif(i)=abs(stfn(ni))
1021 ELSE
1022 nn = ni - nsn
1023 stif(i)=abs(stifi(nin)%P(nn))
1024 END IF
1025 stif(i)=half*(stf(l)+stif(i))
1026c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1027 ENDDO
1028 ELSEIF(igsti==3)THEN
1029 DO i=1,jlt
1030 l = cand_e(i)
1031 ni = cand_n(i)
1032 IF(ni<=nsn)THEN
1033 stif(i)=abs(stfn(ni))
1034 ELSE
1035 nn = ni - nsn
1036 stif(i)=abs(stifi(nin)%P(nn))
1037 END IF
1038 stif(i)=max(stf(l),stif(i))
1039c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1040 ENDDO
1041 ELSEIF(igsti==4.OR.igsti==6)THEN
1042 DO i=1,jlt
1043 l = cand_e(i)
1044 ni = cand_n(i)
1045 IF(ni<=nsn)THEN
1046 stif(i)=abs(stfn(ni))
1047 ELSE
1048 nn = ni - nsn
1049 stif(i)=abs(stifi(nin)%P(nn))
1050 END IF
1051 stif(i)=min(stf(l),stif(i))
1052c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1053 ENDDO
1054 ELSEIF(igsti==5)THEN
1055 DO i=1,jlt
1056 l = cand_e(i)
1057 ni = cand_n(i)
1058 IF(ni<=nsn)THEN
1059 stif(i)=abs(stfn(ni))
1060 ELSE
1061 nn = ni - nsn
1062 stif(i)=abs(stifi(nin)%P(nn))
1063 END IF
1064 stif(i)=stf(l)*stif(i)/
1065 . max(em30,(stf(l)+stif(i)))
1066c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1067 ENDDO
1068 ELSEIF(igsti==7)THEN
1069 DO i=1,jlt
1070 stif(i)=zero
1071 ENDDO
1072 ENDIF
1073
1074C------------------------------------------
1075C Stiffness based on mass and time step
1076C------------------------------------------
1077 IF(istif_msdt > 0) THEN
1078 IF(dtstif > zero) THEN
1079 dts = dtstif
1080 ELSE
1081 dts = parameters%DT_STIFINT
1082 ENDIF
1083 DO i=1,jlt
1084 l = cand_e(i)
1085 ni = cand_n(i)
1086 IF(ni<=nsn)THEN
1087 stif_msdt(i) = stifmsdt_s(ni)
1088 ELSE
1089 nn = ni - nsn
1090 stif_msdt(i) = abs(stif_msdt_fi(nin)%P(nn))
1091 ENDIF
1092 stif_msdt(i) = stifmsdt_m(l)*stif_msdt(i)/(stifmsdt_m(l)+stif_msdt(i))
1093 stif_msdt(i) = stif_msdt(i)/(dts*dts)
1094 stif(i)=max(stif(i),stif_msdt(i))
1095 ENDDO
1096 ENDIF
1097C
1098 DO i=1,jlt
1099 stif(i)=max(kmin,min(stif(i),kmax))
1100 ENDDO
1101C----------
1102 IF(idtmins==2)THEN
1103 DO i=1,jlt
1104 IF(nsvg(i)>0)THEN
1105 nsms(i)=nodnx_sms(nsvg(i))
1106 . +nodnx_sms(ix1(i))+nodnx_sms(ix2(i))
1107 . +nodnx_sms(ix3(i))+nodnx_sms(ix4(i))
1108 ELSE
1109 nn=-nsvg(i)
1110 nsms(i)=nodnxfi(nin)%P(nn)
1111 . +nodnx_sms(ix1(i))+nodnx_sms(ix2(i))
1112 . +nodnx_sms(ix3(i))+nodnx_sms(ix4(i))
1113 END IF
1114 ENDDO
1115 IF(idtmins_int/=0)THEN
1116 DO i=1,jlt
1117 IF(nsms(i)==0)nsms(i)=-1
1118 ENDDO
1119 END IF
1120 ELSEIF(idtmins_int/=0)THEN
1121 DO i=1,jlt
1122 nsms(i)=-1
1123 ENDDO
1124 ENDIF
1125C----------
1126 DO i=1,jlt
1127 it = subtria(i)
1128 pene(i)=penm(it,index(i))
1129 lb(i) =lbm(it,index(i))
1130 lc(i) =lcm(it,index(i))
1131 ENDDO
1132
1133C----Friction model : secnd part IDs---------
1134 IF(intfric > 0) THEN
1135 DO i=1,jlt
1136 ni = cand_n(i)
1137 l = cand_e(i)
1138 IF(ni<=nsn)THEN
1139 ipartfricsi(i)= ipartfrics(ni)
1140 ELSE
1141 nn = ni - nsn
1142 ipartfricsi(i)= ipartfricsfi(nin)%P(nn)
1143 END IF
1144C
1145 ipartfricmi(i) = ipartfricm(l)
1146C
1147 IF(iorthfric > 0) THEN
1148 irep_fricmi(i) =irep_fricm(l)
1149 dir_fricmi(i,1:2)=dir_fricm(1:2,l)
1150 ENDIF
1151 ENDDO
1152 ENDIF
1153
1154 DO i=1,jlt
1155 x1(i)= xx(i,1)
1156 x2(i)= xx(i,2)
1157 x3(i)= xx(i,3)
1158 x4(i)= xx(i,4)
1159 y1(i)= yy(i,1)
1160 y2(i)= yy(i,2)
1161 y3(i)= yy(i,3)
1162 y4(i)= yy(i,4)
1163 z1(i)= zz(i,1)
1164 z2(i)= zz(i,2)
1165 z3(i)= zz(i,3)
1166 z4(i)= zz(i,4)
1167 ENDDO
1168
1169C----Adhesion case - mvsize division of if_adh done in dst3_3
1170
1171 IF(intth>0.OR.ivis2==-1) THEN
1172 DO i=1,jlt
1173 ni = cand_n(i)
1174 l = cand_e(i)
1175 IF(ni<=nsn)THEN
1176 areasi(i)= areas(ni)
1177 ELSE
1178 nn = ni - nsn
1179 areasi(i)= areasfi(nin)%P(nn)
1180 END IF
1181 ENDDO
1182 ENDIF
1183
1184C----Thermal case -
1185 IF(intth>0) THEN
1186 DO i=1,jlt
1187 ni = cand_n(i)
1188 l = cand_e(i)
1189 IF(ni<=nsn)THEN
1190 ig = nsv(ni)
1191 tempi(i) = temp(ig)
1192 ielesi(i)= ieles(ni)
1193 ELSE
1194 nn = ni - nsn
1195 tempi(i) = tempfi(nin)%P(nn)
1196 ielesi(i)= matsfi(nin)%P(nn)
1197 END IF
1198 ielemi(i) = ielem(l)
1199 ENDDO
1200 ENDIF
1201C
1202 RETURN
min
#define min(a, b)
Definition macros.h:20
parameters_mod
Definition parameters_mod.F:49
tri7box::stif_msdt_fi
type(real_pointer), dimension(:), allocatable stif_msdt_fi
Definition tri7box.F:552
tri7box::matsfi
type(int_pointer), dimension(:), allocatable matsfi
Definition tri7box.F:440
tri7box::tempfi
type(real_pointer), dimension(:), allocatable tempfi
Definition tri7box.F:449
tri7box::nodnxfi
type(int_pointer), dimension(:), allocatable nodnxfi
Definition tri7box.F:440
tri7box::areasfi
type(real_pointer), dimension(:), allocatable areasfi
Definition tri7box.F:449
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::ipartfricsfi
type(int_pointer), dimension(:), allocatable ipartfricsfi
Definition tri7box.F:440
tri7box::kinfi
type(int_pointer), dimension(:), allocatable kinfi
Definition tri7box.F:440