chischeme

File: /nfs/home/0/users/jenkins/mfix.git/model/chischeme_mod.f

1     MODULE ChiScheme
2     !  Purpose: Determine factors for Chi-scheme of Darwish and Moukalled
3     !           to ensure consistency of equation sets (e.g., species mass
4     !           fractions add up to 1)
5     !
6     !  Author: M. Syamlal                                 Date: 1-AUG-03
7     !  Reviewer:                                          Date:
8     !
9     !
10     !  Literature/Document References: Darwish, M. and Moukalled, F.,
11     !   "The Chi-shemes: a new consistent high-resolution formulation based on
12     !    the normalized variable methodology," Comput. Methods Appl. Mech. Engrg.,
13     !    192, 1711-1730 (2003)
14     !
15     
16     ! To initiate Chi-Scheme
17     !   call set_chi( ...)
18     !
19     ! and to terminate Chi-Scheme
20     !   call unset_chi(ier)
21     !
22     
23           USE param
24           USE param1
25           USE run
26           USE geometry
27           USE indices
28           USE compar
29           USE sendrecv
30           IMPLICIT NONE
31     
32           DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_e
33           DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_n
34           DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_t
35     
36     
37        LOGICAL :: ChiScheme_allocated = .false.
38        LOGICAL :: Chi_flag = .false.
39     
40        CONTAINS
41           SUBROUTINE Set_Chi(DISCR, PHI, Nmax, U, V, W)
42     !
43     !                      discretization method
44           INTEGER          DISCR
45     !
46     !                      Second dimension of Phi array
47           INTEGER          NMax
48     !
49     !                      convected quantity
50           DOUBLE PRECISION PHI(DIMENSION_3, Nmax)
51     !
52     !                      Velocity components
53           DOUBLE PRECISION U(DIMENSION_3), V(DIMENSION_3), W(DIMENSION_3)
54           DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_e_temp
55           DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_n_temp
56           DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Chi_t_temp
57     !
58     !                      index
59           INTEGER          IJK, N
60     
61           if(.not.ChiScheme_allocated)then
62             Allocate( Chi_e(DIMENSION_3) , &
63                       Chi_n(DIMENSION_3) , &
64                       Chi_t(DIMENSION_3)     )
65             ChiScheme_allocated = .true.
66           endif
67     
68           if(Chi_flag)then
69             ! Error: Chi-Scheme is already active.  This routine cannot be called
70             ! again before unsetting the flag
71             Print *, 'Module ChiScheme: Cannot call Set_Chi again, before Unset_chi'
72             call Mfix_Exit(0)
73     
74           else
75           ! Set Chi_flag to indicate that future calls to calc_Xsi will use
76           ! the Chi-Scheme for discretization
77             Chi_e = large_number
78             Chi_n = large_number
79             Chi_t = large_number
80             Chi_flag = .true.
81           Endif
82     
83           Allocate( Chi_e_temp(DIMENSION_3) , &
84                     Chi_n_temp(DIMENSION_3) , &
85                     Chi_t_temp(DIMENSION_3)  )
86     
87     !  Start Chi calculations
88           DO N = 1, Nmax
89     
90             CALL CALC_CHI(DISCR, PHI(1,N), U, V, W, Chi_e_temp, Chi_n_temp, Chi_t_temp)
91     
92     !!!$omp    parallel do private(IJK)
93             DO IJK = ijkstart3, ijkend3
94               Chi_e(IJK) = MIN(Chi_e(IJK), Chi_e_temp(IJK))
95               Chi_n(IJK) = MIN(Chi_n(IJK), Chi_n_temp(IJK))
96               Chi_t(IJK) = MIN(Chi_t(IJK), Chi_t_temp(IJK))
97             ENDDO
98     
99           ENDDO
100     
101     !  End Chi calculations
102     
103           call send_recv(CHI_E,2)
104           call send_recv(CHI_N,2)
105           call send_recv(CHI_T,2)
106     
107           Deallocate( Chi_e_temp , &
108                       Chi_n_temp , &
109                       Chi_t_temp  )
110     
111     
112           RETURN
113           END SUBROUTINE Set_Chi
114     
115     
116           SUBROUTINE Unset_Chi()
117             Chi_flag = .false.
118           RETURN
119           END SUBROUTINE Unset_Chi
120     
121     !
122     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
123     !                                                                      C
124     !  Subroutine name: CALC_CHI(DISCR, PHI, U, V, W, CHI_e, CHI_n, CHI_t)     C
125     !  Purpose: Determine CHI factors for higher order discretization.
126     !  Author: M. Syamlal                                 Date: 4-AUG-03   C
127     !  Reviewer:                                          Date:            C
128     !                                                                      C
129     !                                                                      C
130     !  Literature/Document References: Darwish and Moukalled (2003)
131     !                                                                      C
132     !  Variables referenced:                                               C
133     !  Variables modified:                                                 C
134     !                                                                      C
135     !  Local variables:                                                    C
136     !                                                                      C
137     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
138     !
139           SUBROUTINE CALC_CHI(DISCR, PHI, U, V, W, CHI_E, CHI_N, CHI_T)
140     !
141     !-----------------------------------------------
142     !   M o d u l e s
143     !-----------------------------------------------
144           USE compar
145           USE discretization
146           USE functions
147           USE geometry
148           USE indices
149           USE param
150           USE param1
151           USE run
152           USE sendrecv
153           USE vshear
154           IMPLICIT NONE
155     !-----------------------------------------------
156     !   G l o b a l   P a r a m e t e r s
157     !-----------------------------------------------
158     !-----------------------------------------------
159     !   D u m m y   A r g u m e n t s
160     !-----------------------------------------------
161     
162     !                      discretization method
163           INTEGER          DISCR
164     !
165     !                      convected quantity
166           DOUBLE PRECISION PHI(DIMENSION_3)
167     !
168     !                      Velocity components
169           DOUBLE PRECISION U(DIMENSION_3), V(DIMENSION_3), W(DIMENSION_3)
170     !
171     !                      Convection weighting factors
172           DOUBLE PRECISION CHI_e(DIMENSION_3), CHI_n(DIMENSION_3),&
173                            CHI_t(DIMENSION_3)
174     !
175     !                      Indices
176           INTEGER          IJK, IJKC, IJKD, IJKU
177     
178     !
179     !                      Error message
180           CHARACTER(LEN=80)     LINE(1)
181     !
182     !
183           DOUBLE PRECISION PHI_C
184     !-----------------------------------------------
185     
186             IF (SHEAR) THEN
187     ! calculate CHI_E,CHI_N,CHI_T when periodic shear BCs are used
188     
189     !       call CXS(incr,DISCR,U,V,W,PHI,CHI_E,CHI_N,CHI_T)  !need implementation
190              print *,'From CALC_CHI:  "Shear" option not implemented'
191              Call MFIX_EXIT(0)
192     
193             ELSE
194     !
195     !
196           SELECT CASE (DISCR)                        !first order upwinding
197           CASE (:1)
198     !
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              END DO
205     !      CASE (2)                                   !Superbee
206           CASE (3)                                   !SMART
207     !
208     !!!$omp    parallel do private(IJK, IJKC,IJKD,IJKU, PHI_C)
209              DO IJK = ijkstart3, ijkend3
210               IF (.NOT.WALL_AT(IJK)) THEN ! no need to do these calculations for walls
211                 IF (U(IJK) >= ZERO) THEN
212                    IJKC = IJK
213                    IJKD = EAST_OF(IJK)
214                    IJKU = WEST_OF(IJKC)
215                 ELSE
216                    IJKC = EAST_OF(IJK)
217                    IJKD = IJK
218                    IJKU = EAST_OF(IJKC)
219                 ENDIF
220     !
221                 PHI_C = PHI_C_OF(PHI(IJKU),PHI(IJKC),PHI(IJKD))
222     !
223                 CHI_E(IJK) = CHI4SMART(PHI_C,PHI(IJKU),PHI(IJKC),PHI(IJKD))
224     !
225                 IF (V(IJK) >= ZERO) THEN
226                    IJKC = IJK
227                    IJKD = NORTH_OF(IJK)
228                    IJKU = SOUTH_OF(IJKC)
229                 ELSE
230                    IJKC = NORTH_OF(IJK)
231                    IJKD = IJK
232                    IJKU = NORTH_OF(IJKC)
233                 ENDIF
234     !
235                 PHI_C = PHI_C_OF(PHI(IJKU),PHI(IJKC),PHI(IJKD))
236     !
237                 CHI_N(IJK) = CHI4SMART(PHI_C,PHI(IJKU),PHI(IJKC),PHI(IJKD))
238     !
239                 IF (DO_K) THEN
240                    IF (W(IJK) >= ZERO) THEN
241                       IJKC = IJK
242                       IJKD = TOP_OF(IJK)
243                       IJKU = BOTTOM_OF(IJKC)
244                    ELSE
245                       IJKC = TOP_OF(IJK)
246                       IJKD = IJK
247                       IJKU = TOP_OF(IJKC)
248                    ENDIF
249     !
250                    PHI_C = PHI_C_OF(PHI(IJKU),PHI(IJKC),PHI(IJKD))
251     !
252                    CHI_T(IJK) = CHI4SMART(PHI_C,PHI(IJKU),PHI(IJKC),PHI(IJKD))
253                 ENDIF
254               ELSE
255                 CHI_E(IJK) = ZERO
256                 CHI_N(IJK) = ZERO
257                 CHI_T(IJK) = ZERO
258               ENDIF
259              END DO
260     !      CASE (4)                                   !ULTRA-QUICK
261     !      CASE (5)                                   !QUICKEST
262           CASE (6)                                   !MUSCL
263     
264     !!!$omp    parallel do private(IJK, IJKC,IJKD,IJKU, PHI_C )
265              DO IJK = ijkstart3, ijkend3
266               IF (.NOT.WALL_AT(IJK)) THEN ! no need to do these calculations for walls
267                 IF (U(IJK) >= ZERO) THEN
268                    IJKC = IJK
269                    IJKD = EAST_OF(IJK)
270                    IJKU = WEST_OF(IJKC)
271                 ELSE
272                    IJKC = EAST_OF(IJK)
273                    IJKD = IJK
274                    IJKU = EAST_OF(IJKC)
275                 ENDIF
276     !
277                 PHI_C = PHI_C_OF(PHI(IJKU),PHI(IJKC),PHI(IJKD))
278     !
279                 CHI_E(IJK) = CHI4MUSCL(PHI_C,PHI(IJKU),PHI(IJKC),PHI(IJKD))
280     !
281                 IF (V(IJK) >= ZERO) THEN
282                    IJKC = IJK
283                    IJKD = NORTH_OF(IJK)
284                    IJKU = SOUTH_OF(IJKC)
285                 ELSE
286                    IJKC = NORTH_OF(IJK)
287                    IJKD = IJK
288                    IJKU = NORTH_OF(IJKC)
289                 ENDIF
290     !
291                 PHI_C = PHI_C_OF(PHI(IJKU),PHI(IJKC),PHI(IJKD))
292     !
293                 CHI_N(IJK) = CHI4MUSCL(PHI_C,PHI(IJKU),PHI(IJKC),PHI(IJKD))
294     !
295                 IF (DO_K) THEN
296                    IF (W(IJK) >= ZERO) THEN
297                       IJKC = IJK
298                       IJKD = TOP_OF(IJK)
299                       IJKU = BOTTOM_OF(IJKC)
300                    ELSE
301                       IJKC = TOP_OF(IJK)
302                       IJKD = IJK
303                       IJKU = TOP_OF(IJKC)
304                    ENDIF
305     !
306                    PHI_C = PHI_C_OF(PHI(IJKU),PHI(IJKC),PHI(IJKD))
307     !
308                    CHI_T(IJK) = CHI4MUSCL(PHI_C,PHI(IJKU),PHI(IJKC),PHI(IJKD))
309                 ENDIF
310               ELSE
311                 CHI_E(IJK) = ZERO
312                 CHI_N(IJK) = ZERO
313                 CHI_T(IJK) = ZERO
314               ENDIF ! for walls
315              END DO
316     !      CASE (7)                                   !Van Leer
317     !      CASE (8)                                   !Minmod
318           CASE DEFAULT                               !Error
319              WRITE (LINE, '(A,I2,A)') 'Chi-Scheme for DISCRETIZE = ', DISCR, ' not supported.'
320              CALL WRITE_ERROR ('CALC_CHI', LINE, 1)
321              CALL MFIX_EXIT(myPE)
322           END SELECT
323     
324           ENDIF
325     
326           call send_recv(CHI_E,2)
327           call send_recv(CHI_N,2)
328           call send_recv(CHI_T,2)
329     
330           RETURN
331           END SUBROUTINE CALC_CHI
332     
333     END MODULE CHIScheme
334     
335