OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop12.F File Reference
#include "implicit_f.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_prop12 (geo, igeo, unitab, igtyp, ig, prop_tag, idtitl, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_prop12()

subroutine hm_read_prop12 ( geo,
integer, dimension(npropgi) igeo,
type (unit_type_), intent(in) unitab,
integer igtyp,
integer ig,
type(prop_tag_), dimension(0:maxprop) prop_tag,
character(len=nchartitle) idtitl,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 38 of file hm_read_prop12.F.

40C============================================================================
41C M o d u l e s
42C-----------------------------------------------
43 USE unitab_mod
44 USE message_mod
45 USE elbuftag_mod
46 USE submodel_mod
47 USE names_and_titles_mod , ONLY : nchartitle
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "units_c.inc"
56#include "param_c.inc"
57#include "tablen_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
62 INTEGER IGEO(NPROPGI),IGTYP,IG
63C REAL
64 my_real geo(npropg)
65 CHARACTER(LEN=NCHARTITLE) :: IDTITL
66 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
67 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER J, IFUNC, IFUNC2, IFUNC3, IECROU, IFV, ISENS,IFL,
72 . ILENG,FTAB_ID,IFRIC
73C REAL
74 my_real
75 . a, b, d, e, f, dn, dx, fric, lscale, pun, gf3,
76 . yscalef,xscalef,fmax,fmin
77 my_real
78 . a_unit,d_unit,e_unit,f_unit,lscale_unit,gf3_unit,rup_unit,xscale_unit,fmin_unit
79 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
80C=======================================================================
81c
82 pun = em01
83C
84 is_encrypted = .false.
85 is_available = .false.
86
87C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
88 igeo( 1)=ig
89 igeo(11)=igtyp
90 geo(12) =igtyp+pun
91C
92C--------------------------------------------------
93C EXTRACT DATA (IS OPTION CRYPTED)
94C--------------------------------------------------
95 CALL hm_option_is_encrypted(is_encrypted)
96C--------------------------------------------------
97C EXTRACT DATAS (INTEGER VALUES)
98C--------------------------------------------------
99 CALL hm_get_intv('ISENSOR',isens,is_available,lsubmodel)
100 CALL hm_get_intv('ISFLAG',ifl,is_available,lsubmodel)
101 CALL hm_get_intv('Ileng',ileng,is_available,lsubmodel)
102 CALL hm_get_intv('FUN_A1',ifunc,is_available,lsubmodel)
103 CALL hm_get_intv('HFLAG1',iecrou,is_available,lsubmodel)
104 CALL hm_get_intv('FUN_B1',ifv,is_available,lsubmodel)
105 CALL hm_get_intv('fct_ID31',ifunc2,is_available,lsubmodel)
106 CALL hm_get_intv('FUN_A2',ifunc3,is_available,lsubmodel)
107C--optional-
108 CALL hm_get_intv('FUNCT_ID',ftab_id,is_available,lsubmodel)
109 CALL hm_get_intv('P12_SPR_PUL_Ifric',ifric,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('FRIC',fric,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_X_F',f,is_available,lsubmodel,unitab)
123 CALL hm_get_floatv('Prop_X_E',e,is_available,lsubmodel,unitab)
124 CALL hm_get_floatv('scale1',lscale,is_available,lsubmodel,unitab)
125 CALL hm_get_floatv('h',gf3,is_available,lsubmodel,unitab)
126C--optional-
127 CALL hm_get_floatv('scale2',yscalef,is_available,lsubmodel,unitab)
128 CALL hm_get_floatv('scale3',xscalef,is_available,lsubmodel,unitab)
129 CALL hm_get_floatv('P12_SPR_PUL_F_min',fmin,is_available,lsubmodel,unitab)
130 CALL hm_get_floatv('P12_SPR_PUL_F_max',fmax,is_available,lsubmodel,unitab)
131c
132 CALL hm_get_floatv_dim('Acoeft1',a_unit,is_available,lsubmodel,unitab)
133 CALL hm_get_floatv_dim('Dcoeft1',d_unit,is_available,lsubmodel,unitab)
134 CALL hm_get_floatv_dim('h',gf3_unit,is_available,lsubmodel,unitab)
135 CALL hm_get_floatv_dim('Prop_X_F',f_unit,is_available,lsubmodel,unitab)
136 CALL hm_get_floatv_dim('Prop_X_E',e_unit,is_available,lsubmodel,unitab)
137 CALL hm_get_floatv_dim('scale1',lscale_unit,is_available,lsubmodel,unitab)
138 CALL hm_get_floatv_dim('MIN_RUP1',rup_unit,is_available,lsubmodel,unitab)
139 CALL hm_get_floatv_dim('scale3',xscale_unit,is_available,lsubmodel,unitab)
140 CALL hm_get_floatv_dim('P12_SPR_PUL_F_min',fmin_unit,is_available,lsubmodel,unitab)
141C----
142 IF(geo(2)==zero.AND.geo(3)==zero.AND.ifunc==zero) THEN
143 CALL ancmsg(msgid=602,
144 . msgtype=msgerror,
145 . anmode=aninfo_blind_1,
146 . i1=ig,
147 . c1=idtitl)
148 END IF
149 IF(geo(1)<=em15)THEN
150 CALL ancmsg(msgid=229,
151 . msgtype=msgerror,
152 . anmode=aninfo_blind_1,
153 . i1=ig,
154 . c1=idtitl)
155 ENDIF
156! IF(IFUNC/=0.AND.IECROU>=1.AND.GEO(2)==ZERO)THEN
157! CALL ANCMSG(MSGID=230,
158! . MSGTYPE=MSGERROR,
159! . ANMODE=ANINFO_BLIND_1,
160! . I1=IG,
161! . C1=TITR)
162! ENDIF
163 IF(iecrou==4.AND.(ifunc==0.OR.ifunc2==0))THEN
164 CALL ancmsg(msgid=231,
165 . msgtype=msgerror,
166 . anmode=aninfo_blind_1,
167 . i1=ig,
168 . c1=idtitl)
169 ENDIF
170 IF(iecrou==4.AND.geo(2)==zero)THEN
171 CALL ancmsg(msgid=230,
172 . msgtype=msgerror,
173 . anmode=aninfo_blind_1,
174 . i1=ig,
175 . c1=idtitl)
176 ENDIF
177 IF(iecrou==5.AND.(ifunc==0.OR.ifunc2==0))THEN
178 CALL ancmsg(msgid=231,
179 . msgtype=msgerror,
180 . anmode=aninfo_blind_1,
181 . i1=ig,
182 . c1=idtitl)
183 ENDIF
184 IF(iecrou==6.AND.(ifunc==0.OR.ifunc2==0))THEN
185 CALL ancmsg(msgid=1057,
186 . msgtype=msgerror,
187 . anmode=aninfo_blind_1,
188 . i1=ig,
189 . c1=idtitl)
190 ENDIF
191 IF(iecrou==7.AND.ifunc==0)THEN
192 CALL ancmsg(msgid=1058,
193 . msgtype=msgerror,
194 . anmode=aninfo_blind_1,
195 . i1=ig,
196 . c1=idtitl)
197
198 ELSEIF(iecrou==7.AND.ifunc2==0)THEN
199 CALL ancmsg(msgid=1059,
200 . msgtype=msgwarning,
201 . anmode=aninfo_blind_1,
202 . i1=ig,
203 . c1=idtitl,
204 . i2=iecrou)
205 iecrou = 2
206 ENDIF
207 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
208 CALL ancmsg(msgid=663,
209 . msgtype=msgwarning,
210 . anmode=aninfo_blind_1,
211 . i1=ig,
212 . c1=idtitl)
213 ENDIF
214C----
215 IF (a == zero) a = one * a_unit
216 IF (d == zero) d = one * d_unit
217 IF (e == zero) e = one * e_unit
218 IF (f == zero) f = one * f_unit
219 IF (lscale == zero) lscale = one * lscale_unit
220 IF (gf3 == zero) gf3 = one * gf3_unit
221 IF (ifunc == 0) THEN
222 a = one
223 b = zero
224 e = zero
225 ENDIF
226 IF (ifl == 1) isens=-isens
227C
228 IF (dn == zero) dn=-ep30
229 IF (dx == zero) dx= ep30
230 dn = dn * lscale / rup_unit
231 dx = dx * lscale / rup_unit
232c
233 IF (xscalef == zero) xscalef = one * xscale_unit
234 IF (yscalef == zero) yscalef = one
235 IF (fmin == zero) fmin = -ep30
236 IF (fmax == zero) fmax = ep30
237C------------------------
238 IF(is_encrypted)THEN
239 WRITE(iout,1000)ig
240 ELSE
241 IF (iecrou/=5) THEN
242 WRITE(iout,1400)ig,(geo(j),j=1,3),ifunc,lscale,ifunc2,f,iecrou,
243 . a,b,d,e,ifv,gf3,ifunc3,dn,dx,abs(isens),ifl,ileng,fric,
244 . ftab_id,ifric,yscalef,xscalef,fmin,fmax
245 ELSE
246 WRITE(iout,1500)ig,(geo(j),j=1,3),ifunc,lscale,ifunc2,f,iecrou,
247 . a,b,d,e,ifv,gf3,ifunc3,dn,dx,abs(isens),ifl,ileng,fric,
248 . ftab_id,ifric,yscalef,xscalef,fmin,fmax
249 ENDIF
250 ENDIF
251C----
252cmi IF (FTAB_ID > 0) FRIC = YSCALEF
253C----
254 geo(2) = geo(2) / a
255 geo(7) = iecrou+pun
256 geo(8) = 3
257 geo(9) = zero
258 geo(10) = a
259 geo(11) = b
260 geo(13) = d
261 geo(18) = one / f
262 geo(39) = one / lscale
263 geo(40) = e
264 geo(132)= gf3
265 geo(15) = dn
266 geo(16) = dx
267 geo(17) = fric
268 geo(20) = one/xscalef
269 geo(80) = ifl
270 geo(93) = ileng
271 geo(138) = fmin
272 geo(139) = fmax
273 geo(140) = yscalef
274 igeo(3) = isens
275C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
276 IF (iecrou == 6) THEN
277 geo(25) = 1
278 ENDIF
279C
280 igeo(101) = ifunc
281 igeo(102) = ifv
282 igeo(103) = ifunc2
283 igeo(201) = ftab_id
284 igeo(119) = ifunc3
285 igeo(202) = ifric
286C
287C-----------------------------
288C PROPERTY BUFFER
289C-----------------------------
290C
291 prop_tag(igtyp)%G_EINT = 1
292 prop_tag(igtyp)%G_FOR = 1
293 prop_tag(igtyp)%G_LENGTH = 1
294 prop_tag(igtyp)%G_TOTDEPL = 1
295 prop_tag(igtyp)%G_FOREP = 1
296 prop_tag(igtyp)%G_DEP_IN_TENS = 1
297 prop_tag(igtyp)%G_DEP_IN_COMP = 1
298 prop_tag(igtyp)%G_POSX = 5
299 prop_tag(igtyp)%G_YIELD = 1
300 prop_tag(igtyp)%G_LENGTH_ERR = 1
301 prop_tag(igtyp)%G_DFS = 1
302 prop_tag(igtyp)%G_INIFRIC = 1
303 prop_tag(igtyp)%G_NUVAR = max(prop_tag(igtyp)%G_NUVAR,nint(geo(25))) ! additional internal variables for h=6
304 prop_tag(igtyp)%G_DEFINI = 1
305 prop_tag(igtyp)%G_FORINI = 1
306C
307C------------------------
308 1000 FORMAT(
309 & 5x,'SPRING PROPERTY SET'/,
310 & 5x,'-------------------'/,
311 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
312 & 5x,'CONFIDENTIAL DATA'//)
313 1400 FORMAT(
314 & 5x,'SPRING PROPERTY SET (3 NODES PULLEY)'/,
315 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
316 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
317 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
318 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
319 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
320 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
321 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
322 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
323 & 5x,'FORCE-DISPLACEMENT CURVE (H=4,5,7). . .=',i10/,
324 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
325 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
326 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
327 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
328 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
329 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
330 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
331 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
332 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
333 & 5x,'FUNCTION IDENTIFIER FOR ',/,
334 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
335 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3. . . .=',1pg20.13/,
336 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
337 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
338 & 5x,'NEGATIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
339 & 5x,'POSITIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
340 & 5x,'SENSOR NUMBER (0:NOT USED). . . . . . .=',i10/,
341 & 5x,'SENSOR FLAG (0:ACTIV 1:DEACT 2:BOTH). .=',i10/,
342 & 5x,'UNIT LENGTH FLAG. . . . . . . . . . . .=',i10/,
343 & 5x,'IF=1 UNIT LENGTH MASS,STIFFNESS AND INPUT',/,
344 & 5x,' CURVE ARE STRAIN DEPENDING',/,
345 & 5x,'CONSTANT PULLEY FRICTION COEFFICIENT. .=',1pg20.13/
346 & 5x,'TABLE ID OF VARIABLE FRICTION FUNCTIONS=',i10/,
347 & 5x,'FRICTION FLAG . . . . . . . . . . . . .=',i10/,
348 & 5x,'Y SCALE FACTOR IN FRICTION TABLE. . . .=',1pg20.13/
349 & 5x,'FORCE ABSCISSA SCALE IN FRICTION TABLE.=',1pg20.13/
350 & 5x,'NON REVERSIBLE NEGATIVE LIMIT FORCE . .=',1pg20.13/
351 & 5x,'NON REVERSIBLE POSITIVE LIMIT FORCE . .=',1pg20.13/)
352 1500 FORMAT(
353 & 5x,'SPRING PROPERTY SET (3 NODES PULLEY)'/,
354 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
355 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
356 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
357 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
358 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
359 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
360 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
361 & 5x,'PERMANENT DISPL./MAX. DISPL. CURVE(H=5)=',i10/,
362 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
363 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
364 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
365 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
366 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
367 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
368 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
369 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
370 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
371 & 5x,'FUNCTION IDENTIFIER FOR ',/,
372 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
373 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3. . . .=',1pg20.13/,
374 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
375 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
376 & 5x,'NEGATIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
377 & 5x,'POSITIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
378 & 5x,'SENSOR NUMBER (0:NOT USED). . . . . . .=',i10/,
379 & 5x,'SENSOR FLAG (0:ACTIV 1:DISACT 2:BOTH) .=',i10/,
380 & 5x,'UNIT LENGTH FLAG. . . . . . . . . . . .=',i10/,
381 & 5x,'IF=1 UNIT LENGTH MASS,STIFFNESS AND INPUT',/,
382 & 5x,' CURVE ARE STRAIN DEPENDING',/,
383 & 5x,'CONSTANT PULLEY FRICTION COEFFICIENT. .=',1pg20.13/
384 & 5x,'TABLE ID OF VARIABLE FRICTION FUNCTIONS=',i10/,
385 & 5x,'FRICTION FLAG . . . . . . . . . . . . .=',i10/,
386 & 5x,'Y SCALE FACTOR IN FRICTION TABLE. . . .=',1pg20.13/
387 & 5x,'FORCE ABSCISSA SCALE IN FRICTION TABLE.=',1pg20.13/
388 & 5x,'NON REVERSIBLE NEGATIVE LIMIT FORCE . .=',1pg20.13/
389 & 5x,'NON REVERSIBLE POSITIVE LIMIT FORCE . .=',1pg20.13/)
390c-----------
391 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
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