OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop04.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_prop04 ../starter/source/properties/spring/hm_read_prop04.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_properties ../starter/source/properties/hm_read_properties.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
34!||--- uses -----------------------------------------------------
35!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_prop04(GEO , IGEO ,UNITAB ,IG ,IGTYP,
40 . PROP_TAG,LSUBMODEL)
41C============================================================================
42C M o d u l e s
43C-----------------------------------------------
44 USE unitab_mod
45 USE elbuftag_mod
46 USE message_mod
47 USE submodel_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "scr17_c.inc"
57#include "units_c.inc"
58#include "param_c.inc"
59#include "tablen_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
64 INTEGER IGEO(NPROPGI),IGTYP
65C REAL
67 . geo(npropg)
68 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
69 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER J, IFUNC, IFUNC2, IFUNC3, IECROU, IFV, IG,ISENS,
74 . ifl, ileng
75C REAL
77 . a, b, d, e, f, dn, dx, pun,
78 . lscale,gf3,a_unit,b_unit,d_unit,e_unit,f_unit,lscale_unit,gf3_unit
79 CHARACTER(LEN=NCHARTITLE) :: TITR
80 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
81C-----------------------------------------------
82C E x t e r n a l F u n c t i o n s
83C-----------------------------------------------
84 pun = em01
85 is_encrypted=.false.
86 is_available = .false.
87C=======================================================================
88C----------------------
89C FROM LECGEO - GENERAL
90C----------------------
91 geo(5)=ep06
92 igeo( 1)=ig
93 igeo(11)=igtyp
94 geo(12) =igtyp+pun
95C--------------------------------------------------
96C EXTRACT DATA (IS OPTION CRYPTED)
97C--------------------------------------------------
98 CALL hm_option_is_encrypted(is_encrypted)
99C--------------------------------------------------
100C EXTRACT DATAS (INTEGER VALUES)
101C--------------------------------------------------
102 CALL hm_get_intv('ISENSOR',isens,is_available,lsubmodel)
103 CALL hm_get_intv('ISFLAG',ifl,is_available,lsubmodel)
104 CALL hm_get_intv('Ileng',ileng,is_available,lsubmodel)
105 CALL hm_get_intv('FUN_A1',ifunc,is_available,lsubmodel)
106 CALL hm_get_intv('HFLAG1',iecrou,is_available,lsubmodel)
107 CALL hm_get_intv('FUN_B1',ifv,is_available,lsubmodel)
108 CALL hm_get_intv('FUN_C1',ifunc2,is_available,lsubmodel)
109 CALL hm_get_intv('FUN_D1',ifunc3,is_available,lsubmodel)
110C--------------------------------------------------
111C EXTRACT DATAS (REAL VALUES)
112C--------------------------------------------------
113 CALL hm_get_floatv('MASS',geo(1),is_available,lsubmodel,unitab)
114 CALL hm_get_floatv('stiff1',GEO(2),IS_AVAILABLE,LSUBMODEL,UNITAB)
115 CALL HM_GET_FLOATV('damp1',GEO(3),IS_AVAILABLE,LSUBMODEL,UNITAB)
116 CALL HM_GET_FLOATV('acoeft1',A,IS_AVAILABLE,LSUBMODEL,UNITAB)
117 CALL HM_GET_FLOATV('bcoeft1',B,IS_AVAILABLE,LSUBMODEL,UNITAB)
118 CALL HM_GET_FLOATV('dcoeft1',D,IS_AVAILABLE,LSUBMODEL,UNITAB)
119 CALL HM_GET_FLOATV('min_rup1',DN,IS_AVAILABLE,LSUBMODEL,UNITAB)
120 CALL HM_GET_FLOATV('max_rup1',DX,IS_AVAILABLE,LSUBMODEL,UNITAB)
121 CALL HM_GET_FLOATV('prop_fscale',F,IS_AVAILABLE,LSUBMODEL,UNITAB)
122 CALL HM_GET_FLOATV('prop_escale',E,IS_AVAILABLE,LSUBMODEL,UNITAB)
123 CALL HM_GET_FLOATV('scale1',LSCALE,IS_AVAILABLE,LSUBMODEL,UNITAB)
124 CALL HM_GET_FLOATV('ffac',GF3,IS_AVAILABLE,LSUBMODEL,UNITAB)
125 !units for default values
126 CALL HM_GET_FLOATV_DIM('acoeft1',A_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
127 CALL HM_GET_FLOATV_DIM('bcoeft1',B_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
128 CALL HM_GET_FLOATV_DIM('dcoeft1',D_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
129 CALL HM_GET_FLOATV_DIM('prop_fscale',F_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
130 CALL HM_GET_FLOATV_DIM('prop_escale',E_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
131 CALL HM_GET_FLOATV_DIM('scale1',LSCALE_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
132 CALL HM_GET_FLOATV_DIM('ffac',GF3_UNIT,IS_AVAILABLE,LSUBMODEL,UNITAB)
133C----------------------
134C----
135 CALL FRETITL2(TITR,IGEO(NPROPGI-LTITR+1),LTITR)
136 IF(GEO(1)<=EM15)THEN
137 CALL ANCMSG(MSGID=229,
138 . MSGTYPE=MSGERROR,
139 . ANMODE=ANINFO_BLIND_1,
140 . I1=IG,
141 . C1=TITR)
142 ENDIF
143.AND..AND.! IF(IFUNC/=0IECROU>=1GEO(2) == 0.0)THEN
144! CALL ANCMSG(MSGID=230,
145! . MSGTYPE=MSGERROR,
146! . ANMODE=ANINFO_BLIND_1,
147! . I1=IG,
148! . C1=TITR)
149! ENDIF
150.AND..OR. IF(IECROU == 4(IFUNC == 0IFUNC2 == 0))THEN
151 CALL ANCMSG(MSGID=231,
152 . MSGTYPE=MSGERROR,
153 . ANMODE=ANINFO_BLIND_1,
154 . I1=IG,
155 . C1=TITR)
156 ENDIF
157.AND. IF(IECROU == 4GEO(2) == ZERO)THEN
158 CALL ANCMSG(MSGID=230,
159 . MSGTYPE=MSGERROR,
160 . ANMODE=ANINFO_BLIND_1,
161 . I1=IG,
162 . C1=TITR)
163 ENDIF
164.AND..OR. IF(IECROU == 5(IFUNC == 0IFUNC2 == 0))THEN
165 CALL ANCMSG(MSGID=231,
166 . MSGTYPE=MSGERROR,
167 . ANMODE=ANINFO_BLIND_1,
168 . I1=IG,
169 . C1=TITR)
170 ENDIF
171.AND..OR. IF(IECROU==6(IFUNC==0IFUNC2==0))THEN
172 CALL ANCMSG(MSGID=1057,
173 . MSGTYPE=MSGERROR,
174 . ANMODE=ANINFO_BLIND_1,
175 . I1=IG,
176 . C1=TITR)
177 ENDIF
178.AND. IF(IECROU==7IFUNC==0)THEN
179 CALL ANCMSG(MSGID=1058,
180 . MSGTYPE=MSGERROR,
181 . ANMODE=ANINFO_BLIND_1,
182 . I1=IG,
183 . C1=TITR)
184
185.AND. ELSEIF(IECROU==7IFUNC2==0)THEN
186 CALL ANCMSG(MSGID=1059,
187 . MSGTYPE=MSGWARNING,
188 . ANMODE=ANINFO_BLIND_1,
189 . I1=IG,
190 . C1=TITR,
191 . I2=IECROU)
192 IECROU = 2
193 ENDIF
194
195.AND. IF(IECROU == 8 IFUNC == 0)THEN
196 CALL ANCMSG(MSGID=231,
197 . MSGTYPE=MSGERROR,
198 . ANMODE=ANINFO_BLIND_1,
199 . I1=IG,
200 . C1=TITR)
201 ENDIF
202.AND..AND. IF (IFUNC == 0 A /= ZERO A /= ONE) THEN
203 CALL ANCMSG(MSGID=663,
204 . MSGTYPE=MSGWARNING,
205 . ANMODE=ANINFO_BLIND_1,
206 . I1=IG,
207 . C1=TITR)
208 ENDIF
209C----
210 IF (A == ZERO) A = ONE * A_UNIT
211 IF (D == ZERO) D = ONE * D_UNIT
212 IF (E == ZERO) E = ONE * E_UNIT
213 IF (F == ZERO) F = ONE * F_UNIT
214 IF (GF3 == ZERO) GF3 = ONE * GF3_UNIT
215 IF (LSCALE == ZERO) THEN
216 IF (ILENG == 0) THEN
217 LSCALE = ONE * LSCALE_UNIT
218 ELSE
219 LSCALE = ONE
220 ENDIF
221 ENDIF
222 IF (IFUNC == 0) THEN
223 A = ONE
224 B = ZERO
225 E = ZERO
226 ENDIF
227 IF (DN == ZERO)DN=-EP30
228 IF (DX == ZERO)DX= EP30
229 IF (IFL == 1) ISENS=-ISENS
230C------------------------
231 DN = DN * LSCALE
232 DX = DX * LSCALE
233C------------------------
234.NOT. IF( IS_ENCRYPTED)THEN
235 IF(IECROU/=5) THEN
236 WRITE(IOUT,1400)IG,(GEO(J),J=1,3),IFUNC,LSCALE,IFUNC2,
237 . F,IECROU,A,B,D,E,IFV,GF3,IFUNC3,DN,DX,ABS(ISENS),
238 . IFL,ILENG
239 ELSE
240 WRITE(IOUT,1500)IG,(GEO(J),J=1,3),IFUNC,LSCALE,IFUNC2,
241 . F,IECROU,A,B,D,E,IFV,GF3,IFUNC3,DN,DX,ABS(ISENS),
242 . IFL,ILENG
243
244 ENDIF
245 ELSE
246 WRITE(IOUT,1000)IG
247 ENDIF
248C------------------------
249 GEO(2) = GEO(2) / A
250 GEO(7) = IECROU+PUN
251 GEO(8) = ONEP1
252 GEO(9) = ZERO
253 GEO(10) = A
254 GEO(11) = B
255 GEO(13) = D
256 GEO(40) = E
257 GEO(132)= GF3
258 GEO(18) = ONE/F
259 GEO(39) = ONE/LSCALE
260 GEO(15) = DN
261 GEO(16) = DX
262 GEO(80) = IFL
263 GEO(93) = ILENG
264C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
265 IF (IECROU == 6) THEN
266 GEO(25) = 1
267 ENDIF
268C
269 IGEO(3) = ISENS
270 IGEO(101) = IFUNC ! FUN_A1
271 IGEO(102) = IFV ! FUN_B1
272 IGEO(103) = IFUNC2 ! FUN_C1
273 IGEO(119) = IFUNC3 ! FUN_D1
274
275C----------------------
276C FROM LECGEO - GENERAL
277C----------------------
278.AND. IF(GEO(39)/=ZEROIGEO( 9)== 0)IGEO( 9)=NINT(GEO(39))
279.AND. IF(GEO(171)/=ZEROIGEO(10)== 0)IGEO(10)=NINT(GEO(171))
280C----------------------
281C
282 PROP_TAG(IGTYP)%G_EINT = 1
283 PROP_TAG(IGTYP)%G_FOR = 1
284 PROP_TAG(IGTYP)%G_LENGTH = 1 ! X0 (AL0) - total length
285 PROP_TAG(IGTYP)%G_TOTDEPL = 1 ! DX - total deformation (translation)
286 PROP_TAG(IGTYP)%G_FOREP = 1 ! FORCE - (ELASTO PLASTIQUE (ISOTROPE))
287 PROP_TAG(IGTYP)%G_DEP_IN_TENS = 1 ! DPX (DPY,DPZ) - max displacement in tension
288 PROP_TAG(IGTYP)%G_DEP_IN_COMP = 1 ! DPX2 (DPY2, DPZ2) - Max Displacement in Compression
289 PROP_TAG(IGTYP)%G_POSX = 5
290 PROP_TAG(IGTYP)%G_YIELD = 1
291 PROP_TAG(IGTYP)%G_LENGTH_ERR = 1
292 PROP_TAG(IGTYP)%G_NUVAR = MAX(PROP_TAG(IGTYP)%G_NUVAR,NINT(GEO(25))) ! additional internal variables for h=6
293 PROP_TAG(IGTYP)%G_DEFINI = 1
294 PROP_TAG(IGTYP)%G_FORINI = 1
295C
296C------------------------
297 RETURN
298C
299 1000 FORMAT(
300 & 5X,'spring property set'/,
301 & 5x,'-------------------'/,
302 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
303 & 5x,'CONFIDENTIAL DATA'//)
304 1400 FORMAT(
305 & 5x,'SPRING PROPERTY SET'/,
306 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
307 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
308 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
309 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
310 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
311 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
312 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
313 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
314 & 5x,'FORCE-DISPLACEMENT CURVE (H=4,5,7). . .=',i10/,
315 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
316 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
317 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
318 & 5x,'4:kinematic 5:uncoupled nl(un/re)loading',/,
319 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
320 & 5X,'8:elastic, total length function',/,
321 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
322 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
323 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
324 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
325 & 5X,'FUNCTION identifier for ',/,
326 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
327 & 5X,'dynamic amplification factor gf3. . . .=',1PG20.13/,
328 & 5X,'function identifier for the additional ',/,
329 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
330 & 5X,'negative failure displacement . . . . .=',1PG20.13/,
331 & 5X,'positive failure displacement . . . . .=',1PG20.13/,
332 & 5X,'sensor number (0:NOT USED). . . . . . .=',I10/,
333 & 5X,'sensor flag (0:ACTIV 1:DISACT 2:BOTH) .=',I10/,
334 & 5X,'unit length flag. . . . . . . . . . . .=',I10/,
335 & 5X,'if=1 unit length mass,stiffness and input',/,
336 & 5X,' curve are strain depending',/)
337 1500 FORMAT(
338 & 5X,'spring property set'/,
339 & 5X,'property set number . . . . . . . . . .=',I10/,
340 & 5X,'spring mass . . . . . . . . . . . . . .=',1PG20.13/,
341 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
342 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
343 & 5X,'function identifier for loading ',/,
344 & 5X,'force-displacement curve. . . . . . . .=',I10/,
345 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
346 & 5X,'permanent displ./max. displ. curve(H=5)=',I10/,
347 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
348 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
349 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
350 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
351 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
352 & 5X,'8:elastic, total length function. . . .',/,
353 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
354 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
355 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
356 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
357 & 5X,'function identifier for ',/,
358 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
359 & 5X,'dynamic amplification factor gf3. . . .=',1PG20.13/,
360 & 5X,'function identifier for the additional ',/,
361 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
362 & 5X,'negative failure displacement . . . . .=',1PG20.13/,
363 & 5X,'positive failure displacement . . . . .=',1PG20.13/,
364 & 5X,'sensor number (0:NOT USED). . . . . . .=',I10/,
365 & 5X,'sensor flag (0:ACTIV 1:DISACT 2:BOTH) .=',I10/,
366 & 5X,'unit length flag. . . . . . . . . . . .=',I10/,
367 & 5X,'if=1 unit length mass,stiffness and input',/,
368 & 5X,' curve are strain depending',/)
369 RETURN
370 END
#define my_real
Definition cppsort.cpp:32
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
if(complex_arithmetic) id
end diagonal values have been computed in the(sparse) matrix id.SOL
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine hm_read_prop04(geo, igeo, unitab, ig, igtyp, prop_tag, lsubmodel)
#define max(a, b)
Definition macros.h:21
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
character *2 function nl()
Definition message.F:2360
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29