File: RELATIVE:/../../../mfix.git/model/des/des_granular_temperature.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 SUBROUTINE DES_GRANULAR_TEMPERATURE
16
17
18
19
20 USE discretelement
21 USE param
22 USE param1
23 USE run
24 USE geometry
25 USE indices
26 USE compar
27 USE sendrecv
28 USE physprop
29 USE fun_avg
30 USE functions
31 USE mpi_utility
32 IMPLICIT NONE
33
34
35
36
37 INTEGER :: I, J, K, IJK
38
39 INTEGER :: M, LL
40
41 INTEGER :: NP_PHASE(DIMENSION_3, DES_MMAX)
42
43 DOUBLE PRECISION :: TEMP(DIMENSION_3, DES_MMAX)
44
45 INTEGER :: PC
46
47 DOUBLE PRECISION :: SQR_VEL, SQR_ROT_VEL
48
49
50
51
52
53
54
55
56
57
58 (:,:) = ZERO
59 NP_PHASE(:,:) = 0
60 PC = 0
61 DO LL = 1, MAX_PIP
62
63 IF(IS_NONEXISTENT(LL)) CYCLE
64 PC = PC + 1
65
66 IF(IS_GHOST(LL) .or. IS_ENTERING_GHOST(LL) .or. IS_EXITING_GHOST(LL)) CYCLE
67
68 I = PIJK(LL,1)
69 J = PIJK(LL,2)
70 K = PIJK(LL,3)
71 IJK = PIJK(LL,4)
72
73 M = PIJK(LL,5)
74 NP_PHASE(IJK,M) = NP_PHASE(IJK,M) + 1
75
76 TEMP(IJK,M) = TEMP(IJK,M) + &
77 (DES_VEL_NEW(1,LL)-DES_U_s(IJK,M))**2
78 TEMP(IJK,M) = TEMP(IJK,M) + &
79 (DES_VEL_NEW(2,LL)-DES_V_s(IJK,M))**2
80 IF(DO_K) THEN
81 TEMP(IJK,M) = TEMP(IJK,M) + &
82 (DES_VEL_NEW(3,LL)-DES_W_s(IJK,M))**2
83 ENDIF
84
85 IF(PC .EQ. PIP) EXIT
86 ENDDO
87
88
89 DO IJK = IJKSTART3, IJKEND3
90 IF(FLUID_AT(IJK)) THEN
91
92 DO M = 1,DES_MMAX
93 IF (NP_PHASE(IJK,M) > 0 ) THEN
94 DES_THETA(IJK,M) = TEMP(IJK,M)/&
95 DBLE(DIMN*NP_PHASE(IJK,M))
96 ELSE
97 DES_THETA(IJK,M) = ZERO
98 ENDIF
99 ENDDO
100 ENDIF
101 ENDDO
102
103
104
105
106
107
108
109 = ZERO
110 DES_ROTE = ZERO
111 DES_PE = ZERO
112 DES_VEL_AVG(:) = ZERO
113
114
115
116 = 0
117 DO LL = 1, MAX_PIP
118
119 IF(IS_NONEXISTENT(LL)) CYCLE
120 PC = PC + 1
121 IF(IS_GHOST(LL) .OR. IS_ENTERING_GHOST(LL) .OR. IS_EXITING_GHOST(LL)) CYCLE
122
123 SQR_VEL = ZERO
124 SQR_ROT_VEL = ZERO
125 DO I = 1, DIMN
126 SQR_VEL = SQR_VEL + DES_VEL_NEW(I,LL)**2
127 ENDDO
128
129 DO I = 1, merge(1,3,NO_K)
130 SQR_ROT_VEL = SQR_ROT_VEL + OMEGA_NEW(I,LL)**2
131 ENDDO
132
133
134 DES_KE = DES_KE + PMASS(LL)/2.d0 * SQR_VEL
135
136 = DES_ROTE + &
137 (0.4D0*PMASS(LL)*DES_RADIUS(LL)**2)/2.d0 * SQR_ROT_VEL
138 DES_PE = DES_PE + PMASS(LL)*DBLE(ABS(GRAV(2)))*&
139 DES_POS_NEW(2,LL)
140 DES_VEL_AVG(:) = DES_VEL_AVG(:) + DES_VEL_NEW(:,LL)
141
142 IF(PC .EQ. PIP) EXIT
143 ENDDO
144
145
146
147 CALL GLOBAL_ALL_SUM(PIP-iGHOST_CNT,TOT_PAR)
148 CALL GLOBAL_ALL_SUM(DES_VEL_AVG(1:DIMN))
149
150
151 IF(TOT_PAR > 0) DES_VEL_AVG(:) = DES_VEL_AVG(:)/DBLE(TOT_PAR)
152
153
154
155
156
157 (:) = ZERO
158 GLOBAL_GRAN_TEMP(:) = ZERO
159 PC = 0
160 DO LL = 1, MAX_PIP
161
162
163 IF(IS_NONEXISTENT(LL)) CYCLE
164 PC = PC + 1
165 IF(IS_GHOST(LL) .OR. IS_ENTERING_GHOST(LL) .OR. IS_EXITING_GHOST(LL)) CYCLE
166
167 GLOBAL_GRAN_ENERGY(:) = GLOBAL_GRAN_ENERGY(:) + &
168 0.5d0*PMASS(LL)*(DES_VEL_NEW(:,LL)-DES_VEL_AVG(:))**2
169 GLOBAL_GRAN_TEMP(:) = GLOBAL_GRAN_TEMP(:) + &
170 (DES_VEL_NEW(:,LL)-DES_VEL_AVG(:))**2
171
172 IF(PC .EQ. PIP) EXIT
173 ENDDO
174
175 CALL GLOBAL_ALL_SUM(GLOBAL_GRAN_TEMP)
176 CALL GLOBAL_ALL_SUM(GLOBAL_GRAN_ENERGY)
177 CALL GLOBAL_ALL_SUM(DES_KE)
178 CALL GLOBAL_ALL_SUM(DES_PE)
179 CALL GLOBAL_ALL_SUM(DES_ROTE)
180
181 IF(TOT_PAR > 0) GLOBAL_GRAN_ENERGY(:) = &
182 GLOBAL_GRAN_ENERGY(:)/DBLE(TOT_PAR)
183 IF(TOT_PAR > 0) GLOBAL_GRAN_TEMP(:) = &
184 GLOBAL_GRAN_TEMP(:)/DBLE(TOT_PAR)
185
186 RETURN
187
188 END SUBROUTINE DES_GRANULAR_TEMPERATURE
189
190
191
192
193
194
195
196
197
198 SUBROUTINE CALC_DES_BEDHEIGHT
199
200
201
202
203 USE indices
204 USE geometry
205 USE compar
206 USE discretelement
207 USE des_bc
208 USE physprop
209 USE fldvar
210 USE functions
211 IMPLICIT NONE
212
213
214
215
216 INTEGER :: L
217
218 INTEGER :: PC
219
220 INTEGER :: M
221
222 INTEGER :: J, IJK
223
224 DOUBLE PRECISION :: hcell
225
226 DOUBLE PRECISION :: hpart
227
228 DOUBLE PRECISION :: EP_SM
229
230 DOUBLE PRECISION :: tmp_num(DES_MMAX), tmp_den(DES_MMAX)
231
232
233
234
235 (:) = ZERO
236 tmp_den(:) = ZERO
237 DO IJK = IJKSTART3, IJKEND3
238 J = J_OF(IJK)
239 DO M = 1, DES_MMAX
240 IF(DES_ROP_S(IJK,M) > ZERO) THEN
241 hcell = 0.5d0*(YN(J)+YN(J-1))
242 EP_SM = DES_ROP_S(IJK,M)/DES_RO_S(M)
243 tmp_num(M) = tmp_num(M) + EP_SM*hcell*VOL(IJK)
244 tmp_den(M) = tmp_den(M) + EP_SM*VOL(IJK)
245 ENDIF
246 ENDDO
247 ENDDO
248
249 IF (PIP >0) bed_height(:) = tmp_num(:)/tmp_den(:)
250
251
252 IF(.FALSE.) THEN
253 tmp_num(:) = ZERO
254 tmp_den(:) = ZERO
255
256 PC = 0
257 DO L = 1, MAX_PIP
258
259 IF(IS_NONEXISTENT(L)) CYCLE
260 PC = PC + 1
261 IF(IS_GHOST(L) .OR. IS_ENTERING_GHOST(L) .OR. IS_EXITING_GHOST(L)) CYCLE
262
263 M = PIJK(L,5)
264 hpart = DES_POS_NEW(2,L)
265 tmp_num(M) = tmp_num(M) + hpart
266 tmp_den(M) = tmp_den(M) + 1
267 IF(PC .EQ. PIP) EXIT
268 ENDDO
269
270 IF (PIP >0) bed_height(:) = tmp_num(:)/tmp_den(:)
271 ENDIF
272
273 RETURN
274
275 END SUBROUTINE CALC_DES_BEDHEIGHT
276