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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat114 (uparam, maxuparam, nuparam, nfunc, parmat, unitab, pm, lsubmodel, israte, mat_id, titr, ifunc, maxfunc, mtag, matparam)

Function/Subroutine Documentation

◆ hm_read_mat114()

subroutine hm_read_mat114 ( intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nfunc,
intent(inout) parmat,
type (unit_type_), intent(in) unitab,
intent(inout) pm,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(inout) israte,
integer, intent(in) mat_id,
character(len=nchartitle), intent(in) titr,
integer, dimension(maxfunc), intent(inout) ifunc,
integer, intent(in) maxfunc,
type(mlaw_tag_), intent(inout) mtag,
type(matparam_struct_), intent(inout) matparam )

Definition at line 39 of file hm_read_mat114.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE message_mod
47 USE submodel_mod
48 USE elbuftag_mod
49 USE matparam_def_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51C-----------------------------------------------
52C I m p l i c i t T y p e sXM
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "units_c.inc"
59#include "param_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, INTENT(IN) :: MAT_ID,MAXUPARAM,MAXFUNC
65 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
66 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
67 INTEGER, INTENT(INOUT) :: ISRATE,IFUNC(MAXFUNC)
68 INTEGER, INTENT(INOUT) :: NUPARAM,NFUNC
69 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
70 my_real, DIMENSION(100),INTENT(INOUT) :: parmat
71 TYPE(SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
72 TYPE(MLAW_TAG_), INTENT(INOUT) :: MTAG
73 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
74C
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER J, IFUNC1, IFUNC2,IFUNC3, IECROU, IFUNC4, IG,
79 . IFAIL,ILENG,IFAIL2,FLGCHK,ILAW,
80 . I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,
81 . IF1,IF2,IF3,IF4
82C REAL
83 my_real
84 . a, b, d, e, f, xk, xc, dn, dx, fwv, lscale,
85 . pun,vt0, vr0, cc(6), cn(6), xa(6), xb(6),asrate,gf3,
86 . check(13,6),rho0,a_unit,e_unit,d_unit,
87 . l_unit,gf_unit,f_unit,lmin,young,sarea,f_max,m_max,rfac,ibend,itors,
88 . k1,k2
89 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
90C=======================================================================
91 is_encrypted = .false.
92 is_available = .false.
93 ilaw = 114
94 pun = em01
95 fwv = zero
96 israte = 0
97 asrate = zero
98 cc(1:6) = zero
99 flgchk = 0
100c------------------------------------------
101 CALL hm_option_is_encrypted(is_encrypted)
102c------------------------------------------
103c
104 IF (is_encrypted) THEN
105 WRITE(iout,1000)mat_id
106 ELSE
107 WRITE(iout,2000)
108 ENDIF
109c
110!-------------------------------------------------------
111! Density
112!-------------------------------------------------------
113c-------------------------------------------------------------------------------
114 WRITE(iout,1100) trim(titr),mat_id,ilaw
115 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
116 WRITE(iout,1300) rho0
117 pm(1) = rho0
118 pm(89) = rho0
119c-------------------------------------------------------------------------------
120!-------------------------------------------------------
121! Flags
122!-------------------------------------------------------
123 ifail2 = 0
124 ifail = 0
125 ileng = 1
126
127 uparam(1)=ifail
128 uparam(2)=ileng
129 uparam(3)=ifail2
130 uparam(4) = 6
131 nuparam = 4
132C
133!-------------------------------------------------------
134! Tension parameters
135!-------------------------------------------------------
136 ifunc2 = 0
137 ifunc4 = 0
138C
139 CALL hm_get_floatv('LMIN' ,lmin ,is_available, lsubmodel, unitab)
140 CALL hm_get_floatv('STIFF1' ,xk ,is_available, lsubmodel, unitab)
141 CALL hm_get_floatv('DAMP1' ,xc ,is_available, lsubmodel, unitab)
142C
143 CALL hm_get_intv ('FUN_L' ,ifunc1 ,is_available, lsubmodel)
144 CALL hm_get_intv ('FUN_UL' ,ifunc3 ,is_available, lsubmodel)
145 CALL hm_get_floatv('Fcoeft1' ,a ,is_available, lsubmodel, unitab)
146 CALL hm_get_floatv('Xcoeft1' ,lscale ,is_available, lsubmodel, unitab)
147C
148!-------------------------------------------------------
149! Compression - bending parameeters only
150!-------------------------------------------------------
151C
152 CALL hm_get_floatv('YOUNG' ,young ,is_available, lsubmodel, unitab)
153 CALL hm_get_floatv('SHEAR_AREA',sarea ,is_available, lsubmodel, unitab)
154 CALL hm_get_floatv('FMAX' ,f_max ,is_available, lsubmodel, unitab)
155 CALL hm_get_floatv('MMAX' ,m_max ,is_available, lsubmodel, unitab)
156 CALL hm_get_floatv('Rfac' ,rfac ,is_available, lsubmodel, unitab)
157 CALL hm_get_floatv('Ibend' ,ibend ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('Itors' ,itors ,is_available, lsubmodel, unitab)
159C
160C----
161 IF (is_encrypted) THEN
162 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
163 ELSE
164 WRITE(iout,2001)'TENSION',xk,xc,ifunc1,ifunc3,lscale,a,lmin
165 WRITE(iout,2002)'BEAM PARAMETERS',young,f_max,m_max,ibend,itors,rfac,sarea
166 ENDIF
167C
168!-------------------------------------------------------
169! Common parameters
170!------------------------------------------------------
171C
172 uparam(119) = lmin
173
174C IF (F_MAX == ZERO) F_MAX = INFINITY
175C IF (M_MAX == ZERO) M_MAX = INFINITY
176 uparam(120) = f_max
177 uparam(121) = m_max
178C
179C --- Computation of inertia / length only if E > 0
180 IF (rfac == zero) rfac = one
181 uparam(122) = ibend
182 uparam(123) = itors
183 uparam(124) = rfac
184C
185!-------------------------------------------------------
186! Tension
187!------------------------------------------------------
188C
189 IF (ifunc1 /= 0) THEN
190 iecrou = 10
191 IF (ifunc3 == 0) ifunc3 = ifunc1
192 ELSE
193 iecrou = 11
194 ENDIF
195C
196 IF (ifunc1 == 0 .AND. a /= zero .AND. a /= one) THEN
197 CALL ancmsg(msgid=663,
198 . msgtype=msgwarning,
199 . anmode=aninfo_blind_1,
200 . i1=ig,
201 . c1=titr)
202 ENDIF
203C
204C--------
205 dn =-infinity
206 dx = infinity
207 IF (lscale == zero) lscale = one
208 IF (a == zero) THEN
209 CALL hm_get_floatv_dim('Fcoeft1' ,a_unit ,is_available, lsubmodel, unitab)
210 a = one * a_unit
211 ENDIF
212C
213 IF (ifunc1 == 0) THEN
214 a = one
215 b = zero
216 e = zero
217 ENDIF
218C----
219 i1 = nuparam
220 i2 = i1 + 6
221 i3 = i2 + 6
222 i4 = i3 + 6
223 i5 = i4 + 6
224 i6 = i5 + 6
225 i7 = i6 + 6
226 i8 = i7 + 6
227 i9 = i8 + 6
228 i10 = i9 + 6
229 i11 = i10 + 6
230 i12 = i11 + 6
231 i13 = i12 + 6
232C
233 uparam(i1 + 1) = a
234 uparam(i3 + 1) = one
235 uparam(i4 + 1) = one
236 uparam(i5 + 1) = one
237 uparam(i6 + 1) = one
238 uparam(i7 + 1) = one / lscale
239 uparam(i8 + 1) = dn
240 uparam(i9 + 1) = dx
241 uparam(i11 + 1) = xk
242 uparam(i12 + 1) = xc
243 uparam(i13 + 1) = iecrou+pun
244C
245 uparam(117) = young
246 uparam(118) = zero
247C
248C for interface stifness
249 pm(191) = xk
250 !!
251 if1 = 0
252 if2 = 6
253 if3 = 12
254 if4 = 18
255C
256 ifunc(1) = ifunc1
257 ifunc(if2 + 1) = 0
258 ifunc(if3 + 1) = ifunc3
259 ifunc(if4 + 1) = 0
260 nfunc = 4
261C
262c-------------------------------------------------------------------------------
263!-------------------------------------------------------
264! Compression bending shear torsion
265!-------------------------------------------------------
266
267c-------------------------------------------------------------------------------
268!-----------------
269 ! Shear XY
270!-----------------
271 ifunc1 = 0
272 ifunc2 = 0
273 ifunc3 = 0
274 ifunc4 = 0
275 dn =-infinity
276 dx = infinity
277 iecrou = 0
278C
279 xk = zero
280 xc = zero
281C
282 IF (young > zero) THEN
283 iecrou = 12
284 xk = half*five_over_6*young*sarea
285 ENDIF
286C----
287 uparam(i1 + 2) = one
288 uparam(i3 + 2) = one
289 uparam(i4 + 2) = one
290 uparam(i5 + 2) = one
291 uparam(i6 + 2) = one
292 uparam(i7 + 2) = one
293 uparam(i8 + 2) = dn
294 uparam(i9 + 2) = dx
295 uparam(i11 + 2) = xk
296 uparam(i12 + 2) = xc
297 uparam(i13 + 2) = iecrou+pun
298CC for interface stifness
299 pm(192) = xk
300 !!
301 ifunc(2) = ifunc1
302 ifunc(if2 + 2) = ifunc2
303 ifunc(if3 + 2) = ifunc3
304 ifunc(if4 + 2) = ifunc4
305 nfunc = nfunc + 4
306C----
307c-------------------------------------------------------------------------------
308!-----------------
309 ! Shear XZ
310!-----------------
311 ifunc1 = 0
312 ifunc2 = 0
313 ifunc3 = 0
314 ifunc4 = 0
315 dn =-infinity
316 dx = infinity
317 iecrou = 0
318C
319 xk = zero
320 xc = zero
321C
322 IF (young > zero) THEN
323 iecrou = 12
324 xk = half*five_over_6*young*sarea
325 ENDIF
326C----
327 uparam(i1 + 3) = one
328 uparam(i3 + 3) = one
329 uparam(i4 + 3) = one
330 uparam(i5 + 3) = one
331 uparam(i6 + 3) = one
332 uparam(i7 + 3) = one
333 uparam(i8 + 3) = dn
334 uparam(i9 + 3) = dx
335 uparam(i11 + 3) = xk
336 uparam(i12 + 3) = xc
337 uparam(i13 + 3) = iecrou+pun
338CC for interface stifness
339 pm(193) = xk
340 !!
341 ifunc(3) = ifunc1
342 ifunc(if2 + 3) = ifunc2
343 ifunc(if3 + 3) = ifunc3
344 ifunc(if4 + 3) = ifunc4
345 nfunc = nfunc + 4
346c
347!-------------------------------------------------------
348! rotations
349!-------------------------------------------------------
350!-----------------
351 ! Torsion X
352!-----------------
353 ifunc1 = 0
354 ifunc2 = 0
355 ifunc3 = 0
356 ifunc4 = 0
357 dn =-infinity
358 dx = infinity
359 iecrou = 0
360C
361 xk = zero
362 xc = zero
363C
364 IF (young > zero) THEN
365 iecrou = 12
366 xk = half*young*itors
367 ENDIF
368C----
369 uparam(i1 + 4) = one
370 uparam(i3 + 4) = one
371 uparam(i4 + 4) = one
372 uparam(i5 + 4) = one
373 uparam(i6 + 4) = one
374 uparam(i7 + 4) = one
375 uparam(i8 + 4) = dn
376 uparam(i9 + 4) = dx
377 uparam(i11 + 4) = xk
378 uparam(i12 + 4) = xc
379 uparam(i13 + 4) = iecrou+pun
380C
381 ifunc(3) = ifunc1
382 ifunc(if2 + 3) = ifunc2
383 ifunc(if3 + 3) = ifunc3
384 ifunc(if4 + 3) = ifunc4
385 nfunc = nfunc + 4
386!-----------------
387 ! Rotation Y
388!----------------
389 ifunc1 = 0
390 ifunc2 = 0
391 ifunc3 = 0
392 ifunc4 = 0
393 dn =-infinity
394 dx = infinity
395 iecrou = 0
396C
397 xk = zero
398 xc = zero
399C
400 IF (young > zero) THEN
401 iecrou = 12
402 xk = young*ibend
403 ENDIF
404C----
405 uparam(i1 + 5) = one
406 uparam(i3 + 5) = one
407 uparam(i4 + 5) = one
408 uparam(i5 + 5) = one
409 uparam(i6 + 5) = one
410 uparam(i7 + 5) = one
411 uparam(i8 + 5) = dn
412 uparam(i9 + 5) = dx
413 uparam(i11 + 5) = xk
414 uparam(i12 + 5) = xc
415 uparam(i13 + 5) = iecrou+pun
416C
417 ifunc(5) = ifunc1
418 ifunc(if2 + 5) = ifunc2
419 ifunc(if3 + 5) = ifunc3
420 ifunc(if4 + 5) = ifunc4
421 nfunc = nfunc + 4
422!-----------------
423 ! Rotation Z
424!-----------------
425 ifunc1 = 0
426 ifunc2 = 0
427 ifunc3 = 0
428 ifunc4 = 0
429 dn =-infinity
430 dx = infinity
431 iecrou = 0
432C
433 xk = zero
434 xc = zero
435C
436 IF (young > zero) THEN
437 iecrou = 12
438 xk = young*ibend
439 ENDIF
440C----
441 uparam(i1 + 6) = one
442 uparam(i3 + 6) = one
443 uparam(i4 + 6) = one
444 uparam(i5 + 6) = one
445 uparam(i6 + 6) = one
446 uparam(i7 + 6) = one
447 uparam(i8 + 6) = dn
448 uparam(i9 + 6) = dx
449 uparam(i11 + 6) = xk
450 uparam(i12 + 6) = xc
451 uparam(i13 + 6) = iecrou+pun
452C
453 ifunc(6) = ifunc1
454 ifunc(if2 + 6) = ifunc2
455 ifunc(if3 + 6) = ifunc3
456 ifunc(if4 + 6) = ifunc4
457 nfunc = nfunc + 4
458C-----------------------------
459C
460 nuparam = 128
461C
462C------------------------
463C------------------------
464 mtag%G_TOTDEPL = 3 ! DX (DY,DZ) - total deformation (translation)
465 mtag%G_TOTROT = 3 ! RX (RY,RZ) - total deformation (rotation)
466 mtag%G_DEP_IN_TENS = 3 ! DPX (DPY,DPZ) - max displacement in tension
467 mtag%G_DEP_IN_COMP = 3 ! DPX2 (DPY2,DPZ2) - max displacement in compression
468 mtag%G_ROT_IN_TENS = 3 ! RPX (RPY,RPZ) - max rotation in tension
469 mtag%G_ROT_IN_COMP = 3 ! RPX2 (RPY2,RPY2) - max rotation in compression
470 mtag%G_POSX = 5
471 mtag%G_POSY = 5
472 mtag%G_POSZ = 5
473 mtag%G_POSXX = 5
474 mtag%G_POSYY = 5
475 mtag%G_POSZZ = 5
476 mtag%G_YIELD = 6
477 mtag%G_RUPTCRIT = 1
478 mtag%G_NUVAR = max(mtag%G_NUVAR,nint(uparam(4)))
479 mtag%G_MASS = 1
480 parmat(4) = zero
481 parmat(5) = zero
482C
483 mtag%G_SLIPRING_ID = 1
484 mtag%G_SLIPRING_FRAM_ID = 1
485 mtag%G_SLIPRING_STRAND = 1
486 mtag%G_RETRACTOR_ID = 1
487 mtag%G_RINGSLIP = 1
488 mtag%G_ADD_NODE = 2
489 mtag%G_UPDATE = 1
490 mtag%G_DFS = 1
491 mtag%G_FRAM_FACTOR = 1
492C-- INTVAR used to comput force in 2nd strand when element is in slipring
493 mtag%G_INTVAR = 10
494C------------------------
495 ! Properties compatibility
496 CALL init_mat_keyword(matparam,"SPRING_MATERIAL")
497C------------------------
498C------------------------
499 RETURN
500c-----------
501 1000 FORMAT(
502 & 5x,'SPRING MATERIAL SET (SEATBELT TYPE)'/,
503 & 5x,'-------------------------------'/,
504 & 5x,'MATERIAL SET NUMBER . . . . . . . . . .=',i10/,
505 & 5x,'CONFIDENTIAL DATA'//)
506 1100 FORMAT(/
507 & 5x,a,/,
508 & 5x,'MATERIAL SET NUMBER. . . . . . . . . . =',i10/,
509 & 5x,'MATERIAL LAW . . . . . . . . . . . . . =',i10/)
510 1300 FORMAT(
511 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
512 2000 FORMAT(
513 & 5x,'SPRING MATERIAL SET (SEATBELT TYPE)'/,
514 & 5x,'-------------------------------'/)
515 2001 FORMAT(
516 & 5x,a,/,
517 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
518 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
519 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
520 & 5x,'FORCE-ENGINEERING STRAIN CURVE. . . . .=',i10/,
521 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
522 & 5x,'FORCE-ENGINEERING STRAIN CURVE CURVE .=',i10/,
523 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
524 & 5x,'ORDINATE SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
525 & 5x,'MINIUM LENGTH FOR MASS COMPUTATION . . =',1pg20.13/)
526 2002 FORMAT(
527 & 5x,a,/,
528 & 5x,'YOUNG MODULUS . . . . . . . . . . . . .=',1pg20.13/,
529 & 5x,'MAXIMUM FORCE FOR SHEAR/COMPRESSION . .=',1pg20.13/,
530 & 5x,'MAXIMUM TORQUE FOR BENDING/TORSION . .=',1pg20.13/,
531 & 5x,'AREA MOMENT OF INERTIA FOR BENDING . .=',1pg20.13/,
532 & 5x,'AREA MOMENT OF INERTIA FOR TORSION . .=',1pg20.13/,
533 & 5x,'SCALING FACTOR FOR INERTIA. . . . . . .=',1pg20.13/,
534 & 5x,'SHEAR AREA . . . . . . . . . . . . . .=',1pg20.13/)
535c-----------
536 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: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
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
max
#define max(a, b)
Definition macros.h:21
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