42
43
44
49 USE matparam_def_mod
51
52
53
54#include "implicit_f.inc"
55
56
57
58#include "units_c.inc"
59#include "param_c.inc"
60
61
62
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
74
75
76
77
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
82
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
90
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
100
102
103
104 IF (is_encrypted) THEN
105 WRITE(iout,1000)mat_id
106 ELSE
107 WRITE(iout,2000)
108 ENDIF
109
110
111! density
112
113
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
119
120
121
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
132
133
134
135
136 ifunc2 = 0
137 ifunc4 = 0
138
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)
142
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)
147
148!-------------------------------------------------------
149! Compression - bending parameeters only
150!-------------------------------------------------------
151
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)
159
160
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
167
168!-------------------------------------------------------
169! Common parameters
170!------------------------------------------------------
171
172 UPARAM(119) = LMIN
173
174
175
176 UPARAM(120) = F_MAX
177 UPARAM(121) = M_MAX
178
179
180 IF (RFAC == ZERO) RFAC = ONE
181 UPARAM(122) = IBEND
182 UPARAM(123) = ITORS
183 UPARAM(124) = RFAC
184
185!-------------------------------------------------------
186! Tension
187!------------------------------------------------------
188
189 IF (IFUNC1 /= 0) THEN
190 IECROU = 10
191 IF (IFUNC3 == 0) IFUNC3 = IFUNC1
192 ELSE
193 IECROU = 11
194 ENDIF
195
196.AND..AND. IF (IFUNC1 == 0 A /= ZERO A /= ONE) THEN
197 CALL ANCMSG(MSGID=663,
198 . MSGTYPE=MSGWARNING,
199 . ANMODE=ANINFO_BLIND_1,
200 . I1=IG,
201 . C1=TITR)
202 ENDIF
203
204
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
212
213 IF (IFUNC1 == 0) THEN
214 A = ONE
215 B = ZERO
216 E = ZERO
217 ENDIF
218
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
232
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
244
245 UPARAM(117) = YOUNG
246 UPARAM(118) = ZERO
247
248
249 PM(191) = XK
250 !!
251 IF1 = 0
252 IF2 = 6
253 IF3 = 12
254 IF4 = 18
255
256 IFUNC(1) = IFUNC1
257 IFUNC(IF2 + 1) = 0
258 IFUNC(IF3 + 1) = IFUNC3
259 IFUNC(IF4 + 1) = 0
260 NFUNC = 4
261
262
263!-------------------------------------------------------
264! Compression bending shear torsion
265!-------------------------------------------------------
266
267
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
278
279 XK = ZERO
280 XC = ZERO
281
282 IF (YOUNG > ZERO) THEN
283 IECROU = 12
284 XK = HALF*FIVE_OVER_6*YOUNG*SAREA
285 ENDIF
286
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
298
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
306
307
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
318
319 XK = ZERO
320 XC = ZERO
321
322 IF (YOUNG > ZERO) THEN
323 IECROU = 12
324 XK = HALF*FIVE_OVER_6*YOUNG*SAREA
325 ENDIF
326
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
338
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
346
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
360
361 XK = ZERO
362 XC = ZERO
363
364 IF (YOUNG > ZERO) THEN
365 IECROU = 12
366 XK = HALF*YOUNG*ITORS
367 ENDIF
368
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
380
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
396
397 XK = ZERO
398 XC = ZERO
399
400 IF (YOUNG > ZERO) THEN
401 IECROU = 12
402 XK = YOUNG*IBEND
403 ENDIF
404
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
416
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
432
433 XK = ZERO
434 XC = ZERO
435
436 IF (YOUNG > ZERO) THEN
437 IECROU = 12
438 XK = YOUNG*IBEND
439 ENDIF
440
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
452
453 IFUNC(6) = IFUNC1
454 IFUNC(IF2 + 6) = IFUNC2
455 IFUNC(IF3 + 6) = IFUNC3
456 IFUNC(IF4 + 6) = IFUNC4
457 NFUNC = NFUNC + 4
458
459
460 NUPARAM = 128
461
462
463
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
482
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
492
493 MTAG%G_INTVAR = 10
494
495 ! Properties compatibility
496 CALL INIT_MAT_KEYWORD(MATPARAM,"SPRING_MATERIAL")
497
498
499 RETURN
500
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/)
535
536 RETURN
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine area(d1, x, x2, y, y2, eint, stif0)
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
1.15.0