File: N:\mfix\model\set_index1a.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: SET_INDEX1A(I, J, K, IJK, IMJK, IPJK, IJMK, IJPK,      C
4     !                            IJKM, IJKP, IJKW, IJKE, IJKS, IJKN,       C
5     !                            IJKB, IJKT)                               C
6     !  Purpose: Set the indices of the neighbors of cell ijk (brute force) C
7     !                                                                      C
8     !  Author: M. Syamlal                                 Date: 21-JAN-92  C
9     !  Reviewer:M. Syamlal, S. Venkatesan, P. Nicoletti,  Date: 29-JAN-92  C
10     !           W. Rogers                                                  C
11     !                                                                      C
12     !  Revision Number: 1                                                  C
13     !  Purpose: Modify index computations for K for setting periodic       C
14     !           boundary conditions in a cylindrical geometry where z goes C
15     !           from 0 to 2 pi                                             C
16     !  Author: M. Syamlal                                 Date: 10-MAR-92  C
17     !  Revision Number: 2                                                  C
18     !  Purpose:  Calculate only the nearest neighbor indices.( for code    C
19     !            optimization)                                             C
20     !  Author: M. Syamlal                                 Date: 23-SEP-92  C
21     !  Reviewer: M. Syamlal                               Date: 11-DEC-92  C
22     !                                                                      C
23     !  Literature/Document References:                                     C
24     !                                                                      C
25     !  Variables referenced: I, J, K, IJK                                  C
26     !                                                                      C
27     !  Variables modified: IJKM, IJMK, IMJK, IPJK, IJPK, IJKP, IJKW, IJKE, C
28     !                      IJKS, IJKN, IJKB, IJKT                          C
29     !                                                                      C
30     !  Local variables: None                                               C
31     !                                                                      C
32     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
33     !
34           SUBROUTINE SET_INDEX1A(I, J, K, IJK, IMJK, IPJK, IJMK, IJPK, IJKM, IJKP, &
35              IJKW, IJKE, IJKS, IJKN, IJKB, IJKT)
36     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
37     !...Switches: -xf
38     !
39     !  Include param.inc file to specify parameter values
40     !
41     !-----------------------------------------------
42     !   M o d u l e s
43     !-----------------------------------------------
44           USE param
45           USE param1
46           USE physprop
47           USE geometry
48           USE compar
49           USE fldvar
50           USE indices
51           USE functions
52           IMPLICIT NONE
53     !-----------------------------------------------
54     !   G l o b a l   P a r a m e t e r s
55     !-----------------------------------------------
56     !-----------------------------------------------
57     !   D u m m y   A r g u m e n t s
58     !-----------------------------------------------
59           INTEGER I, J, K, IJK, IMJK, IPJK, IJMK, IJPK, IJKM, IJKP, IJKW, IJKE, &
60              IJKS, IJKN, IJKB, IJKT
61     !-----------------------------------------------
62     !   L o c a l   P a r a m e t e r s
63     !-----------------------------------------------
64     !-----------------------------------------------
65     !   L o c a l   V a r i a b l e s
66     !-----------------------------------------------
67           LOGICAL :: TRUE_CORNER
68     !-----------------------------------------------
69     
70           IMJK = UNDEFINED_I
71           IPJK = UNDEFINED_I
72           IJMK = UNDEFINED_I
73           IJPK = UNDEFINED_I
74           IJKM = UNDEFINED_I
75           IJKP = UNDEFINED_I
76           IJKW = UNDEFINED_I
77           IJKE = UNDEFINED_I
78           IJKS = UNDEFINED_I
79           IJKN = UNDEFINED_I
80           IJKB = UNDEFINED_I
81           IJKT = UNDEFINED_I
82           TRUE_CORNER = .FALSE.
83     
84     
85           IF(IM1(I).NE.UNDEFINED_I) THEN
86     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),JM1(J),K)).OR.&
87     !           WALL_AT(BOUND_FUNIJK(IM1(I),J,KM1(K))))
88     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IM1(I),JP1(J),K)).OR.&
89     !           WALL_AT(BOUND_FUNIJK(IM1(I),J,KP1(K))))
90     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
91             TRUE_CORNER = .FALSE.
92             TRUE_CORNER = TRUE_CORNER.OR.I_OF(IJK).EQ.IMIN1
93             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
94                IMJK = IJK
95             ELSE
96                IMJK = BOUND_FUNIJK(IM1(I),J,K)
97             ENDIF
98     !
99     !  IJKW
100     !
101             IF (WALL_AT(IMJK)) THEN
102                IJKW = IJK
103             ELSE
104                IJKW = IMJK
105             ENDIF
106           ENDIF
107     
108           IF(IP1(I).NE.UNDEFINED_I) THEN
109     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IP1(I),JM1(J),K)).OR.&
110     !           WALL_AT(BOUND_FUNIJK(IP1(I),J,KM1(K))))
111     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),JP1(J),K)).OR.&
112     !           WALL_AT(BOUND_FUNIJK(IP1(I),J,KP1(K))))
113     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
114             TRUE_CORNER = .FALSE.
115             TRUE_CORNER = TRUE_CORNER.OR.I_OF(IJK).EQ.IMAX1
116             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
117                IPJK = IJK
118             ELSE
119                IPJK = BOUND_FUNIJK(IP1(I),J,K)
120             ENDIF
121     !
122     !  IJKE
123     !
124             IF (WALL_AT(IPJK)) THEN
125                IJKE = IJK
126             ELSE
127                IJKE = IPJK
128             ENDIF
129           ENDIF
130     
131           IF(JM1(J).NE.UNDEFINED_I) THEN
132     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),JM1(J),K)).OR.&
133     !           WALL_AT(BOUND_FUNIJK(I,JM1(J),KM1(K))))
134     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),JM1(J),K)).OR.&
135     !           WALL_AT(BOUND_FUNIJK(I,JM1(J),KP1(K))))
136     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
137             TRUE_CORNER = .FALSE.
138             TRUE_CORNER = TRUE_CORNER.OR.J_OF(IJK).EQ.JMIN1
139             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
140                IJMK = IJK
141             ELSE
142                IJMK = BOUND_FUNIJK(I,JM1(J),K)
143             ENDIF
144     !
145     !  IJKS
146     !
147             IF (WALL_AT(IJMK)) THEN
148                IJKS = IJK
149             ELSE
150                IJKS = IJMK
151             ENDIF
152           ENDIF
153     
154           IF(JP1(J).NE.UNDEFINED_I) THEN
155     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),JP1(J),K)).OR.&
156     !           WALL_AT(BOUND_FUNIJK(I,JP1(J),KM1(K))))
157     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),JP1(J),K)).OR.&
158     !           WALL_AT(BOUND_FUNIJK(I,JP1(J),KP1(K))))
159     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
160             TRUE_CORNER = .FALSE.
161             TRUE_CORNER = TRUE_CORNER.OR.J_OF(IJK).EQ.JMAX1
162             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
163                IJPK = IJK
164             ELSE
165                IJPK = BOUND_FUNIJK(I,JP1(J),K)
166             ENDIF
167     !
168     !  IJKN
169     !
170             IF (WALL_AT(IJPK)) THEN
171                IJKN = IJK
172             ELSE
173                IJKN = IJPK
174             ENDIF
175           ENDIF
176     
177           IF(KM1(K).NE.UNDEFINED_I) THEN
178     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),J,KM1(K))).OR.&
179     !           WALL_AT(BOUND_FUNIJK(I,JM1(J),KM1(K))))
180     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),J,KM1(K))).OR.&
181     !           WALL_AT(BOUND_FUNIJK(I,JP1(J),KM1(K))))
182     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
183             TRUE_CORNER = .FALSE.
184             TRUE_CORNER = TRUE_CORNER.OR.K_OF(IJK).EQ.KMIN1
185             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
186                IJKM = IJK
187             ELSE
188                IJKM = BOUND_FUNIJK(I,J,KM1(K))
189             ENDIF
190     !
191     !  IJKB
192     !
193             IF (WALL_AT(IJKM)) THEN
194                IJKB = IJK
195             ELSE
196                IJKB = IJKM
197             ENDIF
198           ENDIF
199     
200           IF(KP1(K).NE.UNDEFINED_I) THEN
201     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),J,KP1(K))).OR.&
202     !           WALL_AT(BOUND_FUNIJK(I,JM1(J),KP1(K))))
203     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),J,KP1(K))).OR.&
204     !           WALL_AT(BOUND_FUNIJK(I,JP1(J),KP1(K))))
205     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
206             TRUE_CORNER = .FALSE.
207             TRUE_CORNER = TRUE_CORNER.OR.K_OF(IJK).EQ.KMAX1
208             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
209                IJKP = IJK
210             ELSE
211                IJKP = BOUND_FUNIJK(I,J,KP1(K))
212             ENDIF
213     !
214     !  IJKT
215     !
216             IF (WALL_AT(IJKP)) THEN
217                IJKT = IJK
218             ELSE
219                IJKT = IJKP
220             ENDIF
221           ENDIF
222     !
223           RETURN
224           END SUBROUTINE SET_INDEX1A
225     
226     !// Comments on the modifications for DMP version implementation
227     !// Modified calls to BOUND_FUNIJK to have a self consistent formulation
228