OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for26.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i2for26 ../engine/source/interfaces/interf/i2for26.F
25!||--- called by ------------------------------------------------------
26!|| intti2f ../engine/source/interfaces/interf/intti2f.F
27!||--- calls -----------------------------------------------------
28!|| i2loceq ../common_source/interf/i2loceq.F
29!|| i2pen_rot26 ../common_source/interf/i2pen_rot.F
30!|| i2rep ../common_source/interf/i2rep.F
31!|| i2sms26 ../engine/source/interfaces/interf/i2sms26.F
32!||--- uses -----------------------------------------------------
33!|| h3d_mod ../engine/share/modules/h3d_mod.F
34!||====================================================================
35 SUBROUTINE i2for26(
36 . X ,V ,VR ,A ,AR ,
37 . MS ,STIFN ,STIFR ,WEIGHT ,IRECT ,
38 . NSV ,IRTL ,DR ,DL ,FINI ,
39 . FSAV ,FNCONT ,NSN ,STFN ,STFR ,
40 . VISC ,NOINT ,NODNX_SMS,DMINT2 ,SAV_FOR_PENA,
41 . MS_PENA ,IN ,DT2T ,NELTST ,ITYPTST ,
42 . MINER ,H3D_DATA,FNCONTP ,FTCONTP)
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
546 END SUBROUTINE i2for26
i2for26
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)
Definition i2for26.F:43
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