File: RELATIVE:/../../../mfix.git/model/set_increments3.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: SET_INCREMENTS3                                         !
4     !  Author: M. Syamlal, W. Rogers                      Date: 10-DEC-91  !
5     !                                                                      !
6     !  Purpose: The purpose of this module is to create increments to be   !
7     !           stored in the array STORE_INCREMENT which will be added    !
8     !           to cell index ijk to find the effective indices of its     !
9     !           neighbors. These increments are found using the 'class'    !
10     !           of cell ijk. The class is determined based on the          !
11     !           neighboring cell type, i.e. wall or fluid.                 !
12     !                                                                      !
13     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
14           SUBROUTINE SET_INCREMENTS3
15     
16           USE param
17           USE param1
18           USE indices
19           USE geometry
20           USE compar
21           USE physprop
22           USE fldvar
23           USE funits
24     
25     ! Module procedures
26     !---------------------------------------------------------------------//
27           use mpi_utility, only: GLOBAL_ALL_SUM
28           use error_manager
29           use function3
30           use functions
31     
32           IMPLICIT NONE
33     
34     ! Local Variables:
35     !---------------------------------------------------------------------//
36     ! Indices
37           INTEGER :: I, J, K, IJK
38           INTEGER :: IMJK, IPJK, IJKW, IJKE  ! I+, I-, east/west
39           INTEGER :: IJMK, IJPK, IJKS, IJKN  ! J+, J-, north/south
40           INTEGER :: IJKM, IJKP, IJKB, IJKT  ! K+, K-, top/bottom
41     ! DO-loop index, ranges from 1 to ICLASS
42           INTEGER :: IC
43     ! Index denoting cell class
44           INTEGER :: ICLASS
45     ! Array of sum of increments to make the class determination faster.
46           INTEGER :: DENOTE_CLASS(MAX_CLASS)
47     ! Flag for using the 'real' I/J/K value (not cyclic.)
48           LOGICAL :: SHIFT
49     !......................................................................!
50     
51     
52     ! Initialize the error manager.
53           CALL INIT_ERR_MSG("SET_INCREMENTS3")
54     
55     ! Initialize the default values to Undefined_I
56     
57           IP1_3(:) = UNDEFINED_I
58           IM1_3(:) = UNDEFINED_I
59           JP1_3(:) = UNDEFINED_I
60           JM1_3(:) = UNDEFINED_I
61           KP1_3(:) = UNDEFINED_I
62           KM1_3(:) = UNDEFINED_I
63     
64           DO I = ISTART4, IEND4
65     
66              SHIFT = .NOT.(I==IMIN4 .OR. I==IMIN3 .OR. I==IMIN2 .OR. &
67                            I==IMAX4 .OR. I==IMAX3 .OR. I==IMAX2)
68     
69              IF(CYCLIC_X .AND. NODESI.EQ.1 .AND. DO_I .AND. SHIFT) THEN
70                 IP1_3(I) = IMAP_C(IMAP_C(I)+1)
71                 IM1_3(I) = IMAP_C(IMAP_C(I)-1)
72              ELSE
73                 IM1_3(I) = MAX(ISTART4,I - 1)
74                 IP1_3(I) = MIN(IEND4,I + 1)
75              ENDIF
76           ENDDO
77     
78     
79           DO J = JSTART4, JEND4
80     
81              SHIFT = .NOT.(J==JMIN4 .OR. J==JMIN3 .OR. J==JMIN2 .OR. &
82                            J==JMAX4 .OR. J==JMAX3 .OR. J==JMAX2)
83     
84              IF(CYCLIC_Y .AND. NODESJ.EQ.1 .AND. DO_J .AND. SHIFT) THEN
85                 JP1_3(J) = JMAP_C(JMAP_C(J)+1)
86                 JM1_3(J) = JMAP_C(JMAP_C(J)-1)
87              ELSE
88                 JM1_3(J) = MAX(JSTART4,J - 1)
89                 JP1_3(J) = MIN(JEND4,J + 1)
90              ENDIF
91           ENDDO
92     
93     
94           DO K = KSTART4, KEND4
95     
96              SHIFT = .NOT.(K==KMIN4 .OR. K==KMIN3 .OR. K==KMIN2 .OR. &
97                            K==KMAX4 .OR. K==KMAX3 .OR. K==KMAX2)
98     
99              IF(CYCLIC_Z .AND. NODESK.EQ.1 .AND. DO_K .AND. SHIFT) THEN
100                 KP1_3(K) = KMAP_C(KMAP_C(K)+1)
101                 KM1_3(K) = KMAP_C(KMAP_C(K)-1)
102              ELSE
103                 KM1_3(K) = MAX(KSTART4,K - 1)
104                 KP1_3(K) = MIN(KEND4,K + 1)
105              ENDIF
106           ENDDO
107     
108     !     Loop over all cells
109           DO K = KSTART4, KEND4
110           DO J = JSTART4, JEND4
111           DO I = ISTART4, IEND4
112              IJK = FUNIJK3(I,J,K)
113     
114              I3_OF(IJK) = I
115              J3_OF(IJK) = J
116              K3_OF(IJK) = K
117           ENDDO
118           ENDDO
119           ENDDO
120     
121     ! Initialize the number of cell classes
122           ICLASS = 0
123     
124     ! Loop over all cells (minus the ghost layers)
125           DO K = KSTART4, KEND4
126           DO J = JSTART4, JEND4
127           L100: DO I = ISTART4, IEND4
128     
129              IJK = FUNIJK3(I,J,K)
130     
131     !  Find the the effective cell-center indices for all neighbor cells
132              CALL SET_INDEX1A3 (I, J, K, IJK, IMJK, IPJK, IJMK, IJPK, IJKM,&
133                 IJKP, IJKW, IJKE, IJKS, IJKN, IJKB, IJKT)
134     
135     ! Increment the ICLASS counter
136              ICLASS = ICLASS + 1
137              IF(ICLASS > MAX_CLASS) THEN
138                 WRITE(ERR_MSG, 1200) trim(iVal(MAX_CLASS))
139                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
140              ENDIF
141     
142      1200 FORMAT('Error 1200: The number of classes has exceeded the ',    &
143              'maximum: ',A,/'Increase the MAX_CLASS parameter in param1',  &
144              '_mod.f and recompile.')
145     
146              INCREMENT3_FOR_IM(ICLASS) = IMJK - IJK
147              INCREMENT3_FOR_IP(ICLASS) = IPJK - IJK
148              INCREMENT3_FOR_JM(ICLASS) = IJMK - IJK
149              INCREMENT3_FOR_JP(ICLASS) = IJPK - IJK
150              INCREMENT3_FOR_KM(ICLASS) = IJKM - IJK
151              INCREMENT3_FOR_KP(ICLASS) = IJKP - IJK
152     
153              DENOTE_CLASS(ICLASS) =  &
154                 INCREMENT3_FOR_IM(ICLASS) + INCREMENT3_FOR_IP(ICLASS) + &
155                 INCREMENT3_FOR_JM(ICLASS) + INCREMENT3_FOR_JP(ICLASS) + &
156                 INCREMENT3_FOR_KM(ICLASS) + INCREMENT3_FOR_KP(ICLASS)
157     
158                 CELL_CLASS3(IJK) = ICLASS
159     
160     ! Place the cell in a class based on its DENOTE_CLASS(ICLASS) value
161     ! Loop over previous and present classes
162              DO IC = 1, ICLASS - 1
163     
164                 IF (DENOTE_CLASS(ICLASS) == DENOTE_CLASS(IC)) THEN
165                    IF(INCREMENT3_FOR_IM(ICLASS)/=INCREMENT3_FOR_IM(IC))CYCLE
166                    IF(INCREMENT3_FOR_IP(ICLASS)/=INCREMENT3_FOR_IP(IC))CYCLE
167                    IF(INCREMENT3_FOR_JM(ICLASS)/=INCREMENT3_FOR_JM(IC))CYCLE
168                    IF(INCREMENT3_FOR_JP(ICLASS)/=INCREMENT3_FOR_JP(IC))CYCLE
169                    IF(INCREMENT3_FOR_KM(ICLASS)/=INCREMENT3_FOR_KM(IC))CYCLE
170                    IF(INCREMENT3_FOR_KP(ICLASS)/=INCREMENT3_FOR_KP(IC))CYCLE
171                    CELL_CLASS3(IJK) = IC
172                    ICLASS = ICLASS - 1
173                    CYCLE  L100 ! Go to next cell
174                 ENDIF
175              END DO
176     
177           END DO L100
178           END DO
179           END DO
180     
181           CALL FINL_ERR_MSG
182     
183           RETURN
184           END SUBROUTINE SET_INCREMENTS3
185