OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for26.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr11_c.inc"
#include "scr14_c.inc"
#include "sms_c.inc"
#include "task_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2for26 (x, v, vr, a, ar, ms, stifn, stifr, weight, irect, nsv, irtl, dr, dl, fini, fsav, fncont, nsn, stfn, stfr, visc, noint, nodnx_sms, dmint2, sav_for_pena, ms_pena, in, dt2t, neltst, ityptst, miner, h3d_data, fncontp, ftcontp)

Function/Subroutine Documentation

◆ i2for26()

subroutine i2for26 ( x,
v,
vr,
a,
ar,
ms,
stifn,
stifr,
integer, dimension(*) weight,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
dr,
dl,
fini,
fsav,
fncont,
integer nsn,
stfn,
stfr,
visc,
integer noint,
integer, dimension(*) nodnx_sms,
dmint2,
sav_for_pena,
ms_pena,
in,
dt2t,
integer neltst,
integer ityptst,
miner,
type (h3d_database) h3d_data,
fncontp,
ftcontp )

Definition at line 35 of file i2for26.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE h3d_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51#include "comlock.inc"
52C-----------------------------------------------
53C G l o b a l P a r a m e t e r s
54C-----------------------------------------------
55#include "mvsiz_p.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER NSN, NOINT, NELTST,ITYPTST
60 INTEGER IRECT(4,*),NSV(*),IRTL(*),WEIGHT(*),NODNX_SMS(*)
61C REAL
62 my_real
63 . visc,dt2t
64 my_real
65 . x(3,*),v(3,*),a(3,*),vr(3,*),ar(3,*),ms(*),in(*),fini(6,4,*),
66 . dl(3,4,*),dr(3,4,*),stifn(*),stifr(*),stfn(*),stfr(*),
67 . fsav(*),fncont(3,*),dmint2(4,*),sav_for_pena(8,*),ms_pena(*),
68 . miner(*),fncontp(3,*) ,ftcontp(3,*)
69 TYPE (H3D_DATABASE) :: H3D_DATA
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com01_c.inc"
74#include "com06_c.inc"
75#include "com08_c.inc"
76#include "scr11_c.inc"
77#include "scr14_c.inc"
78#include "sms_c.inc"
79#include "task_c.inc"
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER NIR,I,J,IR,II,JJ,L,W,KK,K,LLT,NM,
84 . IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),NSVG(MVSIZ)
85C REAL
86 my_real
87 . econtt,econvt,e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,xsm,ysm,zsm,
88 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,mlx,mly,mlz,dti,stifms,
89 . drx,dry,drz,vrx,vry,vrz,dlx,dly,dlz,len2,dkm,din,
90 . dvx,dvy,dvz,vxx,vyy,vzz,vlx,vly,vlz,wx,wy,wz,dwx,dwy,dwz, dxt
91 my_real
92 . stif(mvsiz),vis(4,mvsiz),visr(4,mvsiz),stf(4,mvsiz),str(4,mvsiz),
93 . fx(4),fy(4),fz(4),mx(4),my(4),mz(4),mrx(4),mry(4),mrz(4),
94 . flocx(4),flocy(4),flocz(4),flocxv(4),flocyv(4),floczv(4),
95 . mlocx(4),mlocy(4),mlocz(4),mlocxv(4),mlocyv(4),mloczv(4),ms_harm,
96 . fnorm,fn(3),ft(3),stbrk,va(3),vb(3),vc(3),vd(3),rx(4),ry(4),rz(4),
97 . vx1,vy1,vz1,vx2,vy2,vz2,vx3,vy3,vz3,vx4,vy4,vz4,rs(3),
98 . x0,y0,z0,xs,ys,zs,dwdu,h(4),stifm(mvsiz),stmax,wlx,wly,wlz,in_harm
99C=======================================================================
100 i7kglo = 1
101 econtt = zero
102 econvt = zero
103C----------------
104 DO kk=1,nsn,mvsiz
105C
106 llt = min(nsn-kk+1,mvsiz)
107c
108 DO k=1,llt
109 ii = kk + k - 1
110 i = nsv(ii)
111C
112 IF (i > 0) THEN
113 nsvg(k) = i
114 w = weight(i)
115 l = irtl(ii)
116C
117 ix1(k) = irect(1,l)
118 ix2(k) = irect(2,l)
119 ix3(k) = irect(3,l)
120 ix4(k) = irect(4,l)
121 IF (ix3(k) == ix4(k)) THEN
122 nir = 3
123 stf(4,k) = zero
124 h(1) = one
125 h(2) = one
126 h(3) = one
127 h(4) = zero
128 ELSE
129 nir= 4
130 h(1) = one
131 h(2) = one
132 h(3) = one
133 h(4) = one
134C
135 ENDIF
136C------------------------------------------------
137C rep local facette main
138C------------------------------------------------
139 x1 = x(1,ix1(k))
140 y1 = x(2,ix1(k))
141 z1 = x(3,ix1(k))
142 x2 = x(1,ix2(k))
143 y2 = x(2,ix2(k))
144 z2 = x(3,ix2(k))
145 x3 = x(1,ix3(k))
146 y3 = x(2,ix3(k))
147 z3 = x(3,ix3(k))
148 x4 = x(1,ix4(k))
149 y4 = x(2,ix4(k))
150 z4 = x(3,ix4(k))
151C
152 vx1 = v(1,ix1(k))
153 vy1 = v(2,ix1(k))
154 vz1 = v(3,ix1(k))
155 vx2 = v(1,ix2(k))
156 vy2 = v(2,ix2(k))
157 vz2 = v(3,ix2(k))
158 vx3 = v(1,ix3(k))
159 vy3 = v(2,ix3(k))
160 vz3 = v(3,ix3(k))
161 vx4 = v(1,ix4(k))
162 vy4 = v(2,ix4(k))
163 vz4 = v(3,ix4(k))
164C
165C---------------------
166 CALL i2rep(x1 ,x2 ,x3 ,x4 ,
167 . y1 ,y2 ,y3 ,y4 ,
168 . z1 ,z2 ,z3 ,z4 ,
169 . e1x ,e1y ,e1z ,
170 . e2x ,e2y ,e2z ,
171 . e3x ,e3y ,e3z ,nir )
172C
173 IF (nir == 4) THEN
174 x0 = (x1 + x2 + x3 + x4)/nir
175 y0 = (y1 + y2 + y3 + y4)/nir
176 z0 = (z1 + z2 + z3 + z4)/nir
177 ELSE
178 x0 = (x1 + x2 + x3)/nir
179 y0 = (y1 + y2 + y3)/nir
180 z0 = (z1 + z2 + z3)/nir
181 ENDIF
182C
183 x1 = x1 - x0
184 y1 = y1 - y0
185 z1 = z1 - z0
186 x2 = x2 - x0
187 y2 = y2 - y0
188 z2 = z2 - z0
189 x3 = x3 - x0
190 y3 = y3 - y0
191 z3 = z3 - z0
192 x4 = x4 - x0
193 y4 = y4 - y0
194 z4 = z4 - z0
195 xs = x(1,i) - x0
196 ys = x(2,i) - y0
197 zs = x(3,i) - z0
198C
199c global -> local
200c
201 rs(1) = xs*e1x + ys*e1y + zs*e1z
202 rs(2) = xs*e2x + ys*e2y + zs*e2z
203 rs(3) = xs*e3x + ys*e3y + zs*e3z
204c
205 rx(1) = e1x*x1 + e1y*y1 + e1z*z1
206 ry(1) = e2x*x1 + e2y*y1 + e2z*z1
207 rz(1) = e3x*x1 + e3y*y1 + e3z*z1
208 rx(2) = e1x*x2 + e1y*y2 + e1z*z2
209 ry(2) = e2x*x2 + e2y*y2 + e2z*z2
210 rz(2) = e3x*x2 + e3y*y2 + e3z*z2
211 rx(3) = e1x*x3 + e1y*y3 + e1z*z3
212 ry(3) = e2x*x3 + e2y*y3 + e2z*z3
213 rz(3) = e3x*x3 + e3y*y3 + e3z*z3
214 rx(4) = e1x*x4 + e1y*y4 + e1z*z4
215 ry(4) = e2x*x4 + e2y*y4 + e2z*z4
216 rz(4) = e3x*x4 + e3y*y4 + e3z*z4
217C
218 IF (nir==3) THEN
219 rx(4)=zero
220 ry(4)=zero
221 rz(4)=zero
222 END IF
223C
224 IF (nir==3) THEN
225 vd(1) = zero
226 vd(2) = zero
227 vd(3) = zero
228 ENDIF
229C
230 IF (iroddl == 0 .OR. (miner(i) <= em20)) THEN
231C--------- Connection solide : calcul vitesse entrainement facette main Vi = Vi -VR ^ MS
232 va(1) = vx1*e1x + vy1*e1y + vz1*e1z
233 va(2) = vx1*e2x + vy1*e2y + vz1*e2z
234 va(3) = vx1*e3x + vy1*e3y + vz1*e3z
235 vb(1) = vx2*e1x + vy2*e1y + vz2*e1z
236 vb(2) = vx2*e2x + vy2*e2y + vz2*e2z
237 vb(3) = vx2*e3x + vy2*e3y + vz2*e3z
238 vc(1) = vx3*e1x + vy3*e1y + vz3*e1z
239 vc(2) = vx3*e2x + vy3*e2y + vz3*e2z
240 vc(3) = vx3*e3x + vy3*e3y + vz3*e3z
241 vd(1) = vx4*e1x + vy4*e1y + vz4*e1z
242 vd(2) = vx4*e2x + vy4*e2y + vz4*e2z
243 vd(3) = vx4*e3x + vy4*e3y + vz4*e3z
244C
245 CALL i2pen_rot26(tt ,dt1 ,dwdu,
246 . wlx ,wly ,wlz ,
247 . rx ,ry ,rz ,va ,vb ,
248 . vc ,vd)
249C
250 ENDIF
251C
252c----------------------------------------------------------
253 DO ir = 1,nir
254 nm = irect(ir,l)
255
256c velocities in global coords
257
258 IF (iroddl == 1 .and. miner(i) > em20) THEN
259 wx = (vr(1,i) + vr(1,nm)) * half
260 wy = (vr(2,i) + vr(2,nm)) * half
261 wz = (vr(3,i) + vr(3,nm)) * half
262 wlx = wx*e1x + wy*e1y + wz*e1z
263 wly = wx*e2x + wy*e2y + wz*e2z
264 wlz = wx*e3x + wy*e3y + wz*e3z
265 dwx = vr(1,i) - vr(1,nm)
266 dwy = vr(2,i) - vr(2,nm)
267 dwz = vr(3,i) - vr(3,nm)
268 stbrk = zero
269 ELSE
270 dwx = zero
271 dwy = zero
272 dwz = zero
273 stbrk = sqrt(xsm*xsm+ysm*ysm+zsm*zsm)*dwdu
274 ENDIF
275
276 dvx = v(1,i) - v(1,nm)
277 dvy = v(2,i) - v(2,nm)
278 dvz = v(3,i) - v(3,nm)
279C
280 xsm = rs(1) - rx(ir)
281 ysm = rs(2) - ry(ir)
282 zsm = rs(3) - rz(ir)
283 len2 = xsm*xsm + ysm*ysm + zsm*zsm
284
285 vxx = dvx
286 vyy = dvy
287 vzz = dvz
288
289c displacements & rotations in local coord
290
291 vlx = vxx*e1x + vyy*e1y + vzz*e1z + ysm*wlz - zsm*wly
292 vly = vxx*e2x + vyy*e2y + vzz*e2z + zsm*wlx - xsm*wlz
293 vlz = vxx*e3x + vyy*e3y + vzz*e3z + xsm*wly - ysm*wlx
294c
295 vrx = dwx*e1x + dwy*e1y + dwz*e1z
296 vry = dwx*e2x + dwy*e2y + dwz*e2z
297 vrz = dwx*e3x + dwy*e3y + dwz*e3z
298c
299 dlx = vlx * dt1
300 dly = vly * dt1
301 dlz = vlz * dt1
302c
303 drx = vrx * dt1
304 dry = vry * dt1
305 drz = vrz * dt1
306c
307 dl(1,ir,ii) = dl(1,ir,ii) + dlx
308 dl(2,ir,ii) = dl(2,ir,ii) + dly
309 dl(3,ir,ii) = dl(3,ir,ii) + dlz
310c
311 dr(1,ir,ii) = dr(1,ir,ii) + drx
312 dr(2,ir,ii) = dr(2,ir,ii) + dry
313 dr(3,ir,ii) = dr(3,ir,ii) + drz
314C----------------------------------------------------
315c Stiffness
316C----------------------------------------------------
317 IF (visc /= zero) THEN
318 ms_harm = (ms_pena(i)*ms_pena(nm))/(ms_pena(i)+ms_pena(nm))
319 dkm = two*stfn(ii)*ms_harm
320 vis(ir,k) = visc*sqrt(dkm)
321 stf(ir,k) = (vis(ir,k) + sqrt(vis(ir,k)**2 + (one+stbrk)*dkm))**2/(two*ms_harm)
322 ELSE
323 stf(ir,k) = (one+stbrk)*stfn(ii)
324 ENDIF
325 IF (iroddl == 1 .and. miner(i) > em20) THEN
326 in_harm = (in(i)*in(nm))/(in(i)+in(nm))
327 stfr(ii) = stfn(ii)*len2
328 dkm = two*stfr(ii)*in_harm
329 visr(ir,k)= visc*sqrt(dkm)
330 str(ir,k) = (visr(ir,k) + sqrt(visr(ir,k)**2 + dkm))**2/(two*in_harm)
331 ELSE
332 visr(ir,k) = zero
333 stfr(ii) = zero
334 str(ir,k) = zero
335 ENDIF
336C----------------------------------------------------
337c forces & moments in local coord
338C----------------------------------------------------
339 flocx(ir) = stfn(ii) * dl(1,ir,ii)
340 flocy(ir) = stfn(ii) * dl(2,ir,ii)
341 flocz(ir) = stfn(ii) * dl(3,ir,ii)
342c
343 flocxv(ir) = vis(ir,k) * vlx
344 flocyv(ir) = vis(ir,k) * vly
345 floczv(ir) = vis(ir,k) * vlz
346c---
347 dxt = dl(1,ir,ii)**2 + dl(2,ir,ii)**2+ dl(3,ir,ii)**2
348 econtt = econtt + half*stfn(ii)*dxt
349
350 econvt = econvt + (flocxv(ir)*vlx
351 . + flocyv(ir)*vly
352 . + floczv(ir)*vlz)*dt1
353c---
354 flocx(ir) = flocx(ir) + flocxv(ir)
355 flocy(ir) = flocy(ir) + flocyv(ir)
356 flocz(ir) = flocz(ir) + floczv(ir)
357c
358 mlocx(ir) = stfr(ii) * dr(1,ir,ii)
359 mlocy(ir) = stfr(ii) * dr(2,ir,ii)
360 mlocz(ir) = stfr(ii) * dr(3,ir,ii)
361c
362 mlocxv(ir) = visr(ir,k) * vrx
363 mlocyv(ir) = visr(ir,k) * vry
364 mloczv(ir) = visr(ir,k) * vrz
365c
366 IF (iroddl == 1 .and. miner(i) > em20) THEN
367
368 dxt = dr(1,ir,ii)**2 + dr(2,ir,ii)**2 + dr(3,ir,ii)**2
369 econtt = econtt + half*stfr(ii)*dxt
370
371 econvt = econvt + (mlocxv(ir)*vrx
372 . + mlocyv(ir)*vry
373 . + mloczv(ir)*vrz)*dt1
374 ENDIF
375c
376 mlocx(ir) = mlocx(ir) + mlocxv(ir)
377 mlocy(ir) = mlocy(ir) + mlocyv(ir)
378 mlocz(ir) = mlocz(ir) + mloczv(ir)
379c
380 ENDDO ! IR = 1,NIR
381C
382 stmax = max(stf(1,k),stf(2,k),stf(3,k),stf(4,k))
383 IF (iroddl == 1 .and. miner(i) > em20) THEN
384 stifm(k) = zero
385 ELSE
386C----------------------------------------------------
387c update main forces (moment balance)
388C
389 CALL i2loceq( nir ,rs ,rx ,ry ,rz ,
390 . flocx ,flocy ,flocz ,h ,stifm(k))
391 ENDIF
392C
393 DO ir = 1,nir
394 nm = irect(ir,l)
395C
396 xsm = x(1,i) - x(1,nm)
397 ysm = x(2,i) - x(2,nm)
398 zsm = x(3,i) - x(3,nm)
399C----------------------------------------------------
400C forces/moments -> global coordinates
401C----------------------------------------------------
402 fx(ir) = e1x*flocx(ir) + e2x*flocy(ir) + e3x*flocz(ir)
403 fy(ir) = e1y*flocx(ir) + e2y*flocy(ir) + e3y*flocz(ir)
404 fz(ir) = e1z*flocx(ir) + e2z*flocy(ir) + e3z*flocz(ir)
405
406 mx(ir) = e1x*mlocx(ir) + e2x*mlocy(ir) + e3x*mlocz(ir)
407 my(ir) = e1y*mlocx(ir) + e2y*mlocy(ir) + e3y*mlocz(ir)
408 mz(ir) = e1z*mlocx(ir) + e2z*mlocy(ir) + e3z*mlocz(ir)
409
410 mrx(ir) = half*(ysm*fz(ir) - zsm*fy(ir))
411 mry(ir) = half*(zsm*fx(ir) - xsm*fz(ir))
412 mrz(ir) = half*(xsm*fy(ir) - ysm*fx(ir))
413c
414c secnd node
415c
416 sav_for_pena(1,i) = sav_for_pena(1,i) - fx(ir)
417 sav_for_pena(2,i) = sav_for_pena(2,i) - fy(ir)
418 sav_for_pena(3,i) = sav_for_pena(3,i) - fz(ir)
419 sav_for_pena(4,i) = sav_for_pena(4,i) + stf(ir,k)
420c
421 IF (iroddl == 1 .and. miner(i) > em20) THEN
422 sav_for_pena(5,i) = sav_for_pena(5,i) - mx(ir) + mrx(ir)
423 sav_for_pena(6,i) = sav_for_pena(6,i) - my(ir) + mry(ir)
424 sav_for_pena(7,i) = sav_for_pena(7,i) - mz(ir) + mrz(ir)
425 sav_for_pena(8,i) = sav_for_pena(8,i) + str(ir,k)
426 ENDIF
427c--------------------------------------------
428c MLX = (MRX(IR)*E1X + MRY(IR)*E1Y + MRZ(IR)*E1Z)*TWO
429c MLY = (MRX(IR)*E2X + MRY(IR)*E2Y + MRZ(IR)*E2Z)*TWO
430c MLZ = (MRX(IR)*E3X + MRY(IR)*E3Y + MRZ(IR)*E3Z)*TWO
431c--------------------------------------------
432
433 fini(1,ir,ii) = flocx(ir)
434 fini(2,ir,ii) = flocy(ir)
435 fini(3,ir,ii) = flocz(ir)
436 IF (iroddl == 1 .and. miner(i) > em20) THEN
437 fini(4,ir,ii) = mlocx(ir)
438 fini(5,ir,ii) = mlocy(ir)
439 fini(6,ir,ii) = mlocz(ir)
440 ENDIF
441C
442C------------------------------------------------
443C composantes N/T de la forces nodale -> output
444C------------------------------------------------
445 fnorm = e3x*flocx(ir) + e3y*flocy(ir) + e3z*flocz(ir)
446 fn(1) = e3x*fnorm
447 fn(2) = e3y*fnorm
448 fn(3) = e3z*fnorm
449C
450 ft(1) = flocx(ir) - fn(1)
451 ft(2) = flocy(ir) - fn(2)
452 ft(3) = flocz(ir) - fn(3)
453C
454 fsav(1) = fsav(1) + fn(1)*dt1*w
455 fsav(2) = fsav(2) + fn(2)*dt1*w
456 fsav(3) = fsav(3) + fn(3)*dt1*w
457 fsav(4) = fsav(4) + ft(1)*dt1*w
458 fsav(5) = fsav(5) + ft(2)*dt1*w
459 fsav(6) = fsav(6) + ft(3)*dt1*w
460C
461 IF (anim_v(13)+h3d_data%N_VECT_CONT2 > 0) THEN
462 fncont(1,i) = fncont(1,i) - fx(ir) * w
463 fncont(2,i) = fncont(2,i) - fy(ir) * w
464 fncont(3,i) = fncont(3,i) - fz(ir) * w
465 fncont(1,irect(ir,l)) = fncont(1,irect(ir,l)) + fx(ir)*w
466 fncont(2,irect(ir,l)) = fncont(2,irect(ir,l)) + fy(ir)*w
467 fncont(3,irect(ir,l)) = fncont(3,irect(ir,l)) + fz(ir)*w
468 ENDIF
469
470 IF(anim_v(27)+h3d_data%N_VECT_PCONT2>0) THEN ! Normal/Tangential forces output
471 fncontp(1,i) = fncontp(1,i) - fn(1) * w
472 fncontp(2,i) = fncontp(2,i) - fn(2) * w
473 fncontp(3,i) = fncontp(3,i) - fn(3) * w
474
475 fncontp(1,irect(ir,l)) = fncontp(1,irect(ir,l)) + fn(1)*w
476 fncontp(2,irect(ir,l)) = fncontp(2,irect(ir,l)) + fn(2)*w
477 fncontp(3,irect(ir,l)) = fncontp(3,irect(ir,l)) + fn(3)*w
478
479 ftcontp(1,i) = ftcontp(1,i) - ft(1) * w
480 ftcontp(2,i) = ftcontp(2,i) - ft(2) * w
481 ftcontp(3,i) = ftcontp(3,i) - ft(3) * w
482
483 ftcontp(1,irect(ir,l)) = ftcontp(1,irect(ir,l)) + ft(1)*w
484 ftcontp(2,irect(ir,l)) = ftcontp(2,irect(ir,l)) + ft(2)*w
485 ftcontp(3,irect(ir,l)) = ftcontp(3,irect(ir,l)) + ft(3)*w
486 ENDIF
487C
488C
489 ENDDO ! IR = 1,NIR
490c--------------------------------------------
491c main node
492c--------------------------------------------
493 IF (w == 1) THEN
494 DO ir = 1,nir
495 nm = irect(ir,l)
496 a(1,nm) = a(1,nm) + fx(ir)
497 a(2,nm) = a(2,nm) + fy(ir)
498 a(3,nm) = a(3,nm) + fz(ir)
499 stifn(nm) = stifn(nm) + stf(ir,k) + stifm(k)*stmax
500c
501 IF (iroddl == 1 .and. miner(i) > em20) THEN
502 ar(1,nm) = ar(1,nm) + mx(ir) + mrx(ir)
503 ar(2,nm) = ar(2,nm) + my(ir) + mry(ir)
504 ar(3,nm) = ar(3,nm) + mz(ir) + mrz(ir)
505 stifr(nm) = stifr(nm) + str(ir,k)
506 ENDIF
507 ENDDO ! loop over penalty springs / main nodes
508 ENDIF
509C------------------------------------------------
510 ELSE
511 nsvg(k)= -i
512 l = irtl(ii)
513C
514 ix1(k) = irect(1,l)
515 ix2(k) = irect(2,l)
516 ix3(k) = irect(3,l)
517 ix4(k) = irect(4,l)
518 stif(k)= zero
519 vis(ir,k) = zero
520 ENDIF ! I > 0
521C---
522 ENDDO ! K=1,LLT
523C------------------------------------------------
524 IF (idtmins==2 .or. idtmins_int/=0) THEN
525 dti = dt2t
526 CALL i2sms26(llt ,ix1 ,ix2 ,ix3 ,ix4 ,
527 . nsvg ,stf ,noint,dmint2(1,kk),
528 . nodnx_sms,vis,dti )
529 IF (dti < dt2t) THEN
530 dt2t = dti
531 neltst = noint
532 ityptst = 10
533 ENDIF
534 END IF
535c
536 ENDDO ! KK=1,NSN,MVSIZ
537C----------
538#include "lockon.inc"
539 econt = econt + econtt ! Elastic energy
540 econtd = econtd + econvt ! Damping Elastic energy
541 fsav(26) = fsav(26) + econtt
542 fsav(28) = fsav(28) + econvt
543#include "lockoff.inc"
544C-----------
545 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i2loceq
subroutine i2loceq(nir, rs, rx, ry, rz, fmx, fmy, fmz, h, stifm)
Definition i2loceq.F:40
i2pen_rot26
subroutine i2pen_rot26(tt, dt1, dwdu, wlx, wly, wlz, rx, ry, rz, va, vb, vc, vd)
Definition i2pen_rot.F:149
i2rep
subroutine i2rep(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nir)
Definition i2rep.F:48
i2sms26
subroutine i2sms26(jlt, ix1, ix2, ix3, ix4, nsvg, stif, noint, dmint2, nodnx_sms, vis, dti)
Definition i2sms26.F:34
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