OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ruser32.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!|| ruser32 ../engine/source/elements/spring/ruser32.F
25!||--- called by ------------------------------------------------------
26!|| rforc3 ../engine/source/elements/spring/rforc3.F
27!||--- calls -----------------------------------------------------
28!|| get_u_func ../engine/source/user_interface/ufunc.f
29!|| get_u_mid ../engine/source/user_interface/upidmid.F
30!|| get_u_mnu ../engine/source/user_interface/upidmid.F
31!|| get_u_pid ../engine/source/user_interface/upidmid.F
32!|| get_u_pnu ../engine/source/user_interface/upidmid.F
33!|| get_u_sens ../engine/source/user_interface/usensor.F
34!||--- uses -----------------------------------------------------
35!|| sensor_mod ../common_source/modules/sensor_mod.F90
36!||====================================================================
37 SUBROUTINE ruser32(
38 1 NEL ,IOUT ,IPROP ,UVAR ,NUVAR ,
39 2 FX ,FY ,FZ ,XMOM ,YMOM ,
40 3 ZMOM ,E ,OFF ,STIFM ,STIFR ,
41 4 VISCM ,VISCR ,MASS ,XINER ,DT ,
42 5 XL ,VX ,RY1 ,RZ1 ,RX ,
43 6 RY2 ,RZ2 ,FR_WAVE,NSENSOR,SENSOR_TAB)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE sensor_mod
48C-------------------------------------------------------------------------
49C This subroutine compute springs forces and moments.
50C-------------------------------------------------------------------------
51C----------+---------+---+---+--------------------------------------------
52C VAR | SIZE |TYP| RW| DEFINITION
53C----------+---------+---+---+--------------------------------------------
54C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
55C IPROP | 1 | I | R | PROPERTY NUMBER
56C----------+---------+---+---+--------------------------------------------
57C XL | NEL | F | R | ELEMENT LENGTH
58C----------+---------+---+---+--------------------------------------------
59C UVAR |NUVAR*NEL| F |R/W| USER ELEMENT VARIABLES
60C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
61C----------+---------+---+---+--------------------------------------------
62C The user routine does not need to return elements mass in vector MASS :
63C this vector is not used by RADIOSS since version 4.1E.
64C The mass which is used by RADIOSS for time step (and output) is the
65C initial mass which was returned by user routine RINI29 into starter.
66C-------------------------------------------------------------------------
67C FUNCTION
68C-------------------------------------------------------------------------
69C INTEGER II = GET_U_PNU(I,IP,KK)
70C IFUNCI = GET_U_PNU(I,IP,KFUNC)
71C IPROPI = GET_U_PNU(I,IP,KFUNC)
72C IMATI = GET_U_PNU(I,IP,KMAT)
73C I : VARIABLE INDEX(1 for first variable,...)
74C IP : PROPERTY NUMBER
75C KK : PARAMETER KFUNC,KMAT,KPROP
76C THIS FUNCTION RETURN THE USER STORED FUNCTION(IF KK=KFUNC),
77C MATERIAL(IF KK=KMAT) OR PROPERTY(IF KK=KPROP) NUMBER.
78C SEE LECG29 FOR CORRESPONDING ID STORAGE.
79C-------------------------------------------------------------------------
80C INTEGER IFUNCI = GET_U_MNU(I,IM,KFUNC)
81C I : VARIABLE INDEX(1 for first function)
82C IM : MATERIAL NUMBER
83C KFUNC : ONLY FUNCTION ARE YET AVAILABLE.
84C THIS FUNCTION RETURN THE USER STORED FUNCTION NUMBER(function
85C referred by users materials).
86C SEE LECM29 FOR CORRESPONDING ID STORAGE.
87C-------------------------------------------------------------------------
88C my_real PARAMI = GET_U_GEO(I,IP)
89C I : PARAMETER INDEX(1 for first parameter,...)
90C IP : PROPERTY NUMBER
91C THIS FUNCTION RETURN THE USER GEOMETRY PARAMETERS
92C NOTE: IF(IP==IPROP) UPARAG(I) == GET_U_GEO(I,IPROP)
93C see lecg30 for storage
94C-------------------------------------------------------------------------
95C my_real PARAMI = GET_U_MAT(I,IM)
96C I : PARAMETER INDEX(1 for first parameter,...)
97C IM : MATERIAL NUMBER
98C THIS FUNCTION RETURN THE USER MATERIAL PARAMETERS
99C NOTE: GET_U_MAT(0,IMAT) RETURN THE DENSITY
100C see lecm29,30,31 for storage
101C-------------------------------------------------------------------------
102C INTEGER PID = GET_U_PID(IP)
103C IP : PROPERTY NUMBER
104C THIS FUNCTION RETURN THE USER PROPERTY ID CORRESPONDING TO
105C USER PROPERTY NUMBER IP.
106C-------------------------------------------------------------------------
107C INTEGER MID = GET_U_MID(IM)
108C IM : MATERIAL NUMBER
109C THIS FUNCTION RETURN THE USER MATERIAL ID CORRESPONDING TO
110C USER MATERIAL NUMBER IM.
111C-------------------------------------------------------------------------
112C my_real Y = GET_U_FUNC(IFUNC,X,DXDY)
113C IFUNC : function number obtained by
114C IFUNC = GET_U_MNU(I,IM,KFUNC) or IFUNC = GET_U_PNU(I,IP,KFUNC)
115C X : X value
116C DXDY : slope dX/dY
117C THIS FUNCTION RETURN Y(X)
118C-------------------------------------------------------------------------
119C I m p l i c i t T y p e s
120C-----------------------------------------------
121#include "implicit_f.inc"
122#include "impl1_c.inc"
123#include "com04_c.inc"
124C----------------------------------------------------------
125C D u m m y A r g u m e n t s a n d F u n c t i o n
126C----------------------------------------------------------
127 INTEGER IOUT,NEL,NUVAR,IPROP,NSENSOR,
128 . GET_U_PNU,GET_U_PID,GET_U_MID,GET_U_MNU,
129 . KFUNC,KMAT,KPROP
130 my_real
131 . UVAR(NUVAR,*),DT ,
132 . FX(*), FY(*), FZ(*), E(*), VX(*),MASS(*) ,XINER(*),
133 . ry1(*), rz1(*), off(*), xmom(*), ymom(*),
134 . zmom(*), rx(*), ry2(*), rz2(*),xl(*),
135 . stifm(*) ,stifr(*) , viscm(*) ,viscr(*) ,fr_wave(*) ,
136 . get_u_mat, get_u_geo, get_u_func, get_u_sens
137 EXTERNAL get_u_mnu,get_u_pnu,get_u_mid,get_u_pid,
138 . get_u_mat,get_u_geo, get_u_func
139 parameter(kfunc=29)
140 parameter(kmat=31)
141 parameter(kprop=33)
142 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
143C-----------------------------------------------
144C L o c a l V a r i a b l e s
145C-----------------------------------------------
146 INTEGER I,IFUNC1,IFUNC2,ISENS,ITYP,IACT,ILOCK
147 my_real
148 . stif0,stif1,dscal,fscal,tscal,x,dxdy,dx,tacti,f0,ff,d1,
149 . dxdy2,ff2
150C=======================================================================
151 stif0 = get_u_geo(2,iprop)
152 stif1 = get_u_geo(3,iprop)
153 tscal = get_u_geo(7,iprop)
154 dscal = get_u_geo(8,iprop)
155 fscal = get_u_geo(9,iprop)
156 d1 = get_u_geo(11,iprop)
157 isens = nint(get_u_geo(5,iprop))
158 ityp = nint(get_u_geo(6,iprop))
159 ilock = nint(get_u_geo(10,iprop))
160 tacti = get_u_sens(isens)
161C
162 IF (tacti == zero .AND. isens /= zero) THEN
163 iact=0
164 DO i=1,nel
165 IF (uvar(2,i) == one) THEN
166 uvar(2,i) = zero
167 ENDIF
168 fx(i) = fx(i) + stif0 * dt * vx(i)
169 uvar(4,i) = stif0
170 stifm(i) = stif0
171 ENDDO
172 ELSE
173 iact=1
174 DO i=1,nel
175 IF (uvar(2,i) == zero) THEN
176 uvar(1,i) = zero
177 uvar(2,i) = one
178 ENDIF
179 uvar(1,i) = uvar(1,i) + dt * vx(i)
180 fx(i) = fx(i) + stif0 * dt * vx(i)
181 uvar(4,i) = stif0
182 stifm(i) = stif0
183 ENDDO
184 ENDIF
185C
186 IF (iact == 0) THEN
187 ELSEIF (ityp == 1) THEN
188 f0 = get_u_geo(4,iprop)
189 DO i=1,nel
190 x = uvar(1,i)
191 ff = f0 + stif1 * x
192 IF (fx(i) > ff .AND. ilock == 2) uvar(3,i) = one
193 IF (ff > zero .AND. uvar(3,i) == zero) THEN
194 fx(i) = max(ff,fx(i))
195 IF (impl_s > zero) THEN
196 ff2 = f0 + stif1 * (x-dt * vx(i))
197 IF (ff2 > ff) THEN
198 uvar(4,i) = min(stif0,stif1)
199 ENDIF
200 ENDIF
201 ENDIF
202 ENDDO
203 ELSEIF (ityp == 2) THEN
204 ifunc1 = get_u_pnu(1,iprop,kfunc)
205 DO i=1,nel
206 x = uvar(1,i)
207 ff = fscal*get_u_func(ifunc1,x*dscal,dxdy)
208 IF (x < d1 .AND. d1 /= zero) uvar(3,i) = one
209 IF (fx(i) > ff .AND. ilock == 2) uvar(3,i) = one
210 IF (ff > zero .AND. uvar(3,i) == zero) THEN
211 fx(i) = max(ff,fx(i))
212 IF (impl_s > zero) THEN
213 ff2 = fscal*get_u_func(ifunc1,(x-dt * vx(i))*dscal,dxdy2)
214 IF (ff2 > ff) THEN
215 uvar(4,i) = min(stif0,abs(dxdy))
216 ENDIF
217 ENDIF
218 ENDIF
219 ENDDO
220 ELSEIF (ityp == 3) THEN
221 ifunc2 = get_u_pnu(2,iprop,kfunc)
222 f0 = fscal*get_u_func(ifunc2,tacti*tscal,dxdy)
223 DO i=1,nel
224 x = uvar(1,i)
225 IF (x < d1 .AND. d1 /= zero) uvar(3,i) = one
226 IF (fx(i) > f0 .AND. ilock == 2) uvar(3,i) = one
227 IF (f0 > zero .AND. uvar(3,i) == zero) THEN
228 fx(i) = max(f0,fx(i))
229 ENDIF
230 ENDDO
231 ELSEIF (ityp == 4) THEN
232 ifunc1 = get_u_pnu(1,iprop,kfunc)
233 ifunc2 = get_u_pnu(2,iprop,kfunc)
234 f0 = fscal*get_u_func(ifunc2,tacti*tscal,dxdy)
235 DO i=1,nel
236 x = uvar(1,i)
237 ff = f0*get_u_func(ifunc1,x*dscal,dxdy)
238 IF (x < d1 .AND. d1 /= zero) uvar(3,i) = one
239 IF (fx(i) > ff .AND. ilock == 2) uvar(3,i) = one
240 IF (ff > zero .AND. uvar(3,i) == zero) THEN
241 fx(i) = max(ff,fx(i))
242 IF (impl_s > zero) THEN
243 ff2 = get_u_func(ifunc1,(x-dt * vx(i))*dscal,dxdy2)
244 IF (ff2 > ff) THEN
245 uvar(4,i) = min(stif0,abs(dxdy))
246 ENDIF
247 ENDIF
248 ENDIF
249 ENDDO
250 ENDIF
251C-------------------------------
252 DO i=1,nel
253 stifr(i) = zero
254 viscm(i) = zero
255 viscr(i) = zero
256 xiner(i) = zero
257 ENDDO
258C-----------
259 RETURN
260 END
dscal
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ruser32
subroutine ruser32(nel, iout, iprop, uvar, nuvar, fx, fy, fz, xmom, ymom, zmom, e, off, stifm, stifr, viscm, viscr, mass, xiner, dt, xl, vx, ry1, rz1, rx, ry2, rz2, fr_wave, nsensor, sensor_tab)
Definition ruser32.F:44