File: /nfs/home/0/users/jenkins/mfix.git/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 boundfunijk
52           USE functions
53           IMPLICIT NONE
54     !-----------------------------------------------
55     !   G l o b a l   P a r a m e t e r s
56     !-----------------------------------------------
57     !-----------------------------------------------
58     !   D u m m y   A r g u m e n t s
59     !-----------------------------------------------
60           INTEGER I, J, K, IJK, IMJK, IPJK, IJMK, IJPK, IJKM, IJKP, IJKW, IJKE, &
61              IJKS, IJKN, IJKB, IJKT
62     !-----------------------------------------------
63     !   L o c a l   P a r a m e t e r s
64     !-----------------------------------------------
65     !-----------------------------------------------
66     !   L o c a l   V a r i a b l e s
67     !-----------------------------------------------
68           LOGICAL :: TRUE_CORNER
69     !-----------------------------------------------
70     
71           IMJK = UNDEFINED_I
72           IPJK = UNDEFINED_I
73           IJMK = UNDEFINED_I
74           IJPK = UNDEFINED_I
75           IJKM = UNDEFINED_I
76           IJKP = UNDEFINED_I
77           IJKW = UNDEFINED_I
78           IJKE = UNDEFINED_I
79           IJKS = UNDEFINED_I
80           IJKN = UNDEFINED_I
81           IJKB = UNDEFINED_I
82           IJKT = UNDEFINED_I
83           TRUE_CORNER = .FALSE.
84     
85     
86           IF(IM1(I).NE.UNDEFINED_I) THEN
87     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),JM1(J),K)).OR.&
88     !           WALL_AT(BOUND_FUNIJK(IM1(I),J,KM1(K))))
89     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IM1(I),JP1(J),K)).OR.&
90     !           WALL_AT(BOUND_FUNIJK(IM1(I),J,KP1(K))))
91     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
92             TRUE_CORNER = .FALSE.
93             TRUE_CORNER = TRUE_CORNER.OR.I_OF(IJK).EQ.IMIN1
94             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
95                IMJK = IJK
96             ELSE
97                IMJK = BOUND_FUNIJK(IM1(I),J,K)
98             ENDIF
99     !
100     !  IJKW
101     !
102             IF (WALL_AT(IMJK)) THEN
103                IJKW = IJK
104             ELSE
105                IJKW = IMJK
106             ENDIF
107           ENDIF
108     
109           IF(IP1(I).NE.UNDEFINED_I) THEN
110     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IP1(I),JM1(J),K)).OR.&
111     !           WALL_AT(BOUND_FUNIJK(IP1(I),J,KM1(K))))
112     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),JP1(J),K)).OR.&
113     !           WALL_AT(BOUND_FUNIJK(IP1(I),J,KP1(K))))
114     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
115             TRUE_CORNER = .FALSE.
116             TRUE_CORNER = TRUE_CORNER.OR.I_OF(IJK).EQ.IMAX1
117             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
118                IPJK = IJK
119             ELSE
120                IPJK = BOUND_FUNIJK(IP1(I),J,K)
121             ENDIF
122     !
123     !  IJKE
124     !
125             IF (WALL_AT(IPJK)) THEN
126                IJKE = IJK
127             ELSE
128                IJKE = IPJK
129             ENDIF
130           ENDIF
131     
132           IF(JM1(J).NE.UNDEFINED_I) THEN
133     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),JM1(J),K)).OR.&
134     !           WALL_AT(BOUND_FUNIJK(I,JM1(J),KM1(K))))
135     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),JM1(J),K)).OR.&
136     !           WALL_AT(BOUND_FUNIJK(I,JM1(J),KP1(K))))
137     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
138             TRUE_CORNER = .FALSE.
139             TRUE_CORNER = TRUE_CORNER.OR.J_OF(IJK).EQ.JMIN1
140             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
141                IJMK = IJK
142             ELSE
143                IJMK = BOUND_FUNIJK(I,JM1(J),K)
144             ENDIF
145     !
146     !  IJKS
147     !
148             IF (WALL_AT(IJMK)) THEN
149                IJKS = IJK
150             ELSE
151                IJKS = IJMK
152             ENDIF
153           ENDIF
154     
155           IF(JP1(J).NE.UNDEFINED_I) THEN
156     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),JP1(J),K)).OR.&
157     !           WALL_AT(BOUND_FUNIJK(I,JP1(J),KM1(K))))
158     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),JP1(J),K)).OR.&
159     !           WALL_AT(BOUND_FUNIJK(I,JP1(J),KP1(K))))
160     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
161             TRUE_CORNER = .FALSE.
162             TRUE_CORNER = TRUE_CORNER.OR.J_OF(IJK).EQ.JMAX1
163             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
164                IJPK = IJK
165             ELSE
166                IJPK = BOUND_FUNIJK(I,JP1(J),K)
167             ENDIF
168     !
169     !  IJKN
170     !
171             IF (WALL_AT(IJPK)) THEN
172                IJKN = IJK
173             ELSE
174                IJKN = IJPK
175             ENDIF
176           ENDIF
177     
178           IF(KM1(K).NE.UNDEFINED_I) THEN
179     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),J,KM1(K))).OR.&
180     !           WALL_AT(BOUND_FUNIJK(I,JM1(J),KM1(K))))
181     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),J,KM1(K))).OR.&
182     !           WALL_AT(BOUND_FUNIJK(I,JP1(J),KM1(K))))
183     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
184             TRUE_CORNER = .FALSE.
185             TRUE_CORNER = TRUE_CORNER.OR.K_OF(IJK).EQ.KMIN1
186             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
187                IJKM = IJK
188             ELSE
189                IJKM = BOUND_FUNIJK(I,J,KM1(K))
190             ENDIF
191     !
192     !  IJKB
193     !
194             IF (WALL_AT(IJKM)) THEN
195                IJKB = IJK
196             ELSE
197                IJKB = IJKM
198             ENDIF
199           ENDIF
200     
201           IF(KP1(K).NE.UNDEFINED_I) THEN
202     !        TRUE_CORNER_1 = (WALL_AT(BOUND_FUNIJK(IM1(I),J,KP1(K))).OR.&
203     !           WALL_AT(BOUND_FUNIJK(I,JM1(J),KP1(K))))
204     !        TRUE_CORNER_2 = (WALL_AT(BOUND_FUNIJK(IP1(I),J,KP1(K))).OR.&
205     !           WALL_AT(BOUND_FUNIJK(I,JP1(J),KP1(K))))
206     !        TRUE_CORNER = TRUE_CORNER_1.OR.TRUE_CORNER_2
207             TRUE_CORNER = .FALSE.
208             TRUE_CORNER = TRUE_CORNER.OR.K_OF(IJK).EQ.KMAX1
209             IF((WALL_AT(IJK).OR.FLOW_AT(IJK)).AND.TRUE_CORNER) THEN
210                IJKP = IJK
211             ELSE
212                IJKP = BOUND_FUNIJK(I,J,KP1(K))
213             ENDIF
214     !
215     !  IJKT
216     !
217             IF (WALL_AT(IJKP)) THEN
218                IJKT = IJK
219             ELSE
220                IJKT = IJKP
221             ENDIF
222           ENDIF
223     !
224           RETURN
225           END SUBROUTINE SET_INDEX1A
226     
227     !// Comments on the modifications for DMP version implementation
228     !// Modified calls to BOUND_FUNIJK to have a self consistent formulation
229