OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat70.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!||====================================================================
25!|| hm_read_mat70 ../starter/source/materials/mat/mat070/hm_read_mat70.F
26!||--- called by ------------------------------------------------------
27!|| hm_read_mat ../starter/source/materials/mat/hm_read_mat.F90
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.f
30!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
31!|| hm_get_float_array_index_dim ../starter/source/devtools/hm_reader/hm_get_float_array_index_dim.F
32!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
33!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
34!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
35!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
36!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
37!|| simple_checksum ../starter/source/tools/curve/simple_checksum.cpp
38!||--- uses -----------------------------------------------------
39!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
40!|| message_mod ../starter/share/message_module/message_mod.F
41!|| simple_checksum_mod ../starter/source/tools/curve/simple_checksum_mod.F90
42!|| submodel_mod ../starter/share/modules1/submodel_mod.F
43!||====================================================================
44 SUBROUTINE hm_read_mat70(UPARAM ,MAXUPARAM,NUPARAM ,ISRATE , IMATVIS ,
45 . NUVAR ,IFUNC ,MAXFUNC ,NFUNC , PARMAT ,
46 . UNITAB ,MAT_ID ,TITR ,MTAG , LSUBMODEL,
47 . PM ,MATPARAM ,NVARTMP )
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 use simple_checksum_mod
52 use myqsort_d_mod
53C-----------------------------------------------
54C D e s c r i p t i o n
55C-----------------------------------------------
56C READ MAT LAW70 WITH HM READER ( TO BE COMPLETED )
57C
58C DUMMY ARGUMENTS DESCRIPTION:
59C ===================
60C
61C NAME DESCRIPTION
62C
63C PM MATERIAL ARRAY(REAL)
64C UNITAB UNITS ARRAY
65C MAT_ID MATERIAL ID(INTEGER)
66C TITR MATERIAL TITLE
67C LSUBMODEL SUBMODEL STRUCTURE
68C
69C-----------------------------------------------
70C M o d u l e s
71C-----------------------------------------------
72 USE unitab_mod
73 USE elbuftag_mod
74 USE message_mod
75 USE submodel_mod
76 USE matparam_def_mod
77 USE names_and_titles_mod , ONLY : nchartitle
78C-----------------------------------------------
79C I m p l i c i t T y p e s
80C-----------------------------------------------
81#include "implicit_f.inc"
82C-----------------------------------------------
83C C o m m o n B l o c k s
84C-----------------------------------------------
85#include "units_c.inc"
86#include "param_c.inc"
87C-----------------------------------------------
88C D u m m y A r g u m e n t s
89C-----------------------------------------------
90 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
91 my_real, INTENT(INOUT) :: PM(NPROPM),PARMAT(100),UPARAM(MAXUPARAM)
92 INTEGER, INTENT(INOUT) :: ISRATE,NFUNC,MAXFUNC,MAXUPARAM,
93 . nuparam,nuvar,nvartmp,imatvis
94 INTEGER, INTENT(INOUT) :: IFUNC(MAXFUNC)
95 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
96 INTEGER,INTENT(IN) :: MAT_ID
97 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
98 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*)
99 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
100C-----------------------------------------------
101C L o c a l V a r i a b l e s
102C-----------------------------------------------
103 INTEGER NRATEN,J,I,NRATEP,IUNLOAD,ITENS,IETANG,NL,ISORT
104 integer :: i1,i2,sizeh,ierror,ifun
105 my_real E,NU,G,C1,VISC, VISCV,EXPO,HYS,
106 . rho0,rhor,e0,emax,epsmax,fcut,a1,a2,aa
107 INTEGER ,DIMENSION(MAXFUNC) :: FID,PERM
108 my_real ,DIMENSION(MAXFUNC) :: rate,yfac,yfac_unit,scale,epsp,rtmp,ytmp
109 double precision :: h1,h2
110 double precision :: chksum
111 double precision :: hasht(3)
112 double precision ,dimension(:) ,allocatable :: hash
113 integer ,dimension(:) ,allocatable :: perml
114 LOGICAL IS_AVAILABLE,IS_ENCRYPTED
115C-----------------------------------------------
116C S o u r c e L i n e s
117C-----------------------------------------------
118 is_encrypted = .false.
119 is_available = .false.
120 imatvis = 2
121
122 rate(1:maxfunc) = zero
123 CALL hm_option_is_encrypted(is_encrypted)
124
125 !line-1
126 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
128 !line-2
129 CALL hm_get_floatv('MAT_E0' ,e0 ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('MAT_NU' ,nu ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('E_Max' ,emax ,is_available, lsubmodel, unitab)
132 CALL hm_get_floatv('MAT_EPS' ,epsmax ,is_available, lsubmodel, unitab)
133 CALL hm_get_intv('Itens' ,itens ,is_available, lsubmodel)
134 !line-3
135 CALL hm_get_floatv('MAT_asrate',fcut ,is_available, lsubmodel, unitab)
136 CALL hm_get_intv('ISRATE' ,israte ,is_available, lsubmodel)
137 CALL hm_get_intv('NRATEP' ,nratep ,is_available, lsubmodel)
138 CALL hm_get_intv('NRATEN' ,nraten ,is_available, lsubmodel)
139 CALL hm_get_intv('MAT_Iflag' ,iunload ,is_available, lsubmodel)
140 CALL hm_get_floatv('MAT_SHAPE' ,expo ,is_available, lsubmodel, unitab)
141 CALL hm_get_floatv('MAT_HYST' ,hys ,is_available, lsubmodel, unitab)
142!-------------------------------------------------------------------------------
143 IF(rhor==zero)rhor=rho0
144 pm(1) =rhor
145 pm(89)=rho0
146
147!-------------------------------------------------------------------------------
148 ! Loading functions
149!-------------------------------------------------------------------------------
150 IF(nratep == 0) THEN
151 CALL ancmsg(msgid=866,msgtype=msgerror,anmode=aninfo_blind,
152 . i1=mat_id,
153 . c1=titr)
154 ENDIF
155 !--loading function
156 DO i=1,nratep
157 CALL hm_get_int_array_index('FUN_LOAD' ,fid(i) ,i,is_available, lsubmodel)
158 CALL hm_get_float_array_index('STRAINRATE_LOAD' ,epsp(i) ,i,is_available, lsubmodel, unitab)
159 CALL hm_get_float_array_index('SCALE_LOAD' ,scale(i) ,i,is_available, lsubmodel, unitab)
160 CALL hm_get_float_array_index_dim('SCALE_LOAD' ,yfac_unit(i),i,is_available, lsubmodel, unitab)
161 !units
162 IF (scale(i) == zero) scale(i) = one * yfac_unit(i)
163 ENDDO
164c---------------------------------------------------------------------------
165c check if there are no input errors in function and strain rate definitions
166c---------------------------------------------------------------------------
167 if (nratep > 1) then
168 allocate (perml(nratep))
169 allocate (hash(nratep))
170 ! create a checksum value for each function input line
171 sizeh = 3
172 do i=1,nratep
173 hasht(1) = fid(i)
174 hasht(2) = epsp(i)
175 hasht(3) = scale(i)
176 call simple_checksum(hasht,sizeh,chksum)
177 hash(i) = chksum
178 end do
179!
180 ! check duplicated input lines
181!
182 call myqsort_d(nratep,hash,perml,ierror)
183 h1 = hash(1)
184 ifun = 1
185 i1 = perml(1)
186 ifunc(1) = fid(i1)
187 rate(1) = epsp(i1)
188 yfac(1) = scale(i1)
189 do i = 2,nratep
190 h2 = hash(i)
191 i1 = perml(i-1)
192 i2 = perml(i)
193 if (h1 == h2) then ! skip double function line
194 call ancmsg(msgid=3101, msgtype=msgwarning, anmode=aninfo_blind_1,
195 . i1=mat_id,c1=titr, i2=ifunc(i1))
196 else
197 ifun = ifun+1
198 ifunc(ifun) = fid(i2)
199 rate(ifun) = epsp(i2)
200 yfac(ifun) = scale(i2)
201 end if
202 h1 = h2
203 end do
204 nratep = ifun
205 else
206 ifunc(1) = fid(1)
207 rate(1) = epsp(1)
208 yfac(1) = scale(1)
209 end if
210c---------------------------------------------------------------------------
211c sort loading functions in increasing strain rate order
212c---------------------------------------------------------------------------
213 IF (nratep > 1) THEN
214 DO i=1,nratep
215 fid(i) = ifunc(i)
216 rtmp(i) = rate(i)
217 ytmp(i) = yfac(i)
218 ENDDO
219 perml(:) = 0
220 CALL myqsort(nratep, rtmp, perml, ierr)
221
222 DO i=1,nratep
223 j = perml(i)
224 ifunc(i) = fid(j)
225 rate(i) = rtmp(i)
226 yfac(i) = ytmp(j)
227 ENDDO
228c
229 IF (rate(1) /= zero) THEN ! static strain rate must be equal to 0
230 rate(1) = zero
231 CALL ancmsg(msgid=1721, msgtype=msgwarning, anmode=aninfo_blind,
232 . i1=mat_id,
233 . c1=titr)
234 ENDIF
235 END IF
236 if (allocated(perml)) deallocate (perml)
237 if (allocated(hash)) deallocate (hash )
238!-------------------------------------------------------------------------------
239 ! Unloading functions
240!-------------------------------------------------------------------------------
241 IF (nraten > 0 ) THEN
242 DO i=1,nraten
243 CALL hm_get_int_array_index('FUN_UNLOAD' ,fid(i) ,i,is_available, lsubmodel)
244 CALL hm_get_float_array_index('STRAINRATE_UNLOAD',epsp(i) ,i,is_available, lsubmodel, unitab)
245 CALL hm_get_float_array_index('SCALE_UNLOAD' ,scale(i) ,i,is_available, lsubmodel, unitab)
246 CALL hm_get_float_array_index_dim('SCALE_UNLOAD' ,yfac_unit(i),i,is_available, lsubmodel, unitab)
247 !units
248 IF (scale(i) == zero) scale(i) = one * yfac_unit(i)
249 ENDDO
250 ELSE
251 IF (nraten == 0 .AND. iunload <= 2) THEN
252 nraten = 1
253 ifunc(nratep+1) = ifunc(1)
254 rate(nratep+1) = rate(1)
255 yfac(nratep+1) = yfac(1)
256 iunload = 0
257C
258 CALL ancmsg(msgid=1226, msgtype=msgwarning, anmode=aninfo_blind_1,
259 . i1=mat_id, c1=titr)
260 ENDIF
261 ENDIF
262c---------------------------------------------------------------------------
263c check if unloading functions are defined in increasing strain rate order
264c---------------------------------------------------------------------------
265 IF (nraten > 1) THEN
266 ierr = 0
267 isort = 0
268 DO i=1,nraten-1
269 IF (epsp(i) == epsp(i+1)) THEN
270 ierr = 1
271 ELSE IF (epsp(i) > epsp(i+1)) THEN
272 isort = 1
273 END IF
274 ENDDO
275 IF (ierr == 1) THEN
276 CALL ancmsg(msgid=478,msgtype=msgerror,anmode=aninfo_blind,
277 . i1=mat_id,
278 . c1=titr)
279 END IF
280c
281 IF (isort == 1) THEN ! sort functions in correct order
282 CALL myqsort(nraten, epsp, perm, ierr)
283
284 DO i=1,nraten
285 j = perm(i)
286 ifunc(i + nratep) = fid(j)
287 rate(i + nratep) = epsp(i)
288 yfac(i + nratep) = scale(j)
289 ENDDO
290 ELSE
291 DO i=1,nraten
292 ifunc(i + nratep) = fid(i)
293 rate(i + nratep) = epsp(i)
294 yfac(i + nratep) = scale(i)
295 ENDDO
296 END IF
297c
298 IF (rtmp(1) /= zero) THEN ! static strain rate must be equal to 0
299 rate(1 + nratep) = zero
300 CALL ancmsg(msgid=1721, msgtype=msgwarning, anmode=aninfo_blind,
301 . i1=mat_id,
302 . c1=titr)
303 ENDIF
304 else if (nraten == 1) then
305 ifunc(nratep+1) = fid(1)
306 rate(nratep+1) = epsp(1)
307 yfac (nratep+1) = scale(1)
308 END IF
309c---------------------------------------------------------------------------
310c
311 IF (fcut > zero) israte = 1
312 IF (fcut == zero) fcut = infinity
313 nl = nratep + nraten
314 IF (itens > 0) THEN
315 nl = nratep + nraten + 1
316 rate(nl) = zero
317 CALL hm_get_int_array_index('FUN_A1' ,ifunc(nl) ,nl,is_available, lsubmodel)
318 CALL hm_get_float_array_index('FScale11' ,yfac(nl) ,nl,is_available, lsubmodel,unitab)
319 IF (yfac(nl) == zero) yfac(nl) = one
320 ENDIF
321
322 DO i=1,nl
323 IF(ifunc(i) == 0)THEN
324 CALL ancmsg(msgid=126, msgtype=msgerror, anmode=aninfo_blind,
325 . i1=mat_id,
326 . c1=titr,
327 . i2=ifunc(i))
328 ENDIF
329 ENDDO
330C
331 IF (emax< e0) THEN
332 CALL ancmsg(msgid=3028,
333 . msgtype=msgwarning,
334 . anmode=aninfo_blind,
335 . i1=mat_id,
336 . c1=titr)
337 emax = zero
338 END IF
339 IF(epsmax == zero) epsmax = one
340 uparam(1)=nl
341 uparam(2)=e0
342 aa = (emax-e0)/epsmax
343 uparam(3)=aa
344 uparam(4)=epsmax
345 g = half*e0/(one + nu)
346 uparam(5)=g
347 uparam(6)=nu
348 uparam(7)= nratep
349 uparam(8)= nraten
350 DO i=1,nl
351 uparam(i + 8) = rate(i)
352 uparam(i + 8 + nl) = yfac(i)
353 END DO
354
355 uparam(2*nl + 9)= iunload
356 IF(expo == zero) expo = one
357 IF(hys == zero) hys = one
358 uparam(2*nl + 10)= expo
359 uparam(2*nl + 11) = hys
360 uparam(2*nl + 12) = emax
361 uparam(2*nl + 13) = itens
362 uparam(2*nl + 14) = 0 ! not used
363C
364 c1 = e0/three/(one - two*nu)
365 nfunc = nl
366 nuparam =16 + 2*nl
367 IF (is_encrypted) uparam(16 + 2*nl) = 1
368C
369 parmat(1) = c1
370 parmat(2) = e0
371 parmat(3) = nu
372 parmat(4) = israte
373 parmat(5) = fcut
374C Formulation for solid elements time step computation.
375 parmat(16) = 2
376 parmat(17) = (one-two*nu)/(one-nu)
377C
378 nuvar = 10
379 nvartmp = 6
380c-----------------
381 CALL init_mat_keyword(matparam,"TOTAL")
382 CALL init_mat_keyword(matparam,"SMALL_STRAIN")
383 IF (nu > 0.49) THEN
384 CALL init_mat_keyword(matparam,"INCOMPRESSIBLE")
385 ELSE
386 CALL init_mat_keyword(matparam,"COMPRESSIBLE")
387 END IF
388 CALL init_mat_keyword(matparam,"HOOK")
389 ! Properties compatibility
390 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
391 CALL init_mat_keyword(matparam,"SPH")
392c------------------------------------
393 WRITE(iout,1001) trim(titr),mat_id,70
394 WRITE(iout,1000)
395 IF(is_encrypted)THEN
396 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
397 ELSE
398 WRITE(iout,1050)rho0
399 WRITE(iout,1100)e0,nu,emax,epsmax
400 WRITE(iout,1200)fcut,israte,nratep,nraten,iunload,expo,hys,itens
401 WRITE(iout,1300)(ifunc(j),rate(j),yfac(j),j=1,nratep)
402 WRITE(iout,1400)(ifunc(j+nratep),rate(j+nratep),yfac(j+nratep),
403 . j=1,nraten)
404 IF(itens > 0) THEN
405 WRITE(iout,1500)ifunc(nl),yfac(nl)
406 ENDIF
407 ENDIF
408c-----------
409 RETURN
410 1000 FORMAT(
411 & 5x,40h tabulated non linear visco elastic law,/,
412 & 5x,40h --------------------------------------,//)
413 1001 FORMAT(/
414 & 5x,a,/,
415 & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
416 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
417 1100 FORMAT(
418 & 5x,'INITIAL YOUNG''S MODULUS. . . . . . . .=',1pg20.13/,
419 & 5x,'POISSON''S RATIO. . . . . . . . . . . .=',1pg20.13/,
420 & 5x,'MAXIMUM YOUNG''S MODULUS. . . . . . . .=',1pg20.13/,
421 & 5x,'MAXIMUM STRAIN . . . . .. . . . . . . .=',1pg20.13)
422 1200 FORMAT(
423 & 5x,'STRAIN RATE COEFFICIENT . . . . . . . .=',1pg20.13/,
424 & 5x,'FLAG FOR STRAIN RATE . . . .. . .=',i10/,
425 & 5x,'NUMBER OF LOAD STRESS FUNCTIONS .. .=',i10/,
426 & 5x,'NUMBER OF UNLOAD STRESS FUNCTIONS .. .=',i10/,
427 & 5x,'CHOICE OF UNLOADING FORMULATION . . . =',i10/,
428 & 5x,'SHAPE FACTOR FOR UNLOADING . . . . . .=',1pg20.13/,
429 & 5x,'HYSTERETIC UNLOADING FACTOR . . . . . =',1pg20.13/,
430 & 5x,'FLAG FOR TENSION BEHAVIOR . . . . . . =',i10/)
431CC & 5X,'FLAG CHOICE FOR YOUNG MODULUS . . . . =',I10 )
432 1300 FORMAT(
433 & 5x,'LOAD YIELD STRESS FUNCTION NUMBER.. . .=',i10/,
434 & 5x,'STRAIN RATE . . . . . . . . . . . . . .=',1pg20.13/,
435 & 5x,'SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13/)
436
437 1400 FORMAT(
438 & 5x,'UNLOAD YIELD STRESS FUNCTION NUMBER.. .=',i10/,
439 & 5x,'STRAIN RATE . . . . . . . . . . . . . .=',1pg20.13/,
440 & 5x,'SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13/)
441 1500 FORMAT(
442 & 5x,'PRESSURE DEPENDENT YIELD FUNCTION . . .=',i10/
443 & 5x,'PRESSURE SCALE FACTOR. . . . . . . . . =',1pg20.13)
444 1050 FORMAT(
445 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
446
447 END SUBROUTINE hm_read_mat70
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_float_array_index_dim
subroutine hm_get_float_array_index_dim(name, dim_fac, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index_dim.F:47
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
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_mat70
subroutine hm_read_mat70(uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, matparam, nvartmp)
Definition hm_read_mat70.F:48
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
myqsort
subroutine myqsort(n, a, perm, error)
Definition myqsort.F:51
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
simple_checksum
void simple_checksum(const double *vector, const int *length, double *hash)
Definition simple_checksum.cpp:43
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
starter
program starter
Definition starter.F:39
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232
submodel_mod::submodel_data
Definition submodel_mod.F:723
tabulated
subroutine tabulated(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, npf, tf)
Definition tabulated.F:32