OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat116.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_mat116 ../starter/source/materials/mat/mat116/hm_read_mat116.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_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
33!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
34!||--- uses -----------------------------------------------------
35!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_mat116(MTAG ,UPARAM ,MAXUPARAM,NUPARAM ,PM ,
40 . PARMAT ,NUVAR ,IFUNC ,NFUNC ,MAXFUNC ,
41 . UNITAB ,MAT_ID ,TITR ,LSUBMODEL,MATPARAM )
42C-----------------------------------------------
43C ROUTINE DESCRIPTION :
44C ===================
45C READ MAT LAW116 WITH HM READER
46C-----------------------------------------------
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C IPM MATERIAL ARRAY(INTEGER)
53C PM MATERIAL ARRAY(REAL)
54C UNITAB UNITS ARRAY
55C ID MATERIAL ID(INTEGER)
56C TITR MATERIAL TITLE
57C LSUBMODEL SUBMODEL STRUCTURE
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE unitab_mod
62 USE elbuftag_mod
63 USE message_mod
64 USE submodel_mod
65 USE matparam_def_mod
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "param_c.inc"
75#include "units_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
80 INTEGER, INTENT(INOUT) :: IFUNC(MAXFUNC),NFUNC,MAXFUNC,MAXUPARAM,
81 . nuparam,nuvar
82 INTEGER, INTENT(IN) :: MAT_ID
83 my_real, INTENT(INOUT) :: PM(NPROPM),PARMAT(100),UPARAM(MAXUPARAM)
84 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
85 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*)
86 TYPE(mlaw_tag_), INTENT(INOUT) :: MTAG
87 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
88C-----------------------------------------------
89C L o c a l V a r i a b l e s
90C-----------------------------------------------
91 INTEGER :: NRATE,ILAW,IMASS,IDEL,IORDER1,IORDER2,
92 . IFAIL1,IFAIL2,ICRIT
93 my_real :: rho0,e,g,thick,gc1_ini,gc2_ini,gc1_inf,gc2_inf,ratg1,ratg2,
94 . fg1,fg2,siga1,siga2,sigb1,sigb2,rate1,rate2,unit_l,alpha
95 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
96C=======================================================================
97 ilaw = 116
98!
99 is_encrypted = .false.
100 is_available = .false.
101!
102 CALL hm_option_is_encrypted(is_encrypted)
103Card1
104 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
105 CALL hm_get_floatv('MAT_E' ,e ,is_available, lsubmodel, unitab)
106 CALL hm_get_floatv('MAT_G' ,g ,is_available, lsubmodel, unitab)
107 CALL hm_get_floatv('MAT_THICK' ,thick ,is_available, lsubmodel, unitab)
108 CALL hm_get_intv ('MAT_IMASS' ,imass ,is_available, lsubmodel)
109 CALL hm_get_intv ('MAT_IDEL' ,idel ,is_available, lsubmodel)
110 CALL hm_get_intv ('MAT_ICRIT' ,icrit ,is_available, lsubmodel)
111Card2
112 CALL hm_get_floatv('MAT_GC1_ini' ,gc1_ini ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('MAT_GC1_inf' ,gc1_inf ,is_available, lsubmodel, unitab)
114 CALL hm_get_floatv('MAT_SRATG1' ,ratg1 ,is_available, lsubmodel, unitab)
115 CALL hm_get_floatv('MAT_FG1' ,fg1 ,is_available, lsubmodel, unitab)
116Card3
117 CALL hm_get_floatv('MAT_GC2_ini' ,gc2_ini ,is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('MAT_GC2_inf' ,gc2_inf ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_SRATG2' ,ratg2 ,is_available, lsubmodel, unitab)
120 CALL hm_get_floatv('MAT_FG2' ,fg2 ,is_available, lsubmodel, unitab)
121Card4
122 CALL hm_get_floatv('MAT_SIGA1' ,siga1 ,is_available, lsubmodel, unitab)
123 CALL hm_get_floatv('MAT_SIGB1' ,sigb1 ,is_available, lsubmodel, unitab)
124 CALL hm_get_floatv('MAT_SRATE1' ,rate1 ,is_available, lsubmodel, unitab)
125 CALL hm_get_intv ('MAT_ORDER1' ,iorder1 ,is_available, lsubmodel)
126 CALL hm_get_intv ('MAT_FAIL1' ,ifail1 ,is_available, lsubmodel)
127Card5
128 CALL hm_get_floatv('MAT_SIGA2' ,siga2 ,is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('MAT_SIGB2' ,sigb2 ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('MAT_SRATE2' ,rate2 ,is_available, lsubmodel, unitab)
131 CALL hm_get_intv ('MAT_ORDER2' ,iorder2 ,is_available, lsubmodel)
132 CALL hm_get_intv ('MAT_FAIL2' ,ifail2 ,is_available, lsubmodel)
133c---------------------------------------------------------------------------------
134 pm(1) = rho0 ! RHOR
135 pm(89)= rho0
136c-------------------
137c Default Values
138c-------------------
139 IF (g == zero) g = e
140 IF (imass == 0) imass = 1
141 IF (idel == 0) idel = 1
142 IF (iorder1 == 0) iorder1 = 1
143 IF (iorder2 == 0) iorder2 = 1
144 IF (ifail1 == 0) ifail1 = 1
145 IF (ifail2 == 0) ifail2 = 1
146 IF (icrit == 0) icrit = 1
147 IF (fg1 == zero .or. gc1_ini == zero) ifail1 = 0
148 IF (fg2 == zero .or. gc2_ini == zero) ifail2 = 0
149 IF (thick == zero) THEN
150 CALL hm_get_floatv_dim('MAT_THICK' ,unit_l ,is_available, lsubmodel, unitab)
151 thick = one * unit_l
152 ENDIF
153 alpha = 0.005 ! strain rate filtering coefficient (exp average)
154c-------------------
155c Check parameter values
156c-------------------
157 IF (ifail1 == 1) THEN
158 IF (fg1 >= one - half*siga1**2 / (e * gc1_ini)) THEN
159 CALL ancmsg(msgid=1825,msgtype=msgwarning,anmode=aninfo_blind_1,
160 . i1 = mat_id,
161 . c1 = titr,
162 . c2 = 'FG1',
163 . r1 = half*siga1**2 / (e * gc1_ini) )
164 END IF
165 ELSE IF (ifail1 == 2) THEN
166 IF (fg1 >= one) THEN
167 CALL ancmsg(msgid=1825,msgtype=msgwarning,anmode=aninfo_blind_1,
168 . i1 = mat_id,
169 . c1 = titr,
170 . c2 = 'FG1',
171 . r1 = one)
172 END IF
173 END IF
174c
175 IF (ifail2 == 1) THEN
176 IF (fg2 >= one - half*siga2**2 / (e * gc2_ini)) THEN
177 CALL ancmsg(msgid=1825,msgtype=msgwarning,anmode=aninfo_blind_1,
178 . i1 = mat_id,
179 . c1 = titr,
180 . c2 = 'FG2',
181 . r1 = half*siga2**2 / (e * gc2_ini) )
182 END IF
183 ELSE IF (ifail2 == 2) THEN
184 IF (fg2 >= one) THEN
185 CALL ancmsg(msgid=1825,msgtype=msgwarning,anmode=aninfo_blind_1,
186 . i1 = mat_id,
187 . c1 = titr,
188 . c2 = 'FG2',
189 . r1 = one)
190 END IF
191 END IF
192c-------------------
193 nfunc = 0
194 nuparam = 25
195 nuvar = 12
196c-------------------
197 uparam(1) = e / thick
198 uparam(2) = g / thick
199 uparam(3) = imass
200 uparam(4) = idel
201 uparam(5) = gc1_ini
202 uparam(6) = gc1_inf
203 uparam(7) = ratg1
204 uparam(8) = fg1
205 uparam(9) = gc2_ini
206 uparam(10) = gc2_inf
207 uparam(11) = ratg2
208 uparam(12) = fg2
209 uparam(13) = siga1
210 uparam(14) = sigb1
211 uparam(15) = rate1
212 uparam(16) = iorder1
213 uparam(17) = ifail1
214 uparam(18) = siga2
215 uparam(19) = sigb2
216 uparam(20) = rate2
217 uparam(21) = iorder2
218 uparam(22) = ifail2
219 uparam(23) = icrit
220 uparam(24) = thick
221 uparam(25) = alpha
222C----------------
223 parmat(1) = max(e,g) / three
224 parmat(2) = max(e,g)
225 parmat(17) = one ! (ONE - TWO*NU)/(ONE - NU), NU=0
226c
227 mtag%G_PLA = 2
228 mtag%G_EPSD = 1
229 mtag%L_PLA = 2
230 mtag%L_EPSD = 1
231 mtag%L_EPE = 3
232 mtag%L_DMG = 1
233 mtag%G_DMG = 1
234c
235 ! MATPARAM keywords
236 CALL init_mat_keyword(matparam,"HOOK")
237c
238 ! Properties compatibility
239 CALL init_mat_keyword(matparam,"SOLID_COHESIVE")
240c-------------------
241c STARTER Output
242c-------------------
243 WRITE(iout,1100) trim(titr),mat_id,ilaw
244 WRITE(iout,1000)
245 IF (is_encrypted) THEN
246 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
247 ELSE
248 WRITE(iout,1200) rho0,e,g,thick,imass,idel,icrit,
249 . gc1_ini,gc1_inf,ratg1,fg1,
250 . gc2_ini,gc2_inf,ratg2,fg2,
251 . siga1,sigb1,rate1,iorder1,ifail1,
252 . siga2,sigb2,rate2,iorder2,ifail2
253 ENDIF
254c-----------
255 RETURN
256c-----------
257 1000 FORMAT(
258 & 10x,' MIXED MODE COHESIVE LAW 116 ',/,
259 & 10x,' --------------------------- ',/)
260 1100 FORMAT(/
261 & 5x,a,/,
262 & 5x,'MATERIAL NUMBER . . . . . . . . . . . . . . .=',i10/,
263 & 5x,'MATERIAL LAW. . . . . . . . . . . . . . . . .=',i10/)
264 1200 FORMAT(
265 & 5x,'MATERIAL DENSITY. . . . . . . . . . . . . . .=',1pg20.13/,
266 & 5x,'YOUNG MODULUS PER THICKNESS UNIT . . . . =',1pg20.13/,
267 & 5x,'SHEAR MODULUS PER THICKNESS UNIT . . . . =',1pg20.13/,
268 & 5x,'COHESIVE ELEMENT THICKNESS . . . . . . . =',1pg20.13/,
269 & 5x,'MASS CALCULATION FLAG . . . . . . . . . . . .=',i10/,
270 & 5x,' = 0 => USING VOLUME DENSITY '/,
271 & 5x,' = 1 => USING SURFACE DENSITY '/,
272 & 5x,'NB OF FAILING GAUSS POINTS TO DELETE ELEMENT =',i10/,
273 & 5x,'ICRIT : YIELD AND DAMAGE INITIATION FLAG . . =',i10/,
274 & 5x,'INITIAL ENERGY RELEASE RATE IN MOD I . . . . =',1pg20.13/,
275 & 5x,'FINAL ENERGY RELEASE RATE IN MOD I . . . . =',1pg20.13/,
276 & 5x,'REFERENCE STRAIN RATE FOR GC IN MOD I. . . . =',1pg20.13/,
277 & 5x,'SHAPE FACTOR FOR GC AT FAIL IN MOD I . . . . =',1pg20.13/,
278 & 5x,'INITIAL ENERGY RELEASE RATE IN MOD II . . . =',1pg20.13/,
279 & 5x,'FINAL ENERGY RELEASE RATE IN MOD II . . . . =',1pg20.13/,
280 & 5x,'REFERENCE STRAIN RATE FOR GC IN MOD II . . . =',1pg20.13/,
281 & 5x,'SHAPE FACTOR FOR GC AT FAIL IN MOD II . . . =',1pg20.13/,
282 & 5x,'STATIC YIELD STRESS TERM IN MODE I . . . . =',1pg20.13/,
283 & 5x,'DYNAMIC YIELD STRESS TERM IN MODE I . . . . =',1pg20.13/,
284 & 5x,'REFERENCE STRAIN RATE FOR YLD IN MODE I. . . =',1pg20.13/,
285 & 5x,'order of yield FUNCTION in mode i . . . . . =',I10/,
286 & 5X,'failure criterion flag in mode i . . . . . =',I10/,
287 & 5X,'static yield stress term in mode ii . . . . =',1PG20.13/,
288 & 5X,'dynamic yield stress term in mode ii . . . . =',1PG20.13/,
289 & 5X,'reference strain rate for yld in mode ii . . =',1PG20.13/,
290 & 5X,'order of yield function in mode ii . . . . . =',I10/,
291 & 5X,'failure criterion flag in mode ii . . . . . =',I10/)
292c--------
293 END
#define alpha
Definition eval.h:35
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine hm_read_mat116(mtag, uparam, maxuparam, nuparam, pm, parmat, nuvar, ifunc, nfunc, maxfunc, unitab, mat_id, titr, lsubmodel, matparam)
subroutine init_mat_keyword(matparam, keyword)
#define max(a, b)
Definition macros.h:21
for(i8=*sizetab-1;i8 >=0;i8--)
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
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33