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,NODE1,NODE2,NODE3,ANCHOR_NODE,FUNC,ISENS,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,ddv,dt11,fb,f1,f2,df
97 my_real tens,xscal,norm,pres,vrel,alpha,alpha2,vec1(3),vec2(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
alpha2
#define alpha2
Definition eval.h:48
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