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, fscale, rscale, 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 CHARACTER(LEN=NCHARTITLE) :: SLASH
80 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
81C=======================================================================
82c
83 pun = em01
84C
85 is_encrypted = .false.
86 is_available = .false.
87
88C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
89 igeo( 1)=ig
90 igeo(11)=igtyp
91 geo(12) =igtyp+pun
92C
93C--------------------------------------------------
94C EXTRACT DATA (IS OPTION CRYPTED)
95C--------------------------------------------------
96 CALL hm_option_is_encrypted(is_encrypted)
97C--------------------------------------------------
98C EXTRACT DATAS (INTEGER VALUES)
99C--------------------------------------------------
100 CALL hm_get_intv('ISENSOR',isens,is_available,lsubmodel)
101 CALL hm_get_intv('ISFLAG',ifl,is_available,lsubmodel)
102 CALL hm_get_intv('Ileng',ileng,is_available,lsubmodel)
103 CALL hm_get_intv('FUN_A1',ifunc,is_available,lsubmodel)
104 CALL hm_get_intv('HFLAG1',iecrou,is_available,lsubmodel)
105 CALL hm_get_intv('fun_b1',IFV,IS_AVAILABLE,LSUBMODEL)
106 CALL HM_GET_INTV('fct_id31',IFUNC2,IS_AVAILABLE,LSUBMODEL)
107 CALL HM_GET_INTV('fun_a2',IFUNC3,IS_AVAILABLE,LSUBMODEL)
108C--optional-
109 CALL HM_GET_INTV('funct_id',FTAB_ID,IS_AVAILABLE,LSUBMODEL)
110 CALL HM_GET_INTV('p12_spr_pul_ifric',IFRIC,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('fric',FRIC,IS_AVAILABLE,LSUBMODEL,UNITAB)
116 CALL HM_GET_FLOATV('stiff1',GEO(2),IS_AVAILABLE,LSUBMODEL,UNITAB)
117 CALL HM_GET_FLOATV('damp1',geo(3),is_available,lsubmodel,unitab)
118 CALL hm_get_floatv('Acoeft1',a,is_available,lsubmodel,unitab)
119 CALL hm_get_floatv('Bcoeft1',b,is_available,lsubmodel,unitab)
120 CALL hm_get_floatv('Dcoeft1',d,is_available,lsubmodel,unitab)
121 CALL hm_get_floatv('MIN_RUP1',dn,is_available,lsubmodel,unitab)
122 CALL hm_get_floatv('MAX_RUP1',dx,is_available,lsubmodel,unitab)
123 CALL hm_get_floatv('Prop_X_F',f,is_available,lsubmodel,unitab)
124 CALL hm_get_floatv('Prop_X_E',e,is_available,lsubmodel,unitab)
125 CALL hm_get_floatv('scale1',lscale,is_available,lsubmodel,unitab)
126 CALL hm_get_floatv('h',gf3,is_available,lsubmodel,unitab)
127C--optional-
128 CALL hm_get_floatv('scale2',yscalef,is_available,lsubmodel,unitab)
129 CALL hm_get_floatv('scale3',xscalef,is_available,lsubmodel,unitab)
130 CALL hm_get_floatv('P12_SPR_PUL_F_min',fmin,is_available,lsubmodel,unitab)
131 CALL hm_get_floatv('P12_SPR_PUL_F_max',fmax,is_available,lsubmodel,unitab)
132c
133 CALL hm_get_floatv_dim('Acoeft1',a_unit,is_available,lsubmodel,unitab)
134 CALL hm_get_floatv_dim('Dcoeft1',d_unit,is_available,lsubmodel,unitab)
135 CALL hm_get_floatv_dim('h',gf3_unit,is_available,lsubmodel,unitab)
136 CALL hm_get_floatv_dim('Prop_X_F',f_unit,is_available,lsubmodel,unitab)
137 CALL hm_get_floatv_dim('Prop_X_E',e_unit,is_available,lsubmodel,unitab)
138 CALL hm_get_floatv_dim('scale1',lscale_unit,is_available,lsubmodel,unitab)
139 CALL hm_get_floatv_dim('MIN_RUP1',rup_unit,is_available,lsubmodel,unitab)
140 CALL hm_get_floatv_dim('scale3',xscale_unit,is_available,lsubmodel,unitab)
141 CALL hm_get_floatv_dim('P12_SPR_PUL_F_min',fmin_unit,is_available,lsubmodel,unitab)
142C----
143 IF(geo(2)==zero.AND.geo(3)==zero.AND.ifunc==zero) THEN
144 CALL ancmsg(msgid=602,
145 . msgtype=msgerror,
146 . anmode=aninfo_blind_1,
147 . i1=ig,
148 . c1=idtitl)
149 END IF
150 IF(geo(1)<=em15)THEN
151 CALL ancmsg(msgid=229,
152 . msgtype=msgerror,
153 . anmode=aninfo_blind_1,
154 . i1=ig,
155 . c1=idtitl)
156 ENDIF
157! IF(IFUNC/=0.AND.IECROU>=1.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==4.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=idtitl)
170 ENDIF
171 IF(iecrou==4.AND.geo(2)==zero)THEN
172 CALL ancmsg(msgid=230,
173 . msgtype=msgerror,
174 . anmode=aninfo_blind_1,
175 . i1=ig,
176 . c1=idtitl)
177 ENDIF
178 IF(iecrou==5.AND.(ifunc==0.OR.ifunc2==0))THEN
179 CALL ancmsg(msgid=231,
180 . msgtype=msgerror,
181 . anmode=aninfo_blind_1,
182 . i1=ig,
183 . c1=idtitl)
184 ENDIF
185 IF(iecrou==6.AND.(ifunc==0.OR.ifunc2==0))THEN
186 CALL ancmsg(msgid=1057,
187 . msgtype=msgerror,
188 . anmode=aninfo_blind_1,
189 . i1=ig,
190 . c1=idtitl)
191 ENDIF
192 IF(iecrou==7.AND.ifunc==0)THEN
193 CALL ancmsg(msgid=1058,
194 . msgtype=msgerror,
195 . anmode=aninfo_blind_1,
196 . i1=ig,
197 . c1=idtitl)
198
199 ELSEIF(iecrou==7.AND.ifunc2==0)THEN
200 CALL ancmsg(msgid=1059,
201 . msgtype=msgwarning,
202 . anmode=aninfo_blind_1,
203 . i1=ig,
204 . c1=idtitl,
205 . i2=iecrou)
206 iecrou = 2
207 ENDIF
208 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
209 CALL ancmsg(msgid=663,
210 . msgtype=msgwarning,
211 . anmode=aninfo_blind_1,
212 . i1=ig,
213 . c1=idtitl)
214 ENDIF
215C----
216 IF (a == zero) a = one * a_unit
217 IF (d == zero) d = one * d_unit
218 IF (e == zero) e = one * e_unit
219 IF (f == zero) f = one * f_unit
220 IF (lscale == zero) lscale = one * lscale_unit
221 IF (gf3 == zero) gf3 = one * gf3_unit
222 IF (ifunc == 0) THEN
223 a = one
224 b = zero
225 e = zero
226 ENDIF
227 IF (ifl == 1) isens=-isens
228C
229 IF (dn == zero) dn=-ep30
230 IF (dx == zero) dx= ep30
231 dn = dn * lscale / rup_unit
232 dx = dx * lscale / rup_unit
233c
234 IF (xscalef == zero) xscalef = one * xscale_unit
235 IF (yscalef == zero) yscalef = one
236 IF (fmin == zero) fmin = -ep30
237 IF (fmax == zero) fmax = ep30
238C------------------------
239 IF(is_encrypted)THEN
240 WRITE(iout,1000)ig
241 ELSE
242 IF (iecrou/=5) THEN
243 WRITE(iout,1400)ig,(geo(j),j=1,3),ifunc,lscale,ifunc2,f,iecrou,
244 . a,b,d,e,ifv,gf3,ifunc3,dn,dx,abs(isens),ifl,ileng,fric,
245 . ftab_id,ifric,yscalef,xscalef,fmin,fmax
246 ELSE
247 WRITE(iout,1500)ig,(geo(j),j=1,3),ifunc,lscale,ifunc2,f,iecrou,
248 . a,b,d,e,ifv,gf3,ifunc3,dn,dx,abs(isens),ifl,ileng,fric,
249 . ftab_id,ifric,yscalef,xscalef,fmin,fmax
250 ENDIF
251 ENDIF
252C----
253cmi IF (FTAB_ID > 0) FRIC = YSCALEF
254C----
255 geo(2) = geo(2) / a
256 geo(7) = iecrou+pun
257 geo(8) = 3
258 geo(9) = zero
259 geo(10) = a
260 geo(11) = b
261 geo(13) = d
262 geo(18) = one / f
263 geo(39) = one / lscale
264 geo(40) = e
265 geo(132)= gf3
266 geo(15) = dn
267 geo(16) = dx
268 geo(17) = fric
269 geo(20) = one/xscalef
270 geo(80) = ifl
271 geo(93) = ileng
272 geo(138) = fmin
273 geo(139) = fmax
274 geo(140) = yscalef
275 igeo(3) = isens
276C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
277 IF (iecrou == 6) THEN
278 geo(25) = 1
279 ENDIF
280C
281 igeo(101) = ifunc
282 igeo(102) = ifv
283 igeo(103) = ifunc2
284 igeo(201) = ftab_id
285 igeo(119) = ifunc3
286 igeo(202) = ifric
287C
288C-----------------------------
289C PROPERTY BUFFER
290C-----------------------------
291C
292 prop_tag(igtyp)%G_EINT = 1
293 prop_tag(igtyp)%G_FOR = 1
294 prop_tag(igtyp)%G_LENGTH = 1
295 prop_tag(igtyp)%G_TOTDEPL = 1
296 prop_tag(igtyp)%G_FOREP = 1
297 prop_tag(igtyp)%G_DEP_IN_TENS = 1
298 prop_tag(igtyp)%G_DEP_IN_COMP = 1
299 prop_tag(igtyp)%G_POSX = 5
300 prop_tag(igtyp)%G_YIELD = 1
301 prop_tag(igtyp)%G_LENGTH_ERR = 1
302 prop_tag(igtyp)%G_DFS = 1
303 prop_tag(igtyp)%G_INIFRIC = 1
304 prop_tag(igtyp)%G_NUVAR = max(prop_tag(igtyp)%G_NUVAR,nint(geo(25))) ! additional internal variables for h=6
305 prop_tag(igtyp)%G_DEFINI = 1
306 prop_tag(igtyp)%G_FORINI = 1
307C
308C------------------------
309 1000 FORMAT(
310 & 5x,'SPRING PROPERTY SET'/,
311 & 5x,'-------------------'/,
312 & 5x,'property set number . . . . . . . . . .=',I10/,
313 & 5X,'confidential data'//)
314 1400 FORMAT(
315 & 5X,'spring property set(3 nodes pulley)'/,
316 & 5X,'property set number . . . . . . . . . .=',I10/,
317 & 5X,'spring mass . . . . . . . . . . . . . .=',1PG20.13/,
318 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
319 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
320 & 5X,'FUNCTION identifier for loading ',/,
321 & 5X,'force-displacement curve. . . . . . . .=',I10/,
322 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
323 & 5X,'function identifier for unloading ',/,
324 & 5X,'force-displacement curve (H=4,5,7). . .=',I10/,
325 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
326 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
327 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
328 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
329 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
330 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
331 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
332 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
333 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
334 & 5X,'function identifier for ',/,
335 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
336 & 5X,'dynamic amplification factor gf3. . . .=',1PG20.13/,
337 & 5X,'function identifier for the additional ',/,
338 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
339 & 5X,'negative failure displacement . . . . .=',1PG20.13/,
340 & 5X,'positive failure displacement . . . . .=',1PG20.13/,
341 & 5X,'sensor number (0:NOT USED). . . . . . .=',I10/,
342 & 5X,'sensor flag (0:ACTIV 1:DEACT 2:BOTH). .=',I10/,
343 & 5X,'unit length flag. . . . . . . . . . . .=',I10/,
344 & 5X,'if=1 unit length mass,stiffness and input',/,
345 & 5X,' curve are strain depending',/,
346 & 5X,'constant pulley friction coefficient. .=',1PG20.13/
347 & 5X,'table id of variable friction functions=',I10/,
348 & 5X,'friction flag . . . . . . . . . . . . .=',I10/,
349 & 5X,'y scale factor in friction table. . . .=',1PG20.13/
350 & 5X,'force abscissa scale in friction table.=',1PG20.13/
351 & 5X,'non reversible negative limit force . .=',1PG20.13/
352 & 5X,'non reversible positive limit force . .=',1PG20.13/)
353 1500 FORMAT(
354 & 5X,'spring property set (3 NODES PULLEY)'/,
355 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
356 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
357 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
358 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
359 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
360 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
361 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
362 & 5x,'PERMANENT DISPL./MAX. DISPL. CURVE(H=5)=',i10/,
363 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
364 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
365 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
366 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
367 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
368 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
369 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
370 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
371 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
372 & 5x,'FUNCTION IDENTIFIER FOR ',/,
373 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
374 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3. . . .=',1pg20.13/,
375 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
376 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
377 & 5x,'NEGATIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
378 & 5x,'POSITIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
379 & 5x,'SENSOR NUMBER (0:NOT USED). . . . . . .=',i10/,
380 & 5x,'SENSOR FLAG (0:ACTIV 1:DISACT 2:BOTH) .=',i10/,
381 & 5x,'UNIT LENGTH FLAG. . . . . . . . . . . .=',i10/,
382 & 5x,'IF=1 UNIT LENGTH MASS,STIFFNESS AND INPUT',/,
383 & 5x,' CURVE ARE STRAIN DEPENDING',/,
384 & 5x,'CONSTANT PULLEY FRICTION COEFFICIENT. .=',1pg20.13/
385 & 5x,'TABLE ID OF VARIABLE FRICTION FUNCTIONS=',i10/,
386 & 5x,'FRICTION FLAG . . . . . . . . . . . . .=',i10/,
387 & 5x,'Y SCALE FACTOR IN FRICTION TABLE. . . .=',1pg20.13/
388 & 5x,'FORCE ABSCISSA SCALE IN FRICTION TABLE.=',1pg20.13/
389 & 5x,'NON REVERSIBLE NEGATIVE LIMIT FORCE . .=',1pg20.13/
390 & 5x,'NON REVERSIBLE POSITIVE LIMIT FORCE . .=',1pg20.13/)
391c-----------
392 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_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
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
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