OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
atherm.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ atherm()

subroutine atherm ( integer, dimension(nparg,ngroup) iparg,
pm,
type (elbuf_struct_), dimension (ngroup), target elbuf_tab,
flux,
val2,
t,
type(t_ale_connectivity), intent(in) ale_connect,
integer, dimension(nixs,numels) ixs,
integer, dimension(7,numelq) ixq,
fv,
x,
bufmat,
tf,
integer, dimension(*) npf,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom,
integer, dimension(npropmi,nummat) ipm,
type(matparam_struct_), dimension(nummat), intent(in) matparam )
Parameters
[in]matparammaterial buffer

Definition at line 45 of file atherm.F.

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