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

1     !
2     !
3     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
4     !                                                                      C
5     !  Module name: DIF_W_IS(Dif, A_m, B_m, M, IER)                        C
6     !  Purpose: Remove diffusive fluxes across internal surfaces.          C
7     !                                                                      C
8     !  Author: M. Syamlal                                 Date: 30-APR-97  C
9     !  Reviewer:                                          Date:            C
10     !                                                                      C
11     !                                                                      C
12     !  Literature/Document References:                                     C
13     !                                                                      C
14     !  Variables referenced:                                               C
15     !  Variables modified:                                                 C
16     !                                                                      C
17     !  Local variables:                                                    C
18     !                                                                      C
19     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
20     !
21           SUBROUTINE DIF_W_IS(DIF, A_M, B_M, M)
22     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
23     !...Switches: -xf
24     !
25     !  Include param.inc file to specify parameter values
26     !
27     !-----------------------------------------------
28     !   M o d u l e s
29     !-----------------------------------------------
30           USE param
31           USE param1
32           USE parallel
33           USE matrix
34           USE scales
35           USE constant
36           USE toleranc
37           USE run
38           USE physprop
39           USE fldvar
40           USE geometry
41           USE output
42           USE indices
43           USE is
44           USE compar
45           USE fun_avg
46           USE functions
47           IMPLICIT NONE
48     !-----------------------------------------------
49     !   G l o b a l   P a r a m e t e r s
50     !-----------------------------------------------
51     !-----------------------------------------------
52     !   D u m m y   A r g u m e n t s
53     !-----------------------------------------------
54     !
55     !                      Internal surface
56           INTEGER          L
57     !
58     !                      Indices
59           INTEGER          I,  J, K, I1, I2, J1, J2, K1, K2, IJK,&
60                            IJKE, IJKN, IJKT, IJPK, IPJK, IJKTN, IJKTE
61     !
62     !                      Solids phase
63           INTEGER          M
64     !
65     !                      Gamma -- diffusion coefficient
66           DOUBLE PRECISION Dif(DIMENSION_3)
67     !
68     !                      Septadiagonal matrix A_m
69           DOUBLE PRECISION A_m(DIMENSION_3, -3:3, 0:DIMENSION_M)
70     !
71     !                      Vector b_m
72           DOUBLE PRECISION B_m(DIMENSION_3, 0:DIMENSION_M)
73     !
74     !                      Difusion parameter
75           DOUBLE PRECISION D_f
76     !
77     !-----------------------------------------------
78     !
79     !
80     ! Make user defined internal surfaces non-conducting
81     !
82           DO L = 1, DIMENSION_IS
83              IF (IS_DEFINED(L)) THEN
84                 I1 = IS_I_W(L)
85                 I2 = IS_I_E(L)
86                 J1 = IS_J_S(L)
87                 J2 = IS_J_N(L)
88                 K1 = IS_K_B(L)
89                 K2 = IS_K_T(L)
90     !
91                 IF (IS_PLANE(L) == 'N') THEN
92     !
93                    DO K = K1, K2
94                       DO J = J1, J2
95                          DO I = I1, I2
96                             IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
97                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
98                             IJK = FUNIJK(I,J,K)
99                             IJKT = TOP_OF(IJK)
100                             IJKN = NORTH_OF(IJK)
101                             IJKTN = TOP_OF(IJKN)
102                             IJPK = JP_OF(IJK)
103     !
104                             D_F = AVG_Z_H(AVG_Y_H(DIF(IJK),DIF(IJKN),J),AVG_Y_H(DIF&
105                                (IJKT),DIF(IJKTN),J),K)*ODY_N(J)*AXZ_W(IJK)
106     !
107                             A_M(IJK,N,M) = A_M(IJK,N,M) - D_F
108                             A_M(IJPK,S,M) = A_M(IJPK,S,M) - D_F
109                          END DO
110                       END DO
111                    END DO
112                 ELSE IF (IS_PLANE(L) == 'E') THEN
113                    DO K = K1, K2
114                       DO J = J1, J2
115                          DO I = I1, I2
116                             IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
117                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
118                             IJK = FUNIJK(I,J,K)
119                             IJKE = EAST_OF(IJK)
120                             IJKT = TOP_OF(IJK)
121                             IJKTE = EAST_OF(IJKT)
122                             IPJK = KP_OF(IJK)
123     !
124                             D_F = AVG_Z_H(AVG_X_H(DIF(IJK),DIF(IJKE),I),AVG_X_H(DIF&
125                                (IJKT),DIF(IJKTE),I),K)*ODX_E(I)*AYZ_W(IJK)
126     !
127                             A_M(IJK,E,M) = A_M(IJK,E,M) - D_F
128                             A_M(IPJK,W,M) = A_M(IPJK,W,M) - D_F
129                          END DO
130                       END DO
131                    END DO
132                 ENDIF
133              ENDIF
134           END DO
135           RETURN
136           END SUBROUTINE DIF_W_IS
137     
138     !// Comments on the modifications for DMP version implementation
139     !// 001 Include header file and common declarations for parallelization
140