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 . IDTITL, PROP_TAG,LSUBMODEL,IUNIT)
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
48 USE names_and_titles_mod , ONLY : nchartitle
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,IUNIT
65C REAL
66 my_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, iform
75C REAL
76 my_real
77 . a0, a, b, d, e, f, xm, xin, xk, xc, 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 CHARACTER(LEN=NCHARTITLE)::IDTITL
81 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
82C-----------------------------------------------
83C E x t e r n a l F u n c t i o n s
84C-----------------------------------------------
85 pun = em01
86 is_encrypted=.false.
87 is_available = .false.
88C=======================================================================
89C----------------------
90C FROM LECGEO - GENERAL
91C----------------------
92 geo(5)=ep06
93 igeo( 1)=ig
94 igeo(11)=igtyp
95 geo(12) =igtyp+pun
96C--------------------------------------------------
97C EXTRACT DATA (IS OPTION CRYPTED)
98C--------------------------------------------------
99 CALL hm_option_is_encrypted(is_encrypted)
100C--------------------------------------------------
101C EXTRACT DATAS (INTEGER VALUES)
102C--------------------------------------------------
103 CALL hm_get_intv('ISENSOR',isens,is_available,lsubmodel)
104 CALL hm_get_intv('ISFLAG',ifl,is_available,lsubmodel)
105 CALL hm_get_intv('Ileng',ileng,is_available,lsubmodel)
106 CALL hm_get_intv('FUN_A1',ifunc,is_available,lsubmodel)
107 CALL hm_get_intv('HFLAG1',iecrou,is_available,lsubmodel)
108 CALL hm_get_intv('FUN_B1',ifv,is_available,lsubmodel)
109 CALL hm_get_intv('FUN_C1',ifunc2,is_available,lsubmodel)
110 CALL hm_get_intv('FUN_D1',ifunc3,is_available,lsubmodel)
111C--------------------------------------------------
112C EXTRACT DATAS (REAL VALUES)
113C--------------------------------------------------
114 CALL hm_get_floatv('MASS',geo(1),is_available,lsubmodel,unitab)
115 CALL hm_get_floatv('STIFF1',geo(2),is_available,lsubmodel,unitab)
116 CALL hm_get_floatv('DAMP1',geo(3),is_available,lsubmodel,unitab)
117 CALL hm_get_floatv('Acoeft1',a,is_available,lsubmodel,unitab)
118 CALL hm_get_floatv('Bcoeft1',b,is_available,lsubmodel,unitab)
119 CALL hm_get_floatv('Dcoeft1',d,is_available,lsubmodel,unitab)
120 CALL hm_get_floatv('MIN_RUP1',dn,is_available,lsubmodel,unitab)
121 CALL hm_get_floatv('MAX_RUP1',dx,is_available,lsubmodel,unitab)
122 CALL hm_get_floatv('Prop_FScale',f,is_available,lsubmodel,unitab)
123 CALL hm_get_floatv('Prop_EScale',e,is_available,lsubmodel,unitab)
124 CALL hm_get_floatv('scale1',lscale,is_available,lsubmodel,unitab)
125 CALL hm_get_floatv('ffac',gf3,is_available,lsubmodel,unitab)
126 !units for default values
127 CALL hm_get_floatv_dim('Acoeft1',a_unit,is_available,lsubmodel,unitab)
128 CALL hm_get_floatv_dim('Bcoeft1',b_unit,is_available,lsubmodel,unitab)
129 CALL hm_get_floatv_dim('Dcoeft1',d_unit,is_available,lsubmodel,unitab)
130 CALL hm_get_floatv_dim('Prop_FScale',f_unit,is_available,lsubmodel,unitab)
131 CALL hm_get_floatv_dim('Prop_EScale',e_unit,is_available,lsubmodel,unitab)
132 CALL hm_get_floatv_dim('scale1',lscale_unit,is_available,lsubmodel,unitab)
133 CALL hm_get_floatv_dim('ffac',gf3_unit,is_available,lsubmodel,unitab)
134C----------------------
135C----
136 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
137 IF(geo(1)<=em15)THEN
138 CALL ancmsg(msgid=229,
139 . msgtype=msgerror,
140 . anmode=aninfo_blind_1,
141 . i1=ig,
142 . c1=titr)
143 ENDIF
144! IF(IFUNC/=0.AND.IECROU>=1.AND.GEO(2) == 0.0)THEN
145! CALL ANCMSG(MSGID=230,
146! . MSGTYPE=MSGERROR,
147! . ANMODE=ANINFO_BLIND_1,
148! . I1=IG,
149! . C1=TITR)
150! ENDIF
151 IF(iecrou == 4.AND.(ifunc == 0.OR.ifunc2 == 0))THEN
152 CALL ancmsg(msgid=231,
153 . msgtype=msgerror,
154 . anmode=aninfo_blind_1,
155 . i1=ig,
156 . c1=titr)
157 ENDIF
158 IF(iecrou == 4.AND.geo(2) == zero)THEN
159 CALL ancmsg(msgid=230,
160 . msgtype=msgerror,
161 . anmode=aninfo_blind_1,
162 . i1=ig,
163 . c1=titr)
164 ENDIF
165 IF(iecrou == 5.AND.(ifunc == 0.OR.ifunc2 == 0))THEN
166 CALL ancmsg(msgid=231,
167 . msgtype=msgerror,
168 . anmode=aninfo_blind_1,
169 . i1=ig,
170 . c1=titr)
171 ENDIF
172 IF(iecrou==6.AND.(ifunc==0.OR.ifunc2==0))THEN
173 CALL ancmsg(msgid=1057,
174 . msgtype=msgerror,
175 . anmode=aninfo_blind_1,
176 . i1=ig,
177 . c1=titr)
178 ENDIF
179 IF(iecrou==7.AND.ifunc==0)THEN
180 CALL ancmsg(msgid=1058,
181 . msgtype=msgerror,
182 . anmode=aninfo_blind_1,
183 . i1=ig,
184 . c1=titr)
185
186 ELSEIF(iecrou==7.AND.ifunc2==0)THEN
187 CALL ancmsg(msgid=1059,
188 . msgtype=msgwarning,
189 . anmode=aninfo_blind_1,
190 . i1=ig,
191 . c1=titr,
192 . i2=iecrou)
193 iecrou = 2
194 ENDIF
195
196 IF(iecrou == 8.AND. ifunc == 0)THEN
197 CALL ancmsg(msgid=231,
198 . msgtype=msgerror,
199 . anmode=aninfo_blind_1,
200 . i1=ig,
201 . c1=titr)
202 ENDIF
203 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
204 CALL ancmsg(msgid=663,
205 . msgtype=msgwarning,
206 . anmode=aninfo_blind_1,
207 . i1=ig,
208 . c1=titr)
209 ENDIF
210C----
211 IF (a == zero) a = one * a_unit
212 IF (d == zero) d = one * d_unit
213 IF (e == zero) e = one * e_unit
214 IF (f == zero) f = one * f_unit
215 IF (gf3 == zero) gf3 = one * gf3_unit
216 IF (lscale == zero) THEN
217 IF (ileng == 0) THEN
218 lscale = one * lscale_unit
219 ELSE
220 lscale = one
221 ENDIF
222 ENDIF
223 IF (ifunc == 0) THEN
224 a = one
225 b = zero
226 e = zero
227 ENDIF
228 IF (dn == zero)dn=-ep30
229 IF (dx == zero)dx= ep30
230 IF (ifl == 1) isens=-isens
231C------------------------
232 dn = dn * lscale
233 dx = dx * lscale
234C------------------------
235 IF(.NOT. is_encrypted)THEN
236 IF(iecrou/=5) THEN
237 WRITE(iout,1400)ig,(geo(j),j=1,3),ifunc,lscale,ifunc2,
238 . f,iecrou,a,b,d,e,ifv,gf3,ifunc3,dn,dx,abs(isens),
239 . ifl,ileng
240 ELSE
241 WRITE(iout,1500)ig,(geo(j),j=1,3),ifunc,lscale,ifunc2,
242 . f,iecrou,a,b,d,e,ifv,gf3,ifunc3,dn,dx,abs(isens),
243 . ifl,ileng
244
245 ENDIF
246 ELSE
247 WRITE(iout,1000)ig
248 ENDIF
249C------------------------
250 geo(2) = geo(2) / a
251 geo(7) = iecrou+pun
252 geo(8) = onep1
253 geo(9) = zero
254 geo(10) = a
255 geo(11) = b
256 geo(13) = d
257 geo(40) = e
258 geo(132)= gf3
259 geo(18) = one/f
260 geo(39) = one/lscale
261 geo(15) = dn
262 geo(16) = dx
263 geo(80) = ifl
264 geo(93) = ileng
265C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
266 IF (iecrou == 6) THEN
267 geo(25) = 1
268 ENDIF
269C
270 igeo(3) = isens
271 igeo(101) = ifunc ! FUN_A1
272 igeo(102) = ifv ! FUN_B1
273 igeo(103) = ifunc2 ! FUN_C1
274 igeo(119) = ifunc3 ! FUN_D1
275
276C----------------------
277C FROM LECGEO - GENERAL
278C----------------------
279 IF(geo(39)/=zero.AND.igeo( 9)== 0)igeo( 9)=nint(geo(39))
280 IF(geo(171)/=zero.AND.igeo(10)== 0)igeo(10)=nint(geo(171))
281C----------------------
282C
283 prop_tag(igtyp)%G_EINT = 1
284 prop_tag(igtyp)%G_FOR = 1
285 prop_tag(igtyp)%G_LENGTH = 1 ! X0 (AL0) - total length
286 prop_tag(igtyp)%G_TOTDEPL = 1 ! DX - total deformation (translation)
287 prop_tag(igtyp)%G_FOREP = 1 ! FORCE - (ELASTO PLASTIQUE (ISOTROPE))
288 prop_tag(igtyp)%G_DEP_IN_TENS = 1 ! DPX (DPY,DPZ) - max displacement in tension
289 prop_tag(igtyp)%G_DEP_IN_COMP = 1 ! DPX2 (DPY2,DPZ2) - max displacement in compression
290 prop_tag(igtyp)%G_POSX = 5
291 prop_tag(igtyp)%G_YIELD = 1
292 prop_tag(igtyp)%G_LENGTH_ERR = 1
293 prop_tag(igtyp)%G_NUVAR = max(prop_tag(igtyp)%G_NUVAR,nint(geo(25))) ! additional internal variables for h=6
294 prop_tag(igtyp)%G_DEFINI = 1
295 prop_tag(igtyp)%G_FORINI = 1
296C
297C------------------------
298 RETURN
299C
300 1000 FORMAT(
301 & 5x,'SPRING PROPERTY SET'/,
302 & 5x,'-------------------'/,
303 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
304 & 5x,'CONFIDENTIAL DATA'//)
305 1400 FORMAT(
306 & 5x,'SPRING PROPERTY SET'/,
307 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
308 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
309 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
310 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
311 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
312 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
313 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
314 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
315 & 5x,'FORCE-DISPLACEMENT CURVE (H=4,5,7). . .=',i10/,
316 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
317 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
318 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
319 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
320 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
321 & 5x,'8:ELASTIC, TOTAL LENGTH FUNCTION',/,
322 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
323 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
324 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
325 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
326 & 5x,'FUNCTION IDENTIFIER FOR ',/,
327 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
328 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3. . . .=',1pg20.13/,
329 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
330 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
331 & 5x,'NEGATIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
332 & 5x,'POSITIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
333 & 5x,'SENSOR NUMBER (0:NOT USED). . . . . . .=',i10/,
334 & 5x,'SENSOR FLAG (0:ACTIV 1:DISACT 2:BOTH) .=',i10/,
335 & 5x,'UNIT LENGTH FLAG. . . . . . . . . . . .=',i10/,
336 & 5x,'IF=1 UNIT LENGTH MASS,STIFFNESS AND INPUT',/,
337 & 5x,' CURVE ARE STRAIN DEPENDING',/)
338 1500 FORMAT(
339 & 5x,'SPRING PROPERTY SET'/,
340 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
341 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
342 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
343 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
344 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
345 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
346 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
347 & 5x,'PERMANENT DISPL./MAX. DISPL. CURVE(H=5)=',i10/,
348 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
349 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
350 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
351 & 5x,'4:kinematic 5:uncoupled nl(un/re)loading',/,
352 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
353 & 5X,'8:elastic, total length function. . . .',/,
354 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
355 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
356 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
357 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
358 & 5X,'FUNCTION identifier for ',/,
359 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
360 & 5X,'dynamic amplification factor gf3. . . .=',1PG20.13/,
361 & 5X,'function identifier for the additional ',/,
362 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
363 & 5X,'negative failure displacement . . . . .=',1PG20.13/,
364 & 5X,'positive failure displacement . . . . .=',1PG20.13/,
365 & 5X,'sensor number (0:NOT USED). . . . . . .=',I10/,
366 & 5X,'sensor flag (0:ACTIV 1:DISACT 2:BOTH) .=',I10/,
367 & 5X,'unit length flag. . . . . . . . . . . .=',I10/,
368 & 5X,'if=1 unit length mass,stiffness and input',/,
369 & 5X,' curve are strain depending',/)
370 RETURN
371 END
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
the
end diagonal values have been computed in the(sparse) matrix id.SOL
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_prop04
subroutine hm_read_prop04(geo, igeo, unitab, ig, igtyp, idtitl, prop_tag, lsubmodel, iunit)
Definition hm_read_prop04.F:41
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
elbuftag_mod
Definition elbuftag_mod.F:227
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
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
nl
character *2 function nl()
Definition message.F:2354
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:374
submodel_mod::submodel_data
Definition submodel_mod.F:723