MFIX  2016-1
check_internal_surfaces.f
Go to the documentation of this file.
1 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2 ! !
3 ! Subroutine: CHECK_INTERNAL_SURFACES !
4 ! Author: M. Syamlal Date: 21-OCT-92 !
5 ! !
6 ! Purpose: Check internal surface specifications, and convert !
7 ! physical locations to i, j, k's. !
8 ! !
9 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
10  SUBROUTINE check_internal_surfaces
11 
12 
13 ! Global Variables:
14 !---------------------------------------------------------------------//
15 ! Type of internal surface.
16  use is, only: is_type
17 ! Flag: IS is specified.
18  use is, only: is_defined
19 
20 ! Global Parameters:
21 !---------------------------------------------------------------------//
22 ! Maximum number of ISs that can be specified.
23  USE param, only: dimension_is
24 
25 ! Use the error manager for posting error messages.
26 !---------------------------------------------------------------------//
27  use error_manager
28 
29  IMPLICIT NONE
30 
31 ! Local Variables:
32 !---------------------------------------------------------------------//
33 ! loop/variable indices
34  INTEGER :: ISV
35 !......................................................................!
36 
37  CALL init_err_msg("CHECK_INTERNAL_SURFACES")
38 
39  CALL check_is_geometry
40 
41  DO isv=1, dimension_is
42 
43 ! Check that the input is valid.
44  IF(is_defined(isv)) THEN
45 ! Convert spatial coordinates into I/J/K values.
46  CALL get_is(isv)
47 ! Check that the required input is specifed for all IS types.
48  SELECT CASE(is_type(isv))
49  CASE('SEMIPERMEABLE')
50  CALL check_is_semipermeable(isv)
51  CASE('X_SEMIPERMEABLE', &
52  'Y_SEMIPERMEABLE', &
53  'Z_SEMIPERMEABLE')
54  CALL check_is_semipermeable(isv)
55  END SELECT
56 ! Check that nothing is specifed for undefined IS regions.
57  ELSE
58  CALL check_is_overflow(isv)
59  ENDIF
60  ENDDO
61 
62  CALL finl_err_msg
63 
64  RETURN
65  END SUBROUTINE check_internal_surfaces
66 
67 
68 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
69 ! !
70 ! Subroutine: CHECK_IS_GEOMETRY !
71 ! Author: M. Syamlal Date: 21-OCT-92 !
72 ! !
73 ! Purpose: Verify that IS geometry is specifed and that the IS_TYPE !
74 ! is valid. !
75 ! !
76 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
77  SUBROUTINE check_is_geometry
78 
79  USE compar
80  USE fldvar
81  USE funits
82  USE geometry
83  USE indices
84  USE is
85  USE param
86  USE param1
87  USE physprop
88  USE run
89 
90 ! Use the error manager for posting error messages.
91 !---------------------------------------------------------------------//
92  use error_manager
93 
94  IMPLICIT NONE
95 
96 ! Global Parameters:
97 !---------------------------------------------------------------------//
98 
99 ! Local Variables:
100 !---------------------------------------------------------------------//
101 ! Loop/Variable indices
102  INTEGER :: ISV, I
103 ! Total number of valid IS types
104  INTEGER, PARAMETER :: DIM_ISTYPE = 4
105 ! Valid internal surface types
106  CHARACTER(LEN=16), DIMENSION(1:DIM_ISTYPE) :: VALID_IS_TYPE = (/&
107  'IMPERMEABLE ', 'IP ',&
108  'SEMIPERMEABLE ', 'SP '/)
109 !......................................................................!
110 
111  CALL init_err_msg("CHECK_IS_GEOMETRY")
112 
113 ! Initialize the ALL_IS flag.
114  any_is_defined = .false.
115 
116 ! DETERMINE WHICH INTERNAL SURFACE INDICES HAVE VALUES
117  l50: DO isv = 1, dimension_is
118 
119  is_defined(isv) = .false.
120  IF (is_x_w(isv) /= undefined) is_defined(isv) = .true.
121  IF (is_x_e(isv) /= undefined) is_defined(isv) = .true.
122  IF (is_y_s(isv) /= undefined) is_defined(isv) = .true.
123  IF (is_y_n(isv) /= undefined) is_defined(isv) = .true.
124  IF (is_z_b(isv) /= undefined) is_defined(isv) = .true.
125  IF (is_z_t(isv) /= undefined) is_defined(isv) = .true.
126  IF (is_i_w(isv) /= undefined_i) is_defined(isv) = .true.
127  IF (is_i_e(isv) /= undefined_i) is_defined(isv) = .true.
128  IF (is_j_s(isv) /= undefined_i) is_defined(isv) = .true.
129  IF (is_j_n(isv) /= undefined_i) is_defined(isv) = .true.
130  IF (is_k_b(isv) /= undefined_i) is_defined(isv) = .true.
131  IF (is_k_t(isv) /= undefined_i) is_defined(isv) = .true.
132 
133 
134  IF(.NOT.is_defined(isv)) cycle l50
135 
136  any_is_defined = .true.
137 
138  IF (is_x_w(isv)==undefined .AND. is_i_w(isv)==undefined_i) THEN
139  IF (no_i) THEN
140  is_x_w(isv) = zero
141  ELSE
142  WRITE(err_msg,1101) isv, 'IS_X_w and IS_I_w '
143  CALL flush_err_msg(abort=.true.)
144  ENDIF
145  ENDIF
146 
147  IF(is_x_e(isv)==undefined .AND. is_i_e(isv)==undefined_i) THEN
148  IF(no_i) THEN
149  is_x_e(isv) = xlength
150  ELSE
151  WRITE(err_msg,1101) isv, 'IS_X_e and IS_I_e '
152  CALL flush_err_msg(abort=.true.)
153  ENDIF
154  ENDIF
155  IF(is_y_s(isv)==undefined .AND. is_j_s(isv)==undefined_i) THEN
156  IF(no_j) THEN
157  is_y_s(isv) = zero
158  ELSE
159  WRITE(err_msg,1101) isv, 'IS_Y_s and IS_J_s '
160  CALL flush_err_msg(abort=.true.)
161  ENDIF
162  ENDIF
163  IF(is_y_n(isv)==undefined .AND. is_j_n(isv)==undefined_i) THEN
164  IF(no_j) THEN
165  is_y_n(isv) = ylength
166  ELSE
167  WRITE(err_msg,1101) isv, 'IS_Y_n and IS_J_n '
168  CALL flush_err_msg(abort=.true.)
169  ENDIF
170  ENDIF
171  IF(is_z_b(isv)==undefined .AND. is_k_b(isv)==undefined_i) THEN
172  IF(no_k) THEN
173  is_z_b(isv) = zero
174  ELSE
175  WRITE(err_msg,1101) isv, 'IS_Z_b and IS_K_b '
176  CALL flush_err_msg(abort=.true.)
177  ENDIF
178  ENDIF
179  IF(is_z_t(isv)==undefined .AND. is_k_t(isv)==undefined_i) THEN
180  IF(no_k) THEN
181  is_z_t(isv) = zlength
182  ELSE
183  WRITE(err_msg,1101) isv, 'IS_Z_t and IS_K_t '
184  CALL flush_err_msg(abort=.true.)
185  ENDIF
186  ENDIF
187 
188  1101 FORMAT('Error 1101: Internal surface ',i3,' is ill-defined.',/ &
189  a,' are not specified.',/'Please correct the mfix.dat file.')
190 
191 
192  DO i = 1, dim_istype
193  IF(valid_is_type(i) == is_type(isv)) THEN
194  IF(mod(i,2) == 0) is_type(isv) = valid_is_type(i-1)
195  cycle l50
196  ENDIF
197  IF(valid_is_type(i) == is_type(isv)(3:16)) THEN
198  IF(mod(i,2) == 0) is_type(isv)(3:16) = valid_is_type(i-1)
199 
200  SELECT CASE(is_type(isv)(1:1))
201  CASE('X', 'Y', 'Z'); cycle l50
202  CASE DEFAULT
203  WRITE(err_msg, 1102) isv, is_type(isv)(1:1)
204  CALL flush_err_msg(abort=.true.)
205  END SELECT
206 
207  1102 FORMAT('Error 1102: Internal surface ',i3,' has an invalid ',&
208  'prefix: ',a,/'Please correct the mfix.dat file.')
209 
210  ENDIF
211  END DO
212  WRITE(err_msg, 1103) trim(ivar('IS_TYPE',isv)), &
213  trim(is_type(isv)), valid_is_type
214  CALL flush_err_msg(abort=.true.)
215 
216  1103 FORMAT('Error 1103: Illegal entry: ',a,' = ',a,/'Valid entries:',&
217  ' ',4(/5x,a,2x,a))
218 
219  ENDDO l50
220 
221  CALL finl_err_msg
222 
223  RETURN
224  END SUBROUTINE check_is_geometry
225 
226 
227 
228 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
229 ! !
230 ! Subroutine: CHECK_IS_SEMIPERMEABLE !
231 ! Author: J.Musser Date: 19-MAR-14 !
232 ! !
233 ! Purpose: Check that required input for semipermeable internal !
234 ! surfaces is specified. !
235 ! !
236 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
237  SUBROUTINE check_is_semipermeable(ISV)
238 
239 
240 ! Global Variables:
241 !---------------------------------------------------------------------//
242 ! Permeability coefficients for semipermeable internal surfaces.
243  USE is, only: is_pc
244 
245 ! Global Parameters:
246 !---------------------------------------------------------------------//
247  USE param1, only: zero, undefined
248 
249 ! Use the error manager for posting error messages.
250 !---------------------------------------------------------------------//
251  use error_manager
252 
253 
254  IMPLICIT NONE
255 
256 
257 ! Dummy Arguments:
258 !---------------------------------------------------------------------//
259 ! Internal surface index
260  INTEGER, INTENT(in) :: ISV
261 !......................................................................!
262 
263  CALL init_err_msg("CHECK_IS_SEMIPERMEABLE")
264 
265 
266 ! Check that the Darcy coefficient is specifed and valid.
267  IF(is_pc(isv,1) == undefined) THEN
268  WRITE(err_msg, 1000) trim(ivar('IS_PC',isv,1))
269  CALL flush_err_msg(abort=.true.)
270  ENDIF
271 
272  IF(is_pc(isv,1) == zero) THEN
273  WRITE(err_msg, 1001) trim(ivar('IS_PC',isv,1)), '0.0'
274  CALL flush_err_msg(abort=.true.)
275  ENDIF
276 
277 ! Check that the inertial resistance factor is specified.
278  IF(is_pc(isv,2) == undefined) THEN
279  WRITE(err_msg, 1000) trim(ivar('IS_PC',isv,2))
280  CALL flush_err_msg(abort=.true.)
281  ENDIF
282 
283  CALL finl_err_msg
284 
285  RETURN
286 
287  1000 FORMAT('Error 1000: Required input not specified: ',a,/'Please ',&
288  'correct the mfix.dat file.')
289 
290  1001 FORMAT('Error 1001: Illegal or unknown input: ',a,' = ',a,/ &
291  'Please correct the mfix.dat file.')
292 
293  END SUBROUTINE check_is_semipermeable
294 
295 
296 
297 
298 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
299 ! !
300 ! Subroutine: CHECK_IS_OVERFLOW !
301 ! Author: J.Musser Date: 19-MAR-14 !
302 ! !
303 ! Purpose: Check internal surface specifications are not specifed for !
304 ! ISs that are not defined. !
305 ! !
306 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
307  SUBROUTINE check_is_overflow(ISV)
308 
309 
310 ! Global Variables:
311 !---------------------------------------------------------------------//
312 ! Permeability coefficients for semipermeable internal surfaces.
313  USE is, only: is_pc
314 
315 ! Global Parameters:
316 !---------------------------------------------------------------------//
317  USE param1, only: zero, undefined
318 
319 ! Use the error manager for posting error messages.
320 !---------------------------------------------------------------------//
321  use error_manager
322 
323  IMPLICIT NONE
324 
325 ! Dummy Arguments:
326 !---------------------------------------------------------------------//
327 ! Internal surface index.
328  INTEGER, INTENT(in) :: ISV
329 !......................................................................!
330 
331 
332  CALL init_err_msg("CHECK_IS_OVERFLOW")
333 
334 ! Check that the Darcy coefficient is undefined.
335  IF(is_pc(isv,1) /= undefined) THEN
336  WRITE(err_msg, 1100) trim(ivar('IS_PC',isv,1))
337  CALL flush_err_msg(abort=.true.)
338  ENDIF
339 
340 ! Check that the inertial resistance factor is undefined.
341  IF(is_pc(isv,2) /= zero) THEN
342  WRITE(err_msg, 1100) trim(ivar('IS_PC',isv,2))
343  CALL flush_err_msg(abort=.true.)
344  ENDIF
345 
346  CALL finl_err_msg
347 
348  RETURN
349 
350  1100 FORMAT('Error 1100: ',a,' specified in an undefined IS region')
351 
352  END SUBROUTINE check_is_overflow
353 
check_is_semipermeable
subroutine check_is_semipermeable(ISV)
Definition: check_internal_surfaces.f:238
is::is_type
character(len=16), dimension(dimension_is) is_type
Definition: is_mod.f:70
error_manager::ivar
character(len=32) function ivar(VAR, i1, i2, i3)
Definition: error_manager_mod.f:558
param::dimension_is
integer, parameter dimension_is
Definition: param_mod.f:63
error_manager::finl_err_msg
subroutine finl_err_msg
Definition: error_manager_mod.f:216
geometry::no_i
logical no_i
Definition: geometry_mod.f:20
is::is_x_e
double precision, dimension(dimension_is) is_x_e
Definition: is_mod.f:25
is::is_i_w
integer, dimension(dimension_is) is_i_w
Definition: is_mod.f:45
is::any_is_defined
logical any_is_defined
Definition: is_mod.f:76
param1::undefined
double precision, parameter undefined
Definition: param1_mod.f:18
is
Definition: is_mod.f:11
error_manager::init_err_msg
subroutine init_err_msg(CALLER)
Definition: error_manager_mod.f:171
is::is_x_w
double precision, dimension(dimension_is) is_x_w
Definition: is_mod.f:21
check_internal_surfaces
subroutine check_internal_surfaces
Definition: check_internal_surfaces.f:11
is::is_k_b
integer, dimension(dimension_is) is_k_b
Definition: is_mod.f:61
get_is
subroutine get_is(ISV)
Definition: get_is.f:10
is::is_z_b
double precision, dimension(dimension_is) is_z_b
Definition: is_mod.f:37
is::is_pc
double precision, dimension(dimension_is, 2) is_pc
Definition: is_mod.f:85
geometry::xlength
double precision xlength
Definition: geometry_mod.f:33
run
Definition: run_mod.f:13
param
Definition: param_mod.f:2
is::is_defined
logical, dimension(dimension_is) is_defined
Definition: is_mod.f:73
geometry::no_k
logical no_k
Definition: geometry_mod.f:28
is::is_j_s
integer, dimension(dimension_is) is_j_s
Definition: is_mod.f:53
check_is_geometry
subroutine check_is_geometry
Definition: check_internal_surfaces.f:78
geometry::no_j
logical no_j
Definition: geometry_mod.f:24
is::is_z_t
double precision, dimension(dimension_is) is_z_t
Definition: is_mod.f:41
param1::undefined_i
integer, parameter undefined_i
Definition: param1_mod.f:19
error_manager::err_msg
character(len=line_length), dimension(line_count) err_msg
Definition: error_manager_mod.f:29
is::is_y_s
double precision, dimension(dimension_is) is_y_s
Definition: is_mod.f:29
error_manager
Definition: error_manager_mod.f:8
is::is_y_n
double precision, dimension(dimension_is) is_y_n
Definition: is_mod.f:33
geometry::ylength
double precision ylength
Definition: geometry_mod.f:35
is::is_j_n
integer, dimension(dimension_is) is_j_n
Definition: is_mod.f:57
is::is_i_e
integer, dimension(dimension_is) is_i_e
Definition: is_mod.f:49
check_is_overflow
subroutine check_is_overflow(ISV)
Definition: check_internal_surfaces.f:308
geometry::x
double precision, dimension(:), allocatable x
Definition: geometry_mod.f:129
param1::zero
double precision, parameter zero
Definition: param1_mod.f:27
geometry::zlength
double precision zlength
Definition: geometry_mod.f:37
error_manager::flush_err_msg
subroutine flush_err_msg(DEBUG, HEADER, FOOTER, ABORT, LOG, CALL_TREE)
Definition: error_manager_mod.f:305
is::is_k_t
integer, dimension(dimension_is) is_k_t
Definition: is_mod.f:65