File: N:\mfix\model\des\des_thermo_rad.f
1
2
3
4
5
6
7
8
9
10
11
12 SUBROUTINE DES_RADIATION
13
14 USE constant
15 USE des_thermo
16 USE discretelement
17 USE fldvar
18 USE param1
19 USE physprop, only: SMAX
20 USE toleranc
21 use functions, only: FLUID_AT
22 use functions, only: IS_NORMAL
23 IMPLICIT NONE
24
25
26
27
28 INTEGER :: NP
29
30 INTEGER :: lM
31
32 INTEGER :: IJK
33
34
35
36
37 DOUBLE PRECISION :: Tenv
38
39 DOUBLE PRECISION :: SBx4Pi
40 INTEGER, PARAMETER :: lUpdateFreq=5
41 INTEGER, SAVE :: lUpdate_avgTs=0
42
43
44
45
46
47
48 IF(.NOT.DES_CONTINUUM_COUPLED) THEN
49 IF(MOD(lUpdate_avgTs,lUpdateFreq) == 0) THEN
50 CALL PARTICLES_IN_CELL
51 CALL CALC_avgTs
52 lUpdate_avgTs = 0
53 ELSE
54 lUpdate_avgTs = lUpdate_avgTs + 1
55 ENDIF
56 ENDIF
57
58 SBx4Pi = SB_CONST*4.0d0*Pi
59
60 DO NP=1,MAX_PIP
61 IF(IS_NORMAL(NP)) THEN
62 lM = PIJK(NP,5)
63 IF(CALC_RADT_DES(lM)) THEN
64
65 IJK = PIJK(NP,4)
66 IF(FLUID_AT(IJK)) THEN
67 Tenv = EP_g(IJK)*T_g(IJK) + &
68 (ONE-EP_g(IJK))*avgDES_T_s(IJK)
69 ELSE
70 Tenv = avgDES_T_s(IJK)
71 ENDIF
72
73 (NP) = Q_Source(NP) + DES_Em(lM)* SBx4Pi * &
74 (DES_RADIUS(NP)**2)*(Tenv**4 - DES_T_s(NP)**4)
75
76 ENDIF
77 ENDIF
78 ENDDO
79
80 RETURN
81 END SUBROUTINE DES_RADIATION
82
83
84
85
86
87
88
89
90
91 SUBROUTINE CALC_avgTs
92
93 USE compar
94 USE derived_types, only: PIC
95 USE des_rxns
96 USE des_thermo
97 USE discretelement
98 USE functions
99 USE geometry
100 USE indices
101 USE param1
102 USE physprop
103 USE run, only: ENERGY_EQ
104
105 IMPLICIT NONE
106
107
108
109
110
111
112
113
114 INTEGER :: IJK
115
116 INTEGER :: NP, lNP
117
118 DOUBLE PRECISION :: SUM_T_s
119 INTEGER, SAVE :: PASS=0
120
121
122 IF(.NOT.ENERGY_EQ) RETURN
123
124
125 IJK_LP: DO IJK = IJKSTART3, IJKEND3
126
127 avgDES_T_s(IJK) = ZERO
128 IF(.NOT.FLUID_AT(IJK)) CYCLE IJK_LP
129
130 IF(PINC(IJK) > 0) THEN
131
132 = ZERO
133
134 lNP_LP: DO lNP = 1, PINC(IJK)
135 NP = PIC(IJK)%p(lNP)
136
137 IF(IS_NORMAL(NP)) SUM_T_s = SUM_T_s + DES_T_s(NP)
138 ENDDO lNP_LP
139
140
141
142 (IJK) = SUM_T_s/PINC(IJK)
143 ENDIF
144 ENDDO IJK_LP
145
146 RETURN
147 END SUBROUTINE CALC_avgTs
148