OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
atherm.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!|| atherm ../engine/source/ale/atherm.f
25!||--- called by ------------------------------------------------------
26!|| alethe ../engine/source/ale/alethe.F
27!||--- calls -----------------------------------------------------
28!|| adiff2 ../engine/source/ale/ale2d/adiff2.F
29!|| adiff3 ../engine/source/ale/ale3d/adiff3.F
30!|| afimp2 ../engine/source/ale/ale2d/afimp2.F
31!|| afimp3 ../engine/source/ale/ale3d/afimp3.f
32!|| initbuf ../engine/share/resol/initbuf.F
33!|| m18th ../engine/source/materials/mat/mat018/m18th.F
34!|| m26th ../engine/source/materials/mat/mat026/m26th.F
35!|| m51th ../engine/source/materials/mat/mat051/heat51.F
36!|| spmd_evois ../engine/source/mpi/fluid/spmd_cfd.f
37!||--- uses -----------------------------------------------------
38!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
39!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
40!|| initbuf_mod ../engine/share/resol/initbuf.F
41!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
42!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
43!||====================================================================
44 SUBROUTINE atherm(
45 1 IPARG, PM, ELBUF_TAB, FLUX,
46 2 VAL2, T, ALE_CONNECT,IXS,
47 3 IXQ, FV, X, BUFMAT,
48 4 TF, NPF, NERCVOIS, NESDVOIS,
49 5 LERCVOIS, LESDVOIS, LENCOM, IPM,
50 6 MATPARAM)
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE initbuf_mod
55 USE elbufdef_mod
56 USE ale_connectivity_mod
57 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
58 USE matparam_def_mod, ONLY : matparam_struct_
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C G l o b a l P a r a m e t e r s
65C-----------------------------------------------
66#include "mvsiz_p.inc"
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "com01_c.inc"
71#include "com04_c.inc"
72#include "vect01_c.inc"
73#include "param_c.inc"
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C-----------------------------------------------
77 INTEGER IPARG(NPARG,NGROUP), IXS(NIXS,NUMELS), IXQ(7,NUMELQ), NPF(*),
78 . NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*),
79 . IPM(NPROPMI,NUMMAT), LENCOM
80 my_real PM(NPROPM,NUMMAT), FLUX(*), VAL2(*), T(*), FV(*), X(3,NUMNOD),TF(*),BUFMAT(*)
81 TYPE (ELBUF_STRUCT_), DIMENSION (NGROUP), TARGET :: ELBUF_TAB
82 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
83 TYPE(matparam_struct_),DIMENSION(NUMMAT),INTENT(IN) :: MATPARAM !< material buffer
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER NG, I, J, NPH1, NPH2, NPH3, IADBUF
88 INTEGER MAT(MVSIZ)
89 my_real rk, re, r, yp0, xmu, ax, e, a, cmu, rpr, yplus, p, xmt
90 my_real, DIMENSION(:) ,POINTER :: ph1,ph2,ph3
91 TYPE(g_bufel_) ,POINTER :: GBUF
92 INTEGER :: NEL !< number of elements in current group
93 INTEGER :: MID !< material identifier
94 my_real :: rhocp !< density * heat capacity at constant pressure
95C-----------------------------------------------
96C S o u r c e L i n e s
97C-----------------------------------------------
98 DO ng=1,ngroup
99 IF(iparg(8,ng) == 1)cycle
100 IF (iparg(76, ng) == 1) cycle ! --> OFF (ALE ON/OFF)
101 gbuf => elbuf_tab(ng)%GBUF
102 CALL initbuf(iparg ,ng ,
103 2 mtn ,llt ,nft ,iad ,ity ,
104 3 npt ,jale ,ismstr ,jeul ,jtur ,
105 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
106 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
107 6 irep ,iint ,igtyp ,israt ,isrot ,
108 7 icsen ,isorth ,isorthg ,ifailure,jsms )
109 IF((ity /= 1).AND.(ity /= 2))cycle
110 IF (mtn == 1)cycle
111
112 lft=1
113 nel = iparg(2, ng)
114c
115 IF(n2d == 0)THEN
116 DO i=1,nel
117 mat(i)=ixs(1,i+nft)
118 ENDDO
119 ELSE
120 DO i=1,nel
121 mat(i)=ixq(1,i+nft)
122 ENDDO
123 ENDIF
124
125 ! thermal diffusivity (alpha) : alpha = k / rhocp where k=A+B*T
126 ! VAL2 is alpha*rhocp=k instead of alpha since scheme applied to E instead of T and dE = rhocp.dT
127 DO i=1,nel
128 j=i+nft
129 t(j) = gbuf%TEMP(i)
130 IF(t(j) <= pm(80,mat(i)))THEN
131 val2(j)=pm(75,mat(i))+pm(76,mat(i))*t(j)
132 ELSE
133 val2(j)=pm(77,mat(i))+pm(78,mat(i))*t(j)
134 ENDIF
135 ENDDO
136
137 IF (mtn == 17)THEN
138 DO i=1,nel
139 j=i+nft
140 rk = gbuf%RK(i)
141 re = gbuf%RE(i)
142 r = gbuf%RHO(i)
143 yp0=pm(51,mat(i))
144 xmu=r*pm(24,mat(i))
145 ax =pm(47,mat(i))
146 e =pm(48,mat(i))
147 a =pm(49,mat(i))
148 cmu=pm(81,mat(i))
149 rpr=pm(95,mat(i))
150 yplus =cmu*rk**2/max(ax*re*xmu,em15)
151 IF(yplus < yp0)cycle
152 p = ninep24*(rpr-one)/(rpr**fourth)
153 val2(j)=val2(j) * rpr*ax*yplus / (a*log(e*yplus) + ax*p)
154 enddo!next I
155 ELSEIF (mtn == 18)THEN
156 CALL m18th( gbuf%TEMP,val2, mat, pm,
157 2 ipm, tf, npf, nel)
158 ELSEIF (mtn == 26)THEN
159 CALL m26th( mat, gbuf%RHO, gbuf%TEMP,val2,
160 2 pm, bufmat, gbuf%RE, nel,
161 3 nft)
162 ELSEIF (mtn == 51) THEN
163 nph1 = (m51_n0phas)*nel
164 nph2 = (m51_n0phas + m51_nvphas)*nel
165 nph3 = (m51_n0phas + m51_nvphas*2)*nel
166 iadbuf = ipm(7,mat(1))
167 ph1 =>elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(nph1+1:nph1+1+nel)
168 ph2 =>elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(nph2+1:nph2+1+nel)
169 ph3 =>elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(nph3+1:nph3+1+nel)
170 CALL m51th( t(1+nft), ph1, ph2, ph3,
171 2 bufmat(iadbuf),val2(1+nft), nel)
172 ELSEIF (jtur /= 0.AND.mtn /= 11) THEN
173 DO i=1,nel
174 j=i+nft
175 rk = gbuf%RK(i)
176 re = gbuf%RE(i)
177 r = gbuf%RHO(i)
178 xmt= pm(81,mat(i))*rk*rk / max(em15,re)
179 xmu= r*pm(24,mat(i))
180 rpr= pm(95,mat(i))
181 val2(j)=val2(j)*(one+rpr*xmt/xmu)
182 ENDDO
183 ENDIF
184 enddo!next ng
185C-----------------------------
186C SPMD EXCHANGE T, VAL2
187C-----------------------------
188 IF (nspmd > 1)THEN
189 CALL spmd_evois(t, val2, nercvois, nesdvois, lercvois, lesdvois, lencom)
190 ENDIF
191C------------------------------
192C IMPOSED FLUX
193C------------------------------
194 DO ng=1,ngroup
195 IF (iparg(76, ng) == 1) cycle ! --> OFF (ALE ON/OFF)
196 mtn=iparg(1,ng)
197 IF (mtn /= 11) cycle
198 jthe=iparg(13,ng)
199 IF (jthe /= 1) cycle
200 lft=1
201 llt=iparg(2,ng)
202 nel=iparg(2,ng)
203 nft=iparg(3,ng)
204 iad=iparg(4,ng)
205 lft=1
206 IF(n2d == 0)THEN
207 CALL afimp3(pm,x,ixs,t,flux(6*nft+1),val2,ale_connect,fv)
208 ELSE
209 CALL afimp2(pm,x,ixq,t,flux(4*nft+1),val2,ale_connect,fv)
210 ENDIF
211 ENDDO
212
213C------------------------------
214C NUMERICAL SCHEME
215C------------------------------
216 DO ng=1,ngroup
217 IF (iparg(76, ng) == 1) cycle ! --> OFF (ALE ON/OFF)
218 gbuf => elbuf_tab(ng)%GBUF
219 CALL initbuf(iparg ,ng ,
220 2 mtn ,llt ,nft ,iad ,ity ,
221 3 npt ,jale ,ismstr ,jeul ,jtur ,
222 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
223 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
224 6 irep ,iint ,igtyp ,israt ,isrot ,
225 7 icsen ,isorth ,isorthg ,ifailure,jsms )
226 IF (iparg(8,ng) == 1)cycle
227 IF (jthe /= 1 .OR. ity == 51)cycle
228 lft=1
229 nel=iparg(2,ng)
230 mid=iparg(18,ng)
231 rhocp = pm(69,mid)
232 if(rhocp == zero)then
233 rhocp = pm(89,mid)*matparam(mid)%eos%cp
234 end if
235 IF (mtn == 51)THEN
236 DO i=1,nel
237 gbuf%TEMP(i) = zero
238 ENDDO
239 IF (n2d == 0) THEN
240 CALL adiff3(gbuf%TEMP,t,flux(6*nft+1),val2,ale_connect,gbuf%VOL,gbuf%TEMP,rhocp,nel)
241 ELSE
242 CALL adiff2(gbuf%TEMP,t,flux(4*nft+1),val2,ale_connect,gbuf%VOL,gbuf%TEMP,rhocp,nel)
243 ENDIF
244 ELSE
245 IF (n2d == 0) THEN
246 CALL adiff3(gbuf%EINT,t,flux(6*nft+1),val2,ale_connect,gbuf%VOL,gbuf%TEMP,rhocp,nel)
247 ELSE
248 CALL adiff2(gbuf%EINT,t,flux(4*nft+1),val2,ale_connect,gbuf%VOL,gbuf%TEMP,rhocp,nel)
249 ENDIF
250 ENDIF
251 enddo!next NG
252C-----------
253 RETURN
254 END
adiff2
subroutine adiff2(phin, phi, grad, alpha, ale_connect, vol, temp, rhocp, nel)
Definition adiff2.F:33
adiff3
subroutine adiff3(phin, phi, grad, alpha, ale_connect, vol, temp, rhocp, nel)
Definition adiff3.F:33
afimp2
subroutine afimp2(pm, x, ixq, t, grad, coef, ale_connect, fv)
Definition afimp2.F:33
afimp3
subroutine afimp3(pm, x, ixs, t, grad, coef, ale_connect, fv)
Definition afimp3.F:31
atherm
subroutine atherm(iparg, pm, elbuf_tab, flux, val2, t, ale_connect, ixs, ixq, fv, x, bufmat, tf, npf, nercvois, nesdvois, lercvois, lesdvois, lencom, ipm, matparam)
Definition atherm.F:51
m51th
subroutine m51th(t, av1, av2, av3, uparam, xk, nel)
Definition heat51.F:31
m18th
subroutine m18th(t, xk, mat, pm, ipm, tf, npf, nel)
Definition m18th.F:33
m26th
subroutine m26th(mat, rho, t, xk, pm, sesame, z, nel, nft)
Definition m26th.F:34
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
spmd_evois
subroutine spmd_evois(t, val2, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:261