OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
material_flow.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!|| material_flow ../engine/source/tools/seatbelts/material_flow.F
25!||--- called by ------------------------------------------------------
26!|| r23l114def3 ../engine/source/elements/spring/r23l114def3.f
27!||--- calls -----------------------------------------------------
28!|| get_u_func ../engine/source/user_interface/ufunc.f
29!|| retractor_table_inv ../engine/source/tools/seatbelts/retractor_table_inv.F90
30!|| retractor_table_inv2 ../engine/source/tools/seatbelts/retractor_table_inv2.F90
31!|| solve_delta_l0 ../engine/source/tools/seatbelts/material_flow.F
32!|| solve_delta_l02 ../engine/source/tools/seatbelts/material_flow.f
33!|| table_interp_dydx ../engine/source/tools/curve/table_tools.F
34!||--- uses -----------------------------------------------------
35!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
36!|| retractor_table_inv2_mod ../engine/source/tools/seatbelts/retractor_table_inv2.F90
37!|| retractor_table_inv_mod ../engine/source/tools/seatbelts/retractor_table_inv.F90
38!|| seatbelt_mod ../common_source/modules/seatbelt_mod.f
39!|| sensor_mod ../common_source/modules/sensor_mod.f90
40!||====================================================================
41 SUBROUTINE material_flow(DFS,DFS_OLD,ALDP,SLIPRING_STRAND,XK,
42 1 OFF,AL0,AL02,LMIN,UPDATE_FLAG,
43 2 RING_SLIP,SLIPRING_ID,XL0,DL,DLOLD,
44 3 EXDP,EYDP,EZDP,X1DP,X2DP,
45 4 X3DP,ADHER,NC1,NC2,NC3,
46 5 FLAG_SLIPRING_UPDATE,ADD_NODE1,ADD_NODE2,VX1,VY1,
47 6 VZ1,VX2,VY2,VZ2,VX3,
48 7 VY3,VZ3,XC,RETRACTOR_ID,FLAG_RETRACTOR_UPDATE,
49 8 SENSOR_TAB,AL0DP,FR_ID,DDF,FX,FX2,
50 9 ALDP2,AL0DP2,EX2DP,EY2DP,EZ2DP,
51 A XL02,XK2,COMPT,INDEX2,NSENSOR)
52C-----------------------------------------------
53C M o d u l e s
54C-----------------------------------------------
55 USE elbufdef_mod
56 USE seatbelt_mod
57 USE sensor_mod
58 USE retractor_table_inv_mod
59 USE retractor_table_inv2_mod
60C----6---------------------------------------------------------------7---------8
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64C-----------------------------------------------
65C G l o b a l P a r a m e t e r s
66C-----------------------------------------------
67#include "mvsiz_p.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "com04_c.inc"
72#include "com08_c.inc"
73C-----------------------------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER ,INTENT(IN) :: NSENSOR
77 INTEGER UPDATE_FLAG(*),SLIPRING_ID(*),NC1(*),NC2(*),NC3(*),SLIPRING_STRAND(*),
78 . ADHER(*),FLAG_SLIPRING_UPDATE,ADD_NODE1(*),ADD_NODE2(*),RETRACTOR_ID(*),
79 . FLAG_RETRACTOR_UPDATE,FR_ID(*)
80 my_real DFS(*),DFS_OLD(*),AL0(*),AL02(*),LMIN(*),RING_SLIP(*),
81 . XL0(*),DL(*),DLOLD(*),EXDP(*),EYDP(*),EZDP(*),
82 . XK(*),VX1(*),VY1(*),VZ1(*),VX2(*),VY2(*),VZ2(*),VX3(*),VY3(*),VZ3(*),XC(*),
83 . OFF(*)
84 INTEGER, INTENT(IN) :: COMPT,INDEX2(MVSIZ)
85 DOUBLE PRECISION ALDP(*),X1DP(3,*),X2DP(3,*),X3DP(3,*),AL0DP(*)
86 my_real, INTENT(IN) :: fx(mvsiz),fx2(mvsiz),xk2(mvsiz)
87 my_real, INTENT(OUT) :: ddf(mvsiz),xl02(mvsiz)
88 DOUBLE PRECISION, INTENT(IN) :: ALDP2(MVSIZ),EX2DP(MVSIZ),EY2DP(MVSIZ),EZ2DP(MVSIZ)
89 DOUBLE PRECISION, INTENT(INOUT) :: AL0DP2(MVSIZ)
90 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 INTEGER I,J,FLAG_SENSOR_LOCK
95 INTEGER FLAG,NEW_NODE2,NEW_NODE1,FORCE_TENS_TYP,FLAG_NO_COUNT_PULL
96 my_real ddfs,beta,hh,hh2,fric,deltaf,dt11,fb
97 my_real tens,xscal,norm,pres,vrel,vec1(3)
98 my_real fricd,frics,xx,dxdy,yy,get_u_func,fb2,angle
99 my_real ddx,ddx2,f_lock,f_unlock,pretens,xx1,xx2,cos_beta
100 my_real omega,eps1,eps2,epsn,fact
101 DOUBLE PRECISION DELTA_LO
102C
103 EXTERNAL GET_U_FUNC
104C---------------------------------------------------------
105C
106 dt11 = dt1
107 IF(dt11==zero) dt11 = ep30
108C
109C----------------------------------------------------------
110C- MATERIAL FLOW COMPUTATION FOR SLIPRING AND RETRACTOR
111C----------------------------------------------------------
112C
113 DO j=1,compt
114C
115 i = index2(j)
116C
117 IF (off(i) == one) THEN
118C
119 IF (slipring_strand(i) == 1) THEN
120CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
121C SLIPRING - BRIN 1
122CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
123C
124C-------- computation of delta_lo
125C
126 ddx = exdp(i) * (vx2(i) - vx1(i))
127 . + eydp(i) * (vy2(i) - vy1(i))
128 . + ezdp(i) * (vz2(i) - vz1(i))
129
130 IF (slipring(slipring_id(i))%FRAM(fr_id(i))%STRAND_DIRECTION(1) == 1) THEN
131 ddx2 = ex2dp(i)* (vx3(i) - vx2(i))
132 . + ey2dp(i)* (vy3(i) - vy2(i))
133 . + ez2dp(i)* (vz3(i) - vz2(i))
134 ELSE
135 ddx2 = ex2dp(i)* (vx1(i) - vx3(i))
136 . + ey2dp(i)* (vy1(i) - vy3(i))
137 . + ez2dp(i)* (vz1(i) - vz3(i))
138 ENDIF
139C
140C----------------------------------------------------------------------------------
141C Computation of friction coefficient
142C
143C---- Effect of material flow --
144C
145 vrel = abs(slipring(slipring_id(i))%FRAM(fr_id(i))%MATERIAL_FLOW_OLD)
146C-- dynamic friction
147 IF (slipring(slipring_id(i))%IFUNC(1) == 0) THEN
148 fricd = slipring(slipring_id(i))%FRIC
149 ELSE
150 fricd = slipring(slipring_id(i))%FRIC
151 xx = tt / slipring(slipring_id(i))%FAC_D(1)
152 fricd = fricd*get_u_func(slipring(slipring_id(i))%IFUNC(1),xx,dxdy)
153 ENDIF
154C-- static friction
155 IF (slipring(slipring_id(i))%IFUNC(3) == 0) THEN
156 frics = slipring(slipring_id(i))%FRICS
157 ELSE
158 frics = slipring(slipring_id(i))%FRICS
159 xx = tt / slipring(slipring_id(i))%FAC_S(1)
160 frics = frics*get_u_func(slipring(slipring_id(i))%IFUNC(3),xx,dxdy)
161 ENDIF
162C
163C---- Effect of normal force--
164C
165C-- bisectrice computation
166 vec1(1) = exdp(i) + ex2dp(i)
167 vec1(2) = eydp(i) + ey2dp(i)
168 vec1(3) = ezdp(i) + ez2dp(i)
169 norm = max(em20,vec1(1)*vec1(1)+vec1(2)*vec1(2)+vec1(3)*vec1(3))
170 norm = sqrt(norm)
171 vec1(1) = vec1(1)/norm
172 vec1(2) = vec1(2)/norm
173 vec1(3) = vec1(3)/norm
174C
175 eps1 = (aldp(i)-al0dp(i))/max(lmin(i),al0(i))
176 eps2 = (aldp2(i)-al0dp2(i))/max(lmin(i),al02(i))
177C
178 fb = fx(i)
179 fb2 = fx2(i)
180 pres = fb*(exdp(i)*vec1(1)+eydp(i)*vec1(2)+ezdp(i)*vec1(3))
181 pres = pres + fb2*(ex2dp(i)*vec1(1)+ey2dp(i)*vec1(2)+ez2dp(i)*vec1(3))
182C
183C-- dynamic friction
184 IF (slipring(slipring_id(i))%IFUNC(2) > 0) THEN
185 xx = pres / slipring(slipring_id(i))%FAC_D(2)
186 fricd = fricd + slipring(slipring_id(i))%FAC_D(3)*get_u_func(slipring(slipring_id(i))%IFUNC(2),xx,dxdy)
187 ENDIF
188C-- static friction
189 IF (slipring(slipring_id(i))%IFUNC(4) > 0) THEN
190 xx = pres / slipring(slipring_id(i))%FAC_S(2)
191 frics = frics + slipring(slipring_id(i))%FAC_S(3)*get_u_func(slipring(slipring_id(i))%IFUNC(4),xx,dxdy)
192 ENDIF
193C
194 IF (frics == zero) THEN
195 fric = fricd
196 ELSE
197 fric = fricd + (frics - fricd)*exp(-slipring(slipring_id(i))%DC*vrel)
198 ENDIF
199C
200C---- Effect of orientation angle --
201C
202 IF (slipring(slipring_id(i))%FRAM(fr_id(i))%ORIENTATION_NODE > 0) THEN
203 angle = slipring(slipring_id(i))%FRAM(fr_id(i))%ORIENTATION_ANGLE
204 fric = fric*(one + slipring(slipring_id(i))%A*angle*angle)
205 ENDIF
206C
207C----------------------------------------------------------------------------------
208C
209 dfs_old(i) = dfs(i)
210 ddfs = ddx*dt1*xk(i)/al0(i) + ddx2*dt1*xk2(i)/al02(i)
211C
212 cos_beta = exdp(i)*ex2dp(i)+eydp(i)*ey2dp(i)+ ezdp(i)*ez2dp(i)
213 cos_beta = sign(min(one,abs(cos_beta)),cos_beta)
214 beta = pi - acos(cos_beta)
215C
216 IF (dfs(i) == zero) THEN
217 hh = exp(beta*sign(fric,ddfs))
218 ELSE
219 hh = exp(beta*sign(fric,dfs(i)))
220 ENDIF
221C
222 flag = 0
223 omega = (hh*fb2-fb+xk(i)*eps1-hh*xk2(i)*eps2)/xk(i)
224 hh2 = hh*(xk2(i)/xk(i))
225 CALL solve_delta_l0(flag,delta_lo,hh2,aldp(i),aldp2(i),al0dp(i),al0dp2(i),lmin(i),omega)
226C
227 fb = fx(i) + xk(i)*(aldp(i)-al0dp(i)-delta_lo)/(al0dp(i)+delta_lo) - xk(i)*eps1
228C
229 IF (al0dp2(i) - delta_lo < lmin(i)) THEN
230 lmin(i) = max(lmin(i),al02(i))
231 flag = 1
232 CALL solve_delta_l0(flag,delta_lo,hh2,aldp(i),aldp2(i),al0dp(i),al0dp2(i),lmin(i),omega)
233 ddfs = ddx*dt1*xk(i)/al0dp(i) + ddx2*dt1*xk2(i)/lmin(i)
234 fb = fx(i) + xk(i)*(aldp(i)-al0dp(i)-delta_lo)/(al0dp(i)+delta_lo) - xk(i)*eps1
235 ELSEIF (al0dp(i) + delta_lo < lmin(i)) THEN
236 lmin(i) = max(lmin(i),al0(i))
237 flag = 2
238 CALL solve_delta_l0(flag,delta_lo,hh2,aldp(i),aldp2(i),al0dp(i),al0dp2(i),lmin(i),omega)
239 ddfs = ddx*dt1*xk(i)/lmin(i) + ddx2*dt1*xk2(i)/al0dp2(i)
240 fb = fx(i) + xk(i)*(aldp(i)-al0dp(i)-delta_lo)/lmin(i) - xk(i)*eps1
241 ENDIF
242C
243 dfs(i) = dfs(i) + ddfs
244 deltaf = fb*(one-one/max(em15,hh))
245C
246C Locking of slipring by sensor
247 flag_sensor_lock = 0
248 IF (slipring(slipring_id(i))%SENSID > 0) THEN
249 IF (tt > sensor_tab(slipring(slipring_id(i))%SENSID)%TSTART) flag_sensor_lock = 1
250 ENDIF
251C
252 IF ((abs(deltaf) >= abs(dfs(i))).OR.
253 . ((slipring(slipring_id(i))%FL_FLAG==1).AND.(delta_lo > 0)).OR.
254 . ((slipring(slipring_id(i))%FL_FLAG==2).AND.(delta_lo < 0)).OR.
255 . ((slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED==1).AND.(delta_lo > 0)).OR.
256 . ((slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED==2).AND.(delta_lo < 0)).OR.
257 . (flag_sensor_lock == 1)) THEN
258C-- adherence or 1 direction flow imposed by fl_flag or blocked because no more seatbelt
259 adher(i) = 1
260 delta_lo = 0
261 ELSE
262 dfs(i) = deltaf
263 ENDIF
264C
265C-- update of variables
266 al0dp(i) = al0dp(i) + delta_lo
267 al0dp2(i) = al0dp2(i) - delta_lo
268 al0(i) = al0dp(i)
269 al02(i) = al0dp2(i)
270C
271 epsn = (aldp(i)-al0dp(i))/max(al0(i),lmin(i))
272 ddf(i) = xk(i)*(epsn-eps1)
273 IF (adher(i) == 1) ddf(i) = ddf(i) + dfs(i) - dfs_old(i)
274 xl0(i) = max(al0(i),lmin(i))
275 xl02(i)= max(al02(i),lmin(i))
276 update_flag(i) = 0
277C
278 slipring(slipring_id(i))%FRAM(fr_id(i))%VECTOR(1) = exdp(i)*slipring(slipring_id(i))%FRAM(fr_id(i))%STRAND_DIRECTION(1)
279 slipring(slipring_id(i))%FRAM(fr_id(i))%VECTOR(2) = eydp(i)*slipring(slipring_id(i))%FRAM(fr_id(i))%STRAND_DIRECTION(1)
280 slipring(slipring_id(i))%FRAM(fr_id(i))%VECTOR(3) = ezdp(i)*slipring(slipring_id(i))%FRAM(fr_id(i))%STRAND_DIRECTION(1)
281C
282C-- TH variables stored only for strand1
283 ring_slip(i) = ring_slip(i) + delta_lo
284 slipring(slipring_id(i))%FRAM(fr_id(i))%RINGSLIP = slipring(slipring_id(i))%FRAM(fr_id(i))%RINGSLIP - delta_lo
285 slipring(slipring_id(i))%FRAM(fr_id(i))%MATERIAL_FLOW = delta_lo/dt11
286 slipring(slipring_id(i))%FRAM(fr_id(i))%BETA = beta
287 slipring(slipring_id(i))%FRAM(fr_id(i))%SLIP_FORCE(3) = pres
288C
289C-------- Detection of slipring update
290C
291 IF (slipring(slipring_id(i))%NFRAM > 1) THEN
292 fact = 6.0
293 ELSE
294 fact = 1.3
295 ENDIF
296C
297 IF (aldp(i) + fact*ddx*dt11 < zero) THEN
298 IF (nc1(i)==slipring(slipring_id(i))%FRAM(fr_id(i))%NODE(1)) THEN
299 IF (add_node1(i) > 0) THEN
300 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(1) = add_node1(i)
301 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(2) = nc1(i)
302 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(3) = nc2(i)
303 slipring(slipring_id(i))%FRAM(fr_id(i))%DFS = dfs(i)
304 slipring(slipring_id(i))%FRAM(fr_id(i))%UPDATE = 2
305 slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED = 0
306 ELSE
307 slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED = 2
308 ENDIF
309 ELSE
310 IF (add_node2(i) > 0) THEN
311 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(1) = add_node2(i)
312 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(2) = nc2(i)
313 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(3) = nc1(i)
314 slipring(slipring_id(i))%FRAM(fr_id(i))%DFS = dfs(i)
315 slipring(slipring_id(i))%FRAM(fr_id(i))%UPDATE = 2
316 slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED = 0
317 ELSE
318 slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED = 1
319 ENDIF
320 ENDIF
321 ENDIF
322C
323 ELSEIF (slipring_strand(i) == 2) THEN
324CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
325C SLIPRING - BRIN 2
326CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
327C
328C-------- computation of delta_lo
329C
330 fric = slipring(slipring_id(i))%FRIC
331C
332 ddx = exdp(i) * (vx1(i) - vx2(i))
333 . + eydp(i) * (vy1(i) - vy2(i))
334 . + ezdp(i) * (vz1(i) - vz2(i))
335
336 IF (slipring(slipring_id(i))%FRAM(fr_id(i))%STRAND_DIRECTION(2) == 1) THEN
337 ddx2 = ex2dp(i)* (vx3(i) - vx1(i))
338 . + ey2dp(i)* (vy3(i) - vy1(i))
339 . + ez2dp(i)* (vz3(i) - vz1(i))
340 ELSE
341 ddx2 = ex2dp(i)* (vx2(i) - vx3(i))
342 . + ey2dp(i)* (vy2(i) - vy3(i))
343 . + ez2dp(i)* (vz2(i) - vz3(i))
344 ENDIF
345
346C Computation of friction coefficient
347C
348C---- Effect of material flow --
349 vrel = abs(slipring(slipring_id(i))%FRAM(fr_id(i))%MATERIAL_FLOW_OLD)
350C-- dynamic friction
351 IF (slipring(slipring_id(i))%IFUNC(1) == 0) THEN
352 fricd = slipring(slipring_id(i))%FRIC
353 ELSE
354 fricd = slipring(slipring_id(i))%FRIC
355 xx = tt / slipring(slipring_id(i))%FAC_D(1)
356 fricd = fricd*get_u_func(slipring(slipring_id(i))%IFUNC(1),xx,dxdy)
357 ENDIF
358C-- static friction
359 IF (slipring(slipring_id(i))%IFUNC(3) == 0) THEN
360 frics = slipring(slipring_id(i))%FRICS
361 ELSE
362 frics = slipring(slipring_id(i))%FRICS
363 xx = tt / slipring(slipring_id(i))%FAC_S(1)
364 frics = frics*get_u_func(slipring(slipring_id(i))%IFUNC(3),xx,dxdy)
365 ENDIF
366C
367C---- Effect of normal force--
368C
369C-- bisectrice computation
370 vec1(1) = exdp(i) + ex2dp(i)
371 vec1(2) = eydp(i) + ey2dp(i)
372 vec1(3) = ezdp(i) + ez2dp(i)
373 norm = max(em20,vec1(1)*vec1(1)+vec1(2)*vec1(2)+vec1(3)*vec1(3))
374 norm = sqrt(norm)
375 vec1(1) = vec1(1)/norm
376 vec1(2) = vec1(2)/norm
377 vec1(3) = vec1(3)/norm
378C
379 eps1 = (aldp(i)-al0dp(i))/max(lmin(i),al0(i))
380 eps2 = (aldp2(i)-al0dp2(i))/max(lmin(i),al02(i))
381C
382 fb = fx(i)
383 fb2 = fx2(i)
384 pres = fb*(exdp(i)*vec1(1)+eydp(i)*vec1(2)+ezdp(i)*vec1(3))
385 pres = pres + fb2*(ex2dp(i)*vec1(1)+ey2dp(i)*vec1(2)+ez2dp(i)*vec1(3))
386C
387C-- dynamic friction
388 IF (slipring(slipring_id(i))%IFUNC(2) > 0) THEN
389 xx = pres / slipring(slipring_id(i))%FAC_D(2)
390 fricd = fricd+slipring(slipring_id(i))%FAC_D(3)*get_u_func(slipring(slipring_id(i))%IFUNC(2),xx,dxdy)
391 ENDIF
392C-- static friction
393 IF (slipring(slipring_id(i))%IFUNC(4) > 0) THEN
394 xx = pres / slipring(slipring_id(i))%FAC_S(2)
395 frics = frics+slipring(slipring_id(i))%FAC_S(3)*get_u_func(slipring(slipring_id(i))%IFUNC(4),xx,dxdy)
396 ENDIF
397C
398 IF (frics == zero) THEN
399 fric = fricd
400 ELSE
401 fric = fricd + (frics - fricd)*exp(-slipring(slipring_id(i))%DC*vrel)
402 ENDIF
403C
404C---- Effect of orientation angle --
405C
406 IF (slipring(slipring_id(i))%FRAM(fr_id(i))%ORIENTATION_NODE > 0) THEN
407 angle = slipring(slipring_id(i))%FRAM(fr_id(i))%ORIENTATION_ANGLE
408 fric = fric*(one + slipring(slipring_id(i))%A*angle*angle)
409 ENDIF
410C
411C----------------------------------------------------------------------------------
412C
413 dfs_old(i) = dfs(i)
414 ddfs = ddx*dt1*xk(i)/al0(i) + ddx2*dt1*xk2(i)/al02(i)
415C
416 cos_beta = exdp(i)*ex2dp(i)+eydp(i)*ey2dp(i)+ ezdp(i)*ez2dp(i)
417 cos_beta = sign(min(one,abs(cos_beta)),cos_beta)
418 beta = pi - acos(cos_beta)
419C
420 IF (dfs(i) == zero) THEN
421 hh = exp(beta*sign(fric,ddfs))
422 ELSE
423 hh = exp(beta*sign(fric,dfs(i)))
424 ENDIF
425C
426 flag = 0
427 omega = (hh*fb-fb2+xk2(i)*eps2-hh*xk(i)*eps1)/xk2(i)
428 hh2 = hh*(xk(i)/xk2(i))
429 CALL solve_delta_l0(flag,delta_lo,hh2,aldp2(i),aldp(i),al0dp2(i),al0dp(i),lmin(i),omega)
430C
431 fb = fx(i) + xk(i)*(aldp(i)-al0dp(i)+delta_lo)/(al0dp(i)-delta_lo) - xk(i)*eps1
432C
433 IF (al0dp(i) - delta_lo < lmin(i)) THEN
434 lmin(i) = max(lmin(i),al0(i))
435 flag = 1
436 CALL solve_delta_l0(flag,delta_lo,hh2,aldp2(i),aldp(i),al0dp2(i),al0dp(i),lmin(i),omega)
437 ddfs = ddx*dt1*xk(i)/lmin(i) + ddx2*dt1*xk2(i)/al0dp2(i)
438 fb = fx(i) + xk(i)*(aldp(i)-al0dp(i)+delta_lo)/lmin(i) - xk(i)*eps1
439 ELSEIF (al0dp2(i) + delta_lo < lmin(i)) THEN
440 lmin(i) = max(lmin(i),al02(i))
441 flag = 2
442 CALL solve_delta_l0(flag,delta_lo,hh2,aldp2(i),aldp(i),al0dp2(i),al0dp(i),lmin(i),omega)
443 ddfs = ddx*dt1*xk(i)/al0(i) + ddx2*dt1*xk2(i)/lmin(i)
444 fb = fx(i) + xk(i)*(aldp(i)-al0dp(i)+delta_lo)/(al0dp(i)-delta_lo) - xk(i)*eps1
445 ENDIF
446C
447 dfs(i) = dfs(i) + ddfs
448 deltaf = fb*(hh-one)
449C
450C Locking of slipring by sensor
451 flag_sensor_lock = 0
452 IF (slipring(slipring_id(i))%SENSID > 0) THEN
453 IF (tt > sensor_tab(slipring(slipring_id(i))%SENSID)%TSTART) flag_sensor_lock = 1
454 ENDIF
455C
456 IF ((abs(deltaf) >= abs(dfs(i))).OR.
457 . ((slipring(slipring_id(i))%FL_FLAG==1).AND.(delta_lo > 0)).OR.
458 . ((slipring(slipring_id(i))%FL_FLAG==2).AND.(delta_lo < 0)).OR.
459 . ((slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED==1).AND.(delta_lo > 0)).OR.
460 . ((slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED==2).AND.(delta_lo < 0)).OR.
461 . (flag_sensor_lock ==1)) THEN
462C-- adherence or 1 direction flow imposed by fl_flag or blocked because no more seatbelt
463 adher(i) = 1
464 delta_lo = 0
465 ELSE
466 dfs(i) = deltaf
467 ENDIF
468C
469 al0dp2(i) = al0dp2(i) + delta_lo
470 al0dp(i) = al0dp(i) - delta_lo
471 al02(i) = al0dp2(i)
472 al0(i) = al0dp(i)
473C
474 epsn = (aldp(i)-al0dp(i))/max(al0(i),lmin(i))
475 ddf(i) = xk(i)*(epsn-eps1)
476 IF (adher(i) == 1) ddf(i) = ddf(i) - dfs(i) + dfs_old(i)
477 xl0(i) = max(al0(i),lmin(i))
478 xl02(i)= max(al02(i),lmin(i))
479 update_flag(i) = 0
480C
481 ring_slip(i) = 0
482 slipring(slipring_id(i))%FRAM(fr_id(i))%VECTOR(4) = exdp(i)*slipring(slipring_id(i))%FRAM(fr_id(i))%STRAND_DIRECTION(2)
483 slipring(slipring_id(i))%FRAM(fr_id(i))%VECTOR(5) = eydp(i)*slipring(slipring_id(i))%FRAM(fr_id(i))%STRAND_DIRECTION(2)
484 slipring(slipring_id(i))%FRAM(fr_id(i))%VECTOR(6) = ezdp(i)*slipring(slipring_id(i))%FRAM(fr_id(i))%STRAND_DIRECTION(2)
485C
486C-------- Detection of slipring update
487C
488 IF (slipring(slipring_id(i))%NFRAM > 1) THEN
489 fact = 6.0
490 ELSE
491 fact = 1.3
492 ENDIF
493C
494 IF (aldp(i) - fact*ddx*dt1 < zero) THEN
495 IF (nc1(i)==slipring(slipring_id(i))%FRAM(fr_id(i))%NODE(2)) THEN
496 IF (add_node2(i) > 0) THEN
497 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(1) = nc1(i)
498 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(2) = nc2(i)
499 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(3) = add_node2(i)
500 slipring(slipring_id(i))%FRAM(fr_id(i))%DFS = dfs(i)
501 slipring(slipring_id(i))%FRAM(fr_id(i))%UPDATE = -2
502 slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED = 0
503 ELSE
504 slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED = 1
505 ENDIF
506 ELSE
507 IF (add_node1(i) > 0) THEN
508 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(1) = nc2(i)
509 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(2) = nc1(i)
510 slipring(slipring_id(i))%FRAM(fr_id(i))%NODE_NEXT(3) = add_node1(i)
511 slipring(slipring_id(i))%FRAM(fr_id(i))%DFS = dfs(i)
512 slipring(slipring_id(i))%FRAM(fr_id(i))%UPDATE = -2
513 slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED = 0
514 ELSE
515 slipring(slipring_id(i))%FRAM(fr_id(i))%LOCKED = 2
516 ENDIF
517 ENDIF
518 ENDIF
519C
520 ELSEIF (slipring_strand(i) == -1) THEN
521CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
522C RETRACTOR
523CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
524C
525 eps1 = (aldp(i)-al0dp(i))/max(em20,max(al0(i),lmin(i)))
526 fb = fx(i)
527 f_lock = fb
528 f_unlock = retractor(retractor_id(i))%UNLOCK_FORCE
529C
530C--------------------Pretensionning -------------------------------------
531 IF ((retractor(retractor_id(i))%ISENS(2) > 0).AND.
532 . (retractor(retractor_id(i))%PRETENS_ACTIV == 0)) THEN
533 IF (tt > sensor_tab(retractor(retractor_id(i))%ISENS(2))%TSTART) THEN
534 retractor(retractor_id(i))%PRETENS_ACTIV = 1
535 retractor(retractor_id(i))%PRETENS_TIME = tt
536 ENDIF
537 ENDIF
538C
539 force_tens_typ = 0
540 pretens = zero
541 IF (retractor(retractor_id(i))%PRETENS_ACTIV == 1) THEN
542 xx = (tt - retractor(retractor_id(i))%PRETENS_TIME) / retractor(retractor_id(i))%FAC(4)
543 pretens = retractor(retractor_id(i))%FAC(3)*get_u_func(retractor(retractor_id(i))%IFUNC(3),xx,dxdy)
544 IF (retractor(retractor_id(i))%TENS_TYP == 1) THEN
545C-- Pretensioning with pullin
546 IF (retractor(retractor_id(i))%FORCE > zero) THEN
547C-- Pretensioning deactivated when force is reached
548 IF (f_lock > retractor(retractor_id(i))%FORCE) THEN
549 retractor(retractor_id(i))%LOCKED = 1
550 yy = f_lock/retractor(retractor_id(i))%FAC(1)
551 CALL retractor_table_inv(retractor(retractor_id(i))%TABLE(1),xx,yy)
552 xx = xx*retractor(retractor_id(i))%FAC(2)
553 retractor(retractor_id(i))%LOCK_PULL = retractor(retractor_id(i))%FAC(2)*xx
554 retractor(retractor_id(i))%PRETENS_ACTIV = -1
555 retractor(retractor_id(i))%PRETENS_PULL = zero
556 ENDIF
557 ENDIF
558 ELSEIF (retractor(retractor_id(i))%TENS_TYP == 2) THEN
559C-- Pretensioning with force -> F = F_retractor + F_pretens
560 force_tens_typ = 2
561 f_unlock = max(retractor(retractor_id(i))%UNLOCK_FORCE,pretens)
562 ELSEIF (retractor(retractor_id(i))%TENS_TYP == 3) THEN
563C-- Pretensioning with force -> F = MAX(F_retractor,F_pretens) - same as type2 with locking
564 force_tens_typ = 2
565 IF (retractor(retractor_id(i))%PRETENS_PULL > retractor(retractor_id(i))%PULLOUT) THEN
566C-- Pretensioning deactivated when pullout is reached
567 retractor(retractor_id(i))%LOCKED = 1
568 yy = f_lock/retractor(retractor_id(i))%FAC(1)
569 CALL retractor_table_inv(retractor(retractor_id(i))%TABLE(1),xx,yy)
570 xx = xx*retractor(retractor_id(i))%FAC(2)
571 retractor(retractor_id(i))%LOCK_PULL = retractor(retractor_id(i))%FAC(2)*xx
572 retractor(retractor_id(i))%PRETENS_ACTIV = -1
573 retractor(retractor_id(i))%PRETENS_PULL = zero
574 ENDIF
575 f_unlock = max(retractor(retractor_id(i))%UNLOCK_FORCE,pretens)
576 ELSEIF (retractor(retractor_id(i))%TENS_TYP == 4) THEN
577C-- Pretensioning with force -> F = F_retractor + F_pretens
578 force_tens_typ = 4
579 IF (retractor(retractor_id(i))%LOCKED == 1) f_lock = f_lock - pretens
580 f_unlock = retractor(retractor_id(i))%UNLOCK_FORCE + pretens
581 ELSEIF (retractor(retractor_id(i))%TENS_TYP == 5) THEN
582C-- Pretensioning with pullin energy
583 IF (retractor(retractor_id(i))%FORCE > zero) THEN
584C-- Pretensioning deactivated when force is reached
585 IF (f_lock > retractor(retractor_id(i))%FORCE) THEN
586 retractor(retractor_id(i))%LOCKED = 1
587 yy = f_lock/retractor(retractor_id(i))%FAC(1)
588 CALL retractor_table_inv(retractor(retractor_id(i))%TABLE(1),xx,yy)
589 xx = xx*retractor(retractor_id(i))%FAC(2)
590 retractor(retractor_id(i))%LOCK_PULL = xx
591 retractor(retractor_id(i))%PRETENS_ACTIV = -1
592 retractor(retractor_id(i))%PRETENS_PULL = zero
593 ENDIF
594 ENDIF
595 ENDIF
596 ENDIF
597C
598C--------------------Retractor is Locked ---------------------------------
599 flag_no_count_pull = 0
600 IF (retractor(retractor_id(i))%LOCKED == 1) THEN
601C-- Loading --
602 IF ((f_lock <= retractor(retractor_id(i))%UNLOCK_FORCE).AND.
603 . (retractor(retractor_id(i))%LOCKED_FREEZE == 0)) THEN
604 retractor(retractor_id(i))%LOCKED_FREEZE = 1
605 retractor(retractor_id(i))%LOCK_PULL_SAV = retractor(retractor_id(i))%RINGSLIP
606 ELSEIF ((retractor(retractor_id(i))%LOCKED_FREEZE == 1).AND.
607 . (retractor(retractor_id(i))%RINGSLIP > retractor(retractor_id(i))%LOCK_PULL_SAV)) THEN
608 retractor(retractor_id(i))%LOCKED_FREEZE = 0
609 retractor(retractor_id(i))%LOCK_PULL_SAV = zero
610 ENDIF
611 IF (retractor(retractor_id(i))%LOCKED_FREEZE == 1) THEN
612 flag_no_count_pull = 1
613 ELSEIF (f_lock > retractor(retractor_id(i))%LOCK_YIELD_FORCE) THEN
614C-- Loading --
615 xx = retractor(retractor_id(i))%LOCK_PULL/retractor(retractor_id(i))%FAC(2)
616 CALL table_interp_dydx(retractor(retractor_id(i))%TABLE(1),xx,1,yy,dxdy)
617 yy = yy*retractor(retractor_id(i))%FAC(1)
618 dxdy = dxdy * (retractor(retractor_id(i))%FAC(2) / retractor(retractor_id(i))%FAC(1))
619 IF ((force_tens_typ == 2).AND.(pretens > yy)) THEN
620 yy = pretens
621 dxdy = zero
622 ELSEIF (force_tens_typ == 4) THEN
623 yy = yy + pretens
624 ENDIF
625 CALL solve_delta_l02(delta_lo,dxdy,yy,xk(i),aldp(i),al0dp(i),lmin(i),fb)
626 epsn = (aldp(i)-al0dp(i)-delta_lo)/max(lmin(i),al0dp(i)+delta_lo)
627 fb = fx(i) + xk(i)*(epsn-eps1)
628 retractor(retractor_id(i))%LOCK_YIELD_FORCE = fb
629 retractor(retractor_id(i))%LOCK_OFFSET = zero
630 ELSE
631C-- Unloading --
632 IF (retractor(retractor_id(i))%LOCK_OFFSET == zero) THEN
633 yy = retractor(retractor_id(i))%LOCK_YIELD_FORCE/retractor(retractor_id(i))%FAC(1)
634 CALL retractor_table_inv2(retractor(retractor_id(i))%TABLE(1),xx1,yy,retractor(retractor_id(i))%LOCK_PULL)
635 CALL retractor_table_inv(retractor(retractor_id(i))%TABLE(2),xx2,yy)
636 retractor(retractor_id(i))%LOCK_OFFSET = retractor(retractor_id(i))%FAC(2)*(xx1-xx2)
637 ENDIF
638 xx = (retractor(retractor_id(i))%LOCK_PULL-retractor(retractor_id(i))%LOCK_OFFSET)/retractor(retractor_id(i))%FAC(2)
639 CALL table_interp_dydx(retractor(retractor_id(i))%TABLE(2),xx,1,yy,dxdy)
640 yy = yy*retractor(retractor_id(i))%FAC(1)
641 dxdy = dxdy * (retractor(retractor_id(i))%FAC(2) / retractor(retractor_id(i))%FAC(1))
642 IF ((force_tens_typ == 2).AND.(pretens > yy)) THEN
643 yy = pretens
644 dxdy = zero
645 ELSEIF (force_tens_typ == 4) THEN
646 yy = yy + pretens
647 ENDIF
648 CALL solve_delta_l02(delta_lo,dxdy,yy,xk(i),aldp(i),al0dp(i),lmin(i),fb)
649 epsn = (aldp(i)-al0dp(i)-delta_lo)/max(lmin(i),al0dp(i)+delta_lo)
650 fb = fx(i) + xk(i)*(epsn-eps1)
651 ENDIF
652 ENDIF
653C
654C--------------------Retractor is Unlocked ---------------------------------
655 IF ((retractor(retractor_id(i))%LOCKED == 0).OR.
656 . (retractor(retractor_id(i))%LOCKED_FREEZE == 1)) THEN
657C
658 tens = (f_unlock - fb) / xk(i) + eps1
659 delta_lo = (aldp(i)-al0dp(i)*(tens + one))/(tens + one)
660C
661 IF (al0dp(i) + delta_lo < lmin(i)) THEN
662 lmin(i) = max(lmin(i),al0(i))
663 delta_lo = aldp(i)-al0dp(i)-xl0(i)*tens
664 ENDIF
665C
666 ENDIF
667C
668C--------------------Pretensionning - imposed pullin with load limiter-----
669 IF (retractor(retractor_id(i))%PRETENS_ACTIV == 1) THEN
670 IF (retractor(retractor_id(i))%TENS_TYP == 1) THEN
671 IF (retractor(retractor_id(i))%FORCE > zero) THEN
672 delta_lo = -pretens + retractor(retractor_id(i))%PRETENS_PULL
673 retractor(retractor_id(i))%PRETENS_PULL = pretens
674 ENDIF
675 ELSEIF (retractor(retractor_id(i))%TENS_TYP == 5) THEN
676 IF (retractor(retractor_id(i))%FORCE > zero) THEN
677 delta_lo = (-pretens + retractor(retractor_id(i))%PRETENS_PULL)/fb
678 retractor(retractor_id(i))%PRETENS_PULL = pretens
679 ENDIF
680 ENDIF
681 ENDIF
682C
683C--------------------Limitation of flow rate ---------------------------------
684C-
685 IF (delta_lo > zero) THEN
686 delta_lo = min(delta_lo,0.01*retractor(retractor_id(i))%ELEMENT_SIZE)
687 ELSEIF (delta_lo < zero) THEN
688 delta_lo = max(delta_lo,-0.01*retractor(retractor_id(i))%ELEMENT_SIZE)
689 ENDIF
690C
691C--------------------Detection of locking -----------------------------------
692C--
693 flag_sensor_lock = 0
694 IF (retractor(retractor_id(i))%ISENS(1) > 0) THEN
695 IF (tt > sensor_tab(retractor(retractor_id(i))%ISENS(1))%TSTART) THEN
696C-- lock sensor activated
697 flag_sensor_lock = 1
698 IF (retractor(retractor_id(i))%LOCKED == 0) THEN
699 IF (retractor(retractor_id(i))%LOCK_PULL >= retractor(retractor_id(i))%PULLOUT) THEN
700 retractor(retractor_id(i))%LOCKED = 1
701C-- rest of lockpull - counted from time of locking
702 retractor(retractor_id(i))%LOCK_PULL = zero
703 ENDIF
704 ENDIF
705 ENDIF
706 ENDIF
707C
708 IF (flag_no_count_pull == 0) THEN
709 IF ((retractor(retractor_id(i))%LOCKED == 0).AND.(flag_sensor_lock == 1)) THEN
710C-- Pullin after sensor activation and before locking not counted -> Lock_pull > 0
711 retractor(retractor_id(i))%LOCK_PULL = max(zero,retractor(retractor_id(i))%LOCK_PULL + delta_lo)
712 ELSEIF ((retractor(retractor_id(i))%LOCKED == 1).OR.(flag_sensor_lock == 1)) THEN
713 retractor(retractor_id(i))%LOCK_PULL = retractor(retractor_id(i))%LOCK_PULL + delta_lo
714 ELSE
715 retractor(retractor_id(i))%LOCK_PULL = zero
716 ENDIF
717 ENDIF
718C
719C--------------------Pretensionning - count of pretens pull-----
720 IF (retractor(retractor_id(i))%PRETENS_ACTIV == 1) THEN
721 IF (retractor(retractor_id(i))%TENS_TYP == 3) THEN
722 retractor(retractor_id(i))%PRETENS_PULL = retractor(retractor_id(i))%PRETENS_PULL + delta_lo
723 ENDIF
724 ENDIF
725C
726C--------------------------------------------------------------
727C
728 IF (abs(delta_lo) > zero) THEN
729C
730 ddx = exdp(i) * (vx2(i) - vx1(i))
731 . + eydp(i) * (vy2(i) - vy1(i))
732 . + ezdp(i) * (vz2(i) - vz1(i))
733
734C--- if XSCAL < 0.9 N2 has crossed AC -> update of retractor
735 xscal = -exdp(i)*retractor(retractor_id(i))%VECTOR(1)*retractor(retractor_id(i))%STRAND_DIRECTION
736 . -eydp(i)*retractor(retractor_id(i))%VECTOR(2)*retractor(retractor_id(i))%STRAND_DIRECTION
737 . -ezdp(i)*retractor(retractor_id(i))%VECTOR(3)*retractor(retractor_id(i))%STRAND_DIRECTION
738C
739 retractor(retractor_id(i))%VECTOR(1) = -exdp(i)*retractor(retractor_id(i))%STRAND_DIRECTION
740 retractor(retractor_id(i))%VECTOR(2) = -eydp(i)*retractor(retractor_id(i))%STRAND_DIRECTION
741 retractor(retractor_id(i))%VECTOR(3) = -ezdp(i)*retractor(retractor_id(i))%STRAND_DIRECTION
742C
743C-------- Detection of retractor update---------------------------------
744C
745 IF (retractor(retractor_id(i))%STRAND_DIRECTION == 1) THEN
746 new_node2 = add_node2(i)
747 new_node1 = add_node1(i)
748 ELSE
749 new_node2 = add_node1(i)
750 new_node1 = add_node2(i)
751 ENDIF
752C
753 IF (update_flag(i) == 0) THEN
754 IF ((ring_slip(i)+delta_lo>retractor(retractor_id(i))%ELEMENT_SIZE).AND.(new_node2 > 0)) THEN
755C-- new element to be released - (if no next node its the end of the belt - no switch)
756 retractor(retractor_id(i))%UPDATE = 2
757 retractor(retractor_id(i))%MATERIAL_FLOW = delta_lo/dt11
758 IF (retractor(retractor_id(i))%STRAND_DIRECTION == 1) THEN
759 retractor(retractor_id(i))%NODE_NEXT(1) = nc2(i)
760 retractor(retractor_id(i))%NODE_NEXT(2) = add_node2(i)
761 ELSE
762 retractor(retractor_id(i))%NODE_NEXT(1) = nc1(i)
763 retractor(retractor_id(i))%NODE_NEXT(2) = add_node1(i)
764 ENDIF
765 ELSEIF ((aldp(i) + 1.3*ddx*dt1 < zero).OR.(xscal < 0.5)) THEN
766 IF (new_node1 > 0) THEN
767C-- element to enter the retractor
768 retractor(retractor_id(i))%UPDATE = -2
769 retractor(retractor_id(i))%MATERIAL_FLOW = delta_lo/dt11
770 IF (retractor(retractor_id(i))%STRAND_DIRECTION == 1) THEN
771 retractor(retractor_id(i))%NODE_NEXT(1) = add_node1(i)
772 retractor(retractor_id(i))%NODE_NEXT(2) = nc1(i)
773 ELSE
774 retractor(retractor_id(i))%NODE_NEXT(1) = add_node2(i)
775 retractor(retractor_id(i))%NODE_NEXT(2) = nc2(i)
776 ENDIF
777 ELSE
778C-- End of the belt - no more length to pullin
779 delta_lo = zero
780 ENDIF
781 ENDIF
782 ENDIF
783C
784 al0dp(i) = al0dp(i) + delta_lo
785 al0(i) = al0dp(i)
786 xl0(i)=max(lmin(i),al0(i))
787C
788 epsn = (aldp(i)-al0dp(i))/max(al0(i),lmin(i))
789 ddf(i) = xk(i)*(epsn-eps1)
790 ring_slip(i) =ring_slip(i) + delta_lo
791 retractor(retractor_id(i))%RINGSLIP = retractor(retractor_id(i))%RINGSLIP + delta_lo
792C
793 ENDIF
794C
795 ENDIF
796C
797 ENDIF
798C
799 ENDDO
800
801C----------------------------------------------------------
802C
803
804C----------------------------------------------------------
805C
806 RETURN
807
808 END
809
810!||====================================================================
811!|| solve_delta_l0 ../engine/source/tools/seatbelts/material_flow.F
812!||--- called by ------------------------------------------------------
813!|| material_flow ../engine/source/tools/seatbelts/material_flow.F
814!||====================================================================
815 SUBROUTINE solve_delta_l0(FLAG,DELTA_LO,HH,L1,L2,L01,L02,LMIN,OMEGA)
816C-----------------------------------------------
817C I m p l i c i t T y p e s
818C-----------------------------------------------
819#include "implicit_f.inc"
820#include "comlock.inc"
821C-----------------------------------------------
822C D u m m y A r g u m e n t s
823C-----------------------------------------------
824 INTEGER FLAG
825 my_real
826 . hh,lmin,omega
827 DOUBLE PRECISION DELTA_LO,L1,L2,L01,L02
828C-----------------------------------------------
829C L o c a l V a r i a b l e s
830C-----------------------------------------------
831 my_real
832 . AA,BB,CC,DD,SOL1,SOL2
833C-----------------------------------------------
834C
835C Computation of Dl0 for the slipring
836C
837C DELTA_LO = -(HH*(ALDP2(I)-AL0DP2(I))*AL0DP(I)-(ALDP(I)-AL0DP(I))*AL0DP2(I))
838C . /(HH*(ALDP2(I)-AL0DP2(I)+AL0DP(I))+ALDP(I)-AL0DP(I)+AL0DP2(I))
839C
840 IF ((hh == one).AND.(flag == 0)) THEN
841C-- equation 1 -> no friction and l2 > lmin - order 1
842 bb = -l1+l01-l02-hh*(l2-l02+l01) + omega*(l01-l02)
843 cc = (l1-l01)*l02-hh*(l2-l02)*l01 - omega*(l02*l01)
844 delta_lo = -cc/bb
845 ELSEIF (flag == 0) THEN
846C-- equation 2 -> friction and l2 and l1 > lmin - order 2
847 aa = one -hh + omega
848 bb = -l1+l01-l02-hh*(l2-l02+l01) + omega*(l01-l02)
849 cc = (l1-l01)*l02-hh*(l2-l02)*l01 - omega*(l02*l01)
850 dd = bb*bb-4*aa*cc
851 sol1 = (-bb+sqrt(dd))/(2*aa)
852 sol2 = (-bb-sqrt(dd))/(2*aa)
853 delta_lo = sol2
854 ELSEIF (flag == 1) THEN
855C-- equation 3 -> friction and l2 = lmin - order 2
856 aa = -hh
857 bb = -lmin -hh*(l2-l02+l01) - omega*lmin
858 cc = (l1-l01)*lmin-hh*(l2-l02)*l01 - omega*lmin*l01
859 dd = bb*bb-4*aa*cc
860 sol1 = (-bb+sqrt(dd))/(2*aa)
861 sol2 = (-bb-sqrt(dd))/(2*aa)
862 delta_lo = sol2
863 ELSEIF (flag == 2) THEN
864C-- equation 4 -> friction and l1 = lmin - order 2
865 aa = one
866 bb = l01-l02-l1-hh*lmin + omega*lmin
867 cc = l1*l02-l01*l02-hh*lmin*(l2-l02) - omega*lmin*l02
868 dd = bb*bb-4*aa*cc
869 sol1 = (-bb+sqrt(dd))/(2*aa)
870 sol2 = (-bb-sqrt(dd))/(2*aa)
871 delta_lo = sol2
872 ENDIF
873
874 RETURN
875 END
876
877!||====================================================================
878!|| solve_delta_l02 ../engine/source/tools/seatbelts/material_flow.F
879!||--- called by ------------------------------------------------------
880!|| material_flow ../engine/source/tools/seatbelts/material_flow.F
881!||====================================================================
882 SUBROUTINE solve_delta_l02(DELTA_LO,ALPHA,BETA,XK,L,L0,LMIN,FB)
883C-----------------------------------------------
884C I m p l i c i t T y p e s
885C-----------------------------------------------
886#include "implicit_f.inc"
887#include "comlock.inc"
888C-----------------------------------------------
889C D u m m y A r g u m e n t s
890C-----------------------------------------------
891 my_real alpha,beta,xk,lmin,fb
892 DOUBLE PRECISION DELTA_LO,L,L0
893C-----------------------------------------------
894C L o c a l V a r i a b l e s
895C-----------------------------------------------
896 DOUBLE PRECISION DD,SOL1,SOL2,AA,BB,CC,EE
897C-----------------------------------------------
898C
899C Computation of Dl0 for locked retractor
900C
901C-Equation 1 -> L0> LMIN
902 IF (l0 > em05) THEN
903 aa = alpha
904 bb = alpha*l0+beta+xk*l/l0-fb
905 cc = beta*l0-fb*l0
906 IF (abs(aa) > em20) THEN
907 dd = max(em20,bb*bb-4*aa*cc)
908 sol1 = (-bb+sqrt(dd))/(2*aa)
909 sol2 = (-bb-sqrt(dd))/(2*aa)
910 delta_lo = sol1
911 ELSE
912 ee = sign(max(em20,abs(bb)),bb)
913 delta_lo = -cc / ee
914 ENDIF
915 ELSE
916C-- computation will be done by equation 2
917 delta_lo = zero
918 ENDIF
919C
920 IF (l0 + delta_lo < lmin) THEN
921C-Equation 2 -> L0 <LMIN
922 beta = beta -fb + xk*(l-l0)/max(lmin,l0)
923 lmin = max(lmin,l0)
924 bb = alpha*lmin + xk
925 ee = sign(max(em20,abs(bb)),bb)
926 delta_lo = (xk*(l-l0) - beta*lmin)/ee
927 ENDIF
928
929 RETURN
930 END
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
table_interp_dydx
subroutine table_interp_dydx(table, xx, xxdim, yy, dydx)
Definition table_tools.F:419
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
solve_delta_l02
subroutine solve_delta_l02(delta_lo, alpha, beta, xk, l, l0, lmin, fb)
Definition material_flow.F:883
material_flow
subroutine material_flow(dfs, dfs_old, aldp, slipring_strand, xk, off, al0, al02, lmin, update_flag, ring_slip, slipring_id, xl0, dl, dlold, exdp, eydp, ezdp, x1dp, x2dp, x3dp, adher, nc1, nc2, nc3, flag_slipring_update, add_node1, add_node2, vx1, vy1, vz1, vx2, vy2, vz2, vx3, vy3, vz3, xc, retractor_id, flag_retractor_update, sensor_tab, al0dp, fr_id, ddf, fx, fx2, aldp2, al0dp2, ex2dp, ey2dp, ez2dp, xl02, xk2, compt, index2, nsensor)
Definition material_flow.F:52
solve_delta_l0
subroutine solve_delta_l0(flag, delta_lo, hh, l1, l2, l01, l02, lmin, omega)
Definition material_flow.F:816
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::retractor
type(retractor_struct), dimension(:), allocatable retractor
Definition seatbelt_mod.F:155
seatbelt_mod::slipring
type(slipring_struct), dimension(:), allocatable slipring
Definition seatbelt_mod.F:110
r23l114def3
subroutine r23l114def3(python, skew, ipm, igeo, mid, pid, geo, uparam, fx, fy, fz, e, dx, dy, dz, npf, tf, off, dpx, dpy, dpz, dpx2, dpy2, dpz2, fxep, fyep, fzep, x0, y0, z0, xmom, ymom, zmom, rx, ry, rz, rpx, rpy, rpz, xmep, ymep, zmep, rpx2, rpy2, rpz2, anim, posx, posy, posz, posxx, posyy, poszz, fr_wave, e6, nel, exx2, eyx2, ezx2, exy2, eyy2, ezy2, exz2, eyz2, ezz2, al2dp, ngl, crit_new, x0_err, aldp, yieldx, yieldy, yieldz, yieldx2, yieldy2, yieldz2, exx, eyx, ezx, exy, eyy, ezy, exz, eyz, ezz, xcr, rx1, ry1, rz1, rx2, ry2, rz2, xin, ak, xm, xkm, xcm, xkr, vx1, vx2, vy1, vy2, vz1, vz2, nuvar, uvar, mass, dx0, dy0, dz0, rx0, ry0, rz0, slipring_strand, dfs, ring_slip, x02, lmin, slipring_id, update_flag, retractor_id, add_node1, add_node2, nc1, nc2, nc3, x1dp, x2dp, x3dp, vx3, vy3, vz3, flag_slipring_update, flag_retractor_update, sensor_tab, uiner, fr_id, fram_factor, eps_old, fx_b2, dpx_b2, yieldx_b2, xx_old_b2, fxep_b2, posx_b2, eps_old_b2, nft, nsensor, stf, sanin, iresp, snpc)
Definition r23l114def3.F:78