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, idtitl, prop_tag, lsubmodel, iunit)

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,
character(len=nchartitle) idtitl,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer iunit )

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,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.AND..AND.! IF(IFUNC/=0IECROU>=1GEO(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.AND..OR. IF(IECROU == 4(IFUNC == 0IFUNC2 == 0))THEN
152 CALL ANCMSG(MSGID=231,
153 . MSGTYPE=MSGERROR,
154 . ANMODE=ANINFO_BLIND_1,
155 . I1=IG,
156 . C1=TITR)
157 ENDIF
158.AND. IF(IECROU == 4GEO(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.AND..OR. IF(IECROU == 5(IFUNC == 0IFUNC2 == 0))THEN
166 CALL ANCMSG(MSGID=231,
167 . MSGTYPE=MSGERROR,
168 . ANMODE=ANINFO_BLIND_1,
169 . I1=IG,
170 . C1=TITR)
171 ENDIF
172.AND..OR. IF(IECROU==6(IFUNC==0IFUNC2==0))THEN
173 CALL ANCMSG(MSGID=1057,
174 . MSGTYPE=MSGERROR,
175 . ANMODE=ANINFO_BLIND_1,
176 . I1=IG,
177 . C1=TITR)
178 ENDIF
179.AND. IF(IECROU==7IFUNC==0)THEN
180 CALL ANCMSG(MSGID=1058,
181 . MSGTYPE=MSGERROR,
182 . ANMODE=ANINFO_BLIND_1,
183 . I1=IG,
184 . C1=TITR)
185
186.AND. ELSEIF(IECROU==7IFUNC2==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.AND. IF(IECROU == 8 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.AND..AND. IF (IFUNC == 0 A /= ZERO 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.NOT. IF( 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.AND. IF(GEO(39)/=ZEROIGEO( 9)== 0)IGEO( 9)=NINT(GEO(39))
280.AND. IF(GEO(171)/=ZEROIGEO(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
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
if
if(complex_arithmetic) id
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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
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
nl
character *2 function nl()
Definition message.F:2354