OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r3len3.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!|| r3len3 ../engine/source/elements/spring/r3len3.F
25!||--- called by ------------------------------------------------------
26!|| rforc3 ../engine/source/elements/spring/rforc3.F
27!||====================================================================
28 SUBROUTINE r3len3(
29 1 JFT, JLT, OFF, DT2T,
30 2 NELTST, ITYPTST, STI, MS,
31 3 MSRT, DMELRT, G_DT, DTEL,
32 4 NGL, XK, XM, XC,
33 5 AK, NC1, NC2, NC3,
34 6 JSMS)
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39#include "comlock.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com08_c.inc"
48#include "scr02_c.inc"
49#include "scr07_c.inc"
50#include "scr17_c.inc"
51#include "scr18_c.inc"
52#include "sms_c.inc"
53#include "units_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER, INTENT(IN) :: JSMS
58 INTEGER NC1(*),NC2(*),NC3(*)
59 my_real,INTENT(INOUT) :: DTEL(JFT:JLT)
60 INTEGER,INTENT(IN) :: G_DT
61 INTEGER JFT,JLT,NELTST ,ITYPTST,NGL(*)
62 my_real DT2T,
63 . off(*), sti(3,*), ms(*), msrt(*), dmelrt(*),
64 . xk(mvsiz),xm(mvsiz),xc(mvsiz),ak(mvsiz)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I
69 my_real
70 . DT(MVSIZ),DTC(MVSIZ),
71 . A, MASS2, DTA, DTB, MX2
72C-----------------------------------------------
73 DO I=jft,jlt
74 xk(i)=xk(i)*ak(i)
75 END DO
76C
77 IF(nodadt/=0.OR.idtmins==2)THEN
78C
79 DO i=jft,jlt
80 sti(1,i) = zero
81 IF(off(i)>zero)THEN
82 IF(xk(i)/=zero.AND.xc(i)/=zero.AND.
83 . ms(nc1(i))/=zero)THEN
84 mass2 = two * ms(nc1(i))
85 sti(1,i) = (sqrt(xc(i)*xc(i)+two*xk(i)*mass2)+xc(i))**2/mass2
86 ELSEIF(xk(i)/=zero)THEN
87 sti(1,i) = two*xk(i)
88 ELSEIF(xc(i)/=zero.AND.ms(nc1(i))/=zero)THEN
89 a = two * xc(i)**2
90 sti(1,i) = a / ms(nc1(i))
91 ENDIF
92 END IF
93 sti(2,i) = zero
94 IF(off(i)>zero)THEN
95 IF(xk(i)/=zero.AND.xc(i)/=zero.AND.
96 . ms(nc2(i))/=zero)THEN
97 mass2 = two* ms(nc2(i))
98 sti(2,i) = (sqrt(xc(i)*xc(i)+two*xk(i)*mass2)+xc(i))**2/mass2
99 ELSEIF(xk(i)/=zero)THEN
100 sti(2,i) = two*xk(i)
101 ELSEIF(xc(i)/=zero.AND.ms(nc2(i))/=zero)THEN
102 a = two * xc(i)**2
103 sti(2,i) = a / ms(nc2(i))
104 ENDIF
105 END IF
106 sti(3,i) = zero
107 IF(off(i)>zero)THEN
108 IF(xk(i)/=zero.AND.xc(i)/=zero.AND.
109 . ms(nc3(i))/=zero)THEN
110 mass2 = two * ms(nc3(i))
111 sti(3,i) = (sqrt(xc(i)*xc(i)+two*xk(i)*mass2)+xc(i))**2/mass2
112 ELSEIF(xk(i)/=zero)THEN
113 sti(3,i) = two*xk(i)
114 ELSEIF(xc(i)/=zero.AND.ms(nc3(i))/=zero)THEN
115 a = two * xc(i)**2
116 sti(3,i) = a / ms(nc3(i))
117 ENDIF
118 END IF
119 ENDDO ! DO I=JFT,JLT
120C
121 IF(idtmin(6)==0.AND.(idtmins/=2.OR.jsms==0))RETURN
122C
123 IF(idtmins==2.AND.jsms/=0)THEN
124C---
125C IDTMINS=2 & JSMS=1 <=> AMS & elementary time step
126C
127 DO i=jft,jlt
128 dt(i)= xm(i)/max(em15,
129 . two*sqrt(xc(i)*xc(i)+xm(i)*xk(i))+xc(i))
130 ENDDO
131C
132 dta=dtmins/dtfacs
133 dtb=dta*dta
134 DO i=jft,jlt
135 IF(off(i)<=zero) cycle
136 dmelrt(i)=max(dmelrt(i),
137 . xc(i)*dta+half*xk(i)*dtb-fourth*msrt(i))
138C
139C MX2 = 2*(M1+2*DeltaM) = 2*(M3+2*DeltaM)
140 mx2= half*msrt(i)+two*dmelrt(i)
141 dt(i)=dtfacs*mx2 /max(em15,
142 . sqrt(xc(i)*xc(i)+mx2*xk(i))+xc(i))
143C
144C MY2 = 2*(M2+4*DeltaM)
145C MY2= MSRT(I)+FOUR*DMELRT(I))
146C DT(I)= DTFACS*MY2 /MAX(EM15,
147C . SQRT(FOUR*XC(I)*XC(I)+MY2*TWO*XK(I))+TWO*XC(I))
148C == DTFACS*MX2 /MAX(EM15,
149C . SQRT(XC(I)*XC(I)+MX2*XK(I))+XC(I))
150 ENDDO
151C
152 DO i=jft,jlt
153 IF(off(i)<=zero) cycle
154 IF(dt(i)<dt2t) THEN
155 dt2t=dt(i)
156 neltst =ngl(i)
157 ityptst=6
158 ENDIF
159 ENDDO
160 ELSE
161C
162 DO i=jft,jlt
163 dt(i)= xm(i)/max(em15,
164 . two*sqrt(xc(i)*xc(i)+xm(i)*xk(i))+xc(i))
165 ENDDO
166C
167 DO i=jft,jlt
168 IF(off(i)>zero) THEN
169 dt(i)=dtfac1(6)*dt(i)
170 IF(idtmin(6)==1.AND.dt(i)<dtmin1(6))THEN
171 tstop = tt
172#include "lockon.inc"
173 WRITE(iout,*)
174 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
175 WRITE(istdo,*)
176 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
177#include "lockoff.inc"
178 ELSEIF(idtmin(6)==5.AND.dt(i)<dtmin1(6))THEN
179 mstop = 2
180#include "lockon.inc"
181 WRITE(iout,*)
182 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
183 WRITE(istdo,*)
184 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
185#include "lockoff.inc"
186 ELSEIF(idtmin(6)==2.AND.dt(i)<dtmin1(6))THEN
187 off(i)=zero
188#include "lockon.inc"
189 WRITE(iout,*) '-- DELETE OF SPRING ELEMENT NUMBER',ngl(i)
190#include "lockoff.inc"
191 idel7nok = 1
192 ENDIF
193 ENDIF
194 ENDDO
195 END IF
196C
197 ELSE
198C
199 DO i=jft,jlt
200 dt(i)= xm(i)/
201 . max(em15,two*sqrt(xc(i)*xc(i)+xm(i)*xk(i))+xc(i))
202 ENDDO
203C
204 DO i=jft,jlt
205 sti(1,i) = zero
206 sti(2,i) = zero
207 sti(3,i) = zero
208 IF(off(i)>zero) THEN
209 sti(1,i) = half*xm(i) / dt(i)**2
210 sti(2,i) = sti(1,i)
211 sti(3,i) = sti(1,i)
212 dt(i)=dtfac1(6)*dt(i)
213 IF(idtmin(6)==1.AND.dt(i)<dtmin1(6))THEN
214 tstop = tt
215#include "lockon.inc"
216 WRITE(iout,*)
217 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
218 WRITE(istdo,*)
219 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
220#include "lockoff.inc"
221 ELSEIF(idtmin(6)==5.AND.dt(i)<dtmin1(6))THEN
222 mstop = 2
223#include "lockon.inc"
224 WRITE(iout,*)
225 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
226 WRITE(istdo,*)
227 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SPRING ELEMENT'
228#include "lockoff.inc"
229 ELSEIF(idtmin(6)==2.AND.dt(i)<dtmin1(6))THEN
230 off(i)=zero
231#include "lockon.inc"
232 WRITE(iout,*) '-- DELETE OF SPRING ELEMENT NUMBER',ngl(i)
233#include "lockoff.inc"
234 idel7nok = 1
235 ENDIF
236 IF(dt(i)<dt2t) THEN
237 dt2t=dt(i)
238 neltst =ngl(i)
239 ityptst=6
240 ENDIF
241 ENDIF
242 ENDDO
243 ENDIF
244C------------------------------
245 IF(g_dt/=zero)THEN
246 DO i=jft,jlt
247 dtel(i) = dt(i)
248 ENDDO
249 ENDIF
250C------------------------------
251
252 RETURN
253 END
max
#define max(a, b)
Definition macros.h:21
r3len3
subroutine r3len3(jft, jlt, off, dt2t, neltst, ityptst, sti, ms, msrt, dmelrt, g_dt, dtel, ngl, xk, xm, xc, ak, nc1, nc2, nc3, jsms)
Definition r3len3.F:35