MFIX  2016-1
chischeme_mod.f
Go to the documentation of this file.
1 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2 ! C
3 ! Purpose: Determine factors for Chi-scheme of Darwish and Moukalled C
4 ! to ensure consistency of equation sets (e.g., species mass C
5 ! fractions add up to 1) C
6 ! C
7 ! To initiate Chi-Scheme C
8 ! call set_chi( ...) C
9 ! and to terminate Chi-Scheme C
10 ! call unset_chi(ier) C
11 ! C
12 ! C
13 ! Author: M. Syamlal Date: 1-AUG-03 C
14 ! C
15 ! C
16 ! References: C
17 ! -Darwish, M. and Moukalled, F., "The Chi-shemes: a new consistent C
18 ! high-resolution formulation based on the normalized variable C
19 ! methodology," Comput. Methods Appl. Mech. Engrg., 192, 1711-1730 C
20 ! (2003) C
21 ! C
22 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
23 
24  MODULE chischeme
25 
26  IMPLICIT NONE
27 
28  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: chi_e
29  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: chi_n
30  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: chi_t
31 
32 
33  LOGICAL :: chischeme_allocated = .false.
34  LOGICAL :: chi_flag = .false.
35 
36 
37  CONTAINS
38 
39 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
40 ! !
41 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
42 
43  SUBROUTINE set_chi(DISCR, PHI, Nmax, U, V, W)
44 
45  USE compar, only: ijkstart3, ijkend3
46  USE param, only: dimension_3
47  USE param1, only: large_number
48  USE sendrecv, only: send_recv
49 
50  USE error_manager, only: err_msg, init_err_msg, finl_err_msg
51  USE error_manager, only: flush_err_msg
52 
53 ! Dummy arguments
54 !---------------------------------------------------------------------//
55 ! discretization method
56  INTEGER, INTENT(IN) :: DISCR
57 ! Second dimension of Phi array
58  INTEGER, INTENT(IN) :: NMax
59 ! convected quantity
60  DOUBLE PRECISION, INTENT(IN) :: PHI(dimension_3, nmax)
61 ! Velocity components
62  DOUBLE PRECISION, INTENT(IN) :: U(dimension_3)
63  DOUBLE PRECISION, INTENT(IN) :: V(dimension_3)
64  DOUBLE PRECISION, INTENT(IN) :: W(dimension_3)
65 
66 ! Local variables
67 !---------------------------------------------------------------------//
68  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_e_temp
69  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_n_temp
70  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_t_temp
71 ! index
72  INTEGER :: IJK, N
73 !---------------------------------------------------------------------//
74 
75  if(.not.chischeme_allocated)then
76  Allocate( chi_e(dimension_3) , &
77  chi_n(dimension_3) , &
78  chi_t(dimension_3) )
79  chischeme_allocated = .true.
80  endif
81 
82  if(chi_flag)then
83 ! Error: Chi-Scheme is already active. This routine cannot be called
84 ! again before unsetting the flag
85  CALL init_err_msg("SET_CHI")
86  WRITE(err_msg, 1102)
87  1102 FORMAT('ERROR 1102: Cannot call Set_Chi again, before Unset_chi')
88  CALL flush_err_msg(abort=.true.)
89  CALL finl_err_msg
90  else
91 ! Set Chi_flag to indicate that future calls to calc_Xsi will use
92 ! the Chi-Scheme for discretization
93  chi_e = large_number
94  chi_n = large_number
95  chi_t = large_number
96  chi_flag = .true.
97  Endif
98 
99  Allocate( chi_e_temp(dimension_3) , &
100  chi_n_temp(dimension_3) , &
101  chi_t_temp(dimension_3) )
102 
103 ! Start Chi calculations
104  DO n = 1, nmax
105  CALL calc_chi(discr, phi(1,n), u, v, w, chi_e_temp, &
106  chi_n_temp, chi_t_temp)
107 
108 !!!$omp parallel do private(IJK)
109  DO ijk = ijkstart3, ijkend3
110  chi_e(ijk) = min(chi_e(ijk), chi_e_temp(ijk))
111  chi_n(ijk) = min(chi_n(ijk), chi_n_temp(ijk))
112  chi_t(ijk) = min(chi_t(ijk), chi_t_temp(ijk))
113  ENDDO
114  ENDDO
115 
116  call send_recv(chi_e,2)
117  call send_recv(chi_n,2)
118  call send_recv(chi_t,2)
119 
120  Deallocate( chi_e_temp , &
121  chi_n_temp , &
122  chi_t_temp )
123 
124 
125  RETURN
126  END SUBROUTINE set_chi
127 
128 
129 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
130 ! C
131 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
132  SUBROUTINE unset_chi()
133  IMPLICIT NONE
134  chi_flag = .false.
135  RETURN
136  END SUBROUTINE unset_chi
137 
138 
139 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
140 ! C
141 ! Subroutine: CALC_CHI C
142 ! Purpose: Determine CHI factors for higher order discretization. C
143 ! C
144 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
145  SUBROUTINE calc_chi(DISCR, PHI, U, V, W, CHI_E, CHI_N, CHI_T)
146 
147 
148 ! Modules
149 !---------------------------------------------------------------------//
150  USE compar, only: ijkstart3, ijkend3
151  USE discretization, only: chi4smart, chi4muscl, phi_c_of
152  USE functions, only: wall_at
153  USE functions, only: east_of, west_of, north_of, south_of
154  USE functions, only: top_of, bottom_of
155  USE geometry, only: do_k
156  USE param, only: dimension_3
157  USE param1, only: zero
158  USE run, only: shear
159  USE sendrecv, only: send_recv
160  USE error_manager, only: err_msg, init_err_msg, finl_err_msg
161  USE error_manager, only: ival, flush_err_msg
162 
163  IMPLICIT NONE
164 
165 ! Dummy arguments
166 !---------------------------------------------------------------------//
167 ! discretization method
168  INTEGER, INTENT(IN) :: DISCR
169 ! convected quantity
170  DOUBLE PRECISION, INTENT(IN) :: PHI(dimension_3)
171 ! Velocity components
172  DOUBLE PRECISION, INTENT(IN) :: U(dimension_3)
173  DOUBLE PRECISION, INTENT(IN) :: V(dimension_3)
174  DOUBLE PRECISION, INTENT(IN) :: W(dimension_3)
175 ! Convection weighting factors
176  DOUBLE PRECISION, INTENT(INOUT) :: CHI_e(dimension_3)
177  DOUBLE PRECISION, INTENT(INOUT) :: CHI_n(dimension_3)
178  DOUBLE PRECISION, INTENT(INOUT) :: CHI_t(dimension_3)
179 
180 ! Local variables
181 !---------------------------------------------------------------------//
182 ! Indices
183  INTEGER :: IJK, IJKC, IJKD, IJKU
184  DOUBLE PRECISION :: PHI_C
185 !---------------------------------------------------------------------//
186 
187 ! calculate CHI_E,CHI_N,CHI_T when periodic shear BCs are used
188  IF (shear) THEN
189 ! this needs implementation...
190 ! note mfix will error before this is hit
191 ! call CXS(incr, DISCR, U, V, W, PHI, CHI_E, CHI_N, CHI_T)
192  ELSE
193 
194 
195  SELECT CASE (discr)
196 
197 
198  CASE (:1) !first order upwinding
199 !!!$omp parallel do private(IJK)
200  DO ijk = ijkstart3, ijkend3
201  chi_e(ijk) = zero
202  chi_n(ijk) = zero
203  IF (do_k) chi_t(ijk) = zero
204  ENDDO
205 
206 
207 ! CASE (2) !Superbee
208 
209 
210  CASE (3) !SMART
211 !!!$omp parallel do private(IJK, IJKC,IJKD,IJKU, PHI_C)
212  DO ijk = ijkstart3, ijkend3
213  IF (.NOT.wall_at(ijk)) THEN ! no need to do these calculations for walls
214  IF (u(ijk) >= zero) THEN
215  ijkc = ijk
216  ijkd = east_of(ijk)
217  ijku = west_of(ijkc)
218  ELSE
219  ijkc = east_of(ijk)
220  ijkd = ijk
221  ijku = east_of(ijkc)
222  ENDIF
223  phi_c = phi_c_of(phi(ijku),phi(ijkc),phi(ijkd))
224  chi_e(ijk) = chi4smart(phi_c, phi(ijku), phi(ijkc), phi(ijkd))
225 
226  IF (v(ijk) >= zero) THEN
227  ijkc = ijk
228  ijkd = north_of(ijk)
229  ijku = south_of(ijkc)
230  ELSE
231  ijkc = north_of(ijk)
232  ijkd = ijk
233  ijku = north_of(ijkc)
234  ENDIF
235  phi_c = phi_c_of(phi(ijku),phi(ijkc),phi(ijkd))
236  chi_n(ijk) = chi4smart(phi_c,phi(ijku),phi(ijkc),phi(ijkd))
237 
238  IF (do_k) THEN
239  IF (w(ijk) >= zero) THEN
240  ijkc = ijk
241  ijkd = top_of(ijk)
242  ijku = bottom_of(ijkc)
243  ELSE
244  ijkc = top_of(ijk)
245  ijkd = ijk
246  ijku = top_of(ijkc)
247  ENDIF
248  phi_c = phi_c_of(phi(ijku),phi(ijkc),phi(ijkd))
249  chi_t(ijk) = chi4smart(phi_c,phi(ijku),phi(ijkc),phi(ijkd))
250  ENDIF
251  ELSE
252  chi_e(ijk) = zero
253  chi_n(ijk) = zero
254  chi_t(ijk) = zero
255  ENDIF ! endif (.not. wall_at)
256  ENDDO ! end do ijk
257 
258 
259 ! CASE (4) !ULTRA-QUICK
260 
261 
262 ! CASE (5) !QUICKEST
263 
264 
265  CASE (6) !MUSCL
266 
267 !!!$omp parallel do private(IJK, IJKC,IJKD,IJKU, PHI_C )
268  DO ijk = ijkstart3, ijkend3
269  IF (.NOT.wall_at(ijk)) THEN ! no need to do these calculations for walls
270  IF (u(ijk) >= zero) THEN
271  ijkc = ijk
272  ijkd = east_of(ijk)
273  ijku = west_of(ijkc)
274  ELSE
275  ijkc = east_of(ijk)
276  ijkd = ijk
277  ijku = east_of(ijkc)
278  ENDIF
279  phi_c = phi_c_of(phi(ijku),phi(ijkc),phi(ijkd))
280  chi_e(ijk) = chi4muscl(phi_c,phi(ijku),phi(ijkc),phi(ijkd))
281 
282  IF (v(ijk) >= zero) THEN
283  ijkc = ijk
284  ijkd = north_of(ijk)
285  ijku = south_of(ijkc)
286  ELSE
287  ijkc = north_of(ijk)
288  ijkd = ijk
289  ijku = north_of(ijkc)
290  ENDIF
291  phi_c = phi_c_of(phi(ijku),phi(ijkc),phi(ijkd))
292  chi_n(ijk) = chi4muscl(phi_c,phi(ijku),phi(ijkc),phi(ijkd))
293 
294  IF (do_k) THEN
295  IF (w(ijk) >= zero) THEN
296  ijkc = ijk
297  ijkd = top_of(ijk)
298  ijku = bottom_of(ijkc)
299  ELSE
300  ijkc = top_of(ijk)
301  ijkd = ijk
302  ijku = top_of(ijkc)
303  ENDIF
304  phi_c = phi_c_of(phi(ijku),phi(ijkc),phi(ijkd))
305  chi_t(ijk) = chi4muscl(phi_c,phi(ijku),phi(ijkc),phi(ijkd))
306  ENDIF
307  ELSE
308  chi_e(ijk) = zero
309  chi_n(ijk) = zero
310  chi_t(ijk) = zero
311  ENDIF ! endif (.not.wall_at)
312  ENDDO ! end do ijk
313 
314 
315 ! CASE (7) !Van Leer
316 
317 
318 ! CASE (8) !Minmod
319 
320 
321  CASE DEFAULT !Error
322 ! should never hit this
323  CALL init_err_msg("CALC_CHI")
324  WRITE(err_msg, 1103) ival(discr)
325  1103 FORMAT('ERROR 1103: Invalid DISCRETIZE= ', a,' when using '&
326  'chi_scheme',/'The check_data routines should have already ',&
327  'caught this error and ',/,'pevented the simulation from ',&
328  'running. Please notify the MFIX ',/,'MFIX developers.')
329  CALL flush_err_msg(abort=.true.)
330  CALL finl_err_msg
331  END SELECT
332 
333  ENDIF
334 
335  call send_recv(chi_e,2)
336  call send_recv(chi_n,2)
337  call send_recv(chi_t,2)
338 
339  RETURN
340  END SUBROUTINE calc_chi
341 
342  END MODULE chischeme
compar::ijkend3
integer ijkend3
Definition: compar_mod.f:80
error_manager::finl_err_msg
subroutine finl_err_msg
Definition: error_manager_mod.f:216
run::shear
logical shear
Definition: run_mod.f:175
param::dimension_3
integer dimension_3
Definition: param_mod.f:11
chischeme::calc_chi
subroutine calc_chi(DISCR, PHI, U, V, W, CHI_E, CHI_N, CHI_T)
Definition: chischeme_mod.f:146
error_manager::ival
Definition: error_manager_mod.f:17
chischeme::unset_chi
subroutine unset_chi()
Definition: chischeme_mod.f:133
discretization::phi_c_of
double precision function phi_c_of(PHI_U, PHI_C, PHI_D)
Definition: discretization_mod.f:342
error_manager::init_err_msg
subroutine init_err_msg(CALLER)
Definition: error_manager_mod.f:171
sendrecv::send_recv
Definition: sendrecv_mod.f:75
chischeme::chischeme_allocated
logical chischeme_allocated
Definition: chischeme_mod.f:33
chischeme::chi_t
double precision, dimension(:), allocatable chi_t
Definition: chischeme_mod.f:30
run
Definition: run_mod.f:13
param1::large_number
double precision, parameter large_number
Definition: param1_mod.f:23
param
Definition: param_mod.f:2
discretization::chi4smart
double precision function chi4smart(PHI_C, PHIU, PHIC, PHID)
Definition: discretization_mod.f:88
discretization::chi4muscl
double precision function chi4muscl(PHI_C, PHIU, PHIC, PHID)
Definition: discretization_mod.f:220
geometry::do_k
logical do_k
Definition: geometry_mod.f:30
compar::ijkstart3
integer ijkstart3
Definition: compar_mod.f:80
chischeme::chi_n
double precision, dimension(:), allocatable chi_n
Definition: chischeme_mod.f:29
error_manager::err_msg
character(len=line_length), dimension(line_count) err_msg
Definition: error_manager_mod.f:29
chischeme::set_chi
subroutine set_chi(DISCR, PHI, Nmax, U, V, W)
Definition: chischeme_mod.f:44
error_manager
Definition: error_manager_mod.f:8
chischeme::chi_e
double precision, dimension(:), allocatable chi_e
Definition: chischeme_mod.f:28
chischeme::chi_flag
logical chi_flag
Definition: chischeme_mod.f:34
param1::zero
double precision, parameter zero
Definition: param1_mod.f:27
error_manager::flush_err_msg
subroutine flush_err_msg(DEBUG, HEADER, FOOTER, ABORT, LOG, CALL_TREE)
Definition: error_manager_mod.f:305