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