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