OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat62.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_mat62 (uparam, maxuparam, nuparam, nuvar, nfunc, parmat, unitab, pm, mat_id, titr, imatvis, lsubmodel, matparam)

Function/Subroutine Documentation

◆ hm_read_mat62()

subroutine hm_read_mat62 ( intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nuvar,
integer, intent(inout) nfunc,
intent(inout) parmat,
type (unit_type_), intent(in) unitab,
intent(inout) pm,
integer, intent(in) mat_id,
character(len=nchartitle), intent(in) titr,
integer, intent(inout) imatvis,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(matparam_struct_), intent(inout) matparam )

Definition at line 38 of file hm_read_mat62.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 matparam_def_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C ROUTINE DESCRIPTION :
52C ===================
53C READ MAT LAW62 (VISC_HYP)
54C-----------------------------------------------
55C DUMMY ARGUMENTS DESCRIPTION:
56C ===================
57C UNITAB UNITS ARRAY
58C ID MATERIAL ID(INTEGER)
59C TITR MATERIAL TITLE
60C LSUBMODEL SUBMODEL STRUCTURE
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "units_c.inc"
69#include "param_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
74 INTEGER, INTENT(IN) :: MAT_ID,MAXUPARAM
75 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
76 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
77 INTEGER, INTENT(INOUT) :: NUPARAM,NUVAR,NFUNC,IMATVIS
78 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
79 my_real, DIMENSION(100),INTENT(INOUT) :: parmat
80 TYPE(SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
81 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER :: J,NORDER,NVISC,FLAG_VISC,IVISC,ILAW,ITAG,
86 . FLAG_RIGIDITY
87 my_real :: rho0,rhor,gammainf,nug,sum,gs,p,viscmax,bulk
88 my_real, DIMENSION(100) :: mu,al,gama,taux,nu,beta
89 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
90C=======================================================================
91 is_encrypted = .false.
92 is_available = .false.
93 ilaw = 62
94c
95C--------------------------------------------------
96C check crypting
97C--------------------------------------------------
98c
99 CALL hm_option_is_encrypted(is_encrypted)
100c
101C--------------------------------------------------
102C Read DATA
103C--------------------------------------------------
104 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
105 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
106c
107 CALL hm_get_floatv('MAT_NU' ,nug ,is_available, lsubmodel, unitab)
108 CALL hm_get_intv ('ORDER' ,norder ,is_available,lsubmodel)
109 CALL hm_get_intv ('Order2' ,nvisc ,is_available,lsubmodel)
110 CALL hm_get_floatv('MU' ,viscmax ,is_available, lsubmodel, unitab)
111 CALL hm_get_intv ('Vflag' ,flag_visc ,is_available,lsubmodel)
112 CALL hm_get_intv ('Rflag' ,flag_rigidity ,is_available,lsubmodel)
113c
114 IF (norder > 0) THEN
115 DO j=1,norder
116 CALL hm_get_float_array_index('Mu_arr' ,mu(j),j,is_available,lsubmodel,unitab)
117 ENDDO
118 DO j=1,norder
119 CALL hm_get_float_array_index('Alpha_arr',al(j),j,is_available,lsubmodel,unitab)
120 ENDDO
121 ELSE
122 CALL ancmsg(msgid=559,
123 . msgtype=msgerror,
124 . anmode=aninfo_blind_1,
125 . i1=mat_id,
126 . c1=titr)
127 ENDIF
128c
129 IF (nvisc > 0) THEN
130 DO j=1,nvisc
131 CALL hm_get_float_array_index('Gamma_arr',gama(j),j,is_available,lsubmodel,unitab)
132 ENDDO
133 DO j=1,nvisc
134 CALL hm_get_float_array_index('Tau_arr' ,taux(j),j,is_available,lsubmodel,unitab)
135 ENDDO
136 ENDIF
137 itag = 0
138 IF (norder > 0) THEN
139 DO j=1,norder
140 CALL hm_get_float_array_index('Nu_arr' ,nu(j),j,is_available,lsubmodel,unitab)
141 IF(nu(j) /= zero) itag = 1
142 IF (nu(j) >= half) nu(j) = zep499
143 ENDDO
144 ENDIF
145c--------------------------------------------------
146c CHECK VALUES
147c--------------------------------------------------
148 IF (rhor == zero) rhor = rho0
149c
150 DO j=1,norder
151 IF (al(j) == zero) al(j) = one
152 ENDDO
153c
154 gammainf = one
155 sum = zero
156 IF (nvisc > 0) THEN
157 DO j=1,nvisc
158 IF (taux(j) <= zero) taux(j) = ep20
159 IF (gama(j) > one .OR. gama(j) < zero) THEN
160 CALL ancmsg(msgid=560,
161 . msgtype=msgerror,
162 . anmode=aninfo_blind_1,
163 . i1=mat_id,
164 . c1=titr,
165 . r1=gama(j))
166 ENDIF
167 sum = sum + gama(j)
168 ENDDO
169 gammainf = one - sum
170 IF(gammainf <= zero ) THEN
171 CALL ancmsg(msgid=2084,
172 . msgtype=msgerror,
173 . anmode=aninfo_blind_1,
174 . i1=mat_id,
175 . c1=titr,
176 . r1=gammainf)
177 ENDIF
178 ENDIF
179 IF (nug >= half) nug = zep499
180 IF (viscmax == zero) viscmax=ep20
181 !
182 IF(nvisc > 0 .AND. flag_rigidity == 2)THEN
183 DO j=1,norder
184 mu(j)= mu(j)/ gammainf
185 ENDDO
186 ENDIF
187c
188 gs = zero
189 DO j=1,norder
190 gs = gs + mu(j)
191 ENDDO
192 IF (gs < zero) THEN
193 CALL ancmsg(msgid=846,
194 . msgtype=msgerror,
195 . anmode=aninfo,
196 . i1=mat_id,
197 . c1=titr)
198 ENDIF
199 IF(itag == 1) THEN
200 bulk = zero
201 DO j=1,norder
202 beta(j) = nu(j)/(one - two*nu(j))
203 bulk = bulk + two*mu(j)*(third + beta(j))
204 ENDDO
205 nug = half*(three*bulk - two*gs)/(three*bulk+ gs)
206 ELSE
207 beta(1:norder) = nug/(one - two*nug)
208 bulk = two_third*gs*(one + nug)/max(em20,(one - two*nug))
209 ENDIF
210C
211 IF (nvisc > 0) THEN
212 ivisc = 1
213 IF (flag_visc == 1) ivisc = 2
214 ELSE
215 ivisc = 0
216 ENDIF
217 flag_visc = min(flag_visc, 2)
218c---------------------
219 uparam(1) = nug
220 uparam(2) = norder
221 uparam(3) = nvisc
222 uparam(4) = gammainf
223 uparam(5) = bulk
224 uparam(6) = viscmax
225 DO j=1,norder
226 uparam(6 + j ) = mu(j)
227 uparam(6 + norder + j) = al(j)
228 ENDDO
229 IF (nvisc > 0) THEN
230 DO j= 1,nvisc
231 uparam(6 + norder*2 + j) = gama(j)
232 uparam(6 + norder*2 + nvisc + j) = taux(j)
233 ENDDO
234 ENDIF
235 nuparam = 6 + 2*norder + 2*nvisc + 1
236 uparam(nuparam) = ivisc
237 !! adding beta_i
238 DO j=1,norder
239 uparam(nuparam + j ) = beta(j)
240 ENDDO
241 nuparam = nuparam + norder
242c---------------------
243 gs = gs*two
244 parmat(1) = bulk
245 parmat(2) = gs*(one + nug)
246 parmat(3) = nug
247 parmat(16) = 2 ! Formulation for solid elements time step computation.
248 parmat(17) = gs/(bulk + two_third*gs)
249c-----------------
250 pm(1) = rhor
251 pm(89) = rho0
252c---------------------
253 nfunc = 0
254 nuvar = 6 + 6*nvisc
255c
256c NUVAR : pour savegarder H et S (integration convolutive)
257c + pressure viscosity NUVAR = 9 + 3*NVISC*2 (a developpe en cas de besoin),
258c---------------------
259 IF (nvisc > 0) THEN
260 imatvis = 3
261 ELSE
262 imatvis = 1
263 ENDIF
264c-----------------
265 CALL init_mat_keyword(matparam,"TOTAL")
266 IF (nug > 0.49) THEN
267 CALL init_mat_keyword(matparam,"INCOMPRESSIBLE")
268 ELSE
269 CALL init_mat_keyword(matparam,"COMPRESSIBLE")
270 END IF
271 CALL init_mat_keyword(matparam,"HOOK")
272 ! Properties compatibility
273 CALL init_mat_keyword(matparam,"SHELL_ISOTROPIC")
274 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
275c-----------------
276 WRITE(iout,1100) trim(titr),mat_id,62
277 WRITE(iout,1000)
278 IF(ivisc > 0 ) THEN
279 SELECT CASE (flag_rigidity)
280 CASE (0,1)
281 flag_rigidity = 1
282 WRITE(iout,1010)flag_rigidity
283 CASE (2)
284 WRITE(iout,1020)flag_rigidity
285 END SELECT
286 ENDIF
287 IF (is_encrypted) THEN
288 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
289 ELSE
290 WRITE(iout,1200) rho0
291
292 WRITE(iout,1300) nug,gs*half,viscmax,norder
293 WRITE(iout,1400) (mu(j),al(j),nu(j),j=1,norder)
294 IF (ivisc > 0) THEN
295 WRITE(iout,1500) nvisc
296 IF (nvisc /= zero) WRITE(iout,1600)(gama(j),taux(j),j=1,nvisc)
297 WRITE(iout,1700) flag_visc
298 ENDIF
299 ENDIF
300C-----------------
301 RETURN
302C-----------------
303 1000 FORMAT
304 & (5x,'MATERIAL MODEL : VISCO HYPERELASTIC',/,
305 & 5x,'-----------------------------------',/)
306 1100 FORMAT(/
307 & 5x,a,/,
308 & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
309 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
310 1200 FORMAT(
311 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
312 1300 FORMAT
313 &(5x,'EQUIVALENT POISSON RATIO . . . . . . .=',e12.4/
314 &,5x,'INITIAL SHEAR MODULUS . . . . . . . . .=',e12.4/
315 & 5x,'MAXIMUM VISCOSITY. . . . .. . . . . . .=',e12.4//
316 &,5x,'ORDER OF STRAIN ENERGY. . . . . . . . .=',i8)
317 1400 FORMAT(
318 & 7x,'MATERIAL PARAMETER (MU). . . . . . . . =',e12.4/
319 & 7x,'MATERIAL PARAMETER (ALPHA) . . . . . . =',e12.4/
320 & 7x,'MATERIAL PARAMETER (NU) . . . . . . . =',e12.4/)
321 1500 FORMAT(//
322 & 5x,'ORDER OF MAXWELL MODEL . . . . . . . . =',i8 )
323 1600 FORMAT(
324 & 7x,'STIFFNESS RATIO. . . . . . . . . . .. .=',e12.4/
325 & 7x,'RELAXATION TIME . . . . . . . . . . . =',e12.4)
326 1700 FORMAT(/
327 & 5x,'VISCOUS STRESS FORMULATION . . . . . . =',i8 /
328 &10x,' 0 : VISCOUS STRESS IS DEVIATORIC ' , /
329 &10x,' 1 : VISCOUS STRESS IS SPHERICAL AND DEVIATORIC' )
330 1010 FORMAT(/
331 & 5x,'LONG-TERM RIGIDITY FLAG . . . . . =',i8 /
332 & 5x,'INITIAL ELASTIC MODULUS IS THE INSTANTANEOUS RIGIDITY ' , / )
333 1020 FORMAT(/
334 & 5x,'LONG-TERM RIGIDITY FLAG . . . . . =',i8 /
335 & 5x,' INITIAL ELASTIC MODULUS IS THE LONG-TERM RIGIDITY. ',/
336 & 5x,' THE MU VALUE ARE UPDATED ' , / )
337C-----------------
338 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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_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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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