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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                         C
3     !     Module name: DES_INIT_NAMELIST                                      C
4     !     Purpose: DES - initialize the des-namelist                          C
5     !                                                                         C
6     !     Reviewer: Rahul Garg                               Date: 01-Aug-07  C
7     !     Comments: Added some interpolation based inputs                     C
8     !                                                                         C
9     !  Keyword Documentation Format:                                          C
10     !<keyword category="category name" required="true/false"                  C
11     !                                    legacy="true/false">                 C
12     !  <description></description>                                            C
13     !  <arg index="" id="" max="" min=""/>                                    C
14     !  <dependent keyword="" value="DEFINED"/>                                C
15     !  <conflict keyword="" value="DEFINED"/>                                 C
16     !  <valid value="" note="" alias=""/>                                     C
17     !  <range min="" max="" />                                                C
18     !  MFIX_KEYWORD=INIT_VALUE                                                C
19     !</keyword>                                                               C
20     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
21     
22           SUBROUTINE DES_INIT_NAMELIST
23     
24           USE param1
25           USE discretelement
26           USE mfix_pic
27           USE des_bc
28           USE des_thermo
29           USE des_rxns
30           USE pic_bc
31           USE particle_filter
32     
33           IMPLICIT NONE
34     !-----------------------------------------------
35     ! Local variables
36     !-----------------------------------------------
37     
38     !-----------------------------------------------
39     
40           INCLUDE 'desnamelist.inc'
41     
42     
43     
44     !#####################################################################!
45     !                             Run Control                             !
46     !#####################################################################!
47     
48     
49     
50     
51     !#####################################################################!
52     !                           Physical Parameters                       !
53     !#####################################################################!
54     
55     
56     
57     !#####################################################################!
58     !                          Numerical Parameters                       !
59     !#####################################################################!
60     
61     
62     
63     !#####################################################################!
64     !                          Output Control                             !
65     !#####################################################################!
66     
67     !<keyword category="Output Control" required="false"
68     !  dem="true" pic="true">
69     !  <description>
70     !    Reports mass based on Lagrangian particles and continuum
71     !    representation. Useful to ensure mass conservation between
72     !    Lagrangian and continuum representations. Recommended use for
73     !    debugging purposes.
74     !  </description>
75     !  <dependent keyword="DES_INTERP_MEAN_FIELDS" value=".TRUE."/>
76           DES_REPORT_MASS_INTERP = .FALSE.
77     !</keyword>
78     
79     !<keyword category="Output Control" required="false"
80     !  dem="true" pic="true">
81     !  <description>
82     !    Allows writing of discrete particle data to output files. Relevant
83     !    to both granular and coupled simulations.
84     !  </description>
85           PRINT_DES_DATA = .FALSE.
86     !</keyword>
87     
88     !<keyword category="Output Control" required="false"
89     !  dem="true" pic="true">
90     !  <description>
91     !    The frequency at which particle data is written. This only applies
92     !    to pure granular simulations. For coupled simulation, the output
93     !    frequency is controlled by SPX_DT(1).
94     !  </description>
95     !  <dependent keyword="PRINT_DES_DATA" value=".True."/>
96     !  <dependent keyword="DES_CONTINUUM_COUPLED" value=".False."/>
97     !  <conflict keyword="DES_CONTINUUM_COUPLED" value=".True."/>
98     !  <conflict keyword="MPPIC" value=".True."/>
99           DES_SPX_DT = LARGE_NUMBER
100     !</keyword>
101     
102     !<keyword category="Output Control" required="false"
103     !  dem="true" pic="true">
104     !  <description>
105     !    The frequency at which _DES.RES file is written. This only applies
106     !    to pure granular simulations as the restart frequency is governed
107     !    by RES_DT for coupled simulations.
108     !  </description>
109     !  <dependent keyword="DES_CONTINUUM_COUPLED" value=".False."/>
110     !  <conflict keyword="DES_CONTINUUM_COUPLED" value=".True."/>
111     !  <conflict keyword="MPPIC" value=".True."/>
112           DES_RES_DT = LARGE_NUMBER
113     !</keyword>
114     
115     !<keyword category="Output Control" required="false"
116     !   dem="true" pic="true">
117     !  <description> The output file format for DES data.</description>
118     !  <valid value="PARAVIEW" note="ParaView formatted files (.vtp)"/>
119     !  <valid value="TECPLOT" note="Tecplot formatted files (.dat)"/>
120           DES_OUTPUT_TYPE = "PARAVIEW"
121     !</keyword>
122     
123     !<keyword category="Output Control" required="false" 
124     !  dem="true" pic="true">
125     !  <description>
126     !    Runtime flag to generate debugging information. Additional data for
127     !    FOCUS_PARTICLE is saved.
128     !  </description>
129           DEBUG_DES = .FALSE.
130     !</keyword>
131     
132     !<keyword category="Output Control" required="false" dem="true" pic="true">
133     !  <description>
134     !    Specify particle number for particle level debugging details.
135     !  </description>
136     !  <dependent keyword="DEBUG_DES" value=".TRUE."/>
137           FOCUS_PARTICLE = 0
138     !</keyword>
139     
140     !<keyword category="Output Control" required="false" pic="true">
141     !  <description>
142     !    Flag to print processor level parcel seeding statistics for inflow
143     !    BC with PIC model.
144     !  </description>
145     !  <dependent keyword="MPPIC" value=".TRUE."/>
146           PIC_REPORT_SEEDING_STATS = .false.
147     !</keyword>
148     
149     !<keyword category="Output Control" required="false" pic="true">
150     !  <description>
151     !     Flag to print processor level parcel deletion statistics for
152     !     outflow BC with PIC model. Not recommended for production runs.
153     !  </description>
154     !  <dependent keyword="MPPIC" value=".TRUE."/>
155           PIC_REPORT_DELETION_STATS = .false.
156     !</keyword>
157     
158     
159     
160     
161     !#####################################################################!
162     ! DEM/PIC COMMON:      Discrete Element Simulation                    !
163     !#####################################################################!
164     
165     
166     !<keyword category="Discrete Element Simulation" required="false"
167     !  dem="true" pic="true">
168     !  <description>
169     !    Number of particles to be read in from the particle_input.dat file.
170     !    This value is overwritten when using automatic particle generation.
171     !    A simulation with a mass inflow BC can start without solids by
172     !    setting PARTICLES = 0.
173     !  </description>
174     !  <range min="0" max="+Inf" />
175           PARTICLES = UNDEFINED_I
176     !</keyword>
177     
178     !<keyword category="Discrete Element Simulation" required="false"
179     !  dem="true" pic="true">
180     !  <description>
181     !    Automatically generate the initial particle position and velocity
182     !    data based on the parameters specified for each initial condition
183     !    (IC) region.
184     !  </description>
185     !  <valid value=".TRUE." note="Generate particle configuration based
186     !    on the initial condition parameters. Data provided in the
187     !    particle_input.dat file, if present, is ignored. "/>
188     !  <valid value=".FALSE." note="Particle position and velocity data are
189     !    provided in the particle_input.dat file. A runtime error occurs if
190     !    this file is not provided."/>
191           GENER_PART_CONFIG = .FALSE.
192     !</keyword>
193     
194     !<keyword category="Discrete Element Simulation" required="false"
195     !  dem="true" pic="true">
196     !  <description>
197     !    To switch between pure granular or coupled simulations of carried
198     !    and dispersed phase flows.
199     !  </description>
200     !  <valid value=".true." note="Performs coupled simulations. "/>
201           DES_CONTINUUM_COUPLED = .FALSE.
202     !</keyword>
203     
204     !<keyword category="Discrete Element Simulation" required="false"
205     !  dem="true" pic="true">
206     !  <description>Run one-way coupled simulations. The fluid does not
207     ! see the particles in terms of drag force. The effect of particle volume
208     ! is still felt by the fluid through non-unity voidage values.
209     ! </description>
210           DES_ONEWAY_COUPLED = .FALSE.
211     !</keyword>
212     
213     !<keyword category="Discrete Element Simulation" required="false" dem="true">
214     !  <description>
215     !    Time stepping scheme.
216     !  </description>
217     !  <valid value="EULER"
218     !    note="First-Order Euler Scheme."/>
219     !  <valid value="ADAMS BASHFORTH"
220     !    note="Second order ADAMS BASHFORTH scheme (DEM only)"/>
221           DES_INTG_METHOD = 'EULER'
222     !</keyword>
223     
224     !<keyword category="Discrete Element Simulation" required="false" dem="true">
225     !  <description>
226     !    Defines the size of the particle-based user variable:
227     !    DES_USR_VAR(SIZE, PARTICLES). Information in this array follows
228     !    the particle throughout a simulation.
229     !  </description>
230           DES_USR_VAR_SIZE = 0
231     !</keyword>
232     
233     !<keyword category="Discrete Element Simulation" required="false"
234     !  dem="true" pic="true">
235     !  <description>
236     !    Number of des grid cells in the I-direction. If left undefined,
237     !    then it is set by MFIX such that its size equals three times the
238     !    maximum particle diameter with a minimum of 1 cell.
239     !  </description>
240           DESGRIDSEARCH_IMAX = UNDEFINED_I
241     !</keyword>
242     
243     !<keyword category="Discrete Element Simulation" required="false"
244     !  dem="true" pic="true">
245     !  <description>
246     !    Number of des grid cells in the J-direction. If left undefined,
247     !    then it is set by MFIX such that its size equals three times
248     !    the maximum particle diameter with a minimum of 1 cell.
249     !  </description>
250           DESGRIDSEARCH_JMAX = UNDEFINED_I
251     !</keyword>
252     
253     !<keyword category="Discrete Element Simulation" required="false"
254     !  dem="true" pic="true">
255     !  <description>
256     !    Number of des grid cells in the K-direction. If left undefined,
257     !    then it is set by MFIX such that its size equals three times
258     !    the maximum particle diameter with a minimum of 1 cell.
259     !  </description>
260           DESGRIDSEARCH_KMAX = UNDEFINED_I
261     !</keyword>
262     
263     !<keyword category="Discrete Element Simulation" required="false"
264     !  dem="true" pic="true">
265     !  <description>
266     !    Specify the scheme used to map data to/from a particle's position
267     !    and the Eulerian grid. This keyword is required when
268     !    DES_INTERP_MEAN_FIELDS and/or DES_INTERP_ON are specified. A 
269     !    graphical representation of the schemes is shown below.
270     !  </description>
271     !  <valid value="NONE" note="Do not use interpolation."/>
272     !  <valid value="GARG_2012" note="Interpolate to/from a particle's
273     !    position using the corners (nodes) of the fluid cells. This was
274     !    the default behavior prior to the 2015-1 Release. 
275     !    See Garg et al. (2012) Documentation of the open-souce MFIX-DEM
276     !    software for gas-solids flows."/>
277     !  <valid value="SQUARE_DPVM" note="Divided Particle Volume Method:
278     !    Information is interpolated to/from a particles position using
279     !    a square filter of size DES_INTERP_WIDTH. This scheme is not
280     !    available to MFIX-PIC simulations."/>
281           DES_INTERP_SCHEME = 'NONE'
282     !</keyword>
283     
284     !<keyword category="Discrete Element Simulation" required="false" dem="true">
285     !  <description>
286     !    The length used in interpolating data to/from a particle's position
287     !    and the Eulerian grid. The interpolation width is only applicable
288     !    to the DPVM_SQUARE and DPVM_GAUSS interpolation schemes as the 
289     !    GARG_2012 scheme's interpolation width is determined by the 
290     !    Eulerian grid dimensions. 
291     !    o The interpolation half-width cannot exceed the minimum cell
292     !      dimension because interpolation is restricted to the 27-cell
293     !      neighborhood surrounding a particle (9-cell neighborhood in 2D).
294     !    o It is recommend that the DES_INTERP_WIDTH be set equal to the
295     !      maximum particle diameter when using STL defined boundaries.
296     !      Field data can be smooth by specifying DES_DIFFUSE_WIDTH.
297     !  </description>
298           DES_INTERP_WIDTH = UNDEFINED
299     !</keyword>
300     
301     
302     !<keyword category="Discrete Element Simulation" required="false"
303     !  dem="true" pic="true">
304     !  <description>
305     !    Enables/Disables interpolation of field quantities to a particle's
306     !    position. This is used in calculating gas-particle interactions,
307     !    such as the drag force.
308     !  </description>
309     !  <valid value=".FALSE." note="Use fluid values from the cell containing
310     !    the particle's center."/>
311     !  <valid value=".TRUE." note="Interpolate fluid values from the 27-cell
312     !    neighborhood to a particle's position."/>
313           DES_INTERP_ON = .FALSE.
314     !</keyword>
315     
316     !<keyword category="Discrete Element Simulation" required="false"
317     !  dem="true" pic="true">
318     !  <description>
319     !    Enables/Disables interpolation of particle data (e.g., solids
320     !    volume and drag force) from a particle's position to the
321     !    Eulerian grid.            
322     !  </description>
323     !  <valid value=".FALSE." note="Assign particle data to the fluid 
324     !    grid cell containing the particle's center."/>
325     !  <valid value=".TRUE." note="Interpolate particle data from the
326     !    particle's position to the 27-cell neighborhood surrounding 
327     !    the particle."/>
328           DES_INTERP_MEAN_FIELDS = .FALSE.
329     !</keyword>
330     
331     
332     !<keyword category="Discrete Element Simulation" required="false" dem="true">
333     !  <description>
334     !    The length scale used to smooth dispersed phase averaged fields by
335     !    solving a diffusion equation. This approach is typically used when
336     !    particle sizes near or exceed the size of the Eulerian grid cell sizes.
337     !    o  Mean filed diffusion is disabled if DES_DIFFUSE_WIDTH is not specified. 
338     !    o  Mean filed diffusion cannot be used with the GARG_2012
339     !       interpolation scheme.
340     !    o  It is recommend that mean field diffusion be used in conjunction
341     !       with DES_EXPLICTLY_COUPLED to minimize the computational cost of
342     !       diffusing field data.
343     !    o  The DES diffusion equation is listed as equation type 10 in the
344     !       Numerical Parameters section.
345     !  </description>
346           DES_DIFFUSE_WIDTH = UNDEFINED
347     !</keyword>
348     
349     
350     !<keyword category="Discrete Element Simulation" required="false" dem="true">
351     !  <description>
352     !    Enable/Disable explicit coupling of DEM solids and the fluid. This
353     !    algorithm is presently limited to hydrodynamic simulations. 
354     !  </description>
355     !  <valid value=".FALSE." note="The fluid and particles calculate 
356     !    interphase forces at their respective time scales. The fluid phase
357     !    calculates the interphase coupling forces once per fluid time step.
358     !    Similarly, DEM particles calculate the interface coupling forces at
359     !    each solids time-step. The DEM must also bin particles to the fluid
360     !    grid and recalculate the fluid volume fraction every time-step."/>
361     !  <valid value=".TRUE." note="Interphase forces are calculated during 
362     !    the fluid time step and stored for each particle. The interphase 
363     !    forces are then distributed among the solids time-steps. This 
364     !    approach can substantially reduce the computational overhead for
365     !    coupled simulations."/>
366           DES_EXPLICITLY_COUPLED = .FALSE.
367     !</keyword>
368     
369     
370     !#####################################################################!
371     ! DEM ONLY:            Discrete Element Model                         !
372     !#####################################################################!
373     
374     !<keyword category="Discrete Element Model" required="false">
375     !  <description>
376     !    The number of iterations of a pure granular simulation to let
377     !    the initial particle configuration settle before a coupled
378     !    gas-solid is started.
379     !  </description>
380     !  <range min="0" max="+Inf" />
381           NFACTOR = 10
382     !</keyword>
383     
384     !<keyword category="Discrete Element Model" required="false">
385     !  <description>
386     !    Maximum number of steps through a DEM loop before a neighbor
387     !    search will be performed. The search may be called earlier
388     !    based on other logic.
389     !  </description>
390     !  <range min="0.0" max="+Inf" />
391           NEIGHBOR_SEARCH_N = 25
392     !</keyword>
393     
394     !<keyword category="Discrete Element Model" required="false">
395     !  <description>
396     !    Flag to set the neighbor search algorithm.
397     !  </description>
398     !  <valid value="1" note="N-Square search algorithm (most expensive)"/>
399     !  <valid value="4" note="Grid-Based Neighbor Search (Recommended)"/>
400           DES_NEIGHBOR_SEARCH = 4
401     !</keyword>
402     
403     
404     !<keyword category="Discrete Element Model" required="false">
405     !  <description>
406     !    Ratio of the distance (imaginary sphere radius) to particle radius
407     !    that is allowed before a neighbor search is performed. This works
408     !    in conjunction with the logic imposed by NEIGHBOR_SEARCH_N in
409     !    deciding calls to the neighbor search algorithm.
410     !  </description>
411           NEIGHBOR_SEARCH_RAD_RATIO = 1.0D0
412     !</keyword>
413     
414     
415     !<keyword category="Discrete Element Model" required="false">
416     !  <description>
417     !    Effectively increase the radius of a particle (multiple of the sum
418     !    of particle radii) during the building of particle neighbor list.
419     !  </description>
420           FACTOR_RLM = 1.2
421     !</keyword>
422     
423     !<keyword category="Discrete Element Model" required="false">
424     !  <description>
425     !    Flag to use van der Hoef et al. (2006) model for adjusting the
426     !    rotation of the contact plane. See the MFIX-DEM documentation.
427     !  </description>
428           USE_VDH_DEM_MODEL = .FALSE.
429     !</keyword>
430     
431     
432     !<keyword category="Discrete Element Model" required="false">
433     !  <description>
434     !    Collision model for the soft-sphere approach used in DEM model.
435     !    All models require specifying the following parameters: DES_EN_INPUT,
436     !    DES_EN_WALL_INPUT, MEW, and MEW_W.
437     !  </description>
438     !  <valid value="LSD" note="The linear spring-dashpot model.
439     !    Requires: KN, KN_W, KT_FAC, KT_W_FAC, DES_ETAT_FAC, DES_ETAT_W_FAC."/>
440     !  <valid value="HERTZIAN" note="The Hertzian model.
441     !    Requires: DES_ET_INPUT, DES_ET_WALL_INPUT, E_YOUNG, EW_YOUNG
442     !    V_POISSON, VW_POISSON."/>
443           DES_COLL_MODEL = 'LSD'
444     !</keyword>
445     
446     
447     !<keyword category="Discrete Element Model" required="false" dem="true">
448     !  <description>
449     !    Normal spring constant [dyne/cm in CGS] for inter-particle collisions.
450     !    Required when using the linear spring-dashpot collision model.
451     !  </description>
452           KN = UNDEFINED
453     !</keyword>
454     
455     
456     !<keyword category="Discrete Element Model" required="false" dem="true">
457     !  <description>
458     !    Ratio of the tangential spring constant to normal spring constant
459     !    for inter-particle collisions. Use it to specify the tangential
460     !    spring constant for particle-particle collisions as KT_FAC*KN.
461     !    Required when using the linear spring-dashpot collision model.
462     !  </description>
463     !  <dependent keyword="DES_COLL_MODEL" value="LSD"/>
464     !  <range min="0.0" max="1.0" />
465           KT_FAC = 2.d0/7.d0
466     !</keyword>
467     
468     
469     !<keyword category="Discrete Element Model" required="false" dem=.true.>
470     !  <description>
471     !    Normal spring constant [dyne/cm in CGS] for particle-wall collisions.
472     !    Required when using the linear spring-dashpot collision model.
473     !  </description>
474           KN_W = UNDEFINED
475     !</keyword>
476     
477     
478     !<keyword category="Discrete Element Model" required="false" dem="true">
479     !  <description>
480     !    Ratio of the tangential spring constant to normal spring constant
481     !    for particle-wall collisions. Use it to specify the tangential
482     !    spring constant for particle-wall collisions as KT_W_FAC*KN_W.
483     !    Required when using the linear spring-dashpot collision model.
484     !  </description>
485     !  <dependent keyword="DES_COLL_MODEL" value="LSD"/>
486     !  <range min="0.0" max="1.0" />
487           KT_W_FAC = 2.d0/7.d0
488     !</keyword>
489     
490     !<keyword category="Discrete Element Model" required="false" dem="true"
491     !  <description>
492     !    Inter-particle Coulomb friction coefficient.
493     !  </description>
494     ! <range min="0.0" max="1.0" />
495           MEW = UNDEFINED
496     !</keyword>
497     
498     !<keyword category="Discrete Element Model" required="false">
499     !  <description>
500     !    Particle-wall Coulomb friction coefficient.
501     !  </description>
502     ! <range min="0.0" max="1.0" />
503           MEW_W = UNDEFINED
504     !</keyword>
505     
506     
507     !<keyword category="Discrete Element Model" required="false" dem="true">
508     !  <description>
509     !    The normal restitution coefficient for inter-particle collisions
510     !    used to determine the inter-particle normal damping factor.
511     !
512     !    Values should be defined for a single dimensional array. For
513     !    example, a simulation with three solids phases (MMAX=3) needs
514     !    six values: en11, en12, en13; en22 en 23; en33.
515     !  </description>
516     !  <range min="0.0" max="1.0" />
517           DES_EN_INPUT(:) = UNDEFINED
518     !</keyword>
519     
520     
521     !<keyword category="Discrete Element Model" required="false" dem="true">
522     !  <description>
523     !    The normal restitution coefficient for particle-wall collisions
524     !    used to determine the particle-wall normal damping factor.
525     !
526     !    Values should be defined in a single dimensional array. For
527     !    example, a simulation with three solids phases (MMAX=3) needs
528     !    three values: enw1, enw2, enw3.
529     !  </description>
530     !  <range min="0.0" max="1.0" />
531           DES_EN_WALL_INPUT(:) = UNDEFINED
532     !</keyword>
533     
534     
535     !<keyword category="Discrete Element Model" required="false" dem="true">
536     !  <description>
537     !    Tangential restitution coefficient for inter-particle collisions.
538     !    Values are defined in a one dimensional array. This is required
539     !    input when using the Hertzian collision model.
540     ! </description>
541     ! <dependent keyword="DES_COLL_MODEL" value="HERTZIAN"/>
542     ! <range min="0.0" max="1.0" />
543           DES_ET_INPUT(:) = UNDEFINED
544     !</keyword>
545     
546     
547     !<keyword category="Discrete Element Model" required="false" dem="true">
548     !  <description>
549     !    Tangential restitution coefficient for particle wall collisions.
550     !    Values are defined in a one dimensional array. This is required
551     !    input when using the Hertzian collision model.
552     !  </description>
553     ! <range min="0.0" max="1.0" />
554     ! <dependent keyword="DES_COLL_MODEL" value="HERTZIAN"/>
555           DES_ET_WALL_INPUT(:) = UNDEFINED
556     !</keyword>
557     
558     
559     !<keyword category="Discrete Element Model" required="false" dem="true">
560     !  <description>
561     !    Ratio of the tangential damping factor to the normal damping factor
562     !    for inter-particle collisions.  Required for the linear spring-
563     !    dashpot model collision model
564     !  </description>
565     !  <dependent keyword="DES_COLL_MODEL" value="LSD"/>
566     !  <range min="0.0" max="1.0" />
567     !  <valid value="UNDEFINED" note="For LSD model, if left undefined, MFIX
568     !   reverts to default value of 0.5" />
569           DES_ETAT_FAC = UNDEFINED
570     !</keyword>
571     
572     
573     !<keyword category="Discrete Element Model" required="false">
574     ! <description>
575     !    Ratio of the tangential damping factor to the normal damping
576     !    factor for particle-wall collisions. Required for the linear
577     !    spring-dashpot model for soft-spring collision modelling under
578     !    DEM. For the Hertzian model, the tangential damping coefficients
579     !    have to be explicitly specified and specification of this
580     !    variable is not required.
581     ! </description>
582     ! <dependent keyword="DES_COLL_MODEL" value="LSD"/>
583     ! <range min="0.0" max="1.0" />
584     ! <valid value="UNDEFINED" note="For LSD model, if left undefined, MFIX
585     ! will revert to default value of 0.5" />
586           DES_ETAT_W_FAC = UNDEFINED
587     !</keyword>
588     
589     
590     !<keyword category="Discrete Element Model" required="false">
591     !  <description>
592     !    Youngs modulus for the wall [barye in CGS]. Required when using the
593     !    Hertzian spring-dashpot model.
594     !  </description>
595     !  <dependent keyword="DES_COLL_MODEL" value="HERTZIAN"/>
596           EW_YOUNG = UNDEFINED
597     !</keyword>
598     
599     !<keyword category="Discrete Element Model" required="false">
600     !  <description>
601     !    Poisson ratio for the wall. Required when using the Hertzian
602     !    spring-dashpot model.
603     !  </description>
604     !  <dependent keyword="DES_COLL_MODEL" value="HERTZIAN"/>
605           VW_POISSON = UNDEFINED
606     !</keyword>
607     
608     
609     !<keyword category="Discrete Element Model" required="false">
610     !  <description>
611     !    Youngs modulus for the particle [barye in CGS]. Required when using
612     !    the Hertzian spring-dashpot model.
613     !  </description>
614     !  <arg index="1" id="Phase" min="1" max="DES_MMAX"/>
615     !  <dependent keyword="DES_COLL_MODEL" value="HERTZIAN"/>
616           E_YOUNG(:DIM_M) = UNDEFINED
617     !</keyword>
618     
619     
620     !<keyword category="Discrete Element Model" required="false">
621     !  <description>
622     !    Poissons ratio for the particle. Required when using the Hertzian
623     !    spring-dashpot model.
624     !  </description>
625     !  <arg index="1" id="Phase" min="1" max="DES_MMAX"/>
626     !  <dependent keyword="DES_COLL_MODEL" value="HERTZIAN"/>
627           V_POISSON(:DIM_M) = UNDEFINED
628     !</keyword>
629     
630     
631     !<keyword category="Discrete Element Model" required="false">
632     !  <description>
633     !    Flag to enable/disable cohesion model.
634     !  </description>
635           USE_COHESION = .FALSE.
636     !</keyword>
637     
638     
639     !<keyword category="Discrete Element Model" required="false">
640     !  <description>
641     !    Flag to turn on the use Hamaker van der Waals forces.
642     !  </description>
643     !  <dependent keyword="USE_COHESION" value=".TRUE."/>
644           VAN_DER_WAALS = .FALSE.
645     !</keyword>
646     
647     
648     ! for cohesion: van der waals
649     !<keyword category="Discrete Element Model" required="false">
650     !  <description>
651     !    Hamaker constant used in particle-particle cohesive interactions.
652     !  </description>
653     !  <dependent keyword="USE_COHESION" value=".TRUE."/>
654           HAMAKER_CONSTANT = UNDEFINED
655     !</keyword>
656     
657     
658     !<keyword category="Discrete Element Model" required="false">
659     !  <description>
660     !    Hamaker constant used in particle-wall cohesive interactions.
661     !  </description>
662     !  <dependent keyword="USE_COHESION" value=".TRUE."/>
663           WALL_HAMAKER_CONSTANT = UNDEFINED
664     !</keyword>
665     
666     
667     !<keyword category="Discrete Element Model" required="false">
668     !  <description>
669     !    Maximum separation distance above which van der Waals forces are
670     !    not implemented.
671     !  </description>
672     !  <dependent keyword="USE_COHESION" value=".TRUE."/>
673           VDW_OUTER_CUTOFF = UNDEFINED
674     !</keyword>
675     
676     
677     !<keyword category="Discrete Element Model" required="false">
678     !  <description>
679     !    Minimum separation distance below which van der Waals forces are
680     !    calculated using a surface adhesion model.
681     !  </description>
682     !  <dependent keyword="USE_COHESION" value=".TRUE."/>
683           VDW_INNER_CUTOFF = UNDEFINED
684     !</keyword>
685     
686     
687     !<keyword category="Discrete Element Model" required="false">
688     !  <description>
689     !    Maximum separation distance above which van der Waals forces are
690     !    not implemented (particle-wall interactions).
691     !  </description>
692     !  <dependent keyword="USE_COHESION" value=".TRUE."/>
693           WALL_VDW_OUTER_CUTOFF = ZERO
694     !</keyword>
695     
696     
697     !<keyword category="Discrete Element Model" required="false">
698     !  <description>
699     !    Minimum separation distance below which van der Waals forces are
700     !    calculated using a surface adhesion model (particle-wall
701     !    interactions).
702     !  </description>
703     !  <dependent keyword="USE_COHESION" value=".TRUE."/>
704           WALL_VDW_INNER_CUTOFF = UNDEFINED
705     !</keyword>
706     
707     
708     !<keyword category="Discrete Element Model" required="false">
709     !  <description>
710     !    Mean radius of surface asperities that influence the cohesive force
711     !    following a model. See H. Rumpf, Particle Technology, Chapman & Hall,
712     !    London/New York, 1990.
713     !  </description>
714     !  <dependent keyword="USE_COHESION" value=".TRUE."/>
715           Asperities = ZERO
716     !</keyword>
717     
718     !<keyword category="Discrete Element Model" required="false">
719     !  <description>
720     !    Specify the Nusselt number correlation used for particle-gas
721     !    convection.
722     !  </description>
723     !  <valid value="RANZ_1952" note="Ranz, W.E. and Marshall, W.R. (1952).
724     !    Chemical Engineering Progress, 48: 141-146 and 173-180"/>
725           DES_CONV_CORR = 'RANZ_1952'
726     !</keyword>
727     
728     !<keyword category="Discrete Element Model" required="false">
729     !  <description>
730     !    Minimum separation distance between the surfaces of two contacting
731     !    particles.
732     !  </description>
733           DES_MIN_COND_DIST = UNDEFINED
734     !</keyword>
735     
736     !<keyword category="Discrete Element Model" required="false">
737     !  <description>
738     !    Fluid lens proportion constant used to calculate the radius of
739     !    the fluid lens that surrounds a particle. This parameter is used
740     !    in the particle-fluid-particle conduction model.
741     !  </description>
742           FLPC = 1.0d0/5.0d0
743     !</keyword>
744     
745     !<keyword category="Discrete Element Model" required="false">
746     !  <description>Emissivity of solids phase M.</description>
747     !  <arg index="1" id="Phase" min="1" max="DES_MMAX"/>
748           DES_Em(:DIM_M) = UNDEFINED
749     !</keyword>
750     
751     
752     
753     !#####################################################################!
754     !                          Particle In Cell                           !
755     !#####################################################################!
756     
757     
758     !<keyword category="Particle In Cell" required="false">
759     !  <description>
760     !    Turn on snider's version of frictional model.
761     !    Does not run very stably.
762     !  </description>
763           MPPIC_SOLID_STRESS_SNIDER = .false.
764     !</keyword>
765     
766     
767     !<keyword category="Particle In Cell" required="false">
768     !  <description>
769     !    First coefficient of restitution for the frictional stress model
770     !    in the MPPIC model. See the MPPIC documentation for more details.
771     !  </description>
772     !  <dependent keyword="MPPIC" value=".TRUE."/>
773           MPPIC_COEFF_EN1 = UNDEFINED
774     !</keyword>
775     
776     
777     !<keyword category="Particle In Cell" required="false">
778     !  <description>
779     !    Second coefficient of restitution for the frictional stress model
780     !    in the MPPIC model. See the MPPIC documentation for more details.
781     !</description>
782     !  <dependent keyword="MPPIC" value=".TRUE."/>
783           MPPIC_COEFF_EN2 = UNDEFINED
784     !</keyword>
785     
786     
787     !<keyword category="Particle In Cell" required="false">
788     !  <description>
789     !    Normal coefficient of restitution for parcel-wall collisions
790     !    in the MPPIC model.
791     !</description>
792     !  <dependent keyword="MPPIC" value=".TRUE."/>
793           MPPIC_COEFF_EN_WALL = UNDEFINED
794     !</keyword>
795     
796     
797     !<keyword category="Particle In Cell" required="false">
798     !  <description> Tangential coefficient of restitution for
799     ! parcel-wall collisions in the MPPIC model.
800     ! Currently not implemented in the code.
801     !</description>
802     !  <dependent keyword="MPPIC" value=".TRUE."/>
803           MPPIC_COEFF_ET_WALL = 1.0
804     !</keyword>
805     
806     
807     !<keyword category="Particle In Cell" required="false">
808     !  <description> Turn on the implicit treatment for interphase drag force.
809     ! Valid only for MPPIC model..
810     !</description>
811     !  <dependent keyword="MPPIC" value=".TRUE."/>
812           MPPIC_PDRAG_IMPLICIT = .false.
813     !</keyword>
814     
815     !<keyword category="Particle In Cell" required="false">
816     !  <description>
817     !     Variable to decide if special treatment is needed or not in the
818     !     direction of gravity in the frictional stress tensor. See the
819     !     MPPIC documentation for details.
820     !  </description>
821     !  <dependent keyword="MPPIC" value=".TRUE."/>
822           MPPIC_GRAV_TREATMENT = .true.
823     !</keyword>
824     
825     !<keyword category="Particle In Cell" required="false">
826     !  <description>
827     !    A run time flag to report minimum value and location of gas
828     !    voidage. This is useful only for debugging and is not
829     !    recommended for production runs.
830     !  </description>
831     !  <dependent keyword="MPPIC" value=".TRUE."/>
832           PIC_REPORT_MIN_EPG = .FALSE.
833     !</keyword>
834     
835     !<keyword category="Particle In Cell" required="false">
836     !  <description>
837     !    P_s term in the frictional stress model of Snider.
838     !  </description>
839     !  <dependent keyword="MPPIC" value=".TRUE."/>
840           PSFAC_FRIC_PIC = 100
841     !</keyword>
842     
843     !<keyword category="Particle In Cell" required="false">
844     !  <description>
845     !    Beta term in the frictional stress model of Snider.
846     !  </description>
847     !  <dependent keyword="MPPIC" value=".TRUE."/>
848           FRIC_EXP_PIC = 2.5
849     !</keyword>
850     
851     !<keyword category="Particle In Cell" required="false">
852     !  <description>
853     !    Non-singularity term (epsilon) in the frictional stress model of
854     !    Snider.
855     !  </description>
856     !  <dependent keyword="MPPIC" value=".TRUE."/>
857           FRIC_NON_SING_FAC = 1E-07
858     !</keyword>
859     
860     !<keyword category="Particle In Cell" required="false">
861     !  <description>CFL number used to decide maximum time
862     ! step size for parcels evolution equations.
863     ! Relevant to MPPIC model only.
864     !</description>
865     !  <dependent keyword="MPPIC" value=".TRUE."/>
866           CFL_PIC = 0.1
867     !</keyword>
868     
869     
870     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
871     !                            UNSUPPORTED KEYWORDS                      !
872     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
873     
874     ! Logical to force the inlet to operate with an ordered boundary
875     ! condition. This may be useful during long simulations or if the
876     ! inlet appears to be taking a long time to randomly place particles.
877           FORCE_ORD_BC = .FALSE.
878     
879     ! Lees-Edwards boundary condition to simulate homogeneous shear
880     ! problem with periodic boundary conditions. Not supported in this
881     ! version.
882           DES_LE_BC = .FALSE.
883     
884     ! Relative velocity needed for Lees-Edwards BC.
885     ! Not supported in this version.
886           DES_LE_REL_VEL = UNDEFINED
887     
888     ! Direction of shear for Lees-Edwards BC.
889     ! Not supported in this version. </description>
890           DES_LE_SHEAR_DIR = UNDEFINED_C
891     
892     ! des wall boundaries: wall velocities. I think they probably
893     ! defined for the Lees-Edwards BC's
894           DES_BC_Uw_s(:,:) = ZERO
895           DES_BC_Vw_s(:,:) = ZERO
896           DES_BC_Ww_s(:,:) = ZERO
897     
898     
899     ! These need to be inialized to 0, but they are not part of the namelist
900           VTP_FINDEX = 0
901           TECPLOT_FINDEX = 0
902     
903     ! not a well supported feature and not generic either. So removing
904     ! from namelists
905           DES_CALC_BEDHEIGHT = .FALSE.
906           RETURN
907           END SUBROUTINE DES_INIT_NAMELIST
908