OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat37.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_mat37 ../starter/source/materials/mat/mat037/hm_read_mat37.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_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
31!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
32!||--- uses -----------------------------------------------------
33!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_mat37(UPARAM ,MAXUPARAM,NUPARAM ,ISRATE , IMATVIS ,
38 . NUVAR ,IFUNC ,MAXFUNC ,NFUNC , PARMAT ,
39 . UNITAB ,ID ,TITR ,MTAG , LSUBMODEL,
40 . PM ,STIFINT ,MAT_ID ,MATPARAM )
41C-----------------------------------------------
42C D e s c r i p t i o n
43C-----------------------------------------------
44C READ MAT LAW37 WITH HM READER ( TO BE COMPLETED )
45C
46C DUMMY ARGUMENTS DESCRIPTION:
47C ===================
48C
49C NAME DESCRIPTION
50C
51C IPM MATERIAL ARRAY(INTEGER)
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
66 USE alemuscl_mod , only:alemuscl_param
67 USE names_and_titles_mod , ONLY : nchartitle
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "units_c.inc"
76#include "com01_c.inc"
77#include "param_c.inc"
78#include "inter22.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
83 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: PM
84 my_real, DIMENSION(100) ,INTENT(INOUT) :: PARMAT
85 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
86 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
87 INTEGER, INTENT(INOUT) :: ISRATE,IMATVIS,NFUNC,MAXFUNC,MAXUPARAM,NUPARAM,NUVAR
88 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
89 INTEGER,INTENT(IN) :: ID
90 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
91 my_real,INTENT(INOUT) :: stifint
92 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(NSUBMOD)
93 INTEGER,INTENT(IN) :: MAT_ID
94 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
99 my_real C1,C2,P0,VIS,VISV,RHO10,RHO20,A1,PMIN,GAM,VIS2,PSHIFT,VISV2,FAC_M,FAC_L,FAC_T,FAC_C,RHO0,RHOR
100 INTEGER I,ISOLVER,IRHO
101 character*63 chain1
102C-----------------------------------------------
103C S o u r c e L i n e s
104C-----------------------------------------------
105
106 israte = 0
107 is_encrypted = .false.
108 is_available = .false.
109
110 !================================= !
111 ! Communicate LAW to ALEMUSC_MOD !
112 !=================================!
113 IF (alemuscl_param%IALEMUSCl > 0) alemuscl_param%I_LAW = 37
114 IF(trimat==0)trimat = -2 !allows to detect bimaterial law BIMAT/BIPHAS (used for /ANIM/BRIC/VFRAC)
115
116 CALL hm_option_is_encrypted(is_encrypted)
117
118 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
120 CALL hm_get_floatv('MAT_PSH' ,pshift ,is_available, lsubmodel, unitab)
121
122 !line-submat-1
123 CALL hm_get_floatv('Lqud_Rho_l' ,rho10 ,is_available, lsubmodel, unitab)
124 CALL hm_get_floatv('C_l' ,c1 ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv('ALPHA1' ,a1 ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('Nu_l' ,vis ,is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('Bulk_Ratio_l' ,visv ,is_available, lsubmodel, unitab)
128
129 !line-submat-2
130 CALL hm_get_floatv('Lqud_Rho_g' ,rho20 ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('Lqud_Gamma_bulk',gam ,is_available, lsubmodel, unitab)
132 CALL hm_get_floatv('Lqud_P0' ,p0 ,is_available, lsubmodel, unitab)
133 CALL hm_get_floatv('Nu_g' ,vis2 ,is_available, lsubmodel, unitab)
134 CALL hm_get_floatv('Bulk_Ratio_g' ,visv2 ,is_available, lsubmodel, unitab)
135
136 irho=0
137 IF(gam*c1==0)irho=int(p0)
138
139 !--------------------------------!
140 ! INPUT CHECK !
141 !--------------------------------!
142 IF(a1<zero .OR. a1>one)THEN
143 chain1 = 'INITIAL MASSIC FRACTION MUST BE BETWEEN 0 AND 1. '
144 CALL ancmsg(msgid=65,
145 . msgtype=msgerror,
146 . anmode=aninfo,
147 . i1=37,
148 . i2=id,
149 . c1='ERROR',
150 . c2=titr,
151 . c3=chain1)
152 a1 = one
153 ENDIF
154
155 IF(rho10<zero .OR. rho20<zero)THEN
156 chain1 = 'INITIAL DENSITY CANNOT BE NEGATIVE. '
157 CALL ancmsg(msgid=65,
158 . msgtype=msgerror,
159 . anmode=aninfo,
160 . i1=37,
161 . i2=id,
162 . c1='ERROR',
163 . c2=titr,
164 . c3=chain1)
165 IF(rho10<zero)rho10 = em20
166 IF(rho20<zero)rho20 = em20
167 ENDIF
168
169 !--------------------------------!
170 ! STORAGE !
171 !--------------------------------!
172
173 !===SOLVER VERSION
174 !ISOLVER = 1 : legacy solver
175 !ISOLVER = 2 : alternative solver (2018.0)
176 isolver = 1
177 IF(int22 > 0) isolver = 2
178
179 !===NEW PRESSURE SHIFT PARAM (2018.0)
180 IF(pshift==zero)THEN
181 pshift=-p0
182 ELSE
183 pshift = -pshift
184 ENDIF
185
186 ! PSH = -P0 : relative pressure P_liq = C1.mu, P_gas = P0(1+mu)**gamma - P0
187 ! PSH = -1e-20 : total pressure P_liq = C0+C1.mu, P_gas = P0(1+mu)**gamma
188
189 !===UPARAM STORAGE
190 pmin = - p0
191 rho0 = rho10 * a1 + (one-a1)*rho20
192 rhor = rho0
193 pm(01) = rho0
194 pm(89) = rho0
195 pm(91) = rho10
196 pm(31) = p0+pshift
197 pm(104) = p0+pshift
198
199 uparam(1) = vis
200 uparam(2) = two*vis
201 uparam(3) = (visv-uparam(2))*third
202 uparam(4) = c1
203 c2 = - pmin * gam
204 uparam(5) = gam
205 uparam(6) = c1/rho10
206 uparam(7) = gam * p0 / rho20
207 uparam(8) = pmin
208 uparam(9) = p0
209 uparam(10) = a1
210 uparam(11) = rho10
211 uparam(12) = rho20
212 uparam(13) = vis2
213 uparam(14) = two*vis2
214 uparam(15) = (visv2-uparam(14))*third
215 uparam(16) = pshift !pressure formulation : total or relative to P0
216 uparam(17) = isolver
217
218 nuparam = 17
219 ifunc(1) = irho
220 nfunc = 1
221 nuvar = 5
222 stifint = c1
223
224 ! MATPARAM keywords
225 CALL init_mat_keyword(matparam,"HOOK")
226
227 ! Properties compatibility
228 CALL init_mat_keyword(matparam,"SOLID_POROUS")
229
230 !--------------------------------!
231 ! PRINTOUT !
232 !--------------------------------!
233 IF(gam*c1>0.)THEN
234 WRITE(iout,1011) trim(titr),mat_id,37
235 WRITE(iout,1000)
236
237 IF(isolver==2)WRITE(iout,1102)
238 IF(is_encrypted)THEN
239 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
240 ELSE
241 WRITE(iout,1012) rho0
242 WRITE(iout,1100)rho10,c1,a1,vis,visv,rho20,gam,p0,vis2,visv2,p0,-pshift
243 ENDIF
244 ELSE
245 WRITE(iout,1001)
246 IF(is_encrypted)THEN
247 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
248 ELSE
249 WRITE(iout,1101)rho10,rho20,irho
250 END IF
251 END IF
252
253C----------------------
254 RETURN
255 1000 FORMAT(
256 & 5x,' BI-PHASE LIQUID-GAS LAW',/,
257 & 5x,' -----------------------',//)
258 1011 FORMAT(/
259 & 5x,a,/,
260 & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
261 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
262 1012 FORMAT(
263 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
264 1001 FORMAT(
265 & 5x,' BOUNDARY FOR BI-PHASE LIQUID-GAS LAW',/,
266 & 5x,' -------------------------------------',//)
267 1100 FORMAT(
268 & 5x,'LIQUID REFERENCE DENSITY. . . . . . . .=',1pg20.13/
269 & 5x,'LIQUID BULK STIFFNESS . . . . . . . . .=',1pg20.13/
270 & 5x,'LIQUID MASS RATIO . . . . . . . . . . .=',1pg20.13/
271 & 5x,' (0. = FULL OF GAZ; 1. = FULL OF LIQUID)'/
272 & 5x,'LIQUID SHEAR KINEMATIC VISCOSITY . . . =',1pg20.13/
273 & 5x,'LIQUID BULK KINEMATIC VISCOSITY . . . =',1pg20.13//
274 & 5x,'GAS REFERENCE DENSITY. . . . . . . .=',1pg20.13/
275 & 5x,'GAS CONSTANT. . . . . . . . . . . . . .=',1pg20.13/
276 & 5x,'GAS REFERENCE PRESSURE. . . . . . . . .=',1pg20.13/
277 & 5x,'GAS SHEAR KINEMATIC VISCOSITY . . . . .=',1pg20.13/
278 & 5x,'GAS BULK KINEMATIC VISCOSITY . . . . .=',1pg20.13//
279 & 5x,'REFERENCE PRESSURE. . . . . . . . . . .=',1pg20.13/
280 & 5x,'PRESSURE SHIFT. . . . . . . . . . . . .=',1pg20.13//)
281 1101 FORMAT(
282 & 5x,'LIQUID REFERENCE DENSITY. . . . . . . .=',1pg20.13/
283 & 5x,'GAS REFERENCE DENSITY. . . . . . . .=',1pg20.13/
284 & 5x,'SCALING FUNCTION FOR GAS DENSITY. . . .=',i10)
285 1102 FORMAT(
286 & 5x,'ITERATIVE NEWTON SOLVER '/)
287 END
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_mat37
subroutine hm_read_mat37(uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, id, titr, mtag, lsubmodel, pm, stifint, mat_id, matparam)
Definition hm_read_mat37.F:41
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
alemuscl_mod
Definition alemuscl_mod.F:54
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:75
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
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
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232
submodel_mod::submodel_data
Definition submodel_mod.F:723