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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Subroutine: CORRECT_0                                               C
4     !  Purpose: Correct the fluid pressure and gas velocities              C
5     !                                                                      C
6     !  Author: M. Syamlal                                 Date: 24-JUN-96  C
7     !  Reviewer:                                          Date:            C
8     !                                                                      C
9     !                                                                      C
10     !  Literature/Document References:                                     C
11     !  Variables referenced:                                               C
12     !  Variables modified:                                                 C
13     !  Local variables:                                                    C
14     !                                                                      C
15     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
16     
17           SUBROUTINE CORRECT_0(IER)
18     
19     !-----------------------------------------------
20     ! Modules
21     !-----------------------------------------------
22           USE param
23           USE param1
24           USE fldvar
25           USE pgcor
26           USE ur_facs
27           IMPLICIT NONE
28     !-----------------------------------------------
29     ! Dummy arguments
30     !-----------------------------------------------
31           INTEGER, INTENT(INOUT) :: IER
32     !-----------------------------------------------
33     
34           CALL CORRECT_0G (PP_G, UR_FAC(1), D_E, D_N, D_T, P_G, &
35              U_G, V_G, W_G)
36     !      CALL CORRECT_0S (PP_G, D_E, D_N, D_T, U_S, V_S, W_S, IER)
37     
38           RETURN
39           END SUBROUTINE CORRECT_0
40     
41     
42     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
43     !                                                                      C
44     !  Subroutine: CORRECT_0g                                              C
45     !  Purpose: Correct the fluid pressure and velocities.                 C
46     !                                                                      C
47     !  Author: M. Syamlal                                 Date: 24-JUN-96  C
48     !  Reviewer:                                          Date:            C
49     !                                                                      C
50     !  Revision Number: 1                                                  C
51     !  Purpose: To incorporate Cartesian grid modifications                C
52     !  Author: Jeff Dietiker                              Date: 01-Jul-09  C
53     !                                                                      C
54     !  Literature/Document References:                                     C
55     !  Variables referenced:                                               C
56     !  Variables modified:                                                 C
57     !  Local variables:                                                    C
58     !                                                                      C
59     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
60     
61           SUBROUTINE CORRECT_0G(PP_G,UR_FAC,D_E,D_N,D_T,P_G,U_G,V_G,W_G)
62     
63     !-----------------------------------------------
64     ! Modules
65     !-----------------------------------------------
66           USE param
67           USE param1
68           USE geometry
69           USE indices
70           USE physprop
71           USE compar
72           USE cutcell
73           USE quadric
74           USE functions
75           IMPLICIT NONE
76     !-----------------------------------------------
77     ! Dummy arguments
78     !-----------------------------------------------
79     ! Pressure correction
80           DOUBLE PRECISION, INTENT(IN) :: Pp_g(DIMENSION_3)
81     ! Under relaxation factor for Pressure correction
82           DOUBLE PRECISION, INTENT(IN) :: UR_fac
83     ! Pressure correction coefficient -- East
84           DOUBLE PRECISION, INTENT(IN) :: d_e(DIMENSION_3, 0:DIMENSION_M)
85     ! Pressure correction coefficient -- North
86           DOUBLE PRECISION, INTENT(IN) :: d_n(DIMENSION_3, 0:DIMENSION_M)
87     ! Pressure correction coefficient -- Top
88           DOUBLE PRECISION, INTENT(IN) :: d_t(DIMENSION_3, 0:DIMENSION_M)
89     ! Pressure
90           DOUBLE PRECISION, INTENT(INOUT) :: P_g(DIMENSION_3)
91     ! Velocity components
92           DOUBLE PRECISION, INTENT(INOUT) :: U_g(DIMENSION_3), &
93                            V_g(DIMENSION_3),&
94                            W_g(DIMENSION_3)
95     !-----------------------------------------------
96     ! Local variables
97     !-----------------------------------------------
98     ! Indices
99           INTEGER :: IJK, IJKE, IJKN, IJKT
100     !-----------------------------------------------
101     
102     ! Underrelax pressure correction.  Velocity corrections should not be
103     ! underrelaxed, so that the continuity eq. is satisfied.
104     
105     !!$omp    parallel do private(IJK,IJKE,IJKN,IJKT)
106           DO IJK = ijkstart3, ijkend3
107     
108              IF (FLUIDORP_FLOW_AT(IJK)) THEN
109     
110                 P_G(IJK) = P_G(IJK) + UR_FAC*PP_G(IJK)
111     
112                 IJKE = EAST_OF(IJK)
113                 IJKN = NORTH_OF(IJK)
114                 IF(.NOT.CARTESIAN_GRID) THEN
115                    U_G(IJK) = U_G(IJK) - D_E(IJK,0)*(PP_G(IJKE)-PP_G(IJK))
116                    V_G(IJK) = V_G(IJK) - D_N(IJK,0)*(PP_G(IJKN)-PP_G(IJK))
117                    IF (DO_K) THEN
118                       IJKT = TOP_OF(IJK)
119                       W_G(IJK) = W_G(IJK) - D_T(IJK,0)*(PP_G(IJKT)-PP_G(IJK))
120                    ENDIF
121                 ELSE
122                    U_G(IJK) = U_G(IJK) - D_E(IJK,0)*&
123                       (PP_G(IJKE)*A_UPG_E(IJK) - PP_G(IJK)*A_UPG_W(IJK))
124                    V_G(IJK) = V_G(IJK) - D_N(IJK,0)*&
125                       (PP_G(IJKN)*A_VPG_N(IJK) - PP_G(IJK)*A_VPG_S(IJK))
126                    IF (DO_K) THEN
127                       IJKT = TOP_OF(IJK)
128                       W_G(IJK) = W_G(IJK) - D_T(IJK,0)*&
129                          (PP_G(IJKT)*A_WPG_T(IJK) - PP_G(IJK)*A_WPG_B(IJK))
130                    ENDIF
131                 ENDIF
132              ENDIF
133           ENDDO
134     
135           RETURN
136           END SUBROUTINE CORRECT_0G
137     
138     
139     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
140     !                                                                      C
141     !  Subroutine: CORRECT_0s                                              C
142     !  Purpose: Correct the solids velocities.                             C
143     !                                                                      C
144     !  Author: M. Syamlal                                 Date: 24-JUN-96  C
145     !  Reviewer:                                          Date:            C
146     !                                                                      C
147     !  Revision Number: 1                                                  C
148     !  Purpose: To incorporate Cartesian grid modifications                C
149     !  Author: Jeff Dietiker                              Date: 01-Jul-09  C
150     !                                                                      C
151     !  Literature/Document References:                                     C
152     !  Variables referenced:                                               C
153     !  Variables modified:                                                 C
154     !  Local variables:                                                    C
155     !                                                                      C
156     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
157     
158           SUBROUTINE CORRECT_0S(PP_G, D_E, D_N, D_T, U_S, V_S, W_S)
159     
160     !-----------------------------------------------
161     ! Modules
162     !-----------------------------------------------
163           USE param
164           USE param1
165           USE geometry
166           USE indices
167           USE physprop
168           USE compar
169           USE cutcell
170           USE quadric
171           USE functions
172           IMPLICIT NONE
173     !-----------------------------------------------
174     ! Dummy Arguments
175     !-----------------------------------------------
176     ! Pressure correction
177           DOUBLE PRECISION, INTENT(IN) :: Pp_g(DIMENSION_3)
178     ! Pressure correction coefficient -- East
179           DOUBLE PRECISION, INTENT(IN) :: d_e(DIMENSION_3, 0:DIMENSION_M)
180     ! Pressure correction coefficient -- North
181           DOUBLE PRECISION, INTENT(IN) :: d_n(DIMENSION_3, 0:DIMENSION_M)
182     ! Pressure correction coefficient -- Top
183           DOUBLE PRECISION, INTENT(IN) :: d_t(DIMENSION_3, 0:DIMENSION_M)
184     ! Velocity components
185           DOUBLE PRECISION, INTENT(INOUT) :: U_s(DIMENSION_3, DIMENSION_M),&
186                            V_s(DIMENSION_3, DIMENSION_M),&
187                            W_s(DIMENSION_3, DIMENSION_M)
188     !-----------------------------------------------
189     ! Local variables
190     !-----------------------------------------------
191     ! Solids index
192           INTEGER :: M
193     ! Indices
194           INTEGER :: IJK, IJKE, IJKN, IJKT
195     !-----------------------------------------------
196     ! Velocity corrections should not be underrelaxed, so that
197     ! the continuity eq. is satisfied.
198     
199           DO M = 1, MMAX
200     !!$omp    parallel do private(IJK,IJKE,IJKN,IJKT)
201              DO IJK = ijkstart3, ijkend3
202                 IF (FLUIDORP_FLOW_AT(IJK)) THEN
203     
204                    IJKE = EAST_OF(IJK)
205                    IJKN = NORTH_OF(IJK)
206                    IF(.NOT.CARTESIAN_GRID) THEN
207                       U_S(IJK,M) = U_S(IJK,M) - D_E(IJK,M)*&
208                          (PP_G(IJKE)-PP_G(IJK))
209                       V_S(IJK,M) = V_S(IJK,M) - D_N(IJK,M)*&
210                          (PP_G(IJKN)-PP_G(IJK))
211                       IF (DO_K) THEN
212                          IJKT = TOP_OF(IJK)
213                          W_S(IJK,M) = W_S(IJK,M) - D_T(IJK,M)*&
214                             (PP_G(IJKT)-PP_G(IJK))
215                       ENDIF
216                    ELSE
217                       U_S(IJK,M) = U_S(IJK,M) - D_E(IJK,M)*&
218                          (PP_G(IJKE)*A_UPG_E(IJK) - PP_G(IJK)*A_UPG_W(IJK))
219                       V_S(IJK,M) = V_S(IJK,M) - D_N(IJK,M)*&
220                          (PP_G(IJKN)*A_VPG_N(IJK) - PP_G(IJK)*A_VPG_S(IJK))
221                       IF (DO_K) THEN
222                          IJKT = TOP_OF(IJK)
223                          W_S(IJK,M) = W_S(IJK,M) - D_T(IJK,M)*&
224                             (PP_G(IJKT)*A_WPG_T(IJK) - PP_G(IJK)*A_WPG_B(IJK))
225                       ENDIF
226                    ENDIF
227     
228                 ENDIF
229              ENDDO
230           ENDDO
231           RETURN
232           END SUBROUTINE CORRECT_0S
233     
234     
235