OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r5len3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "scr02_c.inc"
#include "scr07_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"
#include "sms_c.inc"
#include "units_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ r5len3()

subroutine r5len3 ( integer jft,
integer jlt,
off,
dt2t,
integer neltst,
integer 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,
integer, dimension(*) ipartr,
msrt,
dmelrt,
integer, intent(in) g_dt,
dimension(jft:jlt), intent(inout) dtel,
integer, dimension(*) ngl,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, intent(in) jsms )

Definition at line 28 of file r5len3.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
dtel
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
Definition dtel.F:46
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21