OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat92.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_mat92 ../starter/source/materials/mat/mat092/hm_read_mat92.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_mat ../starter/source/materials/mat/hm_read_mat.F90
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
32!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
33!||--- uses -----------------------------------------------------
34!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.f
35!|| message_mod ../starter/share/message_module/message_mod.F
36!|| submodel_mod ../starter/share/modules1/submodel_mod.F
37!||====================================================================
38 SUBROUTINE hm_read_mat92(UPARAM ,MAXUPARAM,NUPARAM ,ISRATE , IMATVIS ,
39 . NUVAR ,IFUNC ,MAXFUNC ,NFUNC , PARMAT ,
40 . UNITAB ,MAT_ID ,TITR ,MTAG , LSUBMODEL,
41 . PM ,IPM ,MATPARAM )
42C-----------------------------------------------
43C D e s c r i p t i o n
44C-----------------------------------------------
45C READ MAT LAW92 WITH HM READER ( TO BE COMPLETED )
46C
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C PM MATERIAL ARRAY(REAL)
53C UNITAB UNITS ARRAY
54C ID MATERIAL ID(INTEGER)
55C TITR MATERIAL TITLE
56C LSUBMODEL SUBMODEL STRUCTURE
57C
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 "units_c.inc"
75#include "param_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 my_real, INTENT(INOUT) :: PM(NPROPM),PARMAT(100),UPARAM(MAXUPARAM)
81 INTEGER, INTENT(INOUT) :: IPM(NPROPMI),ISRATE,IFUNC(MAXFUNC),NFUNC,MAXFUNC,MAXUPARAM,NUPARAM, NUVAR,IMATVIS
82 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
83 INTEGER,INTENT(IN) :: MAT_ID
84 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
85 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*)
86 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER ID,ITEST,IDAM
91 my_real
92 . E,NU,G,MU,LAM,D,RBULK,SCALEFAC,C(5),
93 . a1,a2,a3,a4,nu0 ,fac_unit
94 CHARACTER(LEN=NCHARFIELD) :: STRING
95 my_real :: RHO0, RHOR
96 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
97C-----------------------------------------------
98C S o u r c e L i n e s
99C-----------------------------------------------
100 is_encrypted = .false.
101 is_available = .false.
102 idam = 0
103 israte = 0
104 imatvis = 1
105 nuvar = 0
106
107 CALL hm_option_is_encrypted(is_encrypted)
108 !line+1
109 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
110 !line-2
111 CALL hm_get_floatv('MAT_MUE1' ,mu ,is_available, lsubmodel, unitab)
112 CALL hm_get_floatv('MAT_D' ,d ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('MAT_Lamda' ,lam ,is_available, lsubmodel, unitab)
114 !line-3
115 CALL hm_get_intv ('Itype' ,itest ,is_available, lsubmodel)
116 CALL hm_get_intv ('mat_fct_idi' ,IFUNC(1) ,IS_AVAILABLE, LSUBMODEL)
117 CALL HM_GET_FLOATV('mat_nu' ,NU ,IS_AVAILABLE, LSUBMODEL, UNITAB)
118 CALL HM_GET_FLOATV('mat_fscale' ,SCALEFAC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
119 IF(SCALEFAC == ZERO)THEN
120 CALL HM_GET_FLOATV_DIM('mat_fscale' ,FAC_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
121 SCALEFAC = ONE * FAC_UNIT
122 ENDIF
123
124 !========== DEFAULT VALUES=============!
125 RHOR=ZERO
126 !IF(RHOR==ZERO)RHOR=RHO0
127 PM(1) =RHOR
128 PM(89)=RHO0
129
130 !C By default we consider the uniaxial test
131 IF(ITEST == 0) ITEST = 1
132 !C Uniaxial - itest = 1
133 !C equibiaxial - Itest = 2
134 !c Planar - Itest = 3
135 !C
136 !the proposed one READ(LINE,FMT=FMT_A_I_F)STRING,IFUNC(1),NU
137 !CSTRING = UNIAXIAL
138 !CSTRING = EQUIBIAXIAL
139 !CSTRING = PLANAR
140 !C By default we consider the unniaxial test
141 !!the proposed one ITEST = 1
142 !!the proposed one IF(STRING(1:8) == ' ' ) THEN
143 !!the proposed one ITEST = 1
144 !!the proposed one ELSEIF(STRING(1:10) == 'equibiaxia') THEN
145 !!the proposed one ITEST = 2
146 !!the proposed one ELSEIF(STRING(1:6) == 'planar') THEN
147 !!the proposed one ITEST = 3
148 !!the proposed one ENDIF
149 C(1) = HALF
150 C(2) = ONE/TWENTY
151 C(3) = ELEVEN/1050.D00
152 C(4) = 19.D00/7000.D00
153 C(5) = 519.D00/673750.D00
154C
155 IF(LAM == ZERO) LAM = SEVEN
156 A1 = ONE/LAM**2
157 A2 = A1**2
158 A3 = A1*A2
159 A4 = A2**2
160 G= MU*(ONE + THREE*A1/FIVE + EIGHTY19*A2/175.D00
161 . + 513.D00*A3/875.D00 + 42039.D00*A4/67375.D00)
162
163 NFUNC= 0
164 RBULK = ZERO
165 IF(IFUNC(1) /= 0) THEN
166 NFUNC = 1
167 IF (NU == ZERO) NU= 0.495
168 ELSEIF(D == ZERO) THEN
169 NU = 0.495
170 RBULK = TWO_THIRD*(ONE + NU)*G/(ONE - TWO*NU)
171 D = TWO/RBULK
172 ELSE
173 RBULK = TWO/D
174 ENDIF
175!
176! computing E
177!
178 E = NINE*RBULK*G/MAX(EM20,(THREE*RBULK + G))
179 IF(IFUNC(1) == 0 ) NU = (THREE*RBULK -TWO*G)/(THREE*RBULK + G)/TWO
180C
181 UPARAM(1) = MU
182 UPARAM(2) = D
183 UPARAM(3) = LAM
184 UPARAM(4) = G
185 UPARAM(5) = RBULK
186 UPARAM(6) = C(1)
187 UPARAM(7) = C(2)
188 UPARAM(8) = C(3)
189 UPARAM(9) = C(4)
190 UPARAM(10) = C(5)
191 UPARAM(11) = NU
192 UPARAM(12) = ITEST
193 UPARAM(14) = SCALEFAC
194
195 NUPARAM = 14
196 IF(NUPARAM > MAXUPARAM)THEN
197 WRITE(IOUT,*)' ** error : nuparam gt maxuparam'
198 WRITE(IOUT,*)' nuparam =',NUPARAM,
199 . ' maxuparam =',MAXUPARAM
200 ENDIF
201!
202 PARMAT(1) = RBULK
203 PARMAT(2) = E
204 PARMAT(3) = NU
205
206 MTAG%L_EPSA = 1 ! hyperelastic energy needed for mullins
207 IMATVIS = 1
208 PM(100) = RBULK
209c-----------------
210 CALL INIT_MAT_KEYWORD(MATPARAM,"INCOMPRESSIBLE")
211 CALL INIT_MAT_KEYWORD(MATPARAM,"TOTAL")
212 CALL INIT_MAT_KEYWORD(MATPARAM,"HOOK")
213 ! Properties compatibility
214 CALL INIT_MAT_KEYWORD(MATPARAM,"SOLID_ISOTROPIC")
215c-----------------
216 !========== OUTPUT =============!
217 WRITE(IOUT,1001) TRIM(TITR),MAT_ID,92
218 WRITE(IOUT,1000)
219 IF(IS_ENCRYPTED)THEN
220 WRITE(IOUT,'(5x,a,//)')'confidential data'
221 ELSE
222 WRITE(IOUT,1002) RHO0
223 IF(IFUNC(1) > 0) THEN
224 IF(ITEST == 1) THEN
225 WRITE(IOUT,1200)IFUNC(1),SCALEFAC, NU
226 ELSEIF(ITEST == 2) THEN
227 WRITE(IOUT,1300)IFUNC(1),SCALEFAC, NU
228 ELSEIF(ITEST == 3) THEN
229 WRITE(IOUT,1400)IFUNC(1),SCALEFAC, NU
230 ENDIF
231 ELSE
232 WRITE(IOUT,1100)MU,D,LAM, NU
233 ENDIF
234 ENDIF
235
236C-----------------------------------------------
237 1000 FORMAT(
238 & 5X,' arruda-boyce law ',/,
239 & 5X,' ---------------- ',/)
240 1001 FORMAT(
241 & 5X,A,/,
242 & 5X,'material number . . . . . . . . . . . . =',I10/,
243 & 5X,'material law. . . . . . . . . . . . . . =',I10/)
244 1002 FORMAT(
245 & 5X,'initial density . . . . . . . . . . . . =',1PG20.13/)
246 1100 FORMAT(
247 & 5X,'mu . . . . . . . . . . . . . . . . . . .=',1PG20.13/
248 & 5X,'d. . . . . . . . . . . . . . . . . . . .=',1PG20.13/
249 & 5X,'lam. . . . . . . . . . . . . . . . . . .=',1PG20.13/
250 & 5X,'poisson ratio. . . . . . . . . . . . . .=',E12.4//)
251 1200 FORMAT(
252 & 5X,'uniaxial DATA test curve . . . . . . .=',I10/
253 & 5X,'scale factor for stress in function. . .=',1PG20.13/
254 & 5X,'poisson ratio. . . . . . . . . . . . . .=',E12.4///)
255 1300 FORMAT(
256 & 5X,'equibiaxial DATA test curve. . . . . . .=',I10/
257 & 5X,'scale factor for stress in function. . .=',1PG20.13/
258 & 5X,'poisson ratio. . . . . . . . . . . . . .=',E12.4///)
259 1400 FORMAT(
260 & 5X,'planar DATA test curve . . . . . . . .=',I10/
261 & 5X,'scale factor for stress in function. . .=',1PG20.13/
262 & 5X,'poisson ratio. . . . . . . . . . . . . .=',E12.4///)
263C-----------------------------------------------
264
265
266 RETURN
267 END
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine hm_read_mat92(uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, ipm, matparam)
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
integer, parameter ncharfield
program starter
Definition starter.F:39