OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r5len3.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!|| r5len3 ../engine/source/elements/spring/r5len3.F
25!||--- called by ------------------------------------------------------
26!|| rforc3 ../engine/source/elements/spring/rforc3.F
27!||====================================================================
28 SUBROUTINE r5len3(
29 1 JFT, JLT, OFF, DT2T,
30 2 NELTST, ITYPTST, STI, STIR,
31 3 MS, IN, USTI, USTIR,
32 4 VISI, VISIR, UMAS, UINER,
33 5 FR_WAVE, FR_W_E, EINT, FX,
34 6 XMOM, YMOM, ZMOM, VX,
35 7 RY1, RZ1, RX, RY2,
36 8 RZ2, XL, FY, FZ,
37 9 PARTSAV, IPARTR, MSRT, DMELRT,
38 A G_DT, DTEL, NGL, NC1,
39 B NC2, JSMS)
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44#include "comlock.inc"
45C-----------------------------------------------
46C G l o b a l P a r a m e t e r s
47C-----------------------------------------------
48#include "mvsiz_p.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com08_c.inc"
54#include "param_c.inc"
55#include "scr02_c.inc"
56#include "scr07_c.inc"
57#include "scr17_c.inc"
58#include "scr18_c.inc"
59#include "sms_c.inc"
60#include "units_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER, INTENT(IN) :: JSMS
65 my_real,INTENT(INOUT) :: DTEL(JFT:JLT)
66 INTEGER,INTENT(IN) :: G_DT
67 INTEGER JFT,JLT,NELTST ,ITYPTST
68 INTEGER IPARTR(*),NGL(*),NC1(*),NC2(*)
69 my_real DT2T,
70 . OFF(*), STI(3,*), STIR(3,*), MS(*), IN(*),
71 . USTI(*) ,USTIR(*), VISI(*) ,VISIR(*) ,UMAS(*) ,
72 . UINER(*),FR_WAVE(*) ,FR_W_E(*) ,EINT(*) ,
73 . FX(*), FY(*), FZ(*), XMOM(*), YMOM(*),ZMOM(*),XL(*),
74 . VX(*), RY1(*), RZ1(*), RX(*), RY2(*), RZ2(*),PARTSAV(NPSAV,*),
75 . msrt(*), dmelrt(*)
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I,MX
80 my_real
81 . dt(mvsiz), dtc(mvsiz),
82 . dtinv, a, mass2, in2, dta, dtb, mx2
83C--------------------------------------------
84C OFF
85C--------------------------------------------
86 DO i=jft,jlt
87 fx(i) = fx(i)*off(i)
88 fy(i) = fy(i)*off(i)
89 fz(i) = fz(i)*off(i)
90 xmom(i) = xmom(i)*off(i)
91 ymom(i) = ymom(i)*off(i)
92 zmom(i) = zmom(i)*off(i)
93 ENDDO
94C--------------------------------------------
95C Energy
96C--------------------------------------------
97 DO i=jft,jlt
98 eint(i) = eint(i)
99 .+ half*dt1 * (vx(i) * fx(i) + rx(i) * xmom(i)
100 . + (ry2(i) - ry1(i)) * ymom(i)
101 . + (rz2(i) - rz1(i)) * zmom(i)
102 . + half * (ry2(i) + ry1(i)) * fz(i) * xl(i)
103 . - half * (rz2(i) + rz1(i)) * fy(i) * xl(i) )
104 ENDDO
105 IF (npsav >= 21) THEN
106 DO i=jft,jlt
107 mx = ipartr(i)
108 partsav(23,mx)=partsav(23,mx)
109 . + half*dt1 * (rx(i) * xmom(i)
110 . + (ry2(i) - ry1(i)) * ymom(i)
111 . + (rz2(i) - rz1(i)) * zmom(i)
112 . + half * (ry2(i) + ry1(i)) * fz(i) * xl(i)
113 . - half * (rz2(i) + rz1(i)) * fy(i) * xl(i) )
114 ENDDO
115 ENDIF
116C--------------------------------------------
117C Front wave
118C--------------------------------------------
119 IF (ifrwv /= 0) THEN
120#include "lockon.inc"
121 DO i=jft,jlt
122 IF (fr_wave(nc1(i)) == zero)fr_wave(nc1(i))=-fr_w_e(i)
123 IF (fr_wave(nc2(i)) == zero)fr_wave(nc2(i))=-fr_w_e(i)
124 ENDDO
125#include "lockoff.inc"
126 ENDIF
127C--------------------------------------------
128C time step
129C--------------------------------------------
130 IF (nodadt /= 0 .OR. idtmins == 2) THEN
131 DO i=jft,jlt
132 usti(i) =usti(i) *max(zero,off(i))
133 ustir(i)=ustir(i)*max(zero,off(i))
134 visi(i) =visi(i) *max(zero,off(i))
135 visir(i)=visir(i)*max(zero,off(i))
136 ENDDO
137 IF (dt1 == zero)THEN
138 DO i=jft,jlt
139 IF (visir(i) < em15) uiner(i) =one
140 sti(1,i) = usti(i)
141 stir(1,i) = ustir(i)
142 IF (umas(i) > em15)
143 . sti(1,i) = sti(1,i) + four*visi(i)**2 / umas(i)
144 IF (uiner(i) > em15)
145 . stir(1,i) = stir(1,i) + four*visir(i)**2 / uiner(i)
146 sti(2,i) = sti(1,i)
147 stir(2,i) = stir(1,i)
148 ENDDO
149 ELSE
150 DO i=jft,jlt
151 sti(1,i) = usti(i) + two*visi(i)/dt1
152 stir(1,i) = ustir(i)+ two*visir(i)/dt1
153 sti(2,i) = sti(1,i)
154 stir(2,i) = stir(1,i)
155 ENDDO
156 ENDIF
157C
158 IF (idtmins == 2 .AND. jsms /= 0) THEN
159 dta=dtmins/dtfacs
160 dtb=dta*dta
161 DO i=jft,jlt
162 IF (off(i) <= zero) cycle
163 dt(i)=ep20
164 IF (visi(i)+usti(i) >= em15) THEN
165 usti(i)= max(em15,usti(i))
166 dmelrt(i)=max(dmelrt(i),
167 . visi(i)*dta+half*usti(i)*dtb-half*msrt(i))
168C MX2 = 2*(Mn+2*DeltaM)
169 mx2 =msrt(i)+two*dmelrt(i)
170 dt(i)=dtfacs*
171 . mx2 /max(em15,sqrt(visi(i)*visi(i)+mx2*usti(i))+visi(i))
172 ENDIF
173 ENDDO
174C
175 DO i=jft,jlt
176 IF (off(i) <= zero) cycle
177 IF (dt(i) < dt2t) THEN
178 dt2t=dt(i)
179 neltst =ngl(i)
180 ityptst=6
181 ENDIF
182 ENDDO
183 ENDIF ! IF (IDTMINS == 2 .AND. JSMS /= 0)
184 ENDIF ! IF (NODADT /= 0 .OR. IDTMINS == 2)
185C
186 IF (nodadt /= 0 .OR. (idtmins == 2. and. jsms /= 0)) RETURN
187C
188 DO i=jft,jlt
189 IF (visi(i)+usti(i) < em15) umas(i) =one
190 ENDDO
191C
192 DO i=jft,jlt
193 usti(i)= max(em15,usti(i))
194 dt(i)=(sqrt(visi(i)*visi(i)+umas(i)*usti(i))-visi(i))/usti(i)
195 dtc(i)=half*umas(i)/ max(em15,visi(i))
196 dt(i)= min(dt(i),dtc(i))
197 ENDDO
198C
199 IF (idtmins /= 2) THEN
200 DO i=jft,jlt
201 sti(1,i) = zero
202 sti(2,i) = zero
203 stir(1,i) = zero
204 stir(2,i) = zero
205 IF (dt(i) == zero) dt(i)=dtc(i)
206 IF (off(i) <= zero) cycle
207 sti(1,i) = umas(i) / dt(i)**2
208 sti(2,i) = sti(1,i)
209 ENDDO
210 ENDIF
211C
212 DO i=jft,jlt
213 IF (visir(i)+ustir(i) < em15) uiner(i)=one
214 ENDDO
215C
216 DO i=jft,jlt
217 ustir(i)= max(em15,ustir(i))
218 dtc(i)=(sqrt(visir(i)*visir(i)+uiner(i)*ustir(i))-visir(i))
219 . /ustir(i)
220 dt(i)= min(dt(i),dtc(i))
221 dtc(i)=half*uiner(i)/ max(em15,visir(i))
222 dt(i)= min(dt(i),dtc(i))
223 ENDDO
224C
225 DO i=jft,jlt
226 IF (off(i) <= zero) cycle
227 IF (dt(i) == zero) dt(i)=dtc(i)
228 dt(i)=dtfac1(6)*dt(i)
229 IF (idtmin(6) == 1 .AND. dt(i) < dtmin1(6)) THEN
230 tstop = tt
231#include "lockon.inc"
232 WRITE(iout,*)
233 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
234 WRITE(istdo,*)
235 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
236#include "lockoff.inc"
237 ELSEIF (idtmin(6) == 5 .AND. dt(i) < dtmin1(6)) THEN
238 mstop = 2
239#include "lockon.inc"
240 WRITE(iout,*)
241 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
242 WRITE(istdo,*)
243 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
244#include "lockoff.inc"
245 ELSEIF (idtmin(6) == 2 .AND. dt(i) < dtmin1(6)) THEN
246 off(i)=zero
247#include "lockon.inc"
248 WRITE(iout,*) '-- DELETE OF SPRING ELEMENT NUMBER',ngl(i)
249#include "lockoff.inc"
250 idel7nok = 1
251 ENDIF
252 IF (dt(i) >= dt2t) cycle
253 dt2t=dt(i)
254 neltst =ngl(i)
255 ityptst=6
256 ENDDO
257C------------------------------
258 IF(g_dt/=zero)THEN
259 DO i=jft,jlt
260 dtel(i) = dt(i)
261 ENDDO
262 ENDIF
263C------------------------------
264 RETURN
265 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
r5len3
subroutine r5len3(jft, jlt, off, dt2t, neltst, ityptst, sti, stir, ms, in, usti, ustir, visi, visir, umas, uiner, fr_wave, fr_w_e, eint, fx, xmom, ymom, zmom, vx, ry1, rz1, rx, ry2, rz2, xl, fy, fz, partsav, ipartr, msrt, dmelrt, g_dt, dtel, ngl, nc1, nc2, jsms)
Definition r5len3.F:40