OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat40.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_mat40 (uparam, maxuparam, nuparam, nuvar, maxfunc, nfunc, stifint, unitab, mat_id, mtag, titr, lsubmodel, pm, imatvis, matparam)

Function/Subroutine Documentation

◆ hm_read_mat40()

subroutine hm_read_mat40 ( intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nuvar,
integer, intent(in) maxfunc,
integer, intent(inout) nfunc,
intent(inout) stifint,
type (unit_type_), intent(in) unitab,
integer, intent(in) mat_id,
type(mlaw_tag_), intent(inout) mtag,
character(len=nchartitle), intent(in) titr,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
intent(inout) pm,
integer, intent(inout) imatvis,
type(matparam_struct_), intent(inout) matparam )

Definition at line 38 of file hm_read_mat40.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE elbuftag_mod
47 USE message_mod
48 USE submodel_mod
49 USE matparam_def_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "units_c.inc"
60#include "param_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
65 my_real, DIMENSION(NPROPM), INTENT(INOUT) :: pm
66 my_real, DIMENSION(100), INTENT(INOUT) :: stifint
67 my_real, DIMENSION(MAXUPARAM), INTENT(INOUT) :: uparam
68 INTEGER, INTENT(INOUT) :: NFUNC, NUPARAM, NUVAR, IMATVIS
69 TYPE(MLAW_TAG_), INTENT(INOUT) :: MTAG
70 INTEGER, INTENT(IN) :: MAT_ID, MAXFUNC, MAXUPARAM
71 CHARACTER(LEN=NCHARTITLE),INTENT(IN) :: TITR
72 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
73 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 my_real :: ak, g0, g1, g2, g3, g4, g5, gt, beta1,
78 . beta2, beta3, beta4, beta5, nu1, nu2,
79 . astas, bstas, vmisk, fac_l, fac_t, fac_m, fac_c,
80 . rho0, rhor
81 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
82C-----------------------------------------------
83C S o u r c e L i n e s
84C-----------------------------------------------
85! Parameter initialization
86 nuvar = 40
87 nfunc = 0
88 imatvis = 1
89
90 is_encrypted = .false.
91 is_available = .false.
92
93! Check input encryption
94 CALL hm_option_is_encrypted(is_encrypted)
95! Initial and reference density
96 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
97 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
98 IF (rhor == zero) THEN
99 rhor = rho0
100 ENDIF
101 pm(1) = rhor
102 pm(89) = rho0
103! Line 1
104 CALL hm_get_floatv('MAT_BULK', ak, is_available, lsubmodel, unitab)
105 CALL hm_get_floatv('MAT_GI', g0, is_available, lsubmodel, unitab)
106 CALL hm_get_floatv('Astass', astas, is_available, lsubmodel, unitab)
107 CALL hm_get_floatv('Bstass', bstas, is_available, lsubmodel, unitab)
108 CALL hm_get_floatv('Kvm', vmisk, is_available, lsubmodel, unitab)
109! Line 2
110 CALL hm_get_floatv('MAT_G0', g1, is_available, lsubmodel, unitab)
111 CALL hm_get_floatv('MAT_G2', g2, is_available, lsubmodel, unitab)
112 CALL hm_get_floatv('MAT_G3', g3, is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('MAT_G4', g4, is_available, lsubmodel, unitab)
114 CALL hm_get_floatv('MAT_G5', g5, is_available, lsubmodel, unitab)
115! Line 3
116 CALL hm_get_floatv('MAT_DECAY', beta1, is_available, lsubmodel, unitab)
117 CALL hm_get_floatv('MAT_DECAY2', beta2, is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('MAT_DECAY3', beta3, is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_DECAY4', beta4, is_available, lsubmodel, unitab)
120 CALL hm_get_floatv('MAT_DECAY5', beta5, is_available, lsubmodel, unitab)
121
122 IF (astas <= em20) astas = infinity
123 IF (bstas <= em20) bstas = infinity
124 IF (vmisk <= em20) vmisk = infinity
125 nu1 = (three * ak - two * g0) / (two * g0 + six * ak)
126 gt = g0 + g1 + g2 + g3 + g4 + g5
127 nu2 = (three * ak - two * gt) / (two * gt + six * ak)
128 IF (nu1 < zero .OR. nu1 >= half) THEN
129 CALL ancmsg(msgid = 49,
130 . msgtype = msgerror,
131 . anmode = aninfo,
132 . r1 = nu1,
133 . i1 = mat_id,
134 . c1 = titr)
135 ENDIF
136 IF (nu2 < zero .OR. nu2 >= half) THEN
137 CALL ancmsg(msgid = 49,
138 . msgtype = msgerror,
139 . anmode = aninfo,
140 . r1 = nu2,
141 . i1 = mat_id,
142 . c1 = titr)
143 ENDIF
144 nuparam = 15
145 IF(nuparam > maxuparam)THEN
146 CALL ancmsg(msgid = 309,
147 . msgtype = msgerror,
148 . anmode = aninfo,
149 . i1 = mat_id,
150 . c1 = titr,
151 . i2 = nuparam,
152 . i3 = maxuparam)
153 ELSE
154 uparam(1) = ak
155 uparam(2) = g0
156 uparam(3) = g1
157 uparam(4) = g2
158 uparam(5) = g3
159 uparam(6) = g4
160 uparam(7) = g5
161 uparam(8) = max(beta1, em20)
162 uparam(9) = max(beta2, em20)
163 uparam(10) = max(beta3, em20)
164 uparam(11) = max(beta4, em20)
165 uparam(12) = max(beta5, em20)
166 uparam(13) = astas
167 uparam(14) = bstas
168 uparam(15) = vmisk
169 ENDIF
170
171 stifint(1) = ak
172
173! Formulation for solid elements time step computation.
174 stifint(16) = 2
175 stifint(17) = two * g0 / (ak + four_over_3 * g0)
176c-----------------
177 IF (nu1 >= 0.49 .or. nu2 >= 0.49) THEN
178 CALL init_mat_keyword(matparam,"INCOMPRESSIBLE")
179 ELSE
180 CALL init_mat_keyword(matparam,"COMPRESSIBLE")
181 END IF
182 CALL init_mat_keyword(matparam,"HOOK")
183 ! Properties compatibility
184 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
185 CALL init_mat_keyword(matparam,"SPH")
186c-----------------
187 WRITE(iout, 800) trim(titr), mat_id, 40
188 WRITE(iout,1000)
189 IF(is_encrypted)THEN
190 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
191 ELSE
192 WRITE(iout, 850) rho0
193 WRITE(iout,1100)ak,g0,g1,g2,g3,g4,g5,
194 . beta1,beta2,beta3,beta4,beta5,
195 . astas,bstas,vmisk
196 ENDIF
197C
198 800 FORMAT(/
199 & 5x,a,/,
200 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . .=',i10/,
201 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . .=',i10/)
202 850 FORMAT(
203 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . .=',1pg20.13/)
204 1000 FORMAT(
205 & 5x,' maxwell visco-elastic law ',/,
206 & 5X,' ------------------------- ',//)
207 1100 FORMAT(
208 & 5X,'bulk modulus . . . . . . . . . . . . .=',1PG20.13/
209 & 5X,'long time shear modulus . . . . . . . .=',1PG20.13/
210 & 5X,'shear modulus 1 . . . . . . . . . . . .=',1PG20.13/
211 & 5X,'shear modulus 2 . . . . . . . . . . . .=',1PG20.13/
212 & 5X,'shear modulus 3 . . . . . . . . . . . .=',1PG20.13/
213 & 5X,'shear modulus 4 . . . . . . . . . . . .=',1PG20.13/
214 & 5X,'shear modulus 5 . . . . . . . . . . . .=',1PG20.13/
215 & 5X,'decay constant 1 . . . . . . . . . . .=',1PG20.13/
216 & 5X,'decay constant 2 . . . . . . . . . . .=',1PG20.13/
217 & 5X,'decay constant 3 . . . . . . . . . . .=',1PG20.13/
218 & 5X,'decay constant 4 . . . . . . . . . . .=',1PG20.13/
219 & 5X,'decay constant 5 . . . . . . . . . . .=',1PG20.13/
220 & 5X,'stassi a coefficient . . . . . . . . .=',1PG20.13/
221 & 5X,'stassi b coefficient . . . . . . . . .=',1PG20.13/
222 & 5X,'k von mises coefficient . . . . . . . =',1PG20.13//)
223C
224 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine init_mat_keyword(matparam, keyword)
#define max(a, b)
Definition macros.h:21
integer, parameter nchartitle
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