OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_retractor.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!|| hm_read_retractor ../starter/source/tools/seatbelts/hm_read_retractor.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| arret ../starter/source/system/arret.F
30!|| fretitl ../starter/source/starter/freform.F
31!|| get_u_func ../starter/source/user_interface/uaccess.F
32!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
33!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
34!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
35!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
36!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
37!|| nintri ../starter/source/system/nintrr.F
38!|| udouble ../starter/source/system/sysfus.F
39!|| usr2sys ../starter/source/system/sysfus.F
40!||--- uses -----------------------------------------------------
41!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
42!|| message_mod ../starter/share/message_module/message_mod.F
43!|| submodel_mod ../starter/share/modules1/submodel_mod.F
44!||====================================================================
45 SUBROUTINE hm_read_retractor(LSUBMODEL,ITABM1,IXR,ITAB,UNITAB,
46 . X,FUNC_ID,NOM_OPT,ALEA,IPM)
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE my_alloc_mod
51 USE message_mod
52 USE unitab_mod
53 USE seatbelt_mod
54 USE groupdef_mod
55 USE submodel_mod
56 USE hm_option_read_mod
57 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "param_c.inc"
66#include "units_c.inc"
67#include "scr17_c.inc"
68#include "com04_c.inc"
69#include "random_c.inc"
70#include "tabsiz_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER, INTENT(IN) :: ITABM1(NUMNOD),IXR(NIXR,NUMELR),ITAB(NUMNOD),FUNC_ID(NFUNCT),IPM(NPROPMI,NUMMAT)
75 INTEGER, INTENT(INOUT) :: NOM_OPT(LNOPT1,SNOM_OPT1)
76 my_real, INTENT(IN) :: alea(nrand)
77 my_real, INTENT(INOUT) :: x(3,numnod)
78 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
79 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER ,DIMENSION(NRETRACTOR) :: RET_ID
84 INTEGER :: I,J,K,ID, UID, NODE_ID, EL_ID, IERR1
85 INTEGER :: NODE1,NODE2,EL_LOC,BID,ISENS(2),IFUNC(3),IFUNC_LOC(3),TENS_TYP,MID,MTYP
86 my_real :: force,elem_size,dist1,dist2,dist3,pull,yscale1,xscale1,xscale1_unit,yscale1_unit
87 my_real :: yscale2,xscale2,xscale2_unit,yscale2_unit,xx,dxdy,get_u_func,alea_max,tole_2
88 CHARACTER(LEN=NCHARTITLE) :: TITR
89 CHARACTER(LEN=NCHARKEY) :: KEY2
90 CHARACTER :: MESS*40
91 LOGICAL :: IS_AVAILABLE
92 EXTERNAL get_u_func
93C-----------------------------------------------
94C E x t e r n a l F u n c t i o n s
95C-----------------------------------------------
96 INTEGER USR2SYS,NINTRI
97C=======================================================================
98 DATA mess/'RETRACTOR DEFINITION '/
99C-----------------------------------------------
100C S o u r c e L i n e s
101C-----------------------------------------------
102 ierr1 = 0
103C
104 IF(nretractor > 0 ) THEN
105C
106 WRITE(iout,1000)
107C
108 ALLOCATE(retractor(nretractor))
109 DO i=1,nretractor
110 retractor(i)%ID = 0
111 retractor(i)%IDG = 0
112 retractor(i)%UPDATE = 0
113 retractor(i)%ANCHOR_NODE = 0
114 retractor(i)%NODE = 0
115 retractor(i)%NODE_NEXT = 0
116 retractor(i)%STRAND_DIRECTION = 0
117 retractor(i)%IFUNC = 0
118 retractor(i)%ISENS = 0
119 retractor(i)%TENS_TYP = 0
120 retractor(i)%LOCKED = 0
121 retractor(i)%LOCKED_FREEZE = 0
122 retractor(i)%PRETENS_ACTIV = 0
123 retractor(i)%INACTI_NNOD = 0
124 retractor(i)%INACTI_NNOD_MAX = 0
125 retractor(i)%N_REMOTE_PROC=0
126 retractor(i)%VECTOR = zero
127 retractor(i)%ELEMENT_SIZE = zero
128 retractor(i)%FORCE = zero
129 retractor(i)%MATERIAL_FLOW = zero
130 retractor(i)%RESIDUAL_LENGTH = zero
131 retractor(i)%FAC = zero
132 retractor(i)%PULLOUT = zero
133 retractor(i)%UNLOCK_FORCE = zero
134 retractor(i)%LOCK_PULL = zero
135 retractor(i)%LOCK_PULL_SAV = zero
136 retractor(i)%LOCK_OFFSET = zero
137 retractor(i)%LOCK_YIELD_FORCE = zero
138 retractor(i)%RINGSLIP = zero
139 retractor(i)%PRETENS_TIME = zero
140 retractor(i)%PRETENS_PULL = zero
141 retractor(i)%PRETENS_PULLMAX = zero
142 retractor(i)%RET_FORCE = zero
143 ENDDO
144C
145 CALL hm_option_start('/RETRACTOR')
146
147 DO i = 1,nretractor
148 CALL hm_option_read_key(lsubmodel, option_titr = titr, option_id = id, unit_id = uid)
149C
150 nom_opt(1,i)=id
151 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
152C
153 CALL hm_get_intv('EL_ID', el_id, is_available, lsubmodel)
154 CALL hm_get_intv('Node_ID', node_id, is_available, lsubmodel)
155 CALL hm_get_floatv('Elem_size', elem_size, is_available, lsubmodel,unitab)
156C
157 CALL hm_get_intv('Sens_ID1', isens(1), is_available, lsubmodel)
158 CALL hm_get_floatv('Pullout', pull, is_available, lsubmodel,unitab)
159 CALL hm_get_intv('Fct_ID1', ifunc(1), is_available, lsubmodel)
160 CALL hm_get_intv('Fct_ID2', ifunc(2), is_available, lsubmodel)
161 CALL hm_get_floatv('yscale1',YSCALE1,IS_AVAILABLE,LSUBMODEL,UNITAB)
162 CALL HM_GET_FLOATV('xscale1',XSCALE1,IS_AVAILABLE,LSUBMODEL,UNITAB)
163C
164 CALL HM_GET_FLOATV_DIM('yscale1',YSCALE1_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
165 CALL HM_GET_FLOATV_DIM('xscale1',XSCALE1_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
166C
167 CALL HM_GET_INTV('sens_id2', ISENS(2), IS_AVAILABLE, LSUBMODEL)
168 CALL HM_GET_INTV('tens_typ', TENS_TYP, IS_AVAILABLE, LSUBMODEL)
169 CALL HM_GET_FLOATV('force', FORCE, IS_AVAILABLE, LSUBMODEL,UNITAB)
170 CALL HM_GET_INTV('fct_id3', IFUNC(3), IS_AVAILABLE, LSUBMODEL)
171 CALL HM_GET_FLOATV('yscale2',YSCALE2,IS_AVAILABLE,LSUBMODEL,UNITAB)
172 CALL HM_GET_FLOATV('xscale2',XSCALE2,IS_AVAILABLE,LSUBMODEL,UNITAB)
173C
174 CALL HM_GET_FLOATV_DIM('yscale2',YSCALE2_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
175 CALL HM_GET_FLOATV_DIM('xscale2',XSCALE2_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
176C
177 RET_ID(I) = ID
178C
179 IF (IFUNC(1) > 0) THEN
180 IF (XSCALE1== ZERO) XSCALE1 = ONE*XSCALE1_UNIT
181 IF (YSCALE1== ZERO) YSCALE1 = ONE*YSCALE1_UNIT
182 ENDIF
183C
184 IF (IFUNC(2) == 0) IFUNC(2) = IFUNC(1)
185C
186 IF (IFUNC(3) > 0) THEN
187 IF (XSCALE2== ZERO) XSCALE2 = ONE*XSCALE2_UNIT
188 IF (YSCALE2== ZERO) YSCALE2 = ONE*YSCALE2_UNIT
189 ENDIF
190C
191 WRITE(IOUT,1100) ID,TRIM(TITR),EL_ID,NODE_ID,ELEM_SIZE,ISENS(1),PULL,IFUNC(1),IFUNC(2),
192 . XSCALE1,YSCALE1
193C
194 IF (ISENS(2) > 0) WRITE(IOUT,1200) ISENS(2),TENS_TYP,FORCE,IFUNC(3),XSCALE2,YSCALE2
195C
196 IF (FORCE == ZERO) FORCE = EP30
197C
198 NODE_ID = USR2SYS(NODE_ID,ITABM1,MESS,RETRACTOR(I)%ID)
199 EL_LOC=NINTRI(EL_ID,IXR,NIXR,NUMELR,NIXR)
200C
201 IF(EL_LOC == 0) THEN
202 CALL ANCMSG(MSGID=2008,
203 . MSGTYPE=MSGERROR,
204 . ANMODE=ANINFO_BLIND_1,
205 . I1=ID,I2=EL_ID)
206 ELSE
207 MTYP = 0
208 MID = IXR(5,EL_LOC)
209 IF (MID > 0) MTYP = IPM(2,MID)
210 IF (MTYP /= 114) CALL ANCMSG(MSGID=2033,
211 . MSGTYPE=MSGERROR,
212 . ANMODE=ANINFO,
213 . I1=ID,I2=EL_ID)
214 ENDIF
215C
216C---------Check of sensors is done in creat_seatblet as sensors are not yet available
217C
218C---------Check of functions
219C
220 IFUNC_LOC(1:3) = 0
221C
222 DO J=1,3
223 IF (IFUNC(J) > 0) THEN
224 DO K=1,NFUNCT
225 IF (FUNC_ID(K) == IFUNC(J)) IFUNC_LOC(J) = K
226 ENDDO
227 IF(IFUNC_LOC(J) == 0) CALL ANCMSG(MSGID=2028,
228 . MSGTYPE=MSGERROR,
229 . ANMODE=ANINFO_BLIND_1,
230 . C1='function',
231 . I1=ID,I2=IFUNC(J))
232 ENDIF
233 ENDDO
234C
235.AND. IF ((ISENS(1) > 0)(IFUNC(1)==0)) THEN
236C-- function is mandatory for locking if sensor1 is input
237 CALL ANCMSG(MSGID=2031,
238 . MSGTYPE=MSGERROR,
239 . ANMODE=ANINFO_BLIND_1,
240 . I1=ID)
241 ENDIF
242C
243.AND. IF ((ISENS(2) > 0)(IFUNC(3)==0)) THEN
244C-- function is mandatory for pretensionin if sensor2 is input
245 CALL ANCMSG(MSGID=2025,
246 . MSGTYPE=MSGERROR,
247 . ANMODE=ANINFO_BLIND_1,I1=ID)
248 ENDIF
249C
250 RETRACTOR(I)%ID = ID
251 RETRACTOR(I)%ANCHOR_NODE = NODE_ID
252 RETRACTOR(I)%ELEMENT_SIZE = ELEM_SIZE
253C
254 RETRACTOR(I)%ISENS(1) = ISENS(1)
255 RETRACTOR(I)%PULLOUT = PULL
256 RETRACTOR(I)%IFUNC(1) = IFUNC_LOC(1)
257 RETRACTOR(I)%IFUNC(2) = IFUNC_LOC(2)
258 RETRACTOR(I)%FAC(1) = YSCALE1
259 RETRACTOR(I)%FAC(2) = XSCALE1
260C
261 RETRACTOR(I)%ISENS(2) = ISENS(2)
262 RETRACTOR(I)%TENS_TYP = TENS_TYP
263 RETRACTOR(I)%FORCE = FORCE
264 RETRACTOR(I)%IFUNC(3) = IFUNC_LOC(3)
265 RETRACTOR(I)%FAC(3) = YSCALE2
266 RETRACTOR(I)%FAC(4) = XSCALE2
267C
268 IF (RETRACTOR(I)%IFUNC(1)==0) THEN
269 RETRACTOR(I)%UNLOCK_FORCE = RETRACTOR(I)%FAC(1)
270 ELSE
271C- Force in unlock state is the first point of the curve
272 XX = ZERO
273 RETRACTOR(I)%UNLOCK_FORCE = RETRACTOR(I)%FAC(1)*GET_U_FUNC(RETRACTOR(I)%IFUNC(1),XX,DXDY)
274 ENDIF
275C
276 NODE1 = IXR(2,EL_LOC)
277 NODE2 = IXR(3,EL_LOC)
278C
279 DIST1 = (X(1,NODE1)-X(1,NODE_ID))**2+(X(2,NODE1)-X(2,NODE_ID))**2+(X(3,NODE1)-X(3,NODE_ID))**2
280 DIST2 = (X(1,NODE2)-X(1,NODE_ID))**2+(X(2,NODE2)-X(2,NODE_ID))**2+(X(3,NODE2)-X(3,NODE_ID))**2
281C
282C-- default tolerance
283 TOLE_2 = EM10*RETRACTOR(I)%ELEMENT_SIZE*RETRACTOR(I)%ELEMENT_SIZE
284C-- compatibility with random noise
285 IF (NRAND > 0) THEN
286 ALEA_MAX = ZERO
287 DO J=1,NRAND
288 ALEA_MAX = MAX(ALEA_MAX,ALEA(J))
289 ENDDO
290 TOLE_2 = MAX(TOLE_2,TEN*ALEA_MAX*ALEA_MAX)
291 ENDIF
292C
293C-- tolerance if node is very close to anchorage node
294.AND. IF ((DIST1 < DIST2)(DIST1 <= TOLE_2)) THEN
295 X(1,NODE1) = X(1,NODE_ID)
296 X(2,NODE1) = X(2,NODE_ID)
297 X(3,NODE1) = X(3,NODE_ID)
298 DIST1 = ZERO
299 ELSEIF (DIST2 <= TOLE_2) THEN
300 X(1,NODE2) = X(1,NODE_ID)
301 X(2,NODE2) = X(2,NODE_ID)
302 X(3,NODE2) = X(3,NODE_ID)
303 DIST2 = ZERO
304 ENDIF
305C
306 DIST3 = (X(1,NODE2)-X(1,NODE1))**2+(X(2,NODE2)-X(2,NODE1))**2+(X(3,NODE2)-X(3,NODE1))**2
307C
308 IF (DIST1 < EM30) THEN
309 RETRACTOR(I)%NODE(1) = NODE2
310 RETRACTOR(I)%NODE(2) = NODE1
311 IF (RETRACTOR(I)%ELEMENT_SIZE == ZERO) RETRACTOR(I)%ELEMENT_SIZE = DIST2
312 RETRACTOR(I)%VECTOR(1) = (X(1,NODE2)-X(1,NODE1))/SQRT(MAX(EM30,DIST3))
313 RETRACTOR(I)%VECTOR(2) = (X(2,NODE2)-X(2,NODE1))/SQRT(MAX(EM30,DIST3))
314 RETRACTOR(I)%VECTOR(3) = (X(3,NODE2)-X(3,NODE1))/SQRT(MAX(EM30,DIST3))
315C-- retractor direction 2->1
316 RETRACTOR(I)%STRAND_DIRECTION = -1
317 ELSEIF (DIST2 < EM30) THEN
318 RETRACTOR(I)%NODE(1) = NODE1
319 RETRACTOR(I)%NODE(2) = NODE2
320 IF (RETRACTOR(I)%ELEMENT_SIZE == ZERO) RETRACTOR(I)%ELEMENT_SIZE = DIST1
321 RETRACTOR(I)%VECTOR(1) = (X(1,NODE1)-X(1,NODE2))/SQRT(MAX(EM30,DIST3))
322 RETRACTOR(I)%VECTOR(2) = (X(2,NODE1)-X(2,NODE2))/SQRT(MAX(EM30,DIST3))
323 RETRACTOR(I)%VECTOR(3) = (X(3,NODE1)-X(3,NODE2))/SQRT(MAX(EM30,DIST3))
324C-- retractor direction 1->2
325 RETRACTOR(I)%STRAND_DIRECTION = 1
326 ELSE
327 CALL ANCMSG(MSGID=2009,
328 . MSGTYPE=MSGERROR,
329 . ANMODE=ANINFO_BLIND_1,
330 . I1=ID)
331 ENDIF
332C
333 IF (DIST3 < EM30) THEN
334 CALL ANCMSG(MSGID=2022,
335 . MSGTYPE=MSGERROR,
336 . ANMODE=ANINFO_BLIND_1,
337 . I1=ID)
338 ENDIF
339C
340 IF (RETRACTOR(I)%NODE(2) == RETRACTOR(I)%ANCHOR_NODE) THEN
341 CALL ANCMSG(MSGID=2030,
342 . MSGTYPE=MSGERROR,
343 . ANMODE=ANINFO_BLIND_1,
344 . I1=ID,I2=ITAB(RETRACTOR(I)%ANCHOR_NODE))
345 ENDIF
346C
347 ENDDO
348C
349 ENDIF
350C
351 IF (IERR1 /= 0) THEN
352 WRITE(IOUT,*)' ** error in memory allocation'
353 WRITE(ISTDO,*)' ** error in memory allocation'
354 CALL ARRET(2)
355 ENDIF
356C
357C-------------------------------------
358C Recherche des ID doubles
359C-------------------------------------
360 CALL UDOUBLE(RET_ID,1,NRETRACTOR,MESS,0,BID)
361 RETURN
362C
3631000 FORMAT(/
364 . ' retractor/spring definitions '/
365 . ' ---------------------- ')
3661100 FORMAT(/5X,'retractor id ',I10,1X,A
367 . /5X,'connected spring element . . . . . . . . .',i10
368 . /5x,'ANCHORAGE NODE . . . . . . . . . . . . . .',i10
369 . /5x,'ELEMENT SIZE . . . . . . . . . . . . . . .',1pg20.4
370 . /5x,'SENSOR ID1 . . . . . . . . . . . . . . . .',i10
371 . /5x,'PULLOUT BEFORE LOCKING . . . . . . . . . .',1pg20.4
372 . /5x,'FUNC1 - LOADING - FORCE VS PULLOUT . . . .',i10
373 . /5x,'FUNC2 - UNLOADING - FORCE VS PULLOUT . . .',i10
374 . /5x,'FUNC1/2 ABCISSA SCALE FACTOR . . . . . . .',1pg20.4
375 . /5x,'FUNC1/2 ORDINATE SCALE FACTOR. . . . . . .',1pg20.4)
3761200 FORMAT( 5x,'PRETENSION :'
377 . /5x,'SENSOR ID2 . . . . . . . . . . . . . . . .',i10
378 . /5x,'PRETENSION TYPE. . . . . . . . . . . . . .',i10
379 . /5x,'MAXIMUM FORCE. . . . . . . . . . . . . . .',1pg20.4
380 . /5x,'FUNC3. . . . . . . . . . . . . . . . . . .',i10
381 . /5x,'FUNC3 ABCISSA SCALE FACTOR . . . . . . . .',1pg20.4
382 . /5x,'FUNC3 ORDINATE SCALE FACTOR . . . . . . .',1pg20.4)
383 END SUBROUTINE hm_read_retractor
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_retractor
subroutine hm_read_retractor(lsubmodel, itabm1, ixr, itab, unitab, x, func_id, nom_opt, alea, ipm)
Definition hm_read_retractor.F:47
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::retractor
type(retractor_struct), dimension(:), allocatable retractor
Definition seatbelt_mod.F:155
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
submodel_mod::submodel_data
Definition submodel_mod.F:723