OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_therm.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_therm (mat_param, bufmat, buflen, ipm, pm, unitab, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_therm()

subroutine hm_read_therm ( type(matparam_struct_), dimension(nummat), intent(inout) mat_param,
intent(inout) bufmat,
integer, intent(in) buflen,
integer, dimension(npropmi,nummat), intent(inout) ipm,
intent(inout) pm,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 40 of file hm_read_therm.F.

42C-----------------------------------------------
43C D e s c r i p t i o n
44C-----------------------------------------------
45C Material Parameters (hm_read_therm.F)
46C PM(71) = JTHE is a material flag. 1: thermal parameters are input 0: no thermal parameter
47C
48C GLOBAL FLAGS (hm_read_part.F)
49C ITHERM_FE : 1 if at least one PART has thermal parameter and lagrangian framework
50C ITHERM : 1 if at least one PART has thermal parameter and ale/euler framework
51C
52C GROUP FLAG (./source/element/....tails.F) IPARG(13) will be flag for thermics.
53C IN ALL CASES
54C IPARG(13) : 0 if current group do not require temperature calculation
55C
56C SOLIDS
57C IPARG(13) : -1 if current group requires temperature calculation at nodes (FEM with Lagrange)
58C IPARG(13) : +1 if current group requires temperature calculation at centroids (FVM with ALE or Euler)
59C
60C SHELLS
61C IPARG(13) : +1 if current group requires temperature calculation at nodes (FEM with Lagrange)
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE unitab_mod
66 USE message_mod
67 USE submodel_mod
68 USE hm_option_read_mod
69 USE names_and_titles_mod , ONLY : nchartitle
70 USE matparam_def_mod
71C============================================================================
72C I m p l i c i t T y p e s
73C-----------------------------------------------
74#include "implicit_f.inc"
75C-----------------------------------------------
76C C o m m o n B l o c k s
77C-----------------------------------------------
78#include "scr17_c.inc"
79#include "com01_c.inc"
80#include "com04_c.inc"
81#include "param_c.inc"
82#include "units_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER,INTENT(IN) :: BUFLEN
87 INTEGER, DIMENSION(NPROPMI,NUMMAT), INTENT(INOUT) :: IPM
88 my_real, DIMENSION(NPROPM ,NUMMAT), INTENT(INOUT) :: pm
89 my_real, DIMENSION(BUFLEN), INTENT(INOUT) :: bufmat
90 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
91 TYPE(SUBMODEL_DATA) ,DIMENSION(NSUBMOD) ,INTENT(IN) :: LSUBMODEL
92 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER :: I,ITH,FLAGMAT,FLAGUNIT,IUNIT,UID,MAT_ID,IMAT,ILAW,ALE,
97 . LAG,EUL,JALE,JTUR,IAD_THERM,NTHERM,IFORM,LAW2_FORM
98 my_real :: tini,tmelt,rho_cp,as,bs,al,bl,rho_cpm1,efrac
99 CHARACTER(LEN=NCHARTITLE) :: TITR
100 CHARACTER :: KEY*80
101 LOGICAL IS_AVAILABLE,IS_AVAILABLE_IFORM
102C=======================================================================
103c COUNT /HEAT MODELS USING CFG FILES
104c--------------------------------------------------
105c
106 CALL hm_option_count('/HEAT',ntherm)
107c
108c--------------------------------------------------
109c START BROWSING /HEAT MODELS
110c--------------------------------------------------
111c
112 CALL hm_option_start('/HEAT')
113c
114c--------------------------------------------------
115 DO ith = 1,ntherm
116c
117 CALL hm_option_read_key(lsubmodel, option_id=mat_id , option_titr=titr , unit_id=uid , keyword2=key )
118c--------------------------------------------------
119c Check MAT_Id
120c--------------------------------------------------
121 flagmat = 0
122 ilaw = 0
123 imat = 0
124 DO i =1,nummat-1
125 IF (mat_id == mat_param(i)%MAT_ID) THEN
126 flagmat = 1
127 imat = i
128 EXIT
129 ENDIF
130 ENDDO
131 IF (mat_id > 0 .AND. flagmat == 0) THEN
132 CALL ancmsg(msgid=1663,anmode=aninfo,msgtype=msgerror,
133 & i1= mat_id, c1='HEAT/MAT', c2='HEAT/MAT', c3='')
134 ENDIF
135 ilaw = mat_param(imat)%ILAW
136c--------------------------------------------------
137c Check Unit_ID
138c--------------------------------------------------
139 flagunit = 0
140 DO iunit=1,unitab%NUNITS
141 IF (unitab%UNIT_ID(iunit) == uid) THEN
142 flagunit = 1
143 EXIT
144 ENDIF
145 ENDDO
146 IF (uid > 0 .AND. flagunit == 0) THEN
147 CALL ancmsg(msgid=659, anmode=aninfo, msgtype=msgerror,
148 & i1= mat_id,
149 & i2= uid,
150 & c1='HEAT/MAT',
151 & c2='HEAT/MAT',
152 & c3= '')
153 ENDIF
154c--------------------------------------------------
155c Reading user parameters
156c--------------------------------------------------
157 CALL hm_get_floatv('HEAT_T0' ,tini ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('HEAT_RHocp' ,rho_cp ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('HEAT_AS' ,as ,is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('HEAT_BS' ,bs ,is_available, lsubmodel, unitab)
161 CALL hm_get_intv ('HEAT_Iform' ,iform ,is_available_iform, lsubmodel)
162c
163 CALL hm_get_floatv('HEAT_T1' ,tmelt ,is_available, lsubmodel, unitab)
164 CALL hm_get_floatv('HEAT_AL' ,al ,is_available, lsubmodel, unitab)
165 CALL hm_get_floatv('HEAT_BL' ,bl ,is_available, lsubmodel, unitab)
166 CALL hm_get_floatv('HEAT_EFRAC' ,efrac ,is_available, lsubmodel, unitab)
167c--------------------------------------------------
168c Specific Case : law2
169c--------------------------------------------------
170 IF (ilaw == 2) THEN
171 law2_form = nint(pm(50,imat))
172 IF (tmelt /= pm(54,imat) .AND. law2_form == 1) THEN ! zerilli
173 CALL ancmsg(msgid=764, msgtype=msgwarning, anmode=aninfo_blind_1,
174 & i1=mat_id, c1=titr, i2=mat_id, i3=mat_id)
175 END IF
176 IF (rho_cp /= pm(69,imat)) THEN
177 CALL ancmsg(msgid=765, msgtype=msgwarning, anmode=aninfo_blind_1,
178 & i1=mat_id, c3=titr, i2=mat_id, i3=mat_id)
179 ENDIF
180c--------------------------------------------------
181c Specific Case : law73
182c--------------------------------------------------
183 ELSEIF (ilaw == 73)THEN
184 iad_therm = ipm(7,imat)-1
185 IF (bufmat(iad_therm+20) /= pm(79,imat) ) THEN
186 CALL ancmsg(msgid=764, msgtype=msgwarning, anmode=aninfo_blind_1,
187 & i1=mat_id, c1=titr, i2=mat_id, i3=mat_id)
188 ENDIF
189 IF (rho_cp == zero) THEN
190 rho_cpm1 = zero
191 ELSE
192 rho_cpm1 = one/rho_cp
193 ENDIF
194 IF (bufmat(iad_therm+21) /= rho_cpm1) THEN
195 CALL ancmsg(msgid=765, msgtype=msgwarning, anmode=aninfo_blind_1,
196 & i1=mat_id, c1=titr, i2=mat_id, i3=mat_id)
197 ENDIF
198 ENDIF
199c-------
200c Check at least if the corresponding material is indeed lagrangian !!
201 lag = 0
202 eul = 0
203 ale = 0
204 jale = nint(pm(72,imat))
205 IF (jale == 0 .AND. ilaw/=18 .AND. ilaw/=11) THEN
206 ilag= 1
207 lag = 1
208 ELSEIF(jale == 1)THEN
209 iale= 1
210 ale = 1
211 ELSEIF(jale == 2)THEN
212 ieuler= 1
213 eul = 1
214 ELSEIF(jale == 3) THEN
215 ilag= 1
216 lag = 1
217 ENDIF
218c
219 IF(is_available_iform)THEN
220 IF(iform /=0 .AND. lag == 0)THEN
221 iform = 0
222 CALL ancmsg(msgid=1609, msgtype=msgwarning, anmode=aninfo_blind_1,
223 & i1=mat_id, c1="WARNING", c2=titr,
224 & c3="IFORM = 1 IS INCOMPATIBLE WITH /ALE AND /EULER MATERIALS, IT WILL BE IGNORED")
225 ENDIF
226 ENDIF
227c
228 IF (rho_cp == zero .AND. lag == 0) THEN
229 CALL ancmsg(msgid=1609, msgtype=msgerror, anmode=aninfo_blind_1,
230 & i1=mat_id, c1="ERROR", c2=titr,
231 & c3="RHO_0 Cp PARAMETER MUST BE GREATER THAN ZERO")
232 ENDIF
233c--------------------------------------------------
234c Default Values
235c--------------------------------------------------
236 IF (tini == zero) tini = pm(23,imat) / max(em20,rho_cp) ! E0 / rho_cp
237 IF (tini == zero) tini = three100
238 IF (tmelt == zero) tmelt = ep20
239 IF (efrac < zero) efrac = zero
240 IF (efrac > one ) efrac = one
241 IF (efrac == zero) efrac = one
242
243 pm(71,imat) = onep1 ! jthe
244 pm(69,imat) = rho_cp
245 pm(75,imat) = as
246 pm(76,imat) = bs
247 pm(77,imat) = al
248 pm(78,imat) = bl
249 pm(79,imat) = tini
250 pm(80,imat) = tmelt
251 pm(90,imat) = efrac
252
253 mat_param(imat)%ITHERM = 1 ! setting jthe=1
254 mat_param(imat)%THERM%RHOCP = rho_cp
255 mat_param(imat)%THERM%TINI = tini
256 mat_param(imat)%THERM%TMELT = tmelt
257 mat_param(imat)%THERM%AS = as
258 mat_param(imat)%THERM%BS = bs
259 mat_param(imat)%THERM%AL = al
260 mat_param(imat)%THERM%BL = bl
261 mat_param(imat)%THERM%EFRAC = efrac
262c--------------------------------------------------
263c Output
264c--------------------------------------------------
265 WRITE(iout,2000) mat_id,tini,tmelt,rho_cp,as,bs,al,bl,efrac
266C
267 ENDDO ! I = 1,NTHERM
268
269c-----------------------------------------
270 2000 FORMAT(/
271 & 5x,' THERMAL PARAMETERS ',/,
272 & 5x,' ------------------ ',/,
273 & 5x,'MATERIAL NUMBER . . . . . . . . . . . . . . . =',i10/,
274 & 5x,'T0 (INITIAL TEMPERATURE). . . . . . . . . . . =',1pg20.13/,
275 & 5x,'TMELT (MELTING TEMPERATURE) . . . . . . . . . =',1pg20.13/,
276 & 5x,'SPECIFIC HEAT . . . . . . . . . . . . . . . . =',1pg20.13/,
277 & 5x,'AS (SOLID PHASE). . . . . . . . . . . . . . . =',1pg20.13/,
278 & 5x,'BS (SOLID PHASE). . . . . . . . . . . . . . . =',1pg20.13/,
279 & 5x,'AL (LIQUID PHASE) . . . . . . . . . . . . . . =',1pg20.13/,
280 & 5x,'BL (LIQUID PHASE) . . . . . . . . . . . . . . =',1pg20.13/,
281 & 5x,'FRACTION OF STRAIN ENERGY CONVERTED INTO HEAT =',1pg20.13/)
282c-----------------------------------------
283 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
max
#define max(a, b)
Definition macros.h:21
hm_option_read_mod
Definition hm_option_read_mod.F:408
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