OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat100.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_mat100 ../starter/source/materials/mat/mat100/hm_read_mat100.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_mat ../starter/source/materials/mat/hm_read_mat.F90
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
32!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
33!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
34!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
35!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
36!||--- uses -----------------------------------------------------
37!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
38!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_mat100(UPARAM ,MAXUPARAM,NUPARAM ,NUVAR ,IFUNC ,
43 . MFUNC ,MAXFUNC ,MTAG ,PARMAT ,UNITAB ,
44 . IMATVIS ,PM ,LSUBMODEL, ID ,TITR ,
45 . MATPARAM )
46C-----------------------------------------------
47C D e s c r i p t i o n
48C-----------------------------------------------
49C
50C DUMMY ARGUMENTS DESCRIPTION:
51C ===================
52C
53C NAME DESCRIPTION
54C
55C IPM MATERIAL ARRAY(INTEGER)
56C PM MATERIAL ARRAY(REAL)
57C UNITAB UNITS ARRAY
58C ID MATERIAL ID(INTEGER)
59C TITR MATERIAL TITLE
60C LSUBMODEL SUBMODEL STRUCTURE
61C
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE unitab_mod
66 USE elbuftag_mod
67 USE message_mod
68 USE submodel_mod
69 USE matparam_def_mod
70 USE hm_option_read_mod
71 USE names_and_titles_mod , ONLY : nchartitle
72C-----------------------------------------------
73C I m p l i c i t T y p e s
74C-----------------------------------------------
75#include "implicit_f.inc"
76C-----------------------------------------------
77C C o m m o n B l o c k s
78C-----------------------------------------------
79#include "units_c.inc"
80#include "param_c.inc"
81C-----------------------------------------------
82C D u m m y A r g u m e n t s
83C-----------------------------------------------
84 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
85 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: PM
86 my_real, DIMENSION(100) ,INTENT(INOUT) :: PARMAT
87 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
88
89 INTEGER, INTENT(INOUT) :: MFUNC,NUPARAM,NUVAR,IMATVIS
90 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
91 TYPE(MLAW_TAG_),INTENT(INOUT) :: MTAG
92 INTEGER,INTENT(IN) :: ID,MAXFUNC,MAXUPARAM
93 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
94 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*)
95 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 INTEGER :: NBMAT, MAT_ID ! Number of declared materials
100 INTEGER :: I,J,NRATE,NPS,ILAW,NFUNC,ITEST,N_NETWORK, FLAG_HE, FLAG_MUL, EXPPL,
101 . FLAG_PL,NHYPER,NET,N,TAB,SHIFT,
102 . nmul,ntemp,nplas,nvisc(10),flag_visc(10)
103 my_real :: rho0, e,nu,g,rbulk,tauref_unit,
104 . c1,c2,c3,c4,c5,mu,lm,d,beta,facpl, scale1, scale2,scalefac,
105 . c10,c01,c20,c11,c02 ,fac_unit,fac_sm,fac_bm,
106 . c30, c21,c12,c03,sb,d1,d2,d3,ff,epshat,tauy ,
107 . a(10),expc(10),
108 . expm(10),ksi(10),stiffn(10),b0(10),expn(10),tauref(10)
109 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
110C-----------------------------------------------
111C S o u r c e L i n e s
112C-----------------------------------------------
113 is_encrypted = .false.
114 is_available = .false.
115 g = zero
116C--------------------------------------------------
117C EXTRACT DATA (IS OPTION CRYPTED)
118C--------------------------------------------------
119 CALL hm_option_is_encrypted(is_encrypted)
120C-----------------------------------------------
121 imatvis = 1
122 ilaw = 100
123 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
124C-----------------------------------------------
125 nfunc = 0
126 nuvar = 0
127 c10 = zero
128 c01 = zero
129 c20 = zero
130 c11 = zero
131 c02 = zero
132 c30 = zero
133 c21 = zero
134 c12 = zero
135 c03 = zero
136 d1 = zero
137 d2 = zero
138 d3 = zero
139 nu = zero
140 nhyper = 0 ! NBRE PARAMETERS OF HYPERELASTIC LAW
141 rbulk = zero
142
143 flag_he = 1
144 flag_pl = 0
145C-----------------------------------------------
146card1
147 CALL hm_get_intv('MAT_N_net' , n_network, is_available, lsubmodel)
148 CALL hm_get_intv('MAT_Flag_HE', flag_he , is_available, lsubmodel)
149 CALL hm_get_intv('MAT_Flag_Cr', flag_pl , is_available, lsubmodel)
150
151 IF (n_network > 10 ) THEN
152 CALL ancmsg(msgid=1567 ,
153 . msgtype=msgerror,
154 . anmode=aninfo_blind_2,
155 . i1=id,
156 . c1=titr)
157 ENDIF
158C-----------------------------------------------
159c FLAG_HE = 1 =>POLYNOMIAL
160c FLAG_HE = 2 =>ARRUDA - BOYCE
161c FLAG_HE = 3 =>NEO-HOOK
162c FLAG_HE = 4 =>MOONEY-RIVLIN
163c FLAG_HE = 5 =>YEOH
164c FLAG_HE = 13=>NEO-HOOK WITH TEMPERATURE
165c Card FOR HYPERELASTIC MODEL
166 !--------------------------------------
167 IF (flag_he == 1)THEN
168card
169 CALL hm_get_floatv('MAT_C_10' ,c10 ,is_available, lsubmodel, unitab)
170 CALL hm_get_floatv('MAT_C_01' ,c01 ,is_available, lsubmodel, unitab)
171 CALL hm_get_floatv('MAT_C_20' ,c20 ,is_available, lsubmodel, unitab)
172 CALL hm_get_floatv('MAT_C_11' ,c11 ,is_available, lsubmodel, unitab)
173 CALL hm_get_floatv('MAT_C_02' ,c02 ,is_available, lsubmodel, unitab)
174card
175 CALL hm_get_floatv('MAT_C_30' ,c30 ,is_available, lsubmodel, unitab)
176 CALL hm_get_floatv('MAT_C_21' ,c21 ,is_available, lsubmodel, unitab)
177 CALL hm_get_floatv('MAT_C_12' ,c12 ,is_available, lsubmodel, unitab)
178 CALL hm_get_floatv('MAT_C_03' ,c03 ,is_available, lsubmodel, unitab)
179card
180 CALL hm_get_floatv('MAT_D_1' ,d1 ,is_available, lsubmodel, unitab)
181 CALL hm_get_floatv('MAT_D_2' ,d2 ,is_available, lsubmodel, unitab)
182 CALL hm_get_floatv('MAT_D_3' ,d3 ,is_available, lsubmodel, unitab)
183 nhyper = 12
184 !--------------------------------------
185 ELSEIF (flag_he == 2)THEN !ARRUDA-BOYCE
186card
187 CALL hm_get_floatv('MAT_MUE1' ,mu ,is_available, lsubmodel, unitab)
188 CALL hm_get_floatv('mat_d' ,D ,IS_AVAILABLE, LSUBMODEL, UNITAB)
189 CALL HM_GET_FLOATV('lambda' ,LM ,IS_AVAILABLE, LSUBMODEL, UNITAB)
190card
191 CALL HM_GET_INTV ('itype' ,ITEST ,IS_AVAILABLE, LSUBMODEL)
192 CALL HM_GET_INTV ('mat_fct_id_ab' ,IFUNC(1) ,IS_AVAILABLE, LSUBMODEL)
193 CALL HM_GET_FLOATV('mat_nu' ,NU ,IS_AVAILABLE, LSUBMODEL, UNITAB)
194 CALL HM_GET_FLOATV('fscale_ab' ,SCALEFAC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
195 IF(SCALEFAC == ZERO)THEN
196 CALL HM_GET_FLOATV_DIM('fscale_ab' ,FAC_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
197 SCALEFAC = ONE * FAC_UNIT
198 ENDIF
199 IF(ITEST == 0) ITEST = 1
200 NHYPER = 11
201 IF(IFUNC(1) /= 0) NFUNC = 1
202 !--------------------------------------
203 ELSEIF (FLAG_HE == 3)THEN !neo-hook
204card
205 CALL HM_GET_FLOATV('mat_c_10' ,c10 ,is_available, lsubmodel, unitab)
206 CALL hm_get_floatv('MAT_D_1' ,d1 ,is_available, lsubmodel, unitab)
207 nhyper = 12
208 !--------------------------------------
209 ELSEIF (flag_he == 4)THEN ! Mooney-Rivlin
210card
211 CALL hm_get_floatv('MAT_C_10' ,c10 ,is_available, lsubmodel, unitab)
212 CALL hm_get_floatv('MAT_C_01' ,c01 ,is_available, lsubmodel, unitab)
213 CALL hm_get_floatv('MAT_D_1' ,d1 ,is_available, lsubmodel, unitab)
214 nhyper = 12
215 !--------------------------------------
216 ELSEIF (flag_he == 5)THEN !yeoh
217card
218 CALL hm_get_floatv('MAT_C_10' ,c10 ,is_available, lsubmodel, unitab)
219 CALL hm_get_floatv('MAT_C_20' ,c20 ,is_available, lsubmodel, unitab)
220 CALL hm_get_floatv('MAT_C_30' ,c30 ,is_available, lsubmodel, unitab)
221 CALL hm_get_floatv('MAT_D_1' ,d1 ,is_available, lsubmodel, unitab)
222 nhyper = 12
223 !--------------------------------------
224 ELSEIF (flag_he == 13)THEN !neo-hook with temperature
225card
226 CALL hm_get_intv ('MAT_fct_ID_SM' ,ifunc(1) ,is_available, lsubmodel)
227 CALL hm_get_intv ('MAT_fct_ID_BM' ,ifunc(2) ,is_available, lsubmodel)
228 CALL hm_get_floatv('MAT_Fscale_SM' ,scale1 ,is_available, lsubmodel, unitab)
229 CALL hm_get_floatv('MAT_Fscale_BM' ,scale2 ,is_available, lsubmodel, unitab)
230 IF(scale1 == zero)THEN
231 CALL hm_get_floatv_dim('MAT_Fscale_SM' ,fac_sm ,is_available, lsubmodel, unitab)
232 scale1 = one * fac_sm
233 ENDIF
234 IF(scale2 == zero)THEN
235 CALL hm_get_floatv_dim('MAT_Fscale_BM' ,fac_bm ,is_available, lsubmodel, unitab)
236 scale2 = one * fac_bm
237 ENDIF
238 nfunc = 2
239 nhyper = 5
240 nuvar = 2
241 IF(ifunc(1)==0 .OR. ifunc(2)==0) THEN
242 CALL ancmsg(msgid=1571 ,
243 . msgtype=msgerror,
244 . anmode=aninfo_blind_2,
245 . i1=id,
246 . c1=titr)
247 ENDIF
248 !--------------------------------------
249 !--------------------------------------
250 ELSE
251 CALL ancmsg(msgid=1569 ,
252 . msgtype=msgerror,
253 . anmode=aninfo_blind_2,
254 . i1=id,
255 . c1=titr,
256 . i2=flag_he)
257 ENDIF
258 !FIN LECTURE PARAMETRES HYPERELASTQUES
259 !--------------------------------------
260 !--------------------------------------
261Card FOR PLASTICITY
262C=======================================================================
263 IF (flag_pl == 1)THEN
264card
265 CALL hm_get_floatv('MAT_A_pl' ,facpl ,is_available, lsubmodel, unitab)
266 CALL hm_get_floatv('MAT_Sigma_pl' ,tauy ,is_available, lsubmodel, unitab)
267 CALL hm_get_floatv('MAT_F_pl' ,ff ,is_available, lsubmodel, unitab)
268 CALL hm_get_floatv('MAT_Epsilon_F' ,epshat ,is_available, lsubmodel, unitab)
269 CALL hm_get_intv ('MAT_N_pl' ,exppl ,is_available, lsubmodel)
270
271 IF(exppl == 0) exppl=1
272 IF(facpl == zero) facpl=one
273 IF(epshat == zero) epshat=one
274 IF(ff == zero) ff=one
275 IF(tauy == zero) tauy = one
276 ! NUVAR = NUVAR + 13
277 ENDIF
278C=======================================================================
279Card FOR VISCOSITY
280
281 !NETWORK 1 OBLIGATOIRE NET = 1
282 !SECONDARY NETWORKS
283 !START READING PARAMETERS OF SECONDARY NETWORKS(VISCOSITY PARAMETERS )
284 nuvar = nuvar + 13 ! variables for equilibrium network
285 shift = 0
286 DO net = 1, n_network
287card
288 CALL hm_get_int_array_index ('MAT_ARR_Flag_visc',flag_visc(net),net,is_available,lsubmodel)
289 CALL hm_get_float_array_index('MAT_ARR_stiffness',stiffn(net) ,net,is_available,lsubmodel,unitab)
290 !-----------------------------
291 IF (flag_visc(net) == 1)THEN
292card
293 nvisc(net) = 5
294 CALL hm_get_float_array_index('MAT_ARR_A1' ,a(net) ,net,is_available,lsubmodel,unitab)
295 CALL hm_get_float_array_index('MAT_ARR_C' ,expc(net) ,net,is_available,lsubmodel,unitab)
296 CALL hm_get_float_array_index('MAT_ARR_M' ,expm(net) ,net,is_available,lsubmodel,unitab)
297 CALL hm_get_float_array_index('MAT_ARR_KSI',ksi(net) ,net,is_available,lsubmodel,unitab)
298 CALL hm_get_float_array_index('TAU_ref' ,tauref(net) ,net,is_available,lsubmodel,unitab)
299 shift = 9 +2 !SET NUVAR
300 IF(tauref(net) == zero) THEN
301 CALL hm_get_floatv_dim('TAU_ref' ,tauref_unit ,is_available, lsubmodel, unitab)
302 tauref(net) = one * tauref_unit
303 ENDIF
304
305
306 !-----------------------------
307 ELSEIF (flag_visc(net) == 2)THEN !hyperbolic sine
308 nvisc(net) = 3
309 CALL hm_get_float_array_index('MAT_ARR_A2',a(net) ,net,is_available,lsubmodel,unitab)
310 CALL hm_get_float_array_index('MAT_ARR_B' ,b0(net) ,net,is_available,lsubmodel,unitab)
311 CALL hm_get_float_array_index('MAT_ARR_N2' ,expn(net) ,net,is_available,lsubmodel,unitab)
312 shift = 9+2 !SET SHIFT FOR NUVAR
313
314 !READ(LINE,ERR=999,FMT=FMT_5F) A(NET),B0(NET),EXPN(NET)
315 ELSEIF (flag_visc(net) == 3)THEN ! POWER LAW
316 nvisc(net) = 3
317 CALL hm_get_float_array_index('MAT_ARR_A3',a(net) ,net,is_available,lsubmodel,unitab)
318 CALL hm_get_float_array_index('MAT_ARR_N3' ,expn(net) ,net,is_available,lsubmodel,unitab)
319 CALL hm_get_float_array_index('MAT_ARR_M3' ,expm(net) ,net,is_available,lsubmodel,unitab)
320 shift = 10 +2!SET NUVAR
321 ELSE
322 CALL ancmsg(msgid=1808 ,
323 . msgtype=msgerror,
324 . anmode=aninfo_blind_2,
325 . i1=id,
326 . c1=titr,
327 . i2=n_network,
328 . i3=net)
329 ! READ(LINE,ERR=999,FMT=FMT_5F) A(NET),EXPN(NET),EXPM(NET)
330 ENDIF !FLAG_VISC
331 !-----------------------------
332 nuvar = nuvar + shift
333
334 ENDDO
335
336 !NUVAR = NUVAR +50 !POUR DEBUG
337C
338 sb = zero
339 DO net = 1,n_network
340 sb = sb + stiffn(net) ! check si ca donne un =1
341 ENDDO
342
343 !==============HE========================
344 IF (flag_he == 1 .OR. flag_he == 3 .OR.flag_he == 4 .OR.flag_he == 5 )THEN
345 !--------------------------------------
346 IF(d2 /= zero ) d2 = one/d2
347 IF(d3 /= zero ) d3 = one/d3
348 g = two * (c10 + c01) *(sb + one)
349 IF(d1 /= zero) THEN
350 d1 = one/d1
351 rbulk= two*d1 *(one + sb)
352 nu = (three*rbulk -two*g)/(three*rbulk + g)/two
353 e = nine*rbulk*g/(three*rbulk + g)
354 ELSE
355 d2 = zero
356 d3 = zero
357 nu = 0.495
358 rbulk = two_third*g*(one + nu)/(one-two*nu)
359 d1 = rbulk / two ! 1/d1 a voir si on suprime pas le terme avec j
360 e = two*g*(one + nu)
361 ENDIF
362 !==============HE========================
363 ELSEIF (flag_he == 2)THEN
364 !--------------------------------------
365 c1 = half
366 c2 = one/twenty
367 c3 = eleven/1050.
368 c4 = 19.d00/7000.
369 c5 = 519.d00/673750.
370 IF(d == zero ) d = em20
371 IF(lm == zero) lm = seven
372 beta = one/lm/lm
373 g = mu*(one + three*beta /five + eighty19*beta*beta/175.
374 . + 513.*beta**3/875. + 42039.*beta**4/67375.)*(sb + one)
375 rbulk = two *(one + sb) /d
376 e = nine*rbulk*g/(three*rbulk + g)
377 IF(ifunc(1) == 0)THEN
378 nu = (three*rbulk -two*g)/(three*rbulk + g)/two
379 ELSE !(IFUNC(1) /= 0) THEN
380 nfunc = 1
381 IF (nu == zero) nu= 0.495
382 ENDIF
383 ENDIF ! FLAG_HE
384
385C=======================================================================
386C uparam
387C=======================================================================
388 uparam(1) = n_network
389 uparam(2) = flag_he
390 !UPARAM(3) = FLAG_MUL treated in updmat =1 if /fail/mullins exist
391 uparam(4) = sb
392 uparam(5) = flag_pl
393 !PRINSIPAL NETWORK
394 nmul = 0
395 ntemp = 0
396 nplas = 0
397 uparam(6) = nmul
398 uparam(7) = ntemp
399 uparam(8) = nplas
400 tab = 8 !USED IN UPDMAT AND ENGINE
401 IF (flag_he == 1 .OR. flag_he == 3 .OR.flag_he == 4 .OR.flag_he == 5 ) THEN
402 uparam(tab + 1) = c10
403 uparam(tab + 2) = c01
404 uparam(tab + 3) = c20
405 uparam(tab + 4) = c11
406 uparam(tab + 5) = c02
407 uparam(tab + 6) = c30
408 uparam(tab + 7) = c21
409 uparam(tab + 8) = c12
410 uparam(tab + 9) = c03
411 uparam(tab + 10) = d1
412 uparam(tab + 11) = d2
413 uparam(tab + 12) = d3
414 tab = tab + nhyper
415 ELSEIF (flag_he == 2) THEN
416 uparam(tab + 1) = c1
417 uparam(tab + 2) = c2
418 uparam(tab + 3) = c3
419 uparam(tab + 4) = c4
420 uparam(tab + 5) = c5
421 uparam(tab + 6) = mu
422 uparam(tab + 7) = one/d
423 uparam(tab + 8) = beta
424 uparam(tab + 9) = itest
425 uparam(tab +10) = nu
426 uparam(tab +11) = scalefac
427 tab = tab + nhyper
428 ELSEIF (flag_he == 13)THEN !neo-hook with temperature
429 uparam(tab + 1) = scale1
430 uparam(tab + 2) = scale2
431 uparam(tab + 3) = nfunc
432 !UPARAM(TAB+4) AND UPARAM(TAB+5) CALCULE DANS UPDMAT
433 tab = tab + nhyper
434 ENDIF
435 !NETWORK
436
437 !POUR FUTUR STOCKAGE PARAMETRE MULINS THERMIQUE PLASTIQUE
438 IF (flag_pl == 1) THEN
439 nplas = 5
440 uparam(tab + 1) = ff
441 uparam(tab + 2) = epshat
442 uparam(tab + 3) = tauy
443 uparam(tab + 4) = exppl
444 uparam(tab + 5) = facpl
445 ENDIF
446
447 tab = tab + nplas
448
449 DO n = 1, n_network
450 uparam(tab + 1) = stiffn(n)
451 uparam(tab + 2) = flag_visc(n)
452 uparam(tab + 3) = nvisc(n)
453 IF (flag_visc(n) == 1)THEN
454 IF(expm(n) == zero)expm(n) = one
455 IF(expc(n) == zero)expc(n) = -0.700000000
456 IF(ksi(n) == zero)ksi(n) = em02
457 uparam(tab + 4) = a(n)
458 uparam(tab + 5) = expc(n)
459 uparam(tab + 6) = expm(n)
460 uparam(tab + 7) = ksi(n)
461 uparam(tab + 8) = tauref(n)
462 tab = tab + 3 + nvisc(n)
463
464 ELSEIF (flag_visc(n) == 2)THEN !hperbolic sine
465 uparam(tab + 4) = a(n)
466 uparam(tab + 5) = b0(n)
467 uparam(tab + 6) = expn(n)
468 tab = tab + 3 + nvisc(n)
469 ELSEIF (flag_visc(n) == 3)THEN !power law
470 uparam(tab + 4) = a(n)
471 uparam(tab + 5) = expn(n)
472 uparam(tab + 6) = expm(n)
473 tab = tab + 3 + nvisc(n)
474 ENDIF
475 ENDDO
476 IF (flag_he /= 13)THEN
477 uparam(tab + 1) = g
478 uparam(tab + 2) = rbulk
479 parmat(1) = rbulk
480 parmat(2) = e
481 parmat(3) = nu
482 ENDIF
483 nuparam = tab + 2
484 mfunc = nfunc
485C=======================================================================
486 pm(89) = rho0
487 pm(100) = rbulk
488c-----------------
489 CALL init_mat_keyword(matparam,"INCOMPRESSIBLE")
490 CALL init_mat_keyword(matparam,"total")
491 CALL INIT_MAT_KEYWORD(MATPARAM,"hook")
492 ! Properties compatibility
493 CALL INIT_MAT_KEYWORD(MATPARAM,"solid_isotropic")
494C=======================================================================
495c output
496C=======================================================================
497 WRITE(IOUT,1001) TRIM(TITR),ID,100
498 WRITE(IOUT,1000)
499 IF (IS_ENCRYPTED)THEN
500 WRITE(IOUT,'(5X,A,//)')'CONFIDENTIAL DATA'
501 ELSE
502 WRITE(IOUT,1002)RHO0
503 WRITE(IOUT,900)N_NETWORK, FLAG_HE,FLAG_PL
504 IF (FLAG_HE == 1) THEN
505 WRITE(IOUT,1100)C10,C01,C20,C11,C02,
506 . C30, C21,C12,C03,D1,D2,D3
507
508 ELSEIF (FLAG_HE == 2) THEN
509 WRITE(IOUT,2000)MU,D, LM
510 IF(IFUNC(1) > 0) THEN
511 IF(ITEST == 1) THEN
512 WRITE(IOUT,2200)IFUNC(1),SCALEFAC, NU
513 ELSEIF(ITEST == 2) THEN
514 WRITE(IOUT,2300)IFUNC(1),SCALEFAC, NU
515 ELSEIF(ITEST == 3) THEN
516 WRITE(IOUT,2400)IFUNC(1),SCALEFAC, NU
517 ENDIF
518 ENDIF
519 ELSEIF (FLAG_HE == 3) THEN
520 WRITE(IOUT,2001)C10,D1
521 ELSEIF (FLAG_HE == 4) THEN
522 WRITE(IOUT,2002)C10,C01,D1
523 ELSEIF (FLAG_HE == 5) THEN
524 WRITE(IOUT,2003)C10,C20,C30,D1
525 ELSEIF (FLAG_HE == 13) THEN
526 WRITE(IOUT,2005)IFUNC(1),IFUNC(2),SCALE1,SCALE2
527 ENDIF
528 IF (FLAG_PL == 1) THEN
529 WRITE(IOUT,2004) FACPL , TAUY, EXPPL,FF,EPSHAT
530 ENDIF
531 DO N = 1, N_NETWORK
532 WRITE(IOUT,1150)N
533 IF (FLAG_VISC(N) == 1)THEN
534 WRITE(IOUT,1300)STIFFN(N),A(N),EXPC(N),EXPM(N),KSI(N) , TAUREF(N)
535 ELSEIF (FLAG_VISC(N) == 2)THEN !hperbolic sine
536 WRITE(IOUT,1400)STIFFN(N),A(N),B0(N),EXPN(N)
537 ELSEIF (FLAG_VISC(N) == 3)THEN !power law
538 WRITE(IOUT,1500)STIFFN(N),A(N),EXPN(N),EXPM(N)
539 ENDIF
540
541 ENDDO
542 IF (FLAG_HE /= 13)THEN
543 WRITE(IOUT,1200)G,RBULK, NU
544 endif
545 ENDIF
546c-------------------------------------------------------------
547 1000 FORMAT(
548 & 5X,' PARALLEL RHEOLOGICAL FRAMEWORK : ',/,
549 & 5X,' -------------------------------- ',/)
550 1001 FORMAT(/
551 & 5X,A,/,
552 & 5X,'MATERIAL NUMBER. . . . . . . . . . . . . =',I10/,
553 & 5X,'MATERIAL LAW . . . . . . . . . . . . . . =',I10/)
554 1002 FORMAT(
555 & 5X,'INITIAL DENSITY . . . . . . . . . . . . .=',1PG20.13/)
556 900 FORMAT(
557 & 5X,'NUMBER OF SECONDARY NETWORKS . . . . . .= ',I10/
558 & 5X,'FLAG FOR HYPERELASTIC LAW. . . . . . . .= ',I10/
559 & 5X,'FLAG FOR PLASTICITY. . . . . . . . . . .= ',I10)
560 1100 FORMAT(
561 & 5X,'HYPERELASTIC MODEL = PPOLYNOMIAL ',/,
562 & 5X,'C10 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
563 & 5X,'C01 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
564 & 5X,'C20 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
565 & 5X,'C11 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
566 & 5X,'C02 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
567 & 5X,'C30 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
568 & 5X,'C21 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
569 & 5X,'C12 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
570 & 5X,'C03 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
571 & 5X,'1/D1 . . . . . . . . . . . . . . . . . .=',1PG20.13/
572 & 5X,'1/D2 . . . . . . . . . . . . . . . . . .=',1PG20.13/
573 & 5X,'1/D3 . . . . . . . . . . . . . . . . . .=',1PG20.13/)
574 2000 FORMAT(
575 & 5X,'HYPERELASTIC MODEL = ARRUDA-BOYCE ',/,
576 & 5X,'MATERIAL CONSTANT MU . . . . . . . . . .=',1PG20.13/
577 & 5X,'VOLUMETRIC MATERIAL PARAMETER. . . . . .=',1PG20.13/
578 & 5X,'LOCKING STRETCH. . . . . . . . . . . . .=',1PG20.13//)
579 2200 FORMAT(
580 & 5X,'UNIAXIAL DATA TEST CURVE . . . . . . .=',I10/
581 & 5X,'SCALE FACTOR FOR STRESS IN FUNCTION. . .=',1PG20.13/
582 & 5X,'POISSON RATIO. . . . . . . . . . . . . .=',1PG20.13//)
583 2300 FORMAT(
584 & 5X,'EQUIBIAXIAL DATA TEST CURVE. . . . . . .=',I10/
585 & 5X,'SCALE FACTOR FOR STRESS IN FUNCTION. . .=',1PG20.13/
586 & 5X,'POISSON RATIO. . . . . . . . . . . . . .=',1PG20.13//)
587 2400 FORMAT(
588 & 5X,'PLANAR DATA TEST CURVE . . . . . . . .=',I10/
589 & 5X,'SCALE FACTOR FOR STRESS IN FUNCTION. . .=',1PG20.13/
590 & 5X,'POISSON RATIO. . . . . . . . . . . . . .=',1PG20.13//)
591 2001 FORMAT(
592 & 5X,'HYPERELASTIC MODEL = NEO-HOOKEAN ',/,
593 & 5X,'C10 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
594 & 5X,'1/D1 . . . . . . . . . . . . . . . . . .=',1PG20.13//)
595 2002 FORMAT(
596 & 5X,'HYPERELASTIC MODEL = MOONEY-RIVLIN ',/,
597 & 5X,'C10 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
598 & 5X,'C01 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
599 & 5X,'1/D1 . . . . . . . . . . . . . . . . . .=',1PG20.13//)
600 2003 FORMAT(
601 & 5X,'HYPERELASTIC MODEL = YEOH ',/,
602 & 5X,'C10 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
603 & 5X,'C20 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
604 & 5X,'C30 . . . . . . . . . . . . . . . . . . .=',1PG20.13/
605 & 5X,'1/D1 . . . . . . . . . . . . . . . . . .=',1PG20.13//)
606 2005 FORMAT(
607 & 5X,'HYPERELASTIC MODEL = TEMPERATURE DEPENDENT NEO HOOK',/,
608 & 5X,'FUNCTION ID FOR MU. . . . . . . . . . . .=',I10/
609 & 5X,'FUNCTION ID FOR D . . . . . . . . . . . .=',I10/
610 & 5X,'SCALE FACTOR FOR FUNCTION 1 . . . . . . .=',1PG20.13/
611 & 5X,'SCALE FACTOR FOR FUNCTION 2 . . . . . . .=',1PG20.13//)
612CFACPL , TAUY, EXPPL,FF,EPSHAT
613 2004 FORMAT(
614 & 5X,'PLASTICITY PARAMETERS IN EQUILIBRIUM NETWORK',/,
615 & 5X,'A FACTOR. . . . . . . . . . . . . . . . .=',1PG20.13/
616 & 5X,'FLOW RESISTANCE . . . . . . . . . . . . .=',1PG20.13/
617 & 5X,'EXPONENT FOR FLOW RATE. . . . . . . . . .=',I10/
618 & 5X,'FINAL FLOW RESISTANCE . . . . . . . . . .=',1PG20.13/
619 & 5X,'CHARACTERISTIC STRAIN . . . . . . . . . .=',1PG20.13//)
620 1150 FORMAT(
621 & 5X,'PARAMETERS FOR VISCOUS MODEL FOR NETWORK : ',I10)
622 1300 FORMAT(
623 & 5X,'BERGSTROM BOYCE VISCOUS MODEL ',/,
624 & 5X,'STIFFNESS SCALING COEFFICIENT. . . . . . =',1PG20.13/
625 & 5X,'A. . . . . . . . . . . . . . . . . . . . =',1PG20.13/
626 & 5X,'EXPONENT C . . . . . . . . . . . . . . . =',1PG20.13/
627 & 5X,'EXPONENT M . . . . . . . . . . . . . . . =',1PG20.13/
628 & 5X,'KSI. . . . . . . . . . . . . . . . . . . =',1PG20.13/
629 & 5X,'REFERENCE STRESS . . . . . . . . . . . . =',1PG20.13)
630 1400 FORMAT(
631 & 5X,'HYPERBOLIC SINE VISCOUS MODEL ',/,
632 & 5X,'STIFFNESS SCALING COEFFICIENT. . . . . . =',1PG20.13/
633 & 5X,'A. . . . . . . . . . . . . . . . . . . . =',1PG20.13/
634 & 5X,'COEFFICIENT B0 . . . . . . . . . . . . . =',1PG20.13/
635 & 5X,'EXPONENT N . . . . . . . . . . . . . . . =',1PG20.13/)
636 1500 FORMAT(
637 & 5X,'POWER LAW VISCOUS MODEL ',/,
638 & 5X,'STIFFNESS SCALING COEFFICIENT. . . . . . =',1PG20.13/
639 & 5X,'A. . . . . . . . . . . . . . . . . . . . =',1PG20.13/
640 & 5X,'EXPONENT N . . . . . . . . . . . . . . . =',1PG20.13/
641 & 5X,'EXPONENT M . . . . . . . . . . . . . . . =',1PG20.13/)
642 1200 FORMAT(
643 & 5X,'INITIAL SHEAR MODULUS . . . . . . . . . =',1PG20.13/
644 & 5X,'INITIAL BULK MODULUS. . . . . . . . . . =',1PG20.13/
645 & 5X,'POISSON RATIO . . . . . . . . . . . . . =',1PG20.13//)
646C
647 RETURN
648 END
649
650
651
652
653
654
655
656
657
658
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
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_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
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
hm_read_mat100
subroutine hm_read_mat100(uparam, maxuparam, nuparam, nuvar, ifunc, mfunc, maxfunc, mtag, parmat, unitab, imatvis, pm, lsubmodel, id, titr, matparam)
Definition hm_read_mat100.F:46
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
elbuftag_mod
Definition elbuftag_mod.F:227
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
submodel_mod::submodel_data
Definition submodel_mod.F:723