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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  SUBROUTINE: GET_IS                                                  !
4     !  Author: M. Syamlal                                 Date: 21-OCT-92  !
5     !                                                                      !
6     !  Purpose: Find and validate i, j, k locations for IS's               !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE GET_IS(ISV)
10     
11           USE param
12           USE param1
13           USE geometry
14           USE is
15           USE indices
16           USE funits
17           USE compar
18     
19     ! Use the error manager for posting error messages.
20     !---------------------------------------------------------------------//
21           use error_manager
22     
23           IMPLICIT NONE
24     
25     ! Dummy Arguments:
26     !---------------------------------------------------------------------//
27     ! Loop/variable indices
28           INTEGER, INTENT(in) :: ISV
29     
30     ! Local Variables:
31     !---------------------------------------------------------------------//
32     ! Error flag.
33           INTEGER :: IER
34     ! Calculated indices of the wall boundary
35           INTEGER :: I_w , I_e , J_s , J_n , K_b , K_t
36     ! Surface indictors
37           LOGICAL :: X_CONSTANT, Y_CONSTANT, Z_CONSTANT
38     !......................................................................!
39     
40           CALL INIT_ERR_MSG('GET_IS')
41     
42           X_CONSTANT = .TRUE.
43           Y_CONSTANT = .TRUE.
44           Z_CONSTANT = .TRUE.
45     
46           IF(IS_X_W(ISV)/=UNDEFINED .AND. IS_X_E(ISV)/=UNDEFINED) THEN
47              CALL CALC_CELL(XMIN, IS_X_W(ISV), DX, IMAX, I_W)
48              CALL CALC_CELL(XMIN, IS_X_E(ISV), DX, IMAX, I_E)
49              IF (IS_X_W(ISV) /= IS_X_E(ISV)) THEN
50                 X_CONSTANT = .FALSE.
51                 I_W = I_W + 1
52                 IF(IS_I_W(ISV)/=UNDEFINED_I .OR.                           &
53                    IS_I_E(ISV)/=UNDEFINED_I) THEN
54                    CALL LOCATION_CHECK(IS_I_W(ISV), I_W, ISV, 'IS - west')
55                    CALL LOCATION_CHECK(IS_I_E(ISV), I_E, ISV, 'IS - east')
56                 ENDIF
57              ENDIF
58              IS_I_W(ISV) = I_W
59              IS_I_E(ISV) = I_E
60           ELSE
61              IF(IS_I_W(ISV) /= UNDEFINED_I)                                &
62                 CALL CALC_LOC(XMIN, DX, IS_I_W(ISV), IS_X_W(ISV))
63              IF(IS_I_E(ISV) /= UNDEFINED_I)                                &
64                 CALL CALC_LOC(XMIN, DX, IS_I_E(ISV), IS_X_E(ISV))
65              IF (IS_X_W(ISV) /= IS_X_E(ISV)) X_CONSTANT = .FALSE.
66           ENDIF
67     
68     !  If there is no variation in the I direction set indices to 1
69           IF (NO_I) THEN
70              IS_I_W(ISV) = 1
71              IS_I_E(ISV) = 1
72           ENDIF
73     !
74           IF (IS_Y_S(ISV)/=UNDEFINED .AND. IS_Y_N(ISV)/=UNDEFINED) THEN
75              CALL CALC_CELL(ZERO, IS_Y_S(ISV), DY, JMAX, J_S)
76              CALL CALC_CELL(ZERO, IS_Y_N(ISV), DY, JMAX, J_N)
77              IF (IS_Y_S(ISV) /= IS_Y_N(ISV)) THEN
78                 Y_CONSTANT = .FALSE.
79                 J_S = J_S + 1
80                 IF(IS_J_S(ISV)/=UNDEFINED_I .OR.                           &
81                    IS_J_N(ISV)/=UNDEFINED_I) THEN
82                    CALL LOCATION_CHECK(IS_J_S(ISV), J_S, ISV, 'IS - south')
83                    CALL LOCATION_CHECK(IS_J_N(ISV), J_N, ISV, 'IS - north')
84                 ENDIF
85              ENDIF
86              IS_J_S(ISV) = J_S
87              IS_J_N(ISV) = J_N
88           ELSE
89              IF(IS_J_S(ISV) /= UNDEFINED_I)                                &
90                 CALL CALC_LOC(ZERO, DY, IS_J_S(ISV), IS_Y_S(ISV))
91              IF(IS_J_N(ISV) /= UNDEFINED_I)                                &
92                 CALL CALC_LOC(ZERO, DY, IS_J_N(ISV), IS_Y_N(ISV))
93              IF (IS_Y_S(ISV) /= IS_Y_N(ISV)) Y_CONSTANT = .FALSE.
94           ENDIF
95     
96     ! If there is no variation in the J direction set indices to 1
97           IF (NO_J) THEN
98              IS_J_S(ISV) = 1
99              IS_J_N(ISV) = 1
100           ENDIF
101     
102           IF (IS_Z_B(ISV)/=UNDEFINED .AND. IS_Z_T(ISV)/=UNDEFINED) THEN
103              CALL CALC_CELL(ZERO, IS_Z_B(ISV), DZ, KMAX, K_B)
104              CALL CALC_CELL(ZERO, IS_Z_T(ISV), DZ, KMAX, K_T)
105              IF (IS_Z_B(ISV) /= IS_Z_T(ISV)) THEN
106                 Z_CONSTANT = .FALSE.
107                 K_B = K_B + 1
108                 IF (IS_K_B(ISV)/=UNDEFINED_I .OR.                          &
109                    IS_K_T(ISV)/=UNDEFINED_I) THEN
110                    CALL LOCATION_CHECK(IS_K_B(ISV), K_B, ISV, 'IS - bottom')
111                    CALL LOCATION_CHECK(IS_K_T(ISV), K_T, ISV, 'IS - top')
112                 ENDIF
113              ENDIF
114              IS_K_B(ISV) = K_B
115              IS_K_T(ISV) = K_T
116           ELSE
117              IF(IS_K_B(ISV) /= UNDEFINED_I)                                &
118                 CALL CALC_LOC(ZERO, DZ, IS_K_B(ISV), IS_Z_B(ISV))
119              IF(IS_K_T(ISV) /= UNDEFINED_I)                                &
120                 CALL CALC_LOC(ZERO, DZ, IS_K_T(ISV), IS_Z_T(ISV))
121              IF (IS_Z_B(ISV) /= IS_Z_T(ISV)) Z_CONSTANT = .FALSE.
122           ENDIF
123     
124     !  If there is no variation in the K direction set indices to 1
125           IF (NO_K) THEN
126              IS_K_B(ISV) = 1
127              IS_K_T(ISV) = 1
128           ENDIF
129     
130     !  Check whether the boundary is a plane parallel to one of the three
131     !  coordinate planes, else check whether a direction is specified by IS_TYPE
132           IF(X_CONSTANT .OR. Y_CONSTANT .OR. Z_CONSTANT) THEN
133              IF(IS_X_W(ISV)/=UNDEFINED .AND. IS_Y_S(ISV)/=UNDEFINED .AND.  &
134                 IS_Z_B(ISV)/=UNDEFINED) CALL CHECK_PLANE(X_CONSTANT,       &
135                 Y_CONSTANT, Z_CONSTANT,ISV, 'IS')
136           ELSE
137              SELECT CASE(IS_TYPE(ISV)(1:1))
138              CASE('X','Y','Z') ! Do Nothing
139              CASE DEFAULT
140                 WRITE(ERR_MSG, 1100) trim(iVar('IS_TYPE',ISV)),            &
141                    trim(IS_TYPE(ISV))
142                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
143              END SELECT
144           ENDIF
145     
146      1100 FORMAT('Error 1100: ',A,' = ',A,' is specified as a volume',/    &
147              'and therefore should have should have a directional prefix;',&
148              /'Valid prefix values: X_, Y_, Z_',/'Please correct the ',/   &
149              'mfix.dat file.')
150     
151     ! CHECK FOR VALID VALUES
152           IER = 0
153           IF(IS_I_W(ISV)<1 .OR. IS_I_W(ISV)>IMAX2) IER = 1
154           IF(IS_I_E(ISV)<1 .OR. IS_I_E(ISV)>IMAX2) IER = 1
155           IF(IS_J_S(ISV)<1 .OR. IS_J_S(ISV)>JMAX2) IER = 1
156           IF(IS_J_N(ISV)<1 .OR. IS_J_N(ISV)>JMAX2) IER = 1
157           IF(IS_K_B(ISV)<1 .OR. IS_K_B(ISV)>KMAX2) IER = 1
158           IF(IS_K_T(ISV)<1 .OR. IS_K_T(ISV)>KMAX2) IER = 1
159           IF(IS_K_B(ISV) > IS_K_T(ISV)) IER = 1
160           IF(IS_J_S(ISV) > IS_J_N(ISV)) IER = 1
161           IF(IS_I_W(ISV) > IS_I_E(ISV)) IER = 1
162     
163           IF(IER /= 0)THEN
164              WRITE(ERR_MSG,1101) ISV,                                      &
165                 'X', IS_X_W(ISV), IS_X_E(ISV),'I',IS_I_W(ISV),IS_I_E(ISV), &
166                 'Y', IS_Y_S(ISV), IS_Y_N(ISV),'J',IS_J_S(ISV),IS_J_N(ISV), &
167                 'Z', IS_Z_B(ISV), IS_Z_T(ISV),'K',IS_K_B(ISV),IS_K_T(ISV)
168              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
169           ENDIF
170     
171      1101 FORMAT('Error 1101: Invalid location specified for IS ',I3,'.',  &
172              3(/3x,A1,': ',g12.5,',',g12.5,8x,A1,': ',I8,',',I8),/         &
173              'Please correct the mfix.dat file.')
174     
175           CALL FINL_ERR_MSG
176     
177           RETURN
178           END SUBROUTINE GET_IS
179