OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop04.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "tablen_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop04 (geo, igeo, unitab, ig, igtyp, prop_tag, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_prop04()

subroutine hm_read_prop04 ( geo,
integer, dimension(npropgi) igeo,
type (unit_type_), intent(in) unitab,
integer ig,
integer igtyp,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 39 of file hm_read_prop04.F.

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
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
75C REAL
76 my_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! IF(IFUNC/=0.AND.IECROU>=1.AND.GEO(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 IF(iecrou == 4.AND.(ifunc == 0.OR.ifunc2 == 0))THEN
151 CALL ancmsg(msgid=231,
152 . msgtype=msgerror,
153 . anmode=aninfo_blind_1,
154 . i1=ig,
155 . c1=titr)
156 ENDIF
157 IF(iecrou == 4.AND.geo(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 IF(iecrou == 5.AND.(ifunc == 0.OR.ifunc2 == 0))THEN
165 CALL ancmsg(msgid=231,
166 . msgtype=msgerror,
167 . anmode=aninfo_blind_1,
168 . i1=ig,
169 . c1=titr)
170 ENDIF
171 IF(iecrou==6.AND.(ifunc==0.OR.ifunc2==0))THEN
172 CALL ancmsg(msgid=1057,
173 . msgtype=msgerror,
174 . anmode=aninfo_blind_1,
175 . i1=ig,
176 . c1=titr)
177 ENDIF
178 IF(iecrou==7.AND.ifunc==0)THEN
179 CALL ancmsg(msgid=1058,
180 . msgtype=msgerror,
181 . anmode=aninfo_blind_1,
182 . i1=ig,
183 . c1=titr)
184
185 ELSEIF(iecrou==7.AND.ifunc2==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 IF(iecrou == 8.AND. 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 IF (ifunc == 0 .AND. a /= zero .AND. 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 IF(.NOT. 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 IF(geo(39)/=zero.AND.igeo( 9)== 0)igeo( 9)=nint(geo(39))
279 IF(geo(171)/=zero.AND.igeo(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
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:418
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
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:230
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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:895
nl
character *2 function nl()
Definition message.F:2360
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799