File: RELATIVE:/../../../mfix.git/model/check_data/check_solids_common_discrete.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  SUBROUTINE: CHECK_SOLIDS_COMMON_DISCRETE                            !
4     !  Author: J.Musser                                   Date: 02-FEB-14  !
5     !                                                                      !
6     !  Purpose:                                                            !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE
10     
11     
12     ! Global Variables:
13     !---------------------------------------------------------------------//
14     ! Runtime Flag: Generate initial particle configuration.
15           USE discretelement, only: GENER_PART_CONFIG
16     ! Runtime Flag: Invoke MPPIC model.
17           USE mfix_pic, only: MPPIC
18     ! Runtime Flag: Store DES_*_OLD arrays.
19           USE discretelement, only: DO_OLD
20     ! Runtime Flag: Solve energy equations
21           USE run, only: ENERGY_EQ
22     ! Runtime Flag: One or more species equations are solved.
23           use run, only: ANY_SPECIES_EQ
24     ! Number of DEM solids phases.
25           USE discretelement, only: DES_MMAX
26     ! DEM solid phase diameters and densities.
27           USE discretelement, only: DES_D_p0, DES_RO_s
28     ! TFM solids phase diameters and densities. (DEM default)
29           USE physprop, only: D_p0, RO_s0
30     
31     ! User specified integration method.
32           USE discretelement, only: DES_INTG_METHOD
33           USE discretelement, only: INTG_ADAMS_BASHFORTH
34           USE discretelement, only: INTG_EULER
35     ! User specified neighbor search method.
36           USE discretelement, only: DES_NEIGHBOR_SEARCH
37     ! User specified data out format (VTP, TecPlot)
38           USE discretelement, only: DES_OUTPUT_TYPE
39     ! Max/Min particle radii
40           USE discretelement, only: MAX_RADIUS, MIN_RADIUS
41     ! Runtime Flag: Periodic boundaries
42           USE discretelement, only: DES_PERIODIC_WALLS
43           USE discretelement, only: DES_PERIODIC_WALLS_X
44           USE discretelement, only: DES_PERIODIC_WALLS_Y
45           USE discretelement, only: DES_PERIODIC_WALLS_Z
46     ! Flag: Solve variable solids density.
47           use run, only: SOLVE_ROs
48     ! Calculated baseline variable solids density.
49           use physprop, only: BASE_ROs
50     
51     ! Flag: Solve variable solids density.
52           USE run, only: SOLVE_ROs
53     ! Calculated baseline variable solids density.
54           USE physprop, only: BASE_ROs
55     
56     
57     ! Number of ranks.
58           use run, only: SOLIDS_MODEL
59     
60     ! Subroutine access.
61           use physprop, only: MMAX
62     
63           USE run, only: MOMENTUM_X_EQ
64           USE run, only: MOMENTUM_Y_EQ
65           USE run, only: MOMENTUM_Z_EQ
66     
67           use run, only: RUN_TYPE
68           use discretelement, only: GENER_PART_CONFIG
69     
70           USE physprop, only: CLOSE_PACKED
71     
72           USE mpi_utility
73     
74     
75     ! Global Parameters:
76     !---------------------------------------------------------------------//
77           use param1, only: undefined, undefined_c
78           use param, only: dim_m
79     
80     ! Use the error manager for posting error messages.
81     !---------------------------------------------------------------------//
82           use error_manager
83     
84           implicit none
85     
86     ! Local Variables:
87     !---------------------------------------------------------------------//
88     ! Loop index.
89           INTEGER :: M, lM  ! Solids phase Index
90     
91     ! Initialize the error manager.
92           CALL INIT_ERR_MSG("CHECK_SOLIDS_COMMON_DISCRETE")
93     
94     
95           DES_D_p0 = UNDEFINED
96           DES_RO_s = UNDEFINED
97     
98           MAX_RADIUS = -UNDEFINED
99           MIN_RADIUS =  UNDEFINED
100     
101           M = 0
102           DO lM=1, MMAX+DES_MMAX
103     
104     ! The accounts for an offset between the DEM and TFM phase indices
105              IF(SOLIDS_MODEL(lM) == 'TFM') CYCLE
106              M = M+1
107     
108     ! Copy of the input keyword values into discrete solids arrays. We may be
109     ! able to remove the DES_ specific variables moving forward.
110              DES_D_p0(M) = D_p0(lM)
111              DES_RO_s(M) = merge(BASE_ROs(lM), RO_s0(lM), SOLVE_ROs(lM))
112     ! Determine the maximum particle size in the system (MAX_RADIUS), which
113     ! in turn is used for various tasks
114              MAX_RADIUS = MAX(MAX_RADIUS, 0.5d0*DES_D_P0(M))
115              MIN_RADIUS = MIN(MIN_RADIUS, 0.5d0*DES_D_P0(M))
116           ENDDO
117     
118     
119     ! Set close_packed to true to prevent possible issues stemming from the
120     ! pressure correction equation.  Specifically, if closed_packed is false
121     ! then a mixture pressure correction equation is invoked and this is not
122     ! correctly setup for DEM.  To do so would require ensuring that
123     ! 1) the solids phase continuum quantities used in these equations are
124     !    correctly set based on their DEM counterparts and
125     ! 2) the pressure correction coefficients for such solids phases are
126     !    also calculated (currently these calculations are turned off
127     !    when using DEM)
128           CLOSE_PACKED((MMAX+1):DIM_M) = .TRUE.
129     
130     
131     ! Turn off the 'continuum' equations for discrete solids if the user
132     ! specified them.  We could make use of these flags.
133           MOMENTUM_X_EQ((MMAX+1):DIM_M) = .FALSE.
134           MOMENTUM_Y_EQ((MMAX+1):DIM_M) = .FALSE.
135           MOMENTUM_Z_EQ((MMAX+1):DIM_M) = .FALSE.
136     
137     ! Derive periodicity from cyclic boundary flags.
138           DES_PERIODIC_WALLS_X = CYCLIC_X .OR. CYCLIC_X_PD
139           DES_PERIODIC_WALLS_Y = CYCLIC_Y .OR. CYCLIC_Y_PD
140           DES_PERIODIC_WALLS_Z = CYCLIC_Z .OR. CYCLIC_Z_PD
141     
142           DES_PERIODIC_WALLS = (DES_PERIODIC_WALLS_X .OR.                  &
143             DES_PERIODIC_WALLS_Y .OR. DES_PERIODIC_WALLS_Z)
144     
145     
146     ! Overwrite for restart cases.
147           IF(TRIM(RUN_TYPE) .NE. 'NEW') GENER_PART_CONFIG = .FALSE.
148     
149     ! Check for valid neighbor search option.
150           SELECT CASE(DES_NEIGHBOR_SEARCH)
151           CASE (1) ! N-Square
152           CASE (2)
153              WRITE(ERR_MSG,2001) 2, 'QUADTREE'
154              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
155           CASE (3)
156              WRITE(ERR_MSG,2001) 3, 'OCTREE'
157              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
158           CASE (4) ! Grid based
159           CASE DEFAULT
160              WRITE(ERR_MSG,2001) DES_NEIGHBOR_SEARCH,'UNKNOWN'
161              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
162     
163      2001 FORMAT('Error 2001:Invalid DES_NEIGHBOR_SEARCH method: ',I2,1X,  &
164              A,/'Please correct the mfix.dat file.')
165     
166           END SELECT
167     
168     
169     ! Check the output file format
170           IF(DES_OUTPUT_TYPE == UNDEFINED_C) DES_OUTPUT_TYPE = 'PARAVIEW'
171           SELECT CASE(trim(DES_OUTPUT_TYPE))
172           CASE ('PARAVIEW')
173           CASE ('TECPLOT')
174           CASE DEFAULT
175              WRITE(ERR_MSG,2010) trim(DES_OUTPUT_TYPE)
176              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
177     
178      2010 FORMAT('Error 2010:Invalid DES_OUTPUT_TYPE: ',A,/'Please ',       &
179              'correct the mfix.dat file.')
180     
181           END SELECT
182     
183     
184     ! Check for valid integration method
185           SELECT CASE(trim(DES_INTG_METHOD))
186           CASE ('EULER')
187              INTG_EULER = .TRUE.
188              INTG_ADAMS_BASHFORTH = .FALSE.
189              !DES_INTG_METHOD_ENUM = 1
190           CASE ('ADAMS_BASHFORTH')
191              INTG_EULER = .FALSE.
192              INTG_ADAMS_BASHFORTH = .TRUE.
193              !DES_INTG_METHOD_ENUM = 2
194           CASE DEFAULT
195              WRITE(ERR_MSG,2020) trim(DES_INTG_METHOD)
196              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
197     
198      2020 FORMAT('Error 2020:Invalid DES_INGT_METHOD: ',A,/'Please ',      &
199              'correct the mfix.dat file.')
200     
201           END SELECT
202     
203           DO_OLD = INTG_ADAMS_BASHFORTH .OR. MPPIC
204     
205     ! Check interpolation input.
206           CALL CHECK_SOLIDS_COMMON_DISCRETE_INTERP
207     
208     ! Set flags for energy equations
209           IF(ENERGY_EQ) CALL CHECK_SOLIDS_COMMON_DISCRETE_ENERGY
210     
211     ! Check thermodynamic properties of discrete solids.
212           IF(ANY_SPECIES_EQ) &
213              CALL CHECK_SOLIDS_COMMON_DISCRETE_THERMO
214     
215     ! Check geometry constrains.
216           CALL CHECK_SOLIDS_COMMON_DISCRETE_GEOMETRY
217     
218           CALL FINL_ERR_MSG
219     
220     
221           RETURN
222     
223           END SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE
224     
225     
226     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
227     !                                                                      !
228     !  SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_ENERGY                      !
229     !  Author: J.Musser                                   Date: 02-FEB-14  !
230     !                                                                      !
231     !  Purpose: Check input parameters for solving discrete solids phase   !
232     !  energy equations.  Only DEM simulations (neither hybrid nor MPPIC)  !
233     !  can invoke particle-particle heat transfer. Therefore, checks for   !
234     !  those functions are reseved for later.                              !
235     !                                                                      !
236     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
237           SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_ENERGY
238     
239     
240     ! Global Variables:
241     !---------------------------------------------------------------------//
242           use run, only: UNITS
243     
244           use discretelement, only: DES_MMAX
245     
246           use physprop, only: SMAX
247           use physprop, only: K_S0
248     
249           use des_thermo, only: DES_CONV_CORR
250           use des_thermo, only: DES_CONV_CORR_ENUM
251           use des_thermo, only: RANZ_1952
252     
253           use des_thermo, only: SB_CONST
254           use des_thermo, only: DES_Em
255     
256           use des_thermo, only: CALC_CONV_DES ! Convection
257           use des_thermo, only: CALC_COND_DES ! Conduction
258           use des_thermo, only: CALC_RADT_DES ! Radiation
259     
260           use discretelement, only: DES_CONTINUUM_COUPLED
261     
262           use run, only: SOLIDS_MODEL
263     ! User input for DES interpolation scheme.
264           use particle_filter, only: DES_INTERP_SCHEME
265     ! Enumerated interpolation scheme for faster access
266           use particle_filter, only: DES_INTERP_SCHEME_ENUM
267           use particle_filter, only: DES_INTERP_NONE
268     ! Flag to explicitly couple source terms and DES
269           use discretelement, only: DES_EXPLICITLY_COUPLED
270     
271     ! Global Parameters:
272     !---------------------------------------------------------------------//
273           use param1, only: ZERO, UNDEFINED
274     
275     
276     ! Use the error manager for posting error messages.
277     !---------------------------------------------------------------------//
278           use error_manager
279     
280     
281           IMPLICIT NONE
282     
283     
284     ! Local Variables:
285     !---------------------------------------------------------------------//
286     ! Loop counter
287           INTEGER :: M
288     
289     !......................................................................!
290     
291     
292     ! Initialize the error manager.
293           CALL INIT_ERR_MSG("CHECK_SOLIDS_COMMON_DISCRETE_ENERGY")
294     
295     
296     ! Set runtime flags for which modes of heat transfer to calculate.
297           CALC_CONV_DES = DES_CONTINUUM_COUPLED
298           DO M = SMAX+1, SMAX+DES_MMAX
299     ! Only interested in discrete solids.
300              IF(SOLIDS_MODEL(M) == 'TFM') CYCLE
301     ! Flag to calculate radiation.
302              IF(DES_Em(M) > ZERO) CALC_RADT_DES(M) = .TRUE.
303     ! Flag to calculate conduction.
304              CALC_COND_DES(M) = (K_s0(M) > ZERO .AND. K_s0(M) /= UNDEFINED)
305           ENDDO
306     
307     ! Gas/Solids convection:
308     !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
309     ! Verify the selected convective heat transfer coefficient model
310           SELECT CASE(TRIM(DES_CONV_CORR))
311     ! Ranz, W.E. and Marshall, W.R., "Friction and transfer coefficients
312     ! for single particles and packed beds,"  Chemical Engineering Science,
313     ! Vol. 48, No. 5, pp 247-253, 1952.
314           CASE ('RANZ_1952')
315              DES_CONV_CORR_ENUM = RANZ_1952
316     ! If the heat transfer coefficient correlation provided by the user does
317     ! not match one of the models outlined above, flag the error and exit.
318           CASE DEFAULT
319              WRITE(ERR_MSG,1001)'DES_CONV_CORR', trim(DES_CONV_CORR)
320              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
321           END SELECT
322     
323     
324     ! Radiation Equation:
325     !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
326     ! Verify that a emmisivity value is specified for each solids phase
327           DO M = SMAX+1, SMAX+DES_MMAX
328              IF(DES_Em(M) == UNDEFINED) THEN
329                 WRITE(ERR_MSG,1000) trim(iVar('DES_Em',M))
330                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
331              ENDIF
332           ENDDO
333     
334     ! Set the value of the Stefan-Boltzman Constant based on the units
335           IF(UNITS == 'SI')THEN
336              SB_CONST = 5.6704d0*(10.0d0**(-8)) ! W/((m^2).K^4)
337           ELSE
338              SB_CONST = 1.355282d0*(10.0d0**(-12)) ! cal/((cm^2).sec.K^4)
339           ENDIF
340     
341     
342     ! Notify that interpolation is not support for thermo variables
343           SELECT CASE(DES_INTERP_SCHEME_ENUM)
344           CASE(DES_INTERP_NONE)
345           CASE DEFAULT
346              WRITE(ERR_MSG,2000) trim(adjustl(DES_INTERP_SCHEME))
347              CALL FLUSH_ERR_MSG()
348           END SELECT
349     
350      2000 FORMAT('WARNING 2000: The selected interpolation scheme (',A,    &
351              ') is not',/'supported by the DES energy equation implemen',  &
352              'tation. All energy',/'equation variables will use the ',     &
353              'centroid method for interphase',/'data exchange.')
354     
355           IF(DES_EXPLICITLY_COUPLED)THEN
356              WRITE(ERR_MSG, 2100)
357              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
358           ENDIF
359     
360      2100 FORMAT('Error 2100: The DES Energy equation implementation ',    &
361              'does not',/'currently support explicit coupling (DES_',      &
362              'EXPLICITLY_COUPLED).','Please correct the mfix.dat file.')
363     
364           CALL FINL_ERR_MSG
365     
366     
367           RETURN
368     
369      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
370              'correct the mfix.dat file.')
371     
372      1001 FORMAT('Error 1001: Illegal or unknown input: ',A,' = ',A,/   &
373              'Please correct the mfix.dat file.')
374     
375           END SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_ENERGY
376     
377     
378     
379     
380     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
381     !                                                                      !
382     !  Subroutine: CHECK_SOLIDS_COMMON_DISCRETE_THERMO                     !
383     !  Author: J.Musser                                   Date: 17-Jun-10  !
384     !                                                                      !
385     !  Purpose:                                                            !
386     !                                                                      !
387     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
388           SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_THERMO
389     
390           use stiff_chem, only: STIFF_CHEMISTRY
391           use discretelement, only: DES_EXPLICITLY_COUPLED
392     ! User input for DES interpolation scheme.
393           use particle_filter, only: DES_INTERP_SCHEME
394     ! Enumerated interpolation scheme for faster access
395           use particle_filter, only: DES_INTERP_SCHEME_ENUM
396           use particle_filter, only: DES_INTERP_NONE
397     
398           use error_manager
399     
400           IMPLICIT NONE
401     
402     !......................................................................!
403     
404     
405     ! Initialize the error manager.
406           CALL INIT_ERR_MSG("CHECK_SOLIDS_COMMON_DISCRETE_THERMO")
407     
408     ! Stiff chemistry solver is a TFM reaction model not for DES.
409           IF(STIFF_CHEMISTRY) THEN
410              WRITE(ERR_MSG,9003)
411              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
412           ENDIF
413     
414      9003 FORMAT('Error 9003: The stiff chemistry solver is not ',         &
415           'available in DES',/'simulations. Please correct the input file.')
416     
417     ! Notify that interpolation is not support for thermo variables
418           SELECT CASE(DES_INTERP_SCHEME_ENUM)
419           CASE(DES_INTERP_NONE)
420           CASE DEFAULT
421              WRITE(ERR_MSG,2000) trim(adjustl(DES_INTERP_SCHEME))
422              CALL FLUSH_ERR_MSG()
423           END SELECT
424     
425      2000 FORMAT('WARNING 2000: The selected interpolation scheme (',A,    &
426              ') is not',/'supported by the DES Species equation implemen', &
427              'tation. All energy',/'equation variables will use the ',     &
428              'centroid method for interphase',/'data exchange.')
429     
430           IF(DES_EXPLICITLY_COUPLED)THEN
431              WRITE(ERR_MSG, 2100)
432              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
433           ENDIF
434     
435      2100 FORMAT('Error 2100: The DES Species equation implementation ',   &
436              'does not',/'currently support explicit coupling (DES_',      &
437              'EXPLICITLY_COUPLED).',/'Please correct the mfix.dat file.')
438     
439           CALL FINL_ERR_MSG
440     
441           RETURN
442           END SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_THERMO
443     
444     
445     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
446     !                                                                      !
447     !  Subroutine: CHECK_SOLIDS_COMMON_DISCRETE_GEOMETRY                   !
448     !  Author: J.Musser                                   Date: 11-DEC-13  !
449     !                                                                      !
450     !  Purpose: Check user input data                                      !
451     !                                                                      !
452     !  Comments: Geometry checks were moved here from CHECK_DES_DATA.      !
453     !                                                                      !
454     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
455           SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_GEOMETRY
456     
457     !-----------------------------------------------
458     ! Modules
459     !-----------------------------------------------
460           USE geometry, only: COORDINATES
461           USE geometry, only: NO_I, NO_J
462           USE geometry, only: ZLENGTH
463     ! Flag: Use DES E-L model
464           USE discretelement, only: DES_CONTINUUM_COUPLED
465           USE discretelement, only: MAX_RADIUS
466     ! Flag: Use Cartesian grid cut-cell implementation
467           USE cutcell, only: CARTESIAN_GRID
468     ! Flag: Use STL representation in CG
469           USE cutcell, only: USE_STL
470     
471           use error_manager
472     
473           IMPLICIT NONE
474     !-----------------------------------------------
475     ! Local Variables
476     !-----------------------------------------------
477           DOUBLE PRECISION :: MIN_DEPTH
478     
479     !......................................................................!
480     
481     
482     ! Initialize the error manager.
483           CALL INIT_ERR_MSG("CHECK_SOLIDS_COMMON_DISCRETE_GEOMETRY")
484     
485     
486     ! DEM/MPPIC is restricted to CARTESIAN coordinates.
487           IF(COORDINATES == 'CYLINDRICAL') THEN
488              WRITE (ERR_MSG, 1100)
489              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
490           ENDIF
491     
492      1100 FORMAT('Error: 1100: DES and MPPIC models only support ',        &
493              'CARTESIAN coordinates.')
494     
495     
496     ! Check dimension. This is redundant with check_data_03.
497           IF(NO_I .OR. NO_J) THEN
498              WRITE(ERR_MSG, 1200)
499              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
500           ENDIF
501     
502      1200 FORMAT('Error 1200: Illegal geometry for DEM/MPPIC. 2D ',        &
503              'simulations are',/'restricted to the XY plane. Please ',     &
504              'correct the mfix.dat file.')
505     
506     
507           IF(DES_CONTINUUM_COUPLED)THEN
508     ! Check that the depth of the simulation exceeds the largest particle
509     ! to ensure correct calculation of volume fraction. This is important
510     ! for coupled simulations.
511              MIN_DEPTH = 2.0d0*MAX_RADIUS
512              IF(ZLENGTH < MIN_DEPTH)THEN
513                 WRITE(ERR_MSG, 1300)
514                 CALL FLUSH_ERR_MSG(ABORT=.FALSE.)
515              ENDIF
516           ENDIF
517     
518      1300 FORMAT('Error 1300: The maximum particle diameter exceeds the ', &
519              'simulation',/'depth (ZLENGTH). Please correct the mfix.dat ',&
520              'file.')
521     
522     
523           IF(CARTESIAN_GRID .AND. .NOT.USE_STL) THEN
524              WRITE(ERR_MSG,1400)
525              CALL FLUSH_ERR_MSG(ABORT =.TRUE.)
526           ENDIF
527     
528      1400 FORMAT('Error 1400: Cartesian grid and discrete models (DEM or ',&
529              'PIC) only',/'support STL wall representations. Quadrics ',   &
530              'and polygons are not',/'supported.')
531     
532     
533           CALL FINL_ERR_MSG
534     
535           RETURN
536     
537           END SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_GEOMETRY
538     
539     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
540     !                                                                      !
541     !  Subroutine: CHECK_SOLIDS_COMMON_DISCRETE_INTERP                     !
542     !  Author: J.Musser                                   Date: 25-Nov-14  !
543     !                                                                      !
544     !  Purpose:                                                            !
545     !                                                                      !
546     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
547           SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_INTERP
548     
549     ! Runtime Flag: Invoke gas/solids coupled simulation.
550           use discretelement, only: DES_CONTINUUM_COUPLED
551     ! Runtime Flag: Invoke MPPIC model.
552           USE mfix_pic, only: MPPIC
553     ! User input for DES interpolation scheme.
554           use particle_filter, only: DES_INTERP_SCHEME
555     ! Enumerated interpolation scheme for faster access
556           use particle_filter, only: DES_INTERP_SCHEME_ENUM
557           use particle_filter, only: DES_INTERP_NONE
558           use particle_filter, only: DES_INTERP_GARG
559           use particle_filter, only: DES_INTERP_DPVM
560           use particle_filter, only: DES_INTERP_GAUSS
561     ! User specified filter width
562           use particle_filter, only: DES_INTERP_WIDTH
563     ! Flag: Diffuse DES field variables.
564           use particle_filter, only: DES_DIFFUSE_MEAN_FIELDS
565     ! Diffusion filter width
566           use particle_filter, only: DES_DIFFUSE_WIDTH
567     ! Flag: Interpolate continuum fields
568           use particle_filter, only: DES_INTERP_MEAN_FIELDS
569     ! Flag: Interplate variables for drag calculation.
570           use particle_filter, only: DES_INTERP_ON
571     ! Size of interpolation filter
572           use particle_filter, only: FILTER_SIZE
573     ! Runtime FLag: 3D simulation
574           use geometry, only: DO_K
575     
576           use param1, only: UNDEFINED
577     
578           use error_manager
579     
580           IMPLICIT NONE
581     
582     !......................................................................!
583     
584     
585     ! Initialize the error manager.
586           CALL INIT_ERR_MSG("CHECK_SOLIDS_COMMON_DISCRETE_INTERP")
587     
588     ! Set the runtime flag for diffusing mean fields
589           DES_DIFFUSE_MEAN_FIELDS = (DES_DIFFUSE_WIDTH /= UNDEFINED)
590     
591     ! Set the interpolation ENUM value.
592           SELECT CASE(trim(adjustl(DES_INTERP_SCHEME)))
593           CASE ('NONE')
594              DES_INTERP_SCHEME_ENUM = DES_INTERP_NONE
595     ! Cannot use interpolation when no scheme is selected.
596              IF(DES_INTERP_ON)THEN
597                 WRITE(ERR_MSG,2001) 'DES_INTERP_ON'
598                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
599              ELSEIF(DES_INTERP_MEAN_FIELDS)THEN
600                 WRITE(ERR_MSG,2001) 'DES_INTERP_MEAN_FIELDS'
601                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
602     
603              ELSEIF(DES_CONTINUUM_COUPLED) THEN
604                 IF(MPPIC) THEN
605                    WRITE(ERR_MSG,2002) 'MPPIC solids'
606                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
607                 ELSEIF(MPPIC) THEN
608                    WRITE(ERR_MSG,2002) 'Cartesian grid cut-cells'
609                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
610                 ENDIF
611              ENDIF
612     
613           CASE ('GARG_2012')
614              DES_INTERP_SCHEME_ENUM = DES_INTERP_GARG
615     
616           CASE ('SQUARE_DPVM')
617              DES_INTERP_SCHEME_ENUM = DES_INTERP_DPVM
618     
619           CASE ('GAUSS_DPVM')
620              DES_INTERP_SCHEME_ENUM = DES_INTERP_GAUSS
621     
622           CASE DEFAULT
623              WRITE(ERR_MSG,2000) trim(adjustl(DES_INTERP_SCHEME))
624              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
625           END SELECT
626     
627      2000 FORMAT('Error 2000: Invalid DES_INTERP_SCHEME: ',A,/'Please ',   &
628              'correct the mfix.dat file.')
629     
630      2001 FORMAT('Error 2001: No interpolation scheme specified when ',A,/ &
631              'is enabled. Please correct the mfix.dat file.')
632     
633      2002 FORMAT('Error 2002: DES simulations utilizing ',A,' require',/   &
634              'interpolation (DES_INTERP_ON and DES_INTERP_MEANFIELDS). ',/ &
635              'Please correct the mfix.dat file.')
636     
637     
638           SELECT CASE(DES_INTERP_SCHEME_ENUM)
639     
640           CASE(DES_INTERP_NONE)
641     
642              IF(DES_INTERP_WIDTH /= UNDEFINED) THEN
643                 WRITE(ERR_MSG,2100) trim(adjustl(DES_INTERP_SCHEME))
644                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
645              ENDIF
646     
647      2100 FORMAT('Error 2100: The selected interpolation scheme (',A,') ', &
648              'does',/'not support an adjustable interpolation width.',/    &
649              'Please correct the input file.')
650     
651     
652           CASE(DES_INTERP_GARG)
653              DES_INTERP_MEAN_FIELDS= .TRUE.
654     
655              IF(DES_INTERP_WIDTH /= UNDEFINED) THEN
656                 WRITE(ERR_MSG,2100) trim(adjustl(DES_INTERP_SCHEME))
657                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
658              ENDIF
659     
660              IF(DES_DIFFUSE_MEAN_FIELDS) THEN
661                 WRITE(ERR_MSG,2110) trim(adjustl(DES_INTERP_SCHEME))
662                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
663              ENDIF
664     
665      2110 FORMAT('Error 2110: The selected interpolation scheme (',A,') ', &
666              'does not',/'support diffusive filtering of mean field ',     &
667               'quantities. Please correct',/'the input file.')
668     
669           CASE(DES_INTERP_DPVM, DES_INTERP_GAUSS)
670     
671     ! Set the size of the interpolation filter.
672              FILTER_SIZE = merge(27, 9, DO_K)
673     
674              IF(DES_INTERP_WIDTH == UNDEFINED) THEN
675                 WRITE(ERR_MSG,2120) trim(adjustl(DES_INTERP_SCHEME))
676                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
677              ENDIF
678     
679      2120 FORMAT('Error 2120: The selected interpolation scheme (',A,') ', &
680              'requires',/'a DES_INTERP_WIDTH. Please correct the ',        &
681              'input file.')
682     
683           END SELECT
684     
685           CALL FINL_ERR_MSG
686     
687           RETURN
688           END SUBROUTINE CHECK_SOLIDS_COMMON_DISCRETE_INTERP
689