File: N:\mfix\model\check_data\check_solids_continuum.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: CHECK_CONTINUUM_SOLIDS                                  !
4     !  Purpose: Check kinetic the run control namelist section             !
5     !                                                                      !
6     !  Author: P. Nicoletti                               Date: 27-NOV-91  !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE CHECK_SOLIDS_CONTINUUM
10     
11     ! Global Variables:
12     !---------------------------------------------------------------------//
13           USE constant
14           USE run
15           USE physprop
16     
17     ! Global Parameters:
18     !---------------------------------------------------------------------//
19           USE param1, only: zero, one, undefined, undefined_i
20     
21     ! Global Module procedures:
22     !---------------------------------------------------------------------//
23           use error_manager
24     
25           IMPLICIT NONE
26     
27     ! Local Variables:
28     !---------------------------------------------------------------------//
29           INTEGER :: LC, M
30           DOUBLE PRECISION :: lsin_phi
31     ! counters for number of phases with defined/undefined mu_s0
32           INTEGER :: def_mus0, undef_mus0
33     !......................................................................!
34     
35     
36     ! initialization of various dependent constants
37           SIN_PHI = UNDEFINED   ! friction
38           SIN2_PHI = UNDEFINED   ! schaeffer
39           F_PHI = UNDEFINED    ! commented schaeffer section
40           TAN_PHI_W = UNDEFINED   ! friction or jenkins
41     
42     ! Initialize the error manager.
43           CALL INIT_ERR_MSG("CHECK_SOLIDS_CONTINUUM")
44     
45     ! Check EP_star. This is used to populate ep_star_array which is what
46     ! should be used elsewhere in the code. (see set_constprop)
47           IF(EP_STAR == UNDEFINED) THEN
48              WRITE(ERR_MSG,1000) 'EP_STAR'
49              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
50           ELSEIF(EP_STAR < ZERO .OR. EP_STAR > ONE) THEN
51              WRITE(ERR_MSG, 1001)'EP_STAR', iVal(EP_STAR)
52              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
53           ENDIF
54     
55     ! CHECK DIF_s0
56           DO M = 1, SMAX
57              IF (DIF_S0(M) < ZERO) THEN
58                 WRITE(ERR_MSG, 1001) trim(iVar('Dif_s0',M)), &
59                    iVal(Dif_s0(M)) 
60                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
61              ENDIF
62           ENDDO
63           DO M = SMAX+1, DIM_M
64              IF(DIF_S0(M) /= UNDEFINED)THEN
65                 WRITE(ERR_MSG,1002) trim(iVar('Dif_s0',M))
66                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
67              ENDIF
68           ENDDO
69     
70     ! CHECK MU_s0
71           def_mus0 = 0
72           DO M = 1, SMAX
73              IF (MU_s0(M) /= UNDEFINED) THEN
74                 def_mus0 = def_mus0 + 1
75                 IF(MU_s0(M) < ZERO) THEN
76                    WRITE(ERR_MSG, 1001) trim(iVar('Mu_s0',M)), &
77                       iVal(Mu_s0(M))
78                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
79                 ENDIF
80              ENDIF
81           ENDDO
82           undef_mus0 = smax - def_mus0
83     
84           DO M = SMAX+1, DIM_M
85              IF(MU_s0(M) /= UNDEFINED)THEN
86                 WRITE(ERR_MSG,1002) trim(iVar('Mu_s0',M))
87                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
88              ENDIF
89           ENDDO
90     
91     ! Solids phase with constant solids viscosity is employed
92     !---------------------------------------------------------------------//
93           IF (def_mus0 > 0) THEN
94              IF(GRANULAR_ENERGY) THEN
95     ! calculation of many of the solids phase transport coefficients
96     ! needed by the granular energy equation will be skipped in the
97     ! calc_mu_s if mu_s0 is defined. so make sure that the granular
98     ! energy eqn is not evaluated when the solids viscosity is set to
99     ! a constant.
100     ! Also do not allow a mixed case of constant viscosity and pde
101     ! granular energy. To permit such would require going through the
102     ! KT sections of the code and ensuring that the solids phase with
103     ! granular energy doesn't interact or depend on a phase with a
104     ! constant viscosity.
105                 WRITE(ERR_MSG,1100)
106                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
107              ENDIF
108     
109     ! needed by default solids-solids drag model
110              IF (SMAX >=2) THEN
111                 IF (C_E == UNDEFINED) THEN
112                    WRITE(ERR_MSG,1101)
113                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
114                 ELSEIF (C_F == UNDEFINED) THEN
115                    WRITE(ERR_MSG,1102)
116                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
117                 ENDIF
118              ENDIF
119           ENDIF
120     
121     
122     ! PDE granular energy. Check kinetic theory specifications.
123     !---------------------------------------------------------------------//
124           IF (GRANULAR_ENERGY) THEN
125              IF(def_mus0 >0) THEN
126                 WRITE(ERR_MSG,1100)
127                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
128              ENDIF
129              CALL CHECK_KT_TYPE
130           ENDIF
131     
132     ! Algebraic granular energy equation
133     !---------------------------------------------------------------------//
134           IF (.NOT.GRANULAR_ENERGY .AND. undef_mus0 > 0) THEN
135              IF (C_E == UNDEFINED) THEN
136                 WRITE(ERR_MSG,1101)
137                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
138              ENDIF
139     ! needed by default solids-solids drag model. SMAX may be 1 for
140     ! hybrid simulations and C_F is still needed.
141              IF (SMAX >=2 .OR. DEM_SOLIDS) THEN
142                 IF (C_F == UNDEFINED) THEN
143                    WRITE(ERR_MSG,1102)
144                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
145                 ENDIF
146              ENDIF
147           ENDIF
148      1100 FORMAT('Error 1100: Constant viscosity is specified but', /&
149              'GRANULAR_ENERGY=.TRUE. Please correct the mfix.dat file')
150      1101 FORMAT('Error 1101: Coefficient of restitution (C_E) not ',      &
151              'specified.',/'Please correct the mfix.dat file.')
152      1102 FORMAT('Error 1102: Coefficient of friction (C_F) not ',         &
153              'specified.',/'Please correct the mfix.dat file.')
154     
155     
156     
157     ! If frictional stress modeling check various dependent/conflicting
158     ! settings
159     
160     ! plastic/frictional stress model
161           IF (FRICTION) THEN
162              IF(SCHAEFFER) THEN
163                 WRITE(ERR_MSG, 1200)
164                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
165     ! Check that the granular energy PDE is solved.
166              ELSEIF (.NOT.GRANULAR_ENERGY) THEN
167                 WRITE(ERR_MSG,1201)
168                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
169     ! Check the value specified for SAVAGE.
170              ELSEIF(SAVAGE>2 .OR. SAVAGE<0) THEN
171                 WRITE(ERR_MSG, 1001)'SAVAGE', iVal(SAVAGE)
172                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
173     ! Verify that stress blending is not turned on.
174              ELSEIF(BLENDING_STRESS) THEN
175                 WRITE(ERR_MSG, 1202)
176                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
177              ELSEIF(PHI == UNDEFINED) THEN
178                 WRITE(ERR_MSG, 1203)
179                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
180     ! used by friction bc
181              ELSEIF(PHI_W == UNDEFINED) THEN
182                 WRITE(ERR_MSG, 1204)
183                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
184              ENDIF
185     ! PHI & PHI_W are given in degrees but calculated in radian within
186     ! the fortran codes
187              SIN_PHI = SIN(PHI*PI/180.D0)
188              TAN_PHI_W = TAN(PHI_W*PI/180.D0)
189           ENDIF
190      1201 FORMAT('Error 1201: The FRICTION solids stress model requires ', &
191              /,'GRANULAR_ENERGY=.TRUE. Please correct the mfix.dat file.')
192      1202 FORMAT('Error 1202: Cannot use BLENDING_STRESS with FRICTION ',&
193              /,'Please correct the mfix.dat file.')
194      1204 FORMAT('Error 1204: Angle of particle-wall friction (PHI_W) not',&
195              ' specified.',/'Please correct the mfix.dat file.')
196     
197     
198     ! plastic/frictional stress model
199           IF(SCHAEFFER) THEN
200              IF(FRICTION) THEN
201                 WRITE(ERR_MSG, 1200)
202                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
203              ELSEIF (PHI == UNDEFINED) THEN
204                 WRITE(ERR_MSG, 1203)
205                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
206              ENDIF
207     ! PHI is given in degrees but calculated in radian within
208     ! the fortran codes
209              lsin_phi = sin(phi*PI/180.d0)
210              SIN2_PHI = lSIN_PHI*lSIN_PHI
211              F_PHI = (3.0D0 - 2.0D0*SIN2_PHI)/3.0D0    ! employed in commented
212           ENDIF
213      1200 FORMAT('Error 1200: FRICTION and SCHAEFFER models cannot be ',&
214              'used',/'together. Please correct the mfix.dat file')
215      1203 FORMAT('Error 1203: Angle of internal friction (PHI) not ',      &
216              'specified.',/'Please correct the mfix.dat file.')
217     
218     
219           IF(YU_STANDISH .AND. FEDORS_LANDEL) THEN
220              WRITE(ERR_MSG, 1300)
221              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
222           ELSEIF(YU_STANDISH) THEN
223     ! Yu_Standish correlation checks
224              IF(SMAX < 2) THEN
225                 WRITE(ERR_MSG, 1301)
226                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
227              ENDIF
228           ELSEIF(FEDORS_LANDEL) THEN
229     ! Fedors_Landel correlation checks.
230              IF(SMAX /= 2) THEN
231                 WRITE(ERR_MSG, 1302)
232                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
233              ENDIF
234           ENDIF
235      1300 FORMAT('Error 1300: FEDORS_LANDEL and YU_STANDISH correlations ',&
236              'cannot be',/'used at the same time. Please correct the ',    &
237              'mfix.dat file.')
238      1301 FORMAT('Error 1301: YU_STANDISH correlation is for polydisperse',&
239              ' mixtures',/'(MMAX >= 2). Please correct the mfix.dat file.')
240      1302 FORMAT('Error 1302: FEDORS_LANDEL correlation is for binary ',   &
241              'mixtures (MMAX=2).',/'Please correct the mfix.dat file.')
242     
243     
244     ! Set the flags for blending stresses.
245           IF(BLENDING_STRESS) THEN
246     ! Turn off the default if SIGM_BLEND is set.
247              IF(SIGM_BLEND)  TANH_BLEND = .FALSE.
248           ELSE
249              TANH_BLEND  = .FALSE.
250              SIGM_BLEND  = .FALSE.
251           ENDIF
252     
253     
254           IF(MODEL_B) THEN
255              DO LC = 1, MMAX
256                 IF(.NOT.CLOSE_PACKED(LC)) THEN
257                    WRITE(ERR_MSG, 1400) LC
258                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
259                 ENDIF
260              ENDDO
261           ENDIF
262      1400 FORMAT('Error 1400: Solids phase ',I2,' is not CLOSE_PACKED.',/, &
263              'All solids phases must be CLOSE_PACKED with MODEL_B=.TURE.',/ &
264              'Please correct the mfix.dat file.')
265     
266     
267     ! Check that phase number where added mass applies is properly defined.
268           IF (ADDED_MASS) THEN
269              IF(M_AM == UNDEFINED_I)THEN
270                 WRITE(ERR_MSG, 1500)
271                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
272              ELSEIF(M_AM == 0 .OR. M_AM > MMAX) THEN
273                 WRITE(ERR_MSG,1501)
274                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
275      1500 FORMAT('Error 1500: Must specify a disperse phase, M_AM, where ',&
276              'the',/'virtual mass applies (ADDED_MASS).',/'Please correct',&
277              ' the mfix.dat file.')
278      1501 FORMAT('Error 1501: M_AM is out of range. [1,MMAX]',/'Please ',  &
279              'correct the mfix.dat file.')
280              ENDIF
281           ENDIF
282     
283     
284     ! Check name of radial distribution function
285           SELECT CASE(trim(adjustl(RDF_TYPE)))
286     
287           CASE ('LEBOWITZ')
288              RDF_TYPE_ENUM = LEBOWITZ
289     
290           CASE ('MODIFIED_LEBOWITZ')
291              RDF_TYPE_ENUM = MODIFIED_LEBOWITZ
292     
293           CASE ('MANSOORI')
294              RDF_TYPE_ENUM = MANSOORI
295     
296           CASE ('MODIFIED_MANSOORI')
297              RDF_TYPE_ENUM = MODIFIED_MANSOORI
298     
299           CASE DEFAULT
300                 WRITE(ERR_MSG, 1600)
301                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
302            END SELECT
303     
304      1600 FORMAT('Error 1600: Unknown RDF_TYPE',/'Please ',  &
305              'correct the mfix.dat file.')
306     
307     ! If the default (LEBOWITZ) is not set for a monodisperse case, then
308     ! flag the error and exit. Otherwise, change it to CARNAHAN-STARLING.
309           IF(MMAX == 1) THEN
310              IF(RDF_TYPE_ENUM /= LEBOWITZ) THEN
311                 WRITE(ERR_MSG, 1601) trim(adjustl(RDF_TYPE))
312                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
313     
314      1601 FORMAT('Error 1601: The RDF_TYPE should NOT be specified when ',&
315              'MMAX = 1',/'because Carnahan-Starling is the only available',&
316              ' radial distribution',/'function for monodisperse systems. ',&
317              'Please correct the mfix.dat file.')
318     
319              ELSE
320                 RDF_TYPE_ENUM = CARNAHAN_STARLING
321              ENDIF
322           ENDIF
323     
324      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
325                 'correct the mfix.dat file.')
326      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
327              'Please correct the mfix.dat file.')
328      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of ',&
329              'range.', /,'Please correct the mfix.dat file.')
330     
331     
332           CALL FINL_ERR_MSG
333     
334     
335           RETURN
336           END SUBROUTINE CHECK_SOLIDS_CONTINUUM
337     
338     
339     
340     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
341     !                                                                      !
342     !  Subroutine: CHECK_KT_TYPE                                           !
343     !  Purpose: Check kinetic theory input specifications. These checks    !
344     !  are almost all related to the KT_TYPE keyword.                      !
345     !  Notes: To enter this routine granular_energy must be true           !
346     !                                                                      !
347     !  Author: J.Musser                                   Date: 04-FEB-14  !
348     !                                                                      !
349     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
350           SUBROUTINE CHECK_KT_TYPE
351     
352     
353     ! Global Variables:
354     !---------------------------------------------------------------------//
355           USE constant
356           USE run
357           USE physprop
358     
359     ! Global Parameters:
360     !---------------------------------------------------------------------//
361           USE param1, only: half, one, undefined
362     
363     ! Global Module procedures:
364     !---------------------------------------------------------------------//
365           use error_manager
366     
367           IMPLICIT NONE
368     
369     ! Local Variables:
370     !---------------------------------------------------------------------//
371     ! loop counters
372           INTEGER :: I, J
373     
374     !......................................................................!
375     
376     
377     ! Initialize the error manager.
378           CALL INIT_ERR_MSG("CHECK_KT_TYPE")
379     
380     ! These are some checks to satisfy legacy input:
381           IF (AHMADI .AND. SIMONIN) THEN
382              WRITE(ERR_MSG, 9001)
383              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
384           ELSEIF(AHMADI) THEN
385              IF(KT_TYPE(1:6) /= 'AHMADI' .AND.                        &
386                 KT_TYPE(1:8) /= 'LUN_1984')THEN
387                 WRITE(ERR_MSG,9002)trim(KT_TYPE)
388                 CALL FLUSH_ERR_MSG(ABORT = .TRUE.)
389              ELSE
390                 KT_TYPE='AHMADI'
391              ENDIF
392           ELSEIF(SIMONIN) THEN
393              IF(KT_TYPE(1:7) /= 'SIMONIN' .AND.                       &
394                 KT_TYPE(1:8) /= 'LUN_1984')THEN
395                 WRITE(ERR_MSG,9003)trim(KT_TYPE)
396                 CALL FLUSH_ERR_MSG(ABORT = .TRUE.)
397              ELSE
398                 KT_TYPE='SIMONIN'
399              ENDIF
400           ENDIF
401      9001 FORMAT('Error 9001: Cannot specify AHMADI and SIMONIN together.',&
402              /'Please correct the mfix.dat file.')
403      9002 FORMAT('Error 9002: Cannot specify AHMADI and KT_TYPE = ',A,'.', &
404              /'Please correct the mfix.dat file.')
405      9003 FORMAT('Error 9003: Cannot specify SIMONIN and KT_TYPE = ',A,'.',&
406              /'Please correct the mfix.dat file.')
407     
408     
409     
410     ! Check for valid options for kinetic theory models (KT_TYPE)
411           SELECT CASE(trim(adjustl(KT_TYPE)))
412     
413     !``````````````````````````````````````````````````````````````````````
414           CASE ('IA_NONEP')
415              KT_TYPE_ENUM = IA_2005
416              IF (C_E == UNDEFINED) THEN
417                 WRITE(ERR_MSG,1003)
418                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
419              ENDIF
420     
421     
422     !``````````````````````````````````````````````````````````````````````
423           CASE ('GD_99')
424              KT_TYPE_ENUM = GD_1999
425              IF (C_E == UNDEFINED) THEN
426                 WRITE(ERR_MSG,1003)
427                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
428              ELSEIF(SMAX > 1) THEN
429                 WRITE(ERR_MSG,1002) TRIM(KT_TYPE)
430                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
431              ENDIF
432     
433     
434     !``````````````````````````````````````````````````````````````````````
435           CASE ('GTSH')
436              KT_TYPE_ENUM = GTSH_2012
437              IF (C_E == UNDEFINED) THEN
438                 WRITE(ERR_MSG,1002)
439                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
440              ELSEIF(SMAX > 1) THEN
441                 WRITE(ERR_MSG,1002) TRIM(KT_TYPE)
442                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
443              ENDIF
444     
445     
446     !``````````````````````````````````````````````````````````````````````
447           CASE ('GHD')
448              KT_TYPE_ENUM = GHD_2007
449     ! This variable is only used for GHD at this point...
450     ! Define restitution coefficient matrix
451              DO I = 1, SMAX
452                 DO J = 1, SMAX
453                    IF(r_p(I,J) == UNDEFINED) THEN
454                       IF(C_E == UNDEFINED) THEN
455                          WRITE(ERR_MSG,1003)
456                          CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
457                       ELSE
458                          r_p(I,J) = C_e
459                       ENDIF
460                    ENDIF
461     ! just need to define r_p(1,2) and r_p(2,1) will be set.
462                    r_p(J,I) = r_p(I,J)
463                 ENDDO
464              ENDDO
465     
466              IF(DRAG_TYPE_ENUM /= WEN_YU .AND. DRAG_TYPE_ENUM /= HYS) THEN
467                 WRITE(ERR_MSG, 1030)
468                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
469              ELSEIF(ADDED_MASS) THEN
470                 WRITE(ERR_MSG,1031)
471                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
472              ELSEIF(SMAX > 2) THEN  ! not sure this is still true!
473                 WRITE(ERR_MSG, 1032)
474                 CALL FLUSH_ERR_MSG
475              ENDIF
476     
477     ! Automatically set SPECIES_EQ(MMAX) = .FALSE. to avoid potential
478     ! checks/loops over the mmax species type eqn which has no meaning
479              SPECIES_EQ(MMAX) = .FALSE.
480              NMAX_s(MMAX) = 1
481     
482     ! currently set to avoid an overflow error in write_res0
483     ! legacy variable?
484              NMAX(MMAX) = 1
485     
486      1030 FORMAT('Error 1030: KT_TYPE = "GHD" is restricted to DRAG_TYPE', &
487              'values of WEN_YU and HYS.',/'Please correct the mfix.dat ',  &
488              'file.')
489      1031 FORMAT('Error 1031: ADDED_MASS force cannot be applied with ',   &
490              'GHD theory that',/'solves for mixture equations.',/'Please', &
491              'correct the mifx.dat file.')
492      1032 FORMAT('Warning 1032: GHD theory may not be valid for more ',    &
493              'than two solids phases',/'it requires further development.')
494     
495     
496     !``````````````````````````````````````````````````````````````````````
497           CASE ('AHMADI')
498              KT_TYPE_ENUM = AHMADI_1995
499              AHMADI = .TRUE.
500              IF(.NOT.K_EPSILON) THEN
501                 WRITE(ERR_MSG,1040) 'K_EPSILON = .TRUE.'
502                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
503              ELSEIF (C_E == UNDEFINED) THEN
504                 WRITE(ERR_MSG,1003)
505                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
506              ELSEIF(C_F == UNDEFINED .AND. SMAX>=2) THEN
507                 WRITE(ERR_MSG, 1004)
508                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
509              ENDIF
510      1040 FORMAT('Error 1040: KT_TYPE = "AHMADI" requires ',A,/       &
511              'Please correct the mfix.dat file.')
512     
513     
514     !``````````````````````````````````````````````````````````````````````
515           CASE ('SIMONIN')
516              KT_TYPE_ENUM = SIMONIN_1996
517              SIMONIN = .TRUE.
518              IF(.NOT.K_EPSILON) THEN
519                 WRITE(ERR_MSG,1050) 'K_EPSILON = .TRUE.'
520                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
521              ELSEIF (C_E == UNDEFINED) THEN
522                 WRITE(ERR_MSG,1003)
523                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
524              ELSEIF(C_F == UNDEFINED .AND. SMAX>=2) THEN
525                 WRITE(ERR_MSG, 1004)
526                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
527              ENDIF
528      1050 FORMAT('Error 1050: KT_TYPE = "SIMONIN" requires ',A,/      &
529              'Please correct the mfix.dat file.')
530     
531     
532     ! Lun is the default implementation.
533     !``````````````````````````````````````````````````````````````````````
534           CASE ('LUN_1984')
535              KT_TYPE_ENUM = LUN_1984
536     ! this version of the restitution coefficient is needed by most KT_TYPE
537     ! models. it is also needed in default solids-solids drag model
538              IF (C_E == UNDEFINED) THEN
539                 WRITE(ERR_MSG,1003)
540                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
541              ELSEIF(C_F == UNDEFINED .AND. SMAX>=2) THEN
542                 WRITE(ERR_MSG, 1004)
543                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
544              ENDIF
545     
546     
547           CASE DEFAULT
548              WRITE(ERR_MSG,1001) trim(adjustl(KT_TYPE))
549              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
550      1001 FORMAT('Error 1001: Invalid or unknown KT_TYPE: ',A,/            &
551              'Please correct the mfix.dat file.')
552     
553           END SELECT
554     
555     ! eventually this should be made specific to lun/ahmadi/simonin
556     ! but because calc_gw_hw_cw in calc_u_friction is not consistent
557     ! it currently must be defined for all kt_types whenever friction
558     ! is invoked...
559           ETA = (ONE + C_E)*HALF
560     
561     
562      1002 FORMAT('Error 1002: KT_TYPE = ',A,' is for monodisperse',&
563              ' solids',/'(MMAX = 1). Please correct the mfix.dat file.')
564     
565      1003 FORMAT('Error 1003: Coefficient of restitution (C_E) not ',      &
566              'specified.',/'Please correct the mfix.dat file.')
567     
568      1004 FORMAT('Error 1004: Coefficient of friction (C_F) not ',         &
569              'specified.',/'Please correct the mfix.dat file.')
570     
571     
572           RETURN
573           END SUBROUTINE CHECK_KT_TYPE
574